From d934912349455b5b9771ff1ea55f985ed7b9f325 Mon Sep 17 00:00:00 2001 From: jchristopherson Date: Thu, 8 Dec 2022 07:44:24 -0600 Subject: [PATCH 01/65] Reconfigure build scripts --- CMakeLists.txt | 151 ++++-------------- cmake/helper.cmake | 75 +++++++++ configure/CMakeLists.txt | 23 +++ dependencies/BLAS/CMakeLists.txt | 7 + dependencies/CMakeLists.txt | 14 ++ dependencies/LAPACK/CMakeLists.txt | 27 ++++ dependencies/ferror/CMakeLists.txt | 43 +++++ src/CMakeLists.txt | 245 +++++++++++------------------ 8 files changed, 311 insertions(+), 274 deletions(-) create mode 100644 cmake/helper.cmake create mode 100644 configure/CMakeLists.txt create mode 100644 dependencies/BLAS/CMakeLists.txt create mode 100644 dependencies/CMakeLists.txt create mode 100644 dependencies/LAPACK/CMakeLists.txt create mode 100644 dependencies/ferror/CMakeLists.txt diff --git a/CMakeLists.txt b/CMakeLists.txt index 8fc21906..8d833402 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -1,128 +1,43 @@ # Master CMAKE Build Script -cmake_minimum_required(VERSION 3.7) -project(linalg C CXX Fortran) +cmake_minimum_required(VERSION 3.17) +project( + linalg + LANGUAGES Fortran C + VERSION 1.6.1 +) -# Define version information -set(linalg_VERSION_MAJOR 1) -set(linalg_VERSION_MINOR 6) -set(linalg_VERSION_PATCH 0) -set(linalg_VERSION ${linalg_VERSION_MAJOR}.${linalg_VERSION_MINOR}.${linalg_VERSION_PATCH}) +# Utilize the GNU installation structure +include(GNUInstallDirs) -# Set a default build type if none was specified -if(NOT CMAKE_BUILD_TYPE AND NOT CMAKE_CONFIGURATION_TYPES) - message(STATUS "Setting build type to 'Debug' as none was specified.") - set(CMAKE_BUILD_TYPE Debug CACHE STRING "Choose the type of build." FORCE) - # Set the possible values of build type for cmake-gui - set_property(CACHE CMAKE_BUILD_TYPE PROPERTY STRINGS "Debug" "Release") -endif() +# Get helper macros and functions +include("${PROJECT_SOURCE_DIR}/cmake/helper.cmake") -# By default, shared library -option(BUILD_SHARED_LIBS "Build shared libraries" OFF) +# Confgiure everything +add_subdirectory(configure) -# Get compiler info -get_filename_component (Fortran_COMPILER_NAME ${CMAKE_Fortran_COMPILER} NAME) - -# Export all symbols on Windows when building shared libraries -SET(CMAKE_WINDOWS_EXPORT_ALL_SYMBOLS TRUE) - -# Locate the module files -set(CMAKE_Fortran_MODULE_DIRECTORY ${PROJECT_SOURCE_DIR}/include) - -# Define output directories, if undefined -if (NOT CMAKE_LIBRARY_OUTPUT_DIRECTORY) - message(STATUS "LINALG output directories undefined. Using default directories.") - if (CMAKE_BUILD_TYPE MATCHES Debug) - # Debug Build - message(STATUS "LINALG: Debug Build") - if (BUILD_SHARED_LIBS) - message(STATUS "LINALG: Build shared library") - set(CMAKE_ARCHIVE_OUTPUT_DIRECTORY ${PROJECT_SOURCE_DIR}/bin/Debug) - set(CMAKE_LIBRARY_OUTPUT_DIRECTORY ${PROJECT_SOURCE_DIR}/bin/Debug) - set(CMAKE_RUNTIME_OUTPUT_DIRECTORY ${PROJECT_SOURCE_DIR}/bin/Debug) - else() - message(STATUS "LINALG: Build static library") - set(CMAKE_ARCHIVE_OUTPUT_DIRECTORY ${PROJECT_SOURCE_DIR}/lib/Debug) - set(CMAKE_LIBRARY_OUTPUT_DIRECTORY ${PROJECT_SOURCE_DIR}/lib/Debug) - set(CMAKE_RUNTIME_OUTPUT_DIRECTORY ${PROJECT_SOURCE_DIR}/lib/Debug) - endif () - elseif (CMAKE_BUILD_TYPE MATCHES Release) - # Release Build - message(STATUS "LINALG: Release Build") - if (BUILD_SHARED_LIBS) - message(STATUS "LINALG: Build shared library") - set(CMAKE_ARCHIVE_OUTPUT_DIRECTORY ${PROJECT_SOURCE_DIR}/bin/Release) - set(CMAKE_LIBRARY_OUTPUT_DIRECTORY ${PROJECT_SOURCE_DIR}/bin/Release) - set(CMAKE_RUNTIME_OUTPUT_DIRECTORY ${PROJECT_SOURCE_DIR}/bin/Release) - else() - message(STATUS "LINALG: Build static library") - set(CMAKE_ARCHIVE_OUTPUT_DIRECTORY ${PROJECT_SOURCE_DIR}/lib/Release) - set(CMAKE_LIBRARY_OUTPUT_DIRECTORY ${PROJECT_SOURCE_DIR}/lib/Release) - set(CMAKE_RUNTIME_OUTPUT_DIRECTORY ${PROJECT_SOURCE_DIR}/lib/Release) - endif () - else () - # Default Condition - if (BUILD_SHARED_LIBS) - message(STATUS "LINALG: Build shared library") - set(CMAKE_ARCHIVE_OUTPUT_DIRECTORY ${PROJECT_SOURCE_DIR}/bin/Debug) - set(CMAKE_LIBRARY_OUTPUT_DIRECTORY ${PROJECT_SOURCE_DIR}/bin/Debug) - set(CMAKE_RUNTIME_OUTPUT_DIRECTORY ${PROJECT_SOURCE_DIR}/bin/Debug) - else() - message(STATUS "LINALG: Build static library") - set(CMAKE_ARCHIVE_OUTPUT_DIRECTORY ${PROJECT_SOURCE_DIR}/lib/Debug) - set(CMAKE_LIBRARY_OUTPUT_DIRECTORY ${PROJECT_SOURCE_DIR}/lib/Debug) - set(CMAKE_RUNTIME_OUTPUT_DIRECTORY ${PROJECT_SOURCE_DIR}/lib/Debug) - endif () - endif () -endif() - -# FFLAGS depend on the compiler -if (Fortran_COMPILER_NAME MATCHES "gfortran.*") - # gfortran - set(CMAKE_Fortran_FLAGS_RELEASE "-funroll-all-loops -fno-f2c -O3 -Wl,--allow-multiple-definition") - set(CMAKE_Fortran_FLAGS_DEBUG "-fno-f2c -O0 -g -Wall -Wno-c-binding-type -Wl,--allow-multiple-definition") -elseif (Fortran_COMPILER_NAME MATCHES "ifort.*") - # ifort (untested) - set(CMAKE_Fortran_FLAGS_RELEASE "-f77rtl -O3") - set(CMAKE_Fortran_FLAGS_DEBUG "-f77rtl -O0 -g") -else (Fortran_COMPILER_NAME MATCHES "gfortran.*") - message ("CMAKE_Fortran_COMPILER full path: " ${CMAKE_Fortran_COMPILER}) - message ("Fortran compiler: " ${Fortran_COMPILER_NAME}) - message ("No optimized Fortran compiler flags are known, we just try -O2...") - set(CMAKE_Fortran_FLAGS_RELEASE "-O2 -Wl,--allow-multiple-definition") - set(CMAKE_Fortran_FLAGS_DEBUG "-O0 -g -Wall -Wl,--allow-multiple-definition") -endif() - -# What else to build -option(BUILD_LINALG_EXAMPLES "Build LINALG examples?" OFF) -option(BUILD_LINALG_TESTS "Build LINALG tests?" OFF) - -# Locate the dependencies +# Deal with the dependencies find_package(BLAS) find_package(LAPACK) -find_package(ferror 1.3.0) - -if (BLAS_FOUND) - message(STATUS "BLAS library found.") -endif() - -if (LAPACK_FOUND) - message(STATUS "LAPACK library found.") -endif() +find_package(ferror 1.4.0 QUIET) +add_subdirectory(dependencies) -if (ferror_FOUND) - message(STATUS "FERROR library found.") - set(ferror_LIBRARIES ferror) -endif() +# print_all_variables() -# Locate the files +# Source add_subdirectory(src) - -if (BUILD_LINALG_EXAMPLES) - message(STATUS "Building LINALG examples.") - add_subdirectory(examples) -endif() - -if (BUILD_LINALG_TESTS) - message(STATUS "Building LINALG tests.") - add_subdirectory(tests) -endif() +add_fortran_library( + ${PROJECT_NAME} + ${PROJECT_INCLUDE_DIR} + ${CMAKE_INSTALL_INCLUDEDIR} + ${PROJECT_VERSION} + ${PROJECT_VERSION_MAJOR} + ${LINALG_SOURCES} +) +target_link_libraries(${PROJECT_NAME} ${BLAS_LIBRARIES} ${LAPACK_LIBRARIES}) +link_library(${PROJECT_NAME} ${ferror_LIBRARY} ${ferror_INCLUDE_DIR}) + +# Installation + +# Testing + +# Examples \ No newline at end of file diff --git a/cmake/helper.cmake b/cmake/helper.cmake new file mode 100644 index 00000000..ce2ea3e7 --- /dev/null +++ b/cmake/helper.cmake @@ -0,0 +1,75 @@ +# helper.cmake +# +# A collection of macros and functions making life with CMake and Fortran a +# bit simpler. + +# Use to include and export headers +function(include_headers lib dir install_dir) + target_include_directories( + ${lib} + INTERFACE + $ + $ + ) +endfunction() + +# Use instead of add_library. +function(add_fortran_library lib_name mod_dir include_install_dir version major) + add_library(${lib_name} ${ARGN}) + set_target_properties( + ${lib_name} + PROPERTIES + POSITION_INDEPENDENT_CODE TRUE + OUTPUT_NAME ${lib_name} + VERSION ${version} + SOVERSION ${major} + Fortran_MODULE_DIRECTORY ${include_install_dir} + ) + target_include_directories( + ${lib_name} + PUBLIC + $ + $ + ) +endfunction() + +# Installs the library +function(install_library lib_name lib_install_dir bin_install_dir mod_dir install_dir) + install( + TARGETS ${lib_name} + EXPORT ${lib_name}Targets + RUNTIME DESTINATION ${bin_install_dir} + LIBRARY DESTINATION ${lib_install_dir} + ARCHIVE DESTINATION ${lib_install_dir} + INCLUDES DESTINATION ${install_dir}/include + ) + install( + DIRECTORY ${mod_dir} + DESTINATION ${install_dir} + ) +endfunction() + +# Install the documentation files +function(install_documentation doc_dir install_dir) + install( + DIRECTORY ${doc_dir} + DESTINATION ${install_dir} + ) +endfunction() + +# Links the supplied library +function(link_library targ lib include_dir) + target_link_libraries(${targ} ${lib}) + target_include_directories(${targ} PUBLIC ${include_dir}) +endfunction() + +# ------------------------------------------------------------------------------ +# Helpful Macros +macro(print_all_variables) + message(STATUS "---------- CURRENTLY DEFINED VARIABLES -----------") + get_cmake_property(varNames VARIABLES) + foreach(varName ${varNames}) + message(STATUS ${varName} = ${${varName}}) + endforeach() + message(STATUS "---------- END ----------") +endmacro() \ No newline at end of file diff --git a/configure/CMakeLists.txt b/configure/CMakeLists.txt new file mode 100644 index 00000000..f114e3c5 --- /dev/null +++ b/configure/CMakeLists.txt @@ -0,0 +1,23 @@ +# Get the macros and functions we'll need +include("${PROJECT_SOURCE_DIR}/cmake/helper.cmake") + +# Set a default build type if none was specified +if(NOT CMAKE_BUILD_TYPE AND NOT CMAKE_CONFIGURATION_TYPES) + message(STATUS "Setting build type to 'Release' as none was specified.") + set(CMAKE_BUILD_TYPE Release CACHE STRING "Choose the type of build." FORCE) + # Set the possible values of build type for cmake-gui + set_property(CACHE CMAKE_BUILD_TYPE PROPERTY STRINGS "Debug" "Release") +endif() + +# By default, static library +option(BUILD_SHARED_LIBS "Build shared libraries" OFF) + +# Export all symbols on Windows when building libraries +set(CMAKE_WINDOWS_EXPORT_ALL_SYMBOLS TRUE) + +# Utilize the GNU installation structure +include(GNUInstallDirs) + +# Locate the local include directory +set(PROJECT_INCLUDE_DIR ${PROJECT_BINARY_DIR}/include) +set(PROJECT_INCLUDE_DIR ${PROJECT_INCLUDE_DIR} PARENT_SCOPE) \ No newline at end of file diff --git a/dependencies/BLAS/CMakeLists.txt b/dependencies/BLAS/CMakeLists.txt new file mode 100644 index 00000000..9426e0de --- /dev/null +++ b/dependencies/BLAS/CMakeLists.txt @@ -0,0 +1,7 @@ +# If found, use the installed version; else, import the library +if (${BLAS_FOUND}) + # Inform the user of what's going on + message(STATUS "BLAS library found.") +else() + message(STATUS "BLAS library not found. The reference BLAS will be used.") +endif() \ No newline at end of file diff --git a/dependencies/CMakeLists.txt b/dependencies/CMakeLists.txt new file mode 100644 index 00000000..f2d36e56 --- /dev/null +++ b/dependencies/CMakeLists.txt @@ -0,0 +1,14 @@ +# Get the macros and functions we'll need +include("${PROJECT_SOURCE_DIR}/cmake/helper.cmake") +include(FetchContent) + +# Get BLAS +add_subdirectory(BLAS) + +# Get LAPACK +add_subdirectory(LAPACK) + +# Get FERROR +add_subdirectory(ferror) +set(ferror_LIBRARY ${ferror_LIBRARY} PARENT_SCOPE) +set(ferror_INCLUDE_DIR ${ferror_INCLUDE_DIR} PARENT_SCOPE) diff --git a/dependencies/LAPACK/CMakeLists.txt b/dependencies/LAPACK/CMakeLists.txt new file mode 100644 index 00000000..fe643887 --- /dev/null +++ b/dependencies/LAPACK/CMakeLists.txt @@ -0,0 +1,27 @@ +# If found, use the installed version; else, import the library +if (${LAPACK_FOUND}) + # Inform the user of what's going on + message(STATUS "LAPACK library found.") +else() + # Inform the user of what's going on + message(STATUS "LAPACK not found. Downloading the reference LAPACK.") + + # Fetch the proper content + FetchContent_Declare( + LAPACK + GIT_REPOSITORY "https://github.com/Reference-LAPACK/lapack" + ) + + FetchContent_MakeAvailable(LAPACK) + + if (WIN32) + if (BUILD_SHARED_LIBS) + add_custom_command( + TARGET ${PROJECT_NAME} POST_BUILD + COMMAND ${CMAKE_COMMAND} -E copy_if_different + $ + $ + $ Date: Thu, 8 Dec 2022 07:44:41 -0600 Subject: [PATCH 02/65] Move QRUPDATE source --- src/{external => }/qrupdate/caxcpy.f | 0 src/{external => }/qrupdate/cch1dn.f | 0 src/{external => }/qrupdate/cch1up.f | 0 src/{external => }/qrupdate/cchdex.f | 0 src/{external => }/qrupdate/cchinx.f | 0 src/{external => }/qrupdate/cchshx.f | 0 src/{external => }/qrupdate/cgqvec.f | 0 src/{external => }/qrupdate/clu1up.f | 0 src/{external => }/qrupdate/clup1up.f | 0 src/{external => }/qrupdate/cqhqr.f | 0 src/{external => }/qrupdate/cqr1up.f | 0 src/{external => }/qrupdate/cqrdec.f | 0 src/{external => }/qrupdate/cqrder.f | 0 src/{external => }/qrupdate/cqrinc.f | 0 src/{external => }/qrupdate/cqrinr.f | 0 src/{external => }/qrupdate/cqrot.f | 0 src/{external => }/qrupdate/cqrqh.f | 0 src/{external => }/qrupdate/cqrshc.f | 0 src/{external => }/qrupdate/cqrtv1.f | 0 src/{external => }/qrupdate/dch1dn.f | 0 src/{external => }/qrupdate/dch1up.f | 0 src/{external => }/qrupdate/dchdex.f | 0 src/{external => }/qrupdate/dchinx.f | 0 src/{external => }/qrupdate/dchshx.f | 0 src/{external => }/qrupdate/dgqvec.f | 0 src/{external => }/qrupdate/dlu1up.f | 0 src/{external => }/qrupdate/dlup1up.f | 0 src/{external => }/qrupdate/dqhqr.f | 0 src/{external => }/qrupdate/dqr1up.f | 0 src/{external => }/qrupdate/dqrdec.f | 0 src/{external => }/qrupdate/dqrder.f | 0 src/{external => }/qrupdate/dqrinc.f | 0 src/{external => }/qrupdate/dqrinr.f | 0 src/{external => }/qrupdate/dqrot.f | 0 src/{external => }/qrupdate/dqrqh.f | 0 src/{external => }/qrupdate/dqrshc.f | 0 src/{external => }/qrupdate/dqrtv1.f | 0 src/{external => }/qrupdate/sch1dn.f | 0 src/{external => }/qrupdate/sch1up.f | 0 src/{external => }/qrupdate/schdex.f | 0 src/{external => }/qrupdate/schinx.f | 0 src/{external => }/qrupdate/schshx.f | 0 src/{external => }/qrupdate/sgqvec.f | 0 src/{external => }/qrupdate/slu1up.f | 0 src/{external => }/qrupdate/slup1up.f | 0 src/{external => }/qrupdate/sqhqr.f | 0 src/{external => }/qrupdate/sqr1up.f | 0 src/{external => }/qrupdate/sqrdec.f | 0 src/{external => }/qrupdate/sqrder.f | 0 src/{external => }/qrupdate/sqrinc.f | 0 src/{external => }/qrupdate/sqrinr.f | 0 src/{external => }/qrupdate/sqrot.f | 0 src/{external => }/qrupdate/sqrqh.f | 0 src/{external => }/qrupdate/sqrshc.f | 0 src/{external => }/qrupdate/sqrtv1.f | 0 src/{external => }/qrupdate/zaxcpy.f | 0 src/{external => }/qrupdate/zch1dn.f | 0 src/{external => }/qrupdate/zch1up.f | 0 src/{external => }/qrupdate/zchdex.f | 0 src/{external => }/qrupdate/zchinx.f | 0 src/{external => }/qrupdate/zchshx.f | 0 src/{external => }/qrupdate/zgqvec.f | 0 src/{external => }/qrupdate/zlu1up.f | 0 src/{external => }/qrupdate/zlup1up.f | 0 src/{external => }/qrupdate/zqhqr.f | 0 src/{external => }/qrupdate/zqr1up.f | 0 src/{external => }/qrupdate/zqrdec.f | 0 src/{external => }/qrupdate/zqrder.f | 0 src/{external => }/qrupdate/zqrinc.f | 0 src/{external => }/qrupdate/zqrinr.f | 0 src/{external => }/qrupdate/zqrot.f | 0 src/{external => }/qrupdate/zqrqh.f | 0 src/{external => }/qrupdate/zqrshc.f | 0 src/{external => }/qrupdate/zqrtv1.f | 0 74 files changed, 0 insertions(+), 0 deletions(-) rename src/{external => }/qrupdate/caxcpy.f (100%) rename src/{external => }/qrupdate/cch1dn.f (100%) rename src/{external => }/qrupdate/cch1up.f (100%) rename src/{external => }/qrupdate/cchdex.f (100%) rename src/{external => }/qrupdate/cchinx.f (100%) rename src/{external => }/qrupdate/cchshx.f (100%) rename src/{external => }/qrupdate/cgqvec.f (100%) rename src/{external => }/qrupdate/clu1up.f (100%) rename src/{external => }/qrupdate/clup1up.f (100%) rename src/{external => }/qrupdate/cqhqr.f (100%) rename src/{external => }/qrupdate/cqr1up.f (100%) rename src/{external => }/qrupdate/cqrdec.f (100%) rename src/{external => }/qrupdate/cqrder.f (100%) rename src/{external => }/qrupdate/cqrinc.f (100%) rename src/{external => }/qrupdate/cqrinr.f (100%) rename src/{external => }/qrupdate/cqrot.f (100%) rename src/{external => }/qrupdate/cqrqh.f (100%) rename src/{external => }/qrupdate/cqrshc.f (100%) rename src/{external => }/qrupdate/cqrtv1.f (100%) rename src/{external => }/qrupdate/dch1dn.f (100%) rename src/{external => }/qrupdate/dch1up.f (100%) rename src/{external => }/qrupdate/dchdex.f (100%) rename src/{external => }/qrupdate/dchinx.f (100%) rename src/{external => }/qrupdate/dchshx.f (100%) rename src/{external => }/qrupdate/dgqvec.f (100%) rename src/{external => }/qrupdate/dlu1up.f (100%) rename src/{external => }/qrupdate/dlup1up.f (100%) rename src/{external => }/qrupdate/dqhqr.f (100%) rename src/{external => }/qrupdate/dqr1up.f (100%) rename src/{external => }/qrupdate/dqrdec.f (100%) rename src/{external => }/qrupdate/dqrder.f (100%) rename src/{external => }/qrupdate/dqrinc.f (100%) rename src/{external => }/qrupdate/dqrinr.f (100%) rename src/{external => }/qrupdate/dqrot.f (100%) rename src/{external => }/qrupdate/dqrqh.f (100%) rename src/{external => }/qrupdate/dqrshc.f (100%) rename src/{external => }/qrupdate/dqrtv1.f (100%) rename src/{external => }/qrupdate/sch1dn.f (100%) rename src/{external => }/qrupdate/sch1up.f (100%) rename src/{external => }/qrupdate/schdex.f (100%) rename src/{external => }/qrupdate/schinx.f (100%) rename src/{external => }/qrupdate/schshx.f (100%) rename src/{external => }/qrupdate/sgqvec.f (100%) rename src/{external => }/qrupdate/slu1up.f (100%) rename src/{external => }/qrupdate/slup1up.f (100%) rename src/{external => }/qrupdate/sqhqr.f (100%) rename src/{external => }/qrupdate/sqr1up.f (100%) rename src/{external => }/qrupdate/sqrdec.f (100%) rename src/{external => }/qrupdate/sqrder.f (100%) rename src/{external => }/qrupdate/sqrinc.f (100%) rename src/{external => }/qrupdate/sqrinr.f (100%) rename src/{external => }/qrupdate/sqrot.f (100%) rename src/{external => }/qrupdate/sqrqh.f (100%) rename src/{external => }/qrupdate/sqrshc.f (100%) rename src/{external => }/qrupdate/sqrtv1.f (100%) rename src/{external => }/qrupdate/zaxcpy.f (100%) rename src/{external => }/qrupdate/zch1dn.f (100%) rename src/{external => }/qrupdate/zch1up.f (100%) rename src/{external => }/qrupdate/zchdex.f (100%) rename src/{external => }/qrupdate/zchinx.f (100%) rename src/{external => }/qrupdate/zchshx.f (100%) rename src/{external => }/qrupdate/zgqvec.f (100%) rename src/{external => }/qrupdate/zlu1up.f (100%) rename src/{external => }/qrupdate/zlup1up.f (100%) rename src/{external => }/qrupdate/zqhqr.f (100%) rename src/{external => }/qrupdate/zqr1up.f (100%) rename src/{external => }/qrupdate/zqrdec.f (100%) rename src/{external => }/qrupdate/zqrder.f (100%) rename src/{external => }/qrupdate/zqrinc.f (100%) rename src/{external => }/qrupdate/zqrinr.f (100%) rename src/{external => }/qrupdate/zqrot.f (100%) rename src/{external => }/qrupdate/zqrqh.f (100%) rename src/{external => }/qrupdate/zqrshc.f (100%) rename src/{external => }/qrupdate/zqrtv1.f (100%) diff --git a/src/external/qrupdate/caxcpy.f b/src/qrupdate/caxcpy.f similarity index 100% rename from src/external/qrupdate/caxcpy.f rename to src/qrupdate/caxcpy.f diff --git a/src/external/qrupdate/cch1dn.f b/src/qrupdate/cch1dn.f similarity index 100% rename from src/external/qrupdate/cch1dn.f rename to src/qrupdate/cch1dn.f diff --git a/src/external/qrupdate/cch1up.f b/src/qrupdate/cch1up.f similarity index 100% rename from src/external/qrupdate/cch1up.f rename to src/qrupdate/cch1up.f diff --git a/src/external/qrupdate/cchdex.f b/src/qrupdate/cchdex.f similarity index 100% rename from src/external/qrupdate/cchdex.f rename to src/qrupdate/cchdex.f diff --git a/src/external/qrupdate/cchinx.f b/src/qrupdate/cchinx.f similarity index 100% rename from src/external/qrupdate/cchinx.f rename to src/qrupdate/cchinx.f diff --git a/src/external/qrupdate/cchshx.f b/src/qrupdate/cchshx.f similarity index 100% rename from src/external/qrupdate/cchshx.f rename to src/qrupdate/cchshx.f diff --git a/src/external/qrupdate/cgqvec.f b/src/qrupdate/cgqvec.f similarity index 100% rename from src/external/qrupdate/cgqvec.f rename to src/qrupdate/cgqvec.f diff --git a/src/external/qrupdate/clu1up.f b/src/qrupdate/clu1up.f similarity index 100% rename from src/external/qrupdate/clu1up.f rename to src/qrupdate/clu1up.f diff --git a/src/external/qrupdate/clup1up.f b/src/qrupdate/clup1up.f similarity index 100% rename from src/external/qrupdate/clup1up.f rename to src/qrupdate/clup1up.f diff --git a/src/external/qrupdate/cqhqr.f b/src/qrupdate/cqhqr.f similarity index 100% rename from src/external/qrupdate/cqhqr.f rename to src/qrupdate/cqhqr.f diff --git a/src/external/qrupdate/cqr1up.f b/src/qrupdate/cqr1up.f similarity index 100% rename from src/external/qrupdate/cqr1up.f rename to src/qrupdate/cqr1up.f diff --git a/src/external/qrupdate/cqrdec.f b/src/qrupdate/cqrdec.f similarity index 100% rename from src/external/qrupdate/cqrdec.f rename to src/qrupdate/cqrdec.f diff --git a/src/external/qrupdate/cqrder.f b/src/qrupdate/cqrder.f similarity index 100% rename from src/external/qrupdate/cqrder.f rename to src/qrupdate/cqrder.f diff --git a/src/external/qrupdate/cqrinc.f b/src/qrupdate/cqrinc.f similarity index 100% rename from src/external/qrupdate/cqrinc.f rename to src/qrupdate/cqrinc.f diff --git a/src/external/qrupdate/cqrinr.f b/src/qrupdate/cqrinr.f similarity index 100% rename from src/external/qrupdate/cqrinr.f rename to src/qrupdate/cqrinr.f diff --git a/src/external/qrupdate/cqrot.f b/src/qrupdate/cqrot.f similarity index 100% rename from src/external/qrupdate/cqrot.f rename to src/qrupdate/cqrot.f diff --git a/src/external/qrupdate/cqrqh.f b/src/qrupdate/cqrqh.f similarity index 100% rename from src/external/qrupdate/cqrqh.f rename to src/qrupdate/cqrqh.f diff --git a/src/external/qrupdate/cqrshc.f b/src/qrupdate/cqrshc.f similarity index 100% rename from src/external/qrupdate/cqrshc.f rename to src/qrupdate/cqrshc.f diff --git a/src/external/qrupdate/cqrtv1.f b/src/qrupdate/cqrtv1.f similarity index 100% rename from src/external/qrupdate/cqrtv1.f rename to src/qrupdate/cqrtv1.f diff --git a/src/external/qrupdate/dch1dn.f b/src/qrupdate/dch1dn.f similarity index 100% rename from src/external/qrupdate/dch1dn.f rename to src/qrupdate/dch1dn.f diff --git a/src/external/qrupdate/dch1up.f b/src/qrupdate/dch1up.f similarity index 100% rename from src/external/qrupdate/dch1up.f rename to src/qrupdate/dch1up.f diff --git a/src/external/qrupdate/dchdex.f b/src/qrupdate/dchdex.f similarity index 100% rename from src/external/qrupdate/dchdex.f rename to src/qrupdate/dchdex.f diff --git a/src/external/qrupdate/dchinx.f b/src/qrupdate/dchinx.f similarity index 100% rename from src/external/qrupdate/dchinx.f rename to src/qrupdate/dchinx.f diff --git a/src/external/qrupdate/dchshx.f b/src/qrupdate/dchshx.f similarity index 100% rename from src/external/qrupdate/dchshx.f rename to src/qrupdate/dchshx.f diff --git a/src/external/qrupdate/dgqvec.f b/src/qrupdate/dgqvec.f similarity index 100% rename from src/external/qrupdate/dgqvec.f rename to src/qrupdate/dgqvec.f diff --git a/src/external/qrupdate/dlu1up.f b/src/qrupdate/dlu1up.f similarity index 100% rename from src/external/qrupdate/dlu1up.f rename to src/qrupdate/dlu1up.f diff --git a/src/external/qrupdate/dlup1up.f b/src/qrupdate/dlup1up.f similarity index 100% rename from src/external/qrupdate/dlup1up.f rename to src/qrupdate/dlup1up.f diff --git a/src/external/qrupdate/dqhqr.f b/src/qrupdate/dqhqr.f similarity index 100% rename from src/external/qrupdate/dqhqr.f rename to src/qrupdate/dqhqr.f diff --git a/src/external/qrupdate/dqr1up.f b/src/qrupdate/dqr1up.f similarity index 100% rename from src/external/qrupdate/dqr1up.f rename to src/qrupdate/dqr1up.f diff --git a/src/external/qrupdate/dqrdec.f b/src/qrupdate/dqrdec.f similarity index 100% rename from src/external/qrupdate/dqrdec.f rename to src/qrupdate/dqrdec.f diff --git a/src/external/qrupdate/dqrder.f b/src/qrupdate/dqrder.f similarity index 100% rename from src/external/qrupdate/dqrder.f rename to src/qrupdate/dqrder.f diff --git a/src/external/qrupdate/dqrinc.f b/src/qrupdate/dqrinc.f similarity index 100% rename from src/external/qrupdate/dqrinc.f rename to src/qrupdate/dqrinc.f diff --git a/src/external/qrupdate/dqrinr.f b/src/qrupdate/dqrinr.f similarity index 100% rename from src/external/qrupdate/dqrinr.f rename to src/qrupdate/dqrinr.f diff --git a/src/external/qrupdate/dqrot.f b/src/qrupdate/dqrot.f similarity index 100% rename from src/external/qrupdate/dqrot.f rename to src/qrupdate/dqrot.f diff --git a/src/external/qrupdate/dqrqh.f b/src/qrupdate/dqrqh.f similarity index 100% rename from src/external/qrupdate/dqrqh.f rename to src/qrupdate/dqrqh.f diff --git a/src/external/qrupdate/dqrshc.f b/src/qrupdate/dqrshc.f similarity index 100% rename from src/external/qrupdate/dqrshc.f rename to src/qrupdate/dqrshc.f diff --git a/src/external/qrupdate/dqrtv1.f b/src/qrupdate/dqrtv1.f similarity index 100% rename from src/external/qrupdate/dqrtv1.f rename to src/qrupdate/dqrtv1.f diff --git a/src/external/qrupdate/sch1dn.f b/src/qrupdate/sch1dn.f similarity index 100% rename from src/external/qrupdate/sch1dn.f rename to src/qrupdate/sch1dn.f diff --git a/src/external/qrupdate/sch1up.f b/src/qrupdate/sch1up.f similarity index 100% rename from src/external/qrupdate/sch1up.f rename to src/qrupdate/sch1up.f diff --git a/src/external/qrupdate/schdex.f b/src/qrupdate/schdex.f similarity index 100% rename from src/external/qrupdate/schdex.f rename to src/qrupdate/schdex.f diff --git a/src/external/qrupdate/schinx.f b/src/qrupdate/schinx.f similarity index 100% rename from src/external/qrupdate/schinx.f rename to src/qrupdate/schinx.f diff --git a/src/external/qrupdate/schshx.f b/src/qrupdate/schshx.f similarity index 100% rename from src/external/qrupdate/schshx.f rename to src/qrupdate/schshx.f diff --git a/src/external/qrupdate/sgqvec.f b/src/qrupdate/sgqvec.f similarity index 100% rename from src/external/qrupdate/sgqvec.f rename to src/qrupdate/sgqvec.f diff --git a/src/external/qrupdate/slu1up.f b/src/qrupdate/slu1up.f similarity index 100% rename from src/external/qrupdate/slu1up.f rename to src/qrupdate/slu1up.f diff --git a/src/external/qrupdate/slup1up.f b/src/qrupdate/slup1up.f similarity index 100% rename from src/external/qrupdate/slup1up.f rename to src/qrupdate/slup1up.f diff --git a/src/external/qrupdate/sqhqr.f b/src/qrupdate/sqhqr.f similarity index 100% rename from src/external/qrupdate/sqhqr.f rename to src/qrupdate/sqhqr.f diff --git a/src/external/qrupdate/sqr1up.f b/src/qrupdate/sqr1up.f similarity index 100% rename from src/external/qrupdate/sqr1up.f rename to src/qrupdate/sqr1up.f diff --git a/src/external/qrupdate/sqrdec.f b/src/qrupdate/sqrdec.f similarity index 100% rename from src/external/qrupdate/sqrdec.f rename to src/qrupdate/sqrdec.f diff --git a/src/external/qrupdate/sqrder.f b/src/qrupdate/sqrder.f similarity index 100% rename from src/external/qrupdate/sqrder.f rename to src/qrupdate/sqrder.f diff --git a/src/external/qrupdate/sqrinc.f b/src/qrupdate/sqrinc.f similarity index 100% rename from src/external/qrupdate/sqrinc.f rename to src/qrupdate/sqrinc.f diff --git a/src/external/qrupdate/sqrinr.f b/src/qrupdate/sqrinr.f similarity index 100% rename from src/external/qrupdate/sqrinr.f rename to src/qrupdate/sqrinr.f diff --git a/src/external/qrupdate/sqrot.f b/src/qrupdate/sqrot.f similarity index 100% rename from src/external/qrupdate/sqrot.f rename to src/qrupdate/sqrot.f diff --git a/src/external/qrupdate/sqrqh.f b/src/qrupdate/sqrqh.f similarity index 100% rename from src/external/qrupdate/sqrqh.f rename to src/qrupdate/sqrqh.f diff --git a/src/external/qrupdate/sqrshc.f b/src/qrupdate/sqrshc.f similarity index 100% rename from src/external/qrupdate/sqrshc.f rename to src/qrupdate/sqrshc.f diff --git a/src/external/qrupdate/sqrtv1.f b/src/qrupdate/sqrtv1.f similarity index 100% rename from src/external/qrupdate/sqrtv1.f rename to src/qrupdate/sqrtv1.f diff --git a/src/external/qrupdate/zaxcpy.f b/src/qrupdate/zaxcpy.f similarity index 100% rename from src/external/qrupdate/zaxcpy.f rename to src/qrupdate/zaxcpy.f diff --git a/src/external/qrupdate/zch1dn.f b/src/qrupdate/zch1dn.f similarity index 100% rename from src/external/qrupdate/zch1dn.f rename to src/qrupdate/zch1dn.f diff --git a/src/external/qrupdate/zch1up.f b/src/qrupdate/zch1up.f similarity index 100% rename from src/external/qrupdate/zch1up.f rename to src/qrupdate/zch1up.f diff --git a/src/external/qrupdate/zchdex.f b/src/qrupdate/zchdex.f similarity index 100% rename from src/external/qrupdate/zchdex.f rename to src/qrupdate/zchdex.f diff --git a/src/external/qrupdate/zchinx.f b/src/qrupdate/zchinx.f similarity index 100% rename from src/external/qrupdate/zchinx.f rename to src/qrupdate/zchinx.f diff --git a/src/external/qrupdate/zchshx.f b/src/qrupdate/zchshx.f similarity index 100% rename from src/external/qrupdate/zchshx.f rename to src/qrupdate/zchshx.f diff --git a/src/external/qrupdate/zgqvec.f b/src/qrupdate/zgqvec.f similarity index 100% rename from src/external/qrupdate/zgqvec.f rename to src/qrupdate/zgqvec.f diff --git a/src/external/qrupdate/zlu1up.f b/src/qrupdate/zlu1up.f similarity index 100% rename from src/external/qrupdate/zlu1up.f rename to src/qrupdate/zlu1up.f diff --git a/src/external/qrupdate/zlup1up.f b/src/qrupdate/zlup1up.f similarity index 100% rename from src/external/qrupdate/zlup1up.f rename to src/qrupdate/zlup1up.f diff --git a/src/external/qrupdate/zqhqr.f b/src/qrupdate/zqhqr.f similarity index 100% rename from src/external/qrupdate/zqhqr.f rename to src/qrupdate/zqhqr.f diff --git a/src/external/qrupdate/zqr1up.f b/src/qrupdate/zqr1up.f similarity index 100% rename from src/external/qrupdate/zqr1up.f rename to src/qrupdate/zqr1up.f diff --git a/src/external/qrupdate/zqrdec.f b/src/qrupdate/zqrdec.f similarity index 100% rename from src/external/qrupdate/zqrdec.f rename to src/qrupdate/zqrdec.f diff --git a/src/external/qrupdate/zqrder.f b/src/qrupdate/zqrder.f similarity index 100% rename from src/external/qrupdate/zqrder.f rename to src/qrupdate/zqrder.f diff --git a/src/external/qrupdate/zqrinc.f b/src/qrupdate/zqrinc.f similarity index 100% rename from src/external/qrupdate/zqrinc.f rename to src/qrupdate/zqrinc.f diff --git a/src/external/qrupdate/zqrinr.f b/src/qrupdate/zqrinr.f similarity index 100% rename from src/external/qrupdate/zqrinr.f rename to src/qrupdate/zqrinr.f diff --git a/src/external/qrupdate/zqrot.f b/src/qrupdate/zqrot.f similarity index 100% rename from src/external/qrupdate/zqrot.f rename to src/qrupdate/zqrot.f diff --git a/src/external/qrupdate/zqrqh.f b/src/qrupdate/zqrqh.f similarity index 100% rename from src/external/qrupdate/zqrqh.f rename to src/qrupdate/zqrqh.f diff --git a/src/external/qrupdate/zqrshc.f b/src/qrupdate/zqrshc.f similarity index 100% rename from src/external/qrupdate/zqrshc.f rename to src/qrupdate/zqrshc.f diff --git a/src/external/qrupdate/zqrtv1.f b/src/qrupdate/zqrtv1.f similarity index 100% rename from src/external/qrupdate/zqrtv1.f rename to src/qrupdate/zqrtv1.f From f58d89a4372158e6af5e4ee3e17fb801331e43f2 Mon Sep 17 00:00:00 2001 From: jchristopherson Date: Thu, 8 Dec 2022 07:54:34 -0600 Subject: [PATCH 03/65] Update Fortran API tests --- CMakeLists.txt | 7 +++++++ tests/CMakeLists.txt | 19 +++++++++++-------- 2 files changed, 18 insertions(+), 8 deletions(-) diff --git a/CMakeLists.txt b/CMakeLists.txt index 8d833402..f9e52e08 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -39,5 +39,12 @@ link_library(${PROJECT_NAME} ${ferror_LIBRARY} ${ferror_INCLUDE_DIR}) # Installation # Testing +option(BUILD_TESTING "Build tests") +include(CTest) +message(STATUS "Build tests: ${BUILD_TESTING}") +if (BUILD_TESTING) + enable_testing() + add_subdirectory(tests) +endif() # Examples \ No newline at end of file diff --git a/tests/CMakeLists.txt b/tests/CMakeLists.txt index f1e3bb19..5b679d3f 100644 --- a/tests/CMakeLists.txt +++ b/tests/CMakeLists.txt @@ -1,4 +1,6 @@ -# Fortran Tests +include("${PROJECT_SOURCE_DIR}/cmake/helper.cmake") + +# Fortran API tests source code set(linalg_test_sources linalg_test.f90 test_core.f90 @@ -12,11 +14,12 @@ set(linalg_test_sources test_sort.f90 test_immutable.f90 ) -add_executable(linalg_test ${linalg_test_sources}) -target_link_libraries(linalg_test linalg) - -# Run the tests -add_custom_command(OUTPUT linalg_tests DEPENDS ${linalg_test_sources} - COMMAND linalg_test) -add_custom_target(run_linalg_tests ALL DEPENDS linalg_tests) +# Build the Fortran API tests +add_executable(linalg_test ${linalg_test_sources}) +link_library(linalg_test linalg ${PROJECT_INCLUDE_DIR}) +add_test( + NAME linalg_test + WORKING_DIRECTORY ${CMAKE_LIBRARY_OUTPUT_DIRECTORY} + COMMAND $ +) From 02bb296497929c04bb88c3e5633a5ccb915a83f7 Mon Sep 17 00:00:00 2001 From: jchristopherson Date: Thu, 8 Dec 2022 08:29:57 -0600 Subject: [PATCH 04/65] Start building C API tests --- tests/CMakeLists.txt | 4 ++++ tests/c_test_core.c | 34 ++++++++++++++++++++++++++++++++++ tests/c_test_core.h | 13 +++++++++++++ 3 files changed, 51 insertions(+) create mode 100644 tests/c_test_core.c create mode 100644 tests/c_test_core.h diff --git a/tests/CMakeLists.txt b/tests/CMakeLists.txt index 5b679d3f..f7fe3ec0 100644 --- a/tests/CMakeLists.txt +++ b/tests/CMakeLists.txt @@ -23,3 +23,7 @@ add_test( WORKING_DIRECTORY ${CMAKE_LIBRARY_OUTPUT_DIRECTORY} COMMAND $ ) + + +# C API tests +include_directories(${CMAKE_CURRENT_SOURCE_DIR}) \ No newline at end of file diff --git a/tests/c_test_core.c b/tests/c_test_core.c new file mode 100644 index 00000000..22655144 --- /dev/null +++ b/tests/c_test_core.c @@ -0,0 +1,34 @@ +#include "c_test_core.h" +#include + +bool is_mtx_equal(int m, int n, const double *x, const double *y, double tol) +{ + int i, j; + for (j = 0; j < n; ++j) + { + for (i = 0; i < m; ++i) + { + if (fabs(x[INDEX(i,j,m)] - y[INDEX(i,j,m)]) > tol) return false; + } + } + return true; +} + +bool is_cmplx_mtx_equal(int m, int n, const double complex *x, + const double complex *y, double tol) +{ + int i, j; + double xr, xi, yr, yi; + for (j = 0; j < n; ++j) + { + for (i = 0; i < m; ++i) + { + xr = creal(x[INDEX(i,j,m)]); + xi = cimag(x[INDEX(i,j,m)]); + yr = creal(y[INDEX(i,j,m)]); + yi = cimag(y[INDEX(i,j,m)]); + if (fabs(xr - yr) > tol || fabs(xi - yi) > tol) return false; + } + } + return true; +} \ No newline at end of file diff --git a/tests/c_test_core.h b/tests/c_test_core.h new file mode 100644 index 00000000..edecea3b --- /dev/null +++ b/tests/c_test_core.h @@ -0,0 +1,13 @@ +#ifndef C_TEST_CORE_H_DEFINED +#define C_TEST_CORE_H_DEFINED + +#include +#include + +#define INDEX(i, j, lda) ((lda) * (j) + (i)) + +bool is_mtx_equal(int m, int n, const double *x, const double *y, double tol); +bool is_cmplx_mtx_equal(int m, int n, const double complex *x, + const double complex *y, double tol); + +#endif \ No newline at end of file From fe0ee64c331488e55a0b68549541772b983d3175 Mon Sep 17 00:00:00 2001 From: jchristopherson Date: Thu, 8 Dec 2022 16:09:27 -0600 Subject: [PATCH 05/65] Add to C testing routines --- tests/c_test_core.c | 217 +++++++++++++++++++++++++++++++++++++++++++- tests/c_test_core.h | 37 ++++++++ 2 files changed, 253 insertions(+), 1 deletion(-) diff --git a/tests/c_test_core.c b/tests/c_test_core.c index 22655144..862770c6 100644 --- a/tests/c_test_core.c +++ b/tests/c_test_core.c @@ -1,5 +1,23 @@ #include "c_test_core.h" #include +#include + +double drand(double low, double high) +{ + return ((double)rand() * (high - low)) / (double)RAND_MAX + low; +} + +double complex dcrand(double low, double high) +{ + double a, b; + a = drand(low, high); + b = drand(low, high); + return CMPLX(a, b); +} + + + + bool is_mtx_equal(int m, int n, const double *x, const double *y, double tol) { @@ -31,4 +49,201 @@ bool is_cmplx_mtx_equal(int m, int n, const double complex *x, } } return true; -} \ No newline at end of file +} + +void mtx_mult(int m, int n, int p, const double *x, const double *y, + double *z) +{ + int i, j, k; + double temp; + for (j = 0; j < n; ++j) + { + for (i = 0; i < m; ++i) + { + temp = 0.0; + for (k = 0; k < p; ++k) temp += x[INDEX(i,k,m)] * y[INDEX(k,j,p)]; + z[INDEX(i,j,m)] = temp; + } + } +} + +void cmplx_mtx_mult(int m, int n, int p, const double complex *x, + const double complex *y, double complex *z) +{ + int i, j, k; + double complex temp; + for (j = 0; j < n; ++j) + { + for (i = 0; i < n; ++i) + { + temp = CMPLX(0.0, 0.0); + for (k = 0; k < p; ++k) temp += x[INDEX(i,k,m)] * y[INDEX(k,j,p)]; + z[INDEX(i,j,m)] = temp; + } + } +} + + +void promote_diagonal(int n, const double *x, double *z) +{ + int i, j; + for (j = 0; j < n; ++j) + { + for (i = 0; i < n; ++i) + { + z[INDEX(i,j,n)] = i == j ? x[j] : 0.0; + } + } +} + +void cmplx_promote_diagonal(int n, const double complex *x, double complex *z) +{ + int i, j; + for (j = 0; j < n; ++j) + { + for (i = 0; i < n; ++i) + { + z[INDEX(i,j,n)] = i == j ? x[j] : CMPLX(0.0, 0.0); + } + } +} + + +void transpose(int m, int n, const double *x, double *z) +{ + int i, j; + for (j = 0; j < n; ++j) + { + for (i = 0; i < m; ++i) + { + z[INDEX(j,i,n)] = x[INDEX(i,j,m)]; + } + } +} + +void cmplx_transpose(int m, int n, const double complex *x, double complex *z) +{ + int i, j; + for (j = 0; j < n; ++j) + { + for (i = 0; i < m; ++i) + { + z[INDEX(j,i,n)] = x[INDEX(i,j,m)]; + } + } +} + +void conj_transpose(int m, int n, const double complex *x, double complex *z) +{ + int i, j; + for (j = 0; j < n; ++j) + { + for (i = 0; i < m; ++i) + { + z[INDEX(j,i,n)] = conj(x[INDEX(i,j,m)]); + } + } +} + +void create_matrix(int m, int n, double *x) +{ + int i; + for (i = 0; i < m * n; ++i) + { + x[i] = drand(-1.0, 1.0); + } +} + +void cmplx_create_matrix(int m, int n, double complex *x) +{ + int i; + for (i = 0; i < m * n; ++i) + { + x[i] = dcrand(-1.0, 1.0); + } +} + + + +void create_symmetric_matrix(int n, double *x) +{ + int i, j; + double *temp1, *temp2; + temp1 = (double*)malloc((size_t)(n * n * sizeof(double))); + if (!temp1) return; + temp2 = (double*)malloc((size_t)(n * n * sizeof(double))); + if (!temp2) return; + create_matrix(n, n, temp1); + transpose(n, n, temp1, temp2); + mtx_mult(n, n, n, temp1, temp2, x); + free(temp1); + free(temp2); +} + +void cmplx_create_symmetric_matrix(int n, double complex *x) +{ + int i, j; + double complex *temp1, *temp2; + temp1 = (double complex*)malloc((size_t)(n * n * sizeof(double complex))); + if (!temp1) return; + temp2 = (double complex*)malloc((size_t)(n * n * sizeof(double complex))); + if (!temp2) return; + cmplx_create_matrix(n, n, temp1); + cmplx_transpose(n, n, temp1, temp2); + cmplx_mtx_mult(n, n, n, temp1, temp2, x); + free(temp1); + free(temp2); +} + + + +void identity_matrix(int n, double *x) +{ + int i, j; + for (j = 0; j < n; ++j) + { + for (i = 0; i < n; ++i) + { + x[INDEX(i,j,n)] = i == j ? 1.0 : 0.0; + } + } +} + +void cmplx_identity_matrix(int n, double complex *x) +{ + int i, j; + for (j = 0; j < n; ++j) + { + for (i = 0; i < n; ++i) + { + x[INDEX(i,j,n)] = CMPLX(i == j ? 1.0 : 0.0); + } + } +} + + + +void copy_matrix(int m, int n, const double *src, double *dst) +{ + int i, j; + for (j = 0; j < n; ++j) + { + for (i = 0; i < m; ++i) + { + dst[INDEX(i,j,m)] = src[INDEX(i,j,m)]; + } + } +} + +void cmplx_copy_matrix(int m, int n, const double complex *src, + double complex *dst) +{ + int i, j; + for (j = 0; j < n; ++j) + { + for (i = 0; i < m; ++i) + { + dst[INDEX(i,j,m)] = src[INDEX(i,j,m)]; + } + } +} diff --git a/tests/c_test_core.h b/tests/c_test_core.h index edecea3b..fb30e305 100644 --- a/tests/c_test_core.h +++ b/tests/c_test_core.h @@ -6,8 +6,45 @@ #define INDEX(i, j, lda) ((lda) * (j) + (i)) +// Tests to see if two matrices are equal within the specified tolerance. bool is_mtx_equal(int m, int n, const double *x, const double *y, double tol); bool is_cmplx_mtx_equal(int m, int n, const double complex *x, const double complex *y, double tol); +// Multiplies two matrices: Z = X * Y. +// +// x is M-by-P +// y is P-by-N +// z is M-by-N +void mtx_mult(int m, int n, int p, const double *x, const double *y, + double *z); +void cmplx_mtx_mult(int m, int n, int p, const double complex *x, + const double complex *y, double complex *z); + +// Promotes an N-element vector to an N-by-N diagonal matrix. +void promote_diagonal(int n, const double *x, double *z); +void cmplx_promote_diagonal(int n, const double complex *x, double complex *z); + +// Transposes a matrix +void transpose(int m, int n, const double *x, double *z); +void cmplx_transpose(int m, int n, const double complex *x, double complex *z); +void conj_transpose(int m, int n, const double complex *x, double complex *z); + +// Create a random M-by-N matrix +void create_matrix(int m, int n, double *x); +void cmplx_create_matrix(int m, int n, double complex *x); + +// Create an N-by-N symmetric matrix +void create_symmetric_matrix(int n, double *x); +void cmplx_create_symmetric_matrix(int n, double complex *x); + +// Create an N-by-N identity matrix +void identity_matrix(int n, double *x); +void cmplx_identity_matrix(int n, double complex *x); + +// Copy an M-by-N matrix +void copy_matrix(int m, int n, const double *src, double *dst); +void cmplx_copy_matrix(int m, int n, const double complex *src, + double complex *dst); + #endif \ No newline at end of file From 3b63a56f7bad078e193ae258c4eab3b92a61407b Mon Sep 17 00:00:00 2001 From: jchristopherson Date: Thu, 8 Dec 2022 20:03:02 -0600 Subject: [PATCH 06/65] Add to C API tests --- tests/CMakeLists.txt | 20 +++++++++- tests/c_linalg_test.c | 16 ++++++++ tests/c_linalg_test.h | 10 +++++ tests/c_linalg_test_misc.c | 50 ++++++++++++++++++++++++ tests/c_test_core.c | 79 +++++++++++++++++++++++++++++++++++--- tests/c_test_core.h | 19 +++++++++ 6 files changed, 188 insertions(+), 6 deletions(-) create mode 100644 tests/c_linalg_test.c create mode 100644 tests/c_linalg_test.h create mode 100644 tests/c_linalg_test_misc.c diff --git a/tests/CMakeLists.txt b/tests/CMakeLists.txt index f7fe3ec0..37d002db 100644 --- a/tests/CMakeLists.txt +++ b/tests/CMakeLists.txt @@ -26,4 +26,22 @@ add_test( # C API tests -include_directories(${CMAKE_CURRENT_SOURCE_DIR}) \ No newline at end of file +include_directories( + ${CMAKE_CURRENT_SOURCE_DIR} + ${CMAKE_SOURCE_DIR}/include +) + +set(linalg_c_test_sources + c_linalg_test.c + c_test_core.c + c_linalg_test_misc.c +) + +# Build the C API tests +add_executable(linalg_c_test ${linalg_c_test_sources}) +link_library(linalg_c_test linalg ${PROJECT_INCLUDE_DIR}) +add_test( + NAME linalg_c_test + WORKING_DIRECTORY ${CMAKE_LIBRARY_OUTPUT_DIRECTORY} + COMMAND $ +) \ No newline at end of file diff --git a/tests/c_linalg_test.c b/tests/c_linalg_test.c new file mode 100644 index 00000000..afac64a0 --- /dev/null +++ b/tests/c_linalg_test.c @@ -0,0 +1,16 @@ +#include +#include "c_linalg_test.h" + +int main() +{ + // Variables + bool check; + int flag = 0; + + // Tests + check = test_diagonal_mtx_mult(); + if (!check) flag = 1; + + // End + return flag; +} diff --git a/tests/c_linalg_test.h b/tests/c_linalg_test.h new file mode 100644 index 00000000..5f18afdc --- /dev/null +++ b/tests/c_linalg_test.h @@ -0,0 +1,10 @@ +#ifndef C_LINALG_TEST_H_DEFINED +#define C_LINALG_TEST_H_DEFINED + +#include +#include + +bool test_diagonal_mtx_mult(); +bool test_rank1_update(); + +#endif diff --git a/tests/c_linalg_test_misc.c b/tests/c_linalg_test_misc.c new file mode 100644 index 00000000..3fc9076a --- /dev/null +++ b/tests/c_linalg_test_misc.c @@ -0,0 +1,50 @@ +#include "c_linalg_test.h" +#include "c_test_core.h" +#include "linalg.h" + +bool test_diagonal_mtx_mult() +{ + const int m = 30; + const int n = 30; + const int k = 30; + const double tol = 1.0e-8; + const double alpha = 0.5; + const double beta = 0.25; + const int mn = m * n; + const int kn = k * n; + const int mk = m * k; + const int kk = k * k; + double c1[mn], ans1[mn], b1[kn], b2[kn], ans2[kn], d1[mk], d1v[k], D1[kk], + temp1[kn]; + bool rst, check; + int flag; + + // Initialization + rst = true; + create_matrix(m, n, c1); + create_matrix(k, n, b1); + create_array(k, d1v); + copy_array(k, d1v, d1); + promote_diagonal(k, d1v, D1); + + // Compute C1 = alpha * D1 * B1 + beta * C1 + mtx_mult(k, n, k, D1, b1, temp1); // TEMP1 = D1 * B1 + add_matrix(m, n, alpha, temp1, beta, c1, ans1); // ANS1 = alpha * D1 * B1 + beta * C1 + + flag = la_diag_mtx_mult(true, false, m, n, k, alpha, d1, b1, k, beta, c1, m); + + check = is_mtx_equal(m, n, c1, ans1, tol); + if (!check) rst = false; + + + // End + return rst; +} + + + + +bool test_rank1_update() +{ + // +} \ No newline at end of file diff --git a/tests/c_test_core.c b/tests/c_test_core.c index 862770c6..2213b1fa 100644 --- a/tests/c_test_core.c +++ b/tests/c_test_core.c @@ -12,13 +12,12 @@ double complex dcrand(double low, double high) double a, b; a = drand(low, high); b = drand(low, high); - return CMPLX(a, b); + return a + b * I; } - bool is_mtx_equal(int m, int n, const double *x, const double *y, double tol) { int i, j; @@ -76,7 +75,7 @@ void cmplx_mtx_mult(int m, int n, int p, const double complex *x, { for (i = 0; i < n; ++i) { - temp = CMPLX(0.0, 0.0); + temp = 0.0 + I * 0.0; for (k = 0; k < p; ++k) temp += x[INDEX(i,k,m)] * y[INDEX(k,j,p)]; z[INDEX(i,j,m)] = temp; } @@ -103,7 +102,7 @@ void cmplx_promote_diagonal(int n, const double complex *x, double complex *z) { for (i = 0; i < n; ++i) { - z[INDEX(i,j,n)] = i == j ? x[j] : CMPLX(0.0, 0.0); + z[INDEX(i,j,n)] = i == j ? x[j] : 0.0 + I * 0.0; } } } @@ -216,7 +215,7 @@ void cmplx_identity_matrix(int n, double complex *x) { for (i = 0; i < n; ++i) { - x[INDEX(i,j,n)] = CMPLX(i == j ? 1.0 : 0.0); + x[INDEX(i,j,n)] = (i == j ? 1.0 : 0.0) + I * 0.0; } } } @@ -247,3 +246,73 @@ void cmplx_copy_matrix(int m, int n, const double complex *src, } } } + + + + +void create_array(int n, double *x) +{ + int i; + for (i = 0; i < n; ++i) x[i] = drand(-1.0, 1.0); +} + +void cmplx_create_array(int n, double complex *x) +{ + int i; + for (i = 0; i < n; ++i) x[i] = dcrand(-1.0, 1.0); +} + + + + +void copy_array(int n, const double *src, double *dst) +{ + int i; + for (i = 0; i < n; ++i) dst[i] = src[i]; +} + +void cmplx_copy_array(int n, const double complex *src, double complex *dst) +{ + int i; + for (i = 0; i < n; ++i) dst[i] = src[i]; +} + + +void add_matrix(int m, int n, double alpha, const double *x, double beta, + const double *y, double *z) +{ + int i, j; + for (j = 0; j < n; ++j) + { + for (i = 0; i < m; ++i) + { + z[INDEX(i,j,m)] = alpha * x[INDEX(i,j,m)] + beta * y[INDEX(i,j,m)]; + } + } +} + +void cmplx_add_matrix(int m, int n, double complex alpha, + const double complex *x, double complex beta, const double complex *y, + double complex *z) +{ + int i, j; + for (j = 0; j < n; ++j) + { + for (i = 0; i < m; ++i) + { + z[INDEX(i,j,m)] = alpha * x[INDEX(i,j,m)] + beta * y[INDEX(i,j,m)]; + } + } +} + +void scale_matrix(int m, int n, double x, double *y) +{ + int i; + for (i = 0; i < m * n; ++i) y[i] *= x; +} + +void cmplx_scale_matrix(int m, int n, double complex x, double complex *y) +{ + int i; + for (i = 0; i < m * n; ++i) y[i] *= x; +} diff --git a/tests/c_test_core.h b/tests/c_test_core.h index fb30e305..0a2517e5 100644 --- a/tests/c_test_core.h +++ b/tests/c_test_core.h @@ -47,4 +47,23 @@ void copy_matrix(int m, int n, const double *src, double *dst); void cmplx_copy_matrix(int m, int n, const double complex *src, double complex *dst); +// Create an N-element array. +void create_array(int n, double *x); +void cmplx_create_array(int n, double complex *x); + +// Copy an N-element array. +void copy_array(int n, const double *src, double *dst); +void cmplx_copy_array(int n, const double complex *src, double complex *dst); + +// Adds two M-by-N matrices: Z = alpha * A + beta * C +void add_matrix(int m, int n, double alpha, const double *x, double beta, + const double *y, double *z); +void cmplx_add_matrix(int m, int n, double complex alpha, + const double complex *x, double complex beta, const double complex *y, + double complex *z); + +// Scales a matrix by a scalar. +void scale_matrix(int m, int n, double x, double *y); +void cmplx_scale_matrix(int m, int n, double complex x, double complex *y); + #endif \ No newline at end of file From a27620b3514eec445500b55a7d56ac7b2c389c1d Mon Sep 17 00:00:00 2001 From: jchristopherson Date: Fri, 9 Dec 2022 06:23:20 -0600 Subject: [PATCH 07/65] Fix comment --- include/linalg.h | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/include/linalg.h b/include/linalg.h index 87a2a0d7..4c301d72 100644 --- a/include/linalg.h +++ b/include/linalg.h @@ -202,7 +202,7 @@ int la_diag_mtx_mult(bool lside, bool transb, int m, int n, int k, * * @param lside Set to true to apply matrix A from the left; else, set * to false to apply matrix A from the left. - * @param opb Set to TLA_RANSPOSE to compute op(B) as a direct transpose of B, + * @param opb Set to LA_TRANSPOSE to compute op(B) as a direct transpose of B, * set to LA_HERMITIAN_TRANSPOSE to compute op(B) as the Hermitian transpose * of B, otherwise, set to LA_NO_OPERATION to compute op(B) as B. * @param m The number of rows in the matrix C. From e50fab5feeaf7cd071e407311258d8b1518b39b7 Mon Sep 17 00:00:00 2001 From: jchristopherson Date: Fri, 9 Dec 2022 06:23:25 -0600 Subject: [PATCH 08/65] Add C API tests --- tests/c_linalg_test.c | 12 +++ tests/c_linalg_test.h | 4 + tests/c_linalg_test_misc.c | 160 ++++++++++++++++++++++++++++++++++++- tests/c_test_core.c | 65 +++++++++++++++ tests/c_test_core.h | 15 ++++ 5 files changed, 252 insertions(+), 4 deletions(-) diff --git a/tests/c_linalg_test.c b/tests/c_linalg_test.c index afac64a0..3159199e 100644 --- a/tests/c_linalg_test.c +++ b/tests/c_linalg_test.c @@ -10,6 +10,18 @@ int main() // Tests check = test_diagonal_mtx_mult(); if (!check) flag = 1; + check = test_cmplx_diagonal_mtx_mult(); + if (!check) flag = -1; + + check = test_rank1_update(); + if (!check) flag = 2; + check = test_cmplx_rank1_update(); + if (!check) flag = -2; + + check = test_trace(); + if (!check) flag = 3; + check = test_cmplx_trace(); + if (!check) flag = -3; // End return flag; diff --git a/tests/c_linalg_test.h b/tests/c_linalg_test.h index 5f18afdc..dfa4465c 100644 --- a/tests/c_linalg_test.h +++ b/tests/c_linalg_test.h @@ -5,6 +5,10 @@ #include bool test_diagonal_mtx_mult(); +bool test_cmplx_diagonal_mtx_mult(); bool test_rank1_update(); +bool test_cmplx_rank1_update(); +bool test_trace(); +bool test_cmplx_trace(); #endif diff --git a/tests/c_linalg_test_misc.c b/tests/c_linalg_test_misc.c index 3fc9076a..b8b88127 100644 --- a/tests/c_linalg_test_misc.c +++ b/tests/c_linalg_test_misc.c @@ -1,6 +1,7 @@ #include "c_linalg_test.h" #include "c_test_core.h" #include "linalg.h" +#include bool test_diagonal_mtx_mult() { @@ -32,19 +33,170 @@ bool test_diagonal_mtx_mult() add_matrix(m, n, alpha, temp1, beta, c1, ans1); // ANS1 = alpha * D1 * B1 + beta * C1 flag = la_diag_mtx_mult(true, false, m, n, k, alpha, d1, b1, k, beta, c1, m); - + if (flag != LA_NO_ERROR) rst = false; check = is_mtx_equal(m, n, c1, ans1, tol); if (!check) rst = false; - // End return rst; } +bool test_cmplx_diagonal_mtx_mult() +{ + const int m = 30; + const int n = 30; + const int k = 30; + const double tol = 1.0e-8; + const double complex alpha = 0.5 + 0.0 * I; + const double complex beta = 0.25 + 0.0 * I; + const int mn = m * n; + const int kn = k * n; + const int mk = m * k; + const int kk = k * k; + double complex c1[mn], ans1[mn], b1[kn], b2[kn], ans2[kn], d1[mk], d1v[k], + D1[kk], temp1[kn]; + bool rst, check; + int flag; + + // Initialization + rst = true; + cmplx_create_matrix(m, n, c1); + cmplx_create_matrix(k, n, b1); + cmplx_create_array(k, d1v); + cmplx_copy_array(k, d1v, d1); + cmplx_promote_diagonal(k, d1v, D1); + + // Compute C1 = alpha * D1 * B1 + beta * C1 + cmplx_mtx_mult(k, n, k, D1, b1, temp1); // TEMP1 = D1 * B1 + cmplx_add_matrix(m, n, alpha, temp1, beta, c1, ans1); // ANS1 = alpha * D1 * B1 + beta * C1 + + flag = la_diag_mtx_mult_cmplx(true, LA_NO_OPERATION, m, n, k, alpha, d1, b1, k, beta, c1, m); + if (flag != LA_NO_ERROR) rst = false; + check = is_cmplx_mtx_equal(m, n, c1, ans1, tol); + if (!check) rst = false; + + // End + return rst; +} bool test_rank1_update() { - // -} \ No newline at end of file + // Variables + const int m = 50; + const int n = 20; + const double alpha = 0.5; + const double tol = 1.0e-8; + const int mn = m * n; + double a[mn], a1[mn], b[mn], x[m], y[n], temp1[mn]; + bool rst; + int flag; + + // Initialization + rst = true; + create_matrix(m, n, a); + copy_matrix(m, n, a, a1); + create_array(m, x); + create_array(n, y); + + // Compute the solution: A = alpha * x * y**T + A + rank1_update(m, n, x, y, temp1); + add_matrix(m, n, alpha, temp1, 1.0, a1, a1); // A = A + alpha * TEMP1 + + // Test + flag = la_rank1_update(m, n, alpha, x, y, a, m); + if (flag != LA_NO_ERROR) rst = false; + if (!is_mtx_equal(m, n, a, a1, tol)) rst = false; + + // End + return rst; +} + +bool test_cmplx_rank1_update() +{ + // Variables + const int m = 50; + const int n = 20; + const double complex alpha = 0.5 + 0.0 * I; + const double complex one = 1.0 + 0.0 * I; + const double tol = 1.0e-8; + const int mn = m * n; + double complex a[mn], a1[mn], b[mn], x[m], y[n], temp1[mn]; + bool rst; + int flag; + + // Initialization + rst = true; + cmplx_create_matrix(m, n, a); + cmplx_copy_matrix(m, n, a, a1); + cmplx_create_array(m, x); + cmplx_create_array(n, y); + + // Compute the solution: A = alpha * x * y**T + A + cmplx_rank1_update(m, n, x, y, temp1); + cmplx_add_matrix(m, n, alpha, temp1, one, a1, a1); // A = A + alpha * TEMP1 + + // Test + flag = la_rank1_update_cmplx(m, n, alpha, x, y, a, m); + if (flag != LA_NO_ERROR) rst = false; + if (!is_cmplx_mtx_equal(m, n, a, a1, tol)) rst = false; + + // End + return rst; +} + + + + +bool test_trace() +{ + // Variables + const int n = 20; + const double tol = 1.0e-8; + const int nn = n * n; + double xd[n], x[nn], z, ans; + bool rst; + int flag; + + // Initialization + rst = true; + create_array(n, xd); + promote_diagonal(n, xd, x); + ans = sum(n, xd); + + // Test + flag = la_trace(n, n, x, n, &z); + if (flag != LA_NO_ERROR) rst = false; + if (fabs(z - ans) > tol) rst = false; + + // End + return rst; +} + +bool test_cmplx_trace() +{ + // Variables + const int n = 20; + const double tol = 1.0e-8; + const int nn = n * n; + double complex xd[n], x[nn], z, ans; + bool rst; + int flag; + + // Initialization + rst = true; + cmplx_create_array(n, xd); + cmplx_promote_diagonal(n, xd, x); + ans = cmplx_sum(n, xd); + + // Test + flag = la_trace_cmplx(n, n, x, n, &z); + if (flag != LA_NO_ERROR) rst = false; + if (fabs(creal(z) - creal(ans)) > tol || + fabs(cimag(z) - cimag(ans)) > tol) rst = false; + + // End + return rst; +} + diff --git a/tests/c_test_core.c b/tests/c_test_core.c index 2213b1fa..f3b4d436 100644 --- a/tests/c_test_core.c +++ b/tests/c_test_core.c @@ -316,3 +316,68 @@ void cmplx_scale_matrix(int m, int n, double complex x, double complex *y) int i; for (i = 0; i < m * n; ++i) y[i] *= x; } + + + +void rank1_update(int m, int n, const double *x, const double *y, double *z) +{ + int i, j; + for (j = 0; j < n; ++j) + { + for (i = 0; i < m; ++i) + { + z[INDEX(i,j,m)] = x[i] * y[j]; + } + } +} + +void cmplx_rank1_update(int m, int n, const double complex *x, + const double complex *y, double complex *z) +{ + int i, j; + for (j = 0; j < n; ++j) + { + for (i = 0; i < m; ++i) + { + z[INDEX(i,j,m)] = x[i] * conj(y[j]); + } + } +} + + + +double product(int n, const double *x) +{ + double ans = 1.0; + int i; + for (i = 0; i < n; ++i) ans *= x[i]; + return ans; +} + +double complex cmplx_product(int n, const double complex * x) +{ + double complex ans = 1.0; + int i; + for (i = 0; i < n; ++i) ans *= x[i]; + return ans; +} + + + + + +double sum(int n, const double *x) +{ + double ans = 0.0; + int i; + for (i = 0; i < n; ++i) ans += x[i]; + return ans; +} + +double complex cmplx_sum(int n, const double complex *x) +{ + double complex ans = 0.0 + 0.0 * I; + int i; + for (i = 0; i < n; ++i) ans += x[i]; + return ans; +} diff --git a/tests/c_test_core.h b/tests/c_test_core.h index 0a2517e5..a0e6b5ee 100644 --- a/tests/c_test_core.h +++ b/tests/c_test_core.h @@ -66,4 +66,19 @@ void cmplx_add_matrix(int m, int n, double complex alpha, void scale_matrix(int m, int n, double x, double *y); void cmplx_scale_matrix(int m, int n, double complex x, double complex *y); +// Performs a rank 1 update X * Y**T where X is an M-element array and +// Y is an N-element array. The complex-valued case uses a conjugate +// transpose. +void rank1_update(int m, int n, const double *x, const double *y, double *z); +void cmplx_rank1_update(int m, int n, const double complex *x, + const double complex *y, double complex *z); + +// Computes the product of the elements in an array. +double product(int n, const double *x); +double complex cmplx_product(int n, const double complex * x); + +// Computes the sum of the elements in an array. +double sum(int n, const double *x); +double complex cmplx_sum(int n, const double complex *x); + #endif \ No newline at end of file From ae358ca9c93806e4a28d7bba4f34cd0a9c07089f Mon Sep 17 00:00:00 2001 From: jchristopherson Date: Fri, 9 Dec 2022 16:06:38 -0600 Subject: [PATCH 09/65] Add C API tests --- tests/CMakeLists.txt | 1 + tests/c_linalg_test.c | 28 +++ tests/c_linalg_test.h | 16 ++ tests/c_linalg_test_factor.c | 386 +++++++++++++++++++++++++++++++++++ tests/c_linalg_test_misc.c | 130 ++++++++++++ tests/c_test_core.c | 63 ++++++ tests/c_test_core.h | 8 + 7 files changed, 632 insertions(+) create mode 100644 tests/c_linalg_test_factor.c diff --git a/tests/CMakeLists.txt b/tests/CMakeLists.txt index 37d002db..342c8153 100644 --- a/tests/CMakeLists.txt +++ b/tests/CMakeLists.txt @@ -35,6 +35,7 @@ set(linalg_c_test_sources c_linalg_test.c c_test_core.c c_linalg_test_misc.c + c_linalg_test_factor.c ) # Build the C API tests diff --git a/tests/c_linalg_test.c b/tests/c_linalg_test.c index 3159199e..e06f9858 100644 --- a/tests/c_linalg_test.c +++ b/tests/c_linalg_test.c @@ -23,6 +23,34 @@ int main() check = test_cmplx_trace(); if (!check) flag = -3; + check = test_triangular_matrix_multiply(); + if (!check) flag = 4; + check = test_cmplx_triangular_matrix_multiply(); + if (!check) flag = -4; + + check = test_lu(); + if (!check) flag = 5; + check = test_cmplx_lu(); + if (!check) flag = -5; + + check = test_qr(); + if (!check) flag = 6; + check = test_cmplx_qr(); + if (!check) flag = -6; + + check = test_qr_pivot(); + if (!check) flag = 7; + check = test_cmplx_qr_pivot(); + if (!check) flag = -7; + + check = test_qr_rank1_update(); + if (!check) flag = 8; + check = test_cmplx_qr_rank1_update(); + if (!check) flag = -8; + + check = test_cholesky(); + if (!check) flag = 9; + // End return flag; } diff --git a/tests/c_linalg_test.h b/tests/c_linalg_test.h index dfa4465c..acc9386c 100644 --- a/tests/c_linalg_test.h +++ b/tests/c_linalg_test.h @@ -4,11 +4,27 @@ #include #include +// c_linalg_test_misc.c bool test_diagonal_mtx_mult(); bool test_cmplx_diagonal_mtx_mult(); bool test_rank1_update(); bool test_cmplx_rank1_update(); bool test_trace(); bool test_cmplx_trace(); +bool test_matrix_mulitply(); +bool test_cmplx_matrix_mulitply(); +bool test_triangular_matrix_multiply(); +bool test_cmplx_triangular_matrix_multiply(); + +// c_linalg_test_factor.c +bool test_lu(); +bool test_cmplx_lu(); +bool test_qr(); +bool test_cmplx_qr(); +bool test_qr_pivot(); +bool test_cmplx_qr_pivot(); +bool test_qr_rank1_update(); +bool test_cmplx_qr_rank1_update(); +bool test_cholesky(); #endif diff --git a/tests/c_linalg_test_factor.c b/tests/c_linalg_test_factor.c new file mode 100644 index 00000000..3c972b34 --- /dev/null +++ b/tests/c_linalg_test_factor.c @@ -0,0 +1,386 @@ +#include "linalg.h" +#include "c_linalg_test.h" +#include "c_test_core.h" + + +bool test_lu() +{ + // Variables + const int n = 50; + const int nrhs = 20; + const int nn = n * n; + const int nnrhs = n * nrhs; + const double tol = 1.0e-8; + double a[nn], a1[nn], b[nnrhs], b1[nnrhs], bref[nnrhs]; + int pvt[n]; + bool rst; + int flag; + + // Initialization + rst = true; + create_matrix(n, n, a); + copy_matrix(n, n, a, a1); + create_matrix(n, nrhs, b); + copy_matrix(n, nrhs, b, b1); + + // Factor A + flag = la_lu_factor(n, n, a, n, pvt); + if (flag != LA_NO_ERROR) rst = false; + + // Solve A * X = B - store results in B + flag = la_solve_lu(n, nrhs, a, n, pvt, b, n); + if (flag != LA_NO_ERROR) rst = false; + + // Compare by multiplying the solutions + mtx_mult(n, nrhs, n, a1, b, bref); + if (!is_mtx_equal(n, nrhs, b1, bref, tol)) rst = false; + + // End + return rst; +} + +bool test_cmplx_lu() +{ + // Variables + const int n = 50; + const int nrhs = 20; + const int nn = n * n; + const int nnrhs = n * nrhs; + const double tol = 1.0e-8; + const double complex zero = 0.0 + 0.0 * I; + const double complex one = 1.0 + 0.0 * I; + double complex a[nn], a1[nn], b[nnrhs], b1[nnrhs], bref[nnrhs]; + int pvt[n]; + bool rst; + int flag; + + // Initialization + rst = true; + cmplx_create_matrix(n, n, a); + cmplx_copy_matrix(n, n, a, a1); + cmplx_create_matrix(n, nrhs, b); + cmplx_copy_matrix(n, nrhs, b, b1); + + // Factor A + flag = la_lu_factor_cmplx(n, n, a, n, pvt); + if (flag != LA_NO_ERROR) rst = false; + + // Solve A * X = B - store results in B + flag = la_solve_lu_cmplx(n, nrhs, a, n, pvt, b, n); + if (flag != LA_NO_ERROR) rst = false; + + // Compare by multiplying the solutions + flag = la_mtx_mult_cmplx(LA_NO_OPERATION, LA_NO_OPERATION, n, nrhs, n, one, + a1, n, b, n, zero, bref, n); + if (!is_cmplx_mtx_equal(n, nrhs, b1, bref, tol)) rst = false; + + // End + return rst; +} + + + + +bool test_qr() +{ + // Variables + const int m = 50; + const int n = 50; + const int nrhs = 20; + const int mn = m * n; + const int mnrhs = m * nrhs; + const int minmn = MIN(m, n); + const double tol = 1.0e-8; + const double zero = 0.0; + const double one = 1.0; + double a[mn], a1[mn], b[mnrhs], b1[mnrhs], tau[minmn], bref[mnrhs]; + bool rst; + int flag; + + // Initialization + rst = true; + create_matrix(m, n, a); + copy_matrix(m, n, a, a1); + create_matrix(m, nrhs, b); + copy_matrix(m, nrhs, b, b1); + + // Factor + flag = la_qr_factor(m, n, a, m, tau); + if (flag != LA_NO_ERROR) rst = false; + + // Solve + flag = la_solve_qr(m, n, nrhs, a, m, tau, b, m); + if (flag != LA_NO_ERROR) rst = false; + + // Test by ensuring A * X = B + flag = la_mtx_mult(false, false, m, nrhs, n, one, a1, m, b, m, zero, bref, m); + if (flag != LA_NO_ERROR) rst = false; + if (!is_mtx_equal(m, nrhs, b1, bref, tol)) rst = false; + + // End + return rst; +} + +bool test_cmplx_qr() +{ + // Variables + const int m = 50; + const int n = 50; + const int nrhs = 20; + const int mn = m * n; + const int mnrhs = m * nrhs; + const int minmn = MIN(m, n); + const double tol = 1.0e-8; + const double complex zero = 0.0 + 0.0 * I; + const double complex one = 1.0 + 0.0 * I; + double complex a[mn], a1[mn], b[mnrhs], b1[mnrhs], tau[minmn], bref[mnrhs]; + bool rst; + int flag; + + // Initialization + rst = true; + cmplx_create_matrix(m, n, a); + cmplx_copy_matrix(m, n, a, a1); + cmplx_create_matrix(m, nrhs, b); + cmplx_copy_matrix(m, nrhs, b, b1); + + // Factor + flag = la_qr_factor_cmplx(m, n, a, m, tau); + if (flag != LA_NO_ERROR) rst = false; + + // Solve + flag = la_solve_qr_cmplx(m, n, nrhs, a, m, tau, b, m); + if (flag != LA_NO_ERROR) rst = false; + + // Test by ensuring A * X = B + flag = la_mtx_mult_cmplx(LA_NO_OPERATION, LA_NO_OPERATION, m, nrhs, n, one, + a1, m, b, m, zero, bref, m); + if (flag != LA_NO_ERROR) rst = false; + if (!is_cmplx_mtx_equal(m, nrhs, b1, bref, tol)) rst = false; + + // End + return rst; +} + + + + +bool test_qr_pivot() +{ + // Variables + const int m = 50; + const int n = 50; + const int nrhs = 20; + const int mn = m * n; + const int mnrhs = m * nrhs; + const int minmn = MIN(m, n); + const double tol = 1.0e-8; + const double zero = 0.0; + const double one = 1.0; + double a[mn], a1[mn], b[mnrhs], b1[mnrhs], tau[minmn], bref[mnrhs]; + bool rst; + int flag, pvt[n]; + + // Initialization + rst = true; + create_matrix(m, n, a); + copy_matrix(m, n, a, a1); + create_matrix(m, nrhs, b); + copy_matrix(m, nrhs, b, b1); + zero_int_array(n, pvt); + + // Factor + flag = la_qr_factor_pvt(m, n, a, m, tau, pvt); + if (flag != LA_NO_ERROR) rst = false; + + // Solve + flag = la_solve_qr_pvt(m, n, nrhs, a, m, tau, pvt, b, m); + if (flag != LA_NO_ERROR) rst = false; + + // Test by ensuring A * X = B + flag = la_mtx_mult(false, false, m, nrhs, n, one, a1, m, b, m, zero, bref, m); + if (flag != LA_NO_ERROR) rst = false; + if (!is_mtx_equal(m, nrhs, b1, bref, tol)) rst = false; + + // End + return rst; +} + +bool test_cmplx_qr_pivot() +{ + // Variables + const int m = 50; + const int n = 50; + const int nrhs = 20; + const int mn = m * n; + const int mnrhs = m * nrhs; + const int minmn = MIN(m, n); + const double tol = 1.0e-8; + const double complex zero = 0.0; + const double complex one = 1.0; + double complex a[mn], a1[mn], b[mnrhs], b1[mnrhs], tau[minmn], bref[mnrhs]; + bool rst; + int flag, pvt[n]; + + // Initialization + rst = true; + cmplx_create_matrix(m, n, a); + cmplx_copy_matrix(m, n, a, a1); + cmplx_create_matrix(m, nrhs, b); + cmplx_copy_matrix(m, nrhs, b, b1); + zero_int_array(n, pvt); + + // Factor + flag = la_qr_factor_cmplx_pvt(m, n, a, m, tau, pvt); + if (flag != LA_NO_ERROR) rst = false; + + // Solve + flag = la_solve_qr_cmplx_pvt(m, n, nrhs, a, m, tau, pvt, b, m); + if (flag != LA_NO_ERROR) rst = false; + + // Test by ensuring A * X = B + flag = la_mtx_mult_cmplx(LA_NO_OPERATION, LA_NO_OPERATION, m, nrhs, n, one, + a1, m, b, m, zero, bref, m); + if (flag != LA_NO_ERROR) rst = false; + if (!is_cmplx_mtx_equal(m, nrhs, b1, bref, tol)) rst = false; + + // End + return rst; +} + + + + +bool test_qr_rank1_update() +{ + // Variables + const int m = 50; + const int n = 30; + const int mn = m * n; + const int minmn = MIN(m, n); + const int mm = m * m; + const double tol = 1.0e-8; + const double zero = 0.0; + const double one = 1.0; + double a[mn], u[m], v[n], tau[minmn], q[mm], a1[mn], ans[mn]; + bool rst; + int flag; + + // Initialization + rst = true; + create_matrix(m, n, a); + copy_matrix(m, n, a, a1); + create_array(m, u); + create_array(n, v); + + // Compute the QR factorization of A and then explicity form Q & R + flag = la_qr_factor(m, n, a, m, tau); + if (flag != LA_NO_ERROR) rst = false; + + flag = la_form_qr(true, m, n, a, m, tau, q, m); // R is stored in A + if (flag != LA_NO_ERROR) rst = false; + + // Perform the rank 1 update to the original matrix A + flag = la_rank1_update(m, n, one, u, v, a1, m); + if (flag != LA_NO_ERROR) rst = false; + + // Perform the rank 1 update to the QR factored matrices + flag = la_qr_rank1_update(m, n, q, m, a, m, u, v); + if (flag != LA_NO_ERROR) rst = false; + + // See if A1 = Q1 * R1 + flag = la_mtx_mult(false, false, m, n, m, one, q, m, a, m, zero, ans, m); + if (!is_mtx_equal(m, n, ans, a1, tol)) rst = false; + + // End + return rst; +} + +bool test_cmplx_qr_rank1_update() +{ + // Variables + const int m = 50; + const int n = 30; + const int mn = m * n; + const int minmn = MIN(m, n); + const int mm = m * m; + const double tol = 1.0e-8; + const double complex zero = 0.0 + 0.0 * I; + const double complex one = 1.0 + 0.0 * I; + double complex a[mn], u[m], v[n], tau[minmn], q[mm], a1[mn], ans[mn]; + bool rst; + int flag; + + // Initialization + rst = true; + cmplx_create_matrix(m, n, a); + cmplx_copy_matrix(m, n, a, a1); + cmplx_create_array(m, u); + cmplx_create_array(n, v); + + // Compute the QR factorization of A and then explicity form Q & R + flag = la_qr_factor_cmplx(m, n, a, m, tau); + if (flag != LA_NO_ERROR) rst = false; + + flag = la_form_qr_cmplx(true, m, n, a, m, tau, q, m); // R is stored in A + if (flag != LA_NO_ERROR) rst = false; + + // Perform the rank 1 update to the original matrix A + flag = la_rank1_update_cmplx(m, n, one, u, v, a1, m); + if (flag != LA_NO_ERROR) rst = false; + + // Perform the rank 1 update to the QR factored matrices + flag = la_qr_rank1_update_cmplx(m, n, q, m, a, m, u, v); + if (flag != LA_NO_ERROR) rst = false; + + // See if A1 = Q1 * R1 + flag = la_mtx_mult_cmplx(false, false, m, n, m, one, q, m, a, m, zero, ans, m); + if (!is_cmplx_mtx_equal(m, n, ans, a1, tol)) rst = false; + + // End + return rst; +} + + + + + +bool test_cholesky() +{ + // Variables + const int n = 50; + const int nrhs = 20; + const int nn = n * n; + const int nnrhs = n * nrhs; + const double tol = 1.0e-8; + const double zero = 0.0; + const double one = 1.0; + double a[nn], a1[nn], b[nnrhs], b1[nnrhs], bref[nnrhs]; + bool rst; + int flag; + + // Initialization + rst = true; + create_symmetric_matrix(n, a); + copy_matrix(n, n, a, a1); + create_matrix(n, nrhs, b); + copy_matrix(n, nrhs, b, b1); + + // Factor A + flag = la_cholesky_factor(true, n, a, n); + if (flag != LA_NO_ERROR) rst = false; + + // Solve A * X = B for X + flag = la_solve_cholesky(true, n, nrhs, a, n, b, n); + if (flag != LA_NO_ERROR) rst = false; + + // Check A * X = B + flag = la_mtx_mult(false, false, n, nrhs, n, one, a1, n, b, n, zero, bref, n); + if (flag != LA_NO_ERROR) rst = false; + + // Test + if (!is_mtx_equal(n, nrhs, b1, bref, tol)) rst = false; + + // End + return rst; +} diff --git a/tests/c_linalg_test_misc.c b/tests/c_linalg_test_misc.c index b8b88127..ddf0d43c 100644 --- a/tests/c_linalg_test_misc.c +++ b/tests/c_linalg_test_misc.c @@ -200,3 +200,133 @@ bool test_cmplx_trace() return rst; } + +bool test_matrix_mulitply() +{ + // Variables + const int m = 40; + const int n = 20; + const int p = 30; + const int mn = m * n; + const int mp = m * p; + const int pn = p * n; + const double tol = 1.0e-8; + const double alpha = 1.0; + const double beta = 0.0; + double x[mp], y[pn], z[mn], ans[mn]; + bool rst; + int flag; + + // Initialization + rst = true; + create_matrix(m, p, x); + create_matrix(p, n, y); + mtx_mult(m, n, p, x, y, ans); + + // Test + flag = la_mtx_mult(false, false, m, n, p, alpha, x, m, y, p, beta, z, m); + if (flag != LA_NO_ERROR) rst = false; + if (!is_mtx_equal(m, n, ans, z, tol)) rst = false; + + // End + return rst; +} + +bool test_cmplx_matrix_mulitply() +{ + // Variables + const int m = 40; + const int n = 20; + const int p = 30; + const int mn = m * n; + const int mp = m * p; + const int pn = p * n; + const double tol = 1.0e-8; + const double complex alpha = 1.0 + 0.0 * I; + const double complex beta = 0.0 + 0.0 * I; + double complex x[mp], y[pn], z[mn], ans[mn]; + bool rst; + int flag; + + // Initialization + rst = true; + cmplx_create_matrix(m, p, x); + cmplx_create_matrix(p, n, y); + cmplx_mtx_mult(m, n, p, x, y, ans); + + // Test + flag = la_mtx_mult_cmplx(LA_NO_OPERATION, LA_NO_OPERATION, m, n, p, alpha, + x, m, y, p, beta, z, m); + if (flag != LA_NO_ERROR) rst = false; + if (!is_cmplx_mtx_equal(m, n, ans, z, tol)) rst = false; + + // End + return rst; +} + + + + +bool test_triangular_matrix_multiply() +{ + // Variables + const int n = 50; + const int nn = n * n; + const double tol = 1.0e-8; + const double alpha = 0.5; + const double beta = -1.0; + double x[nn], y[nn], y1[nn]; + bool rst; + int flag; + + // Initialization + rst = true; + create_triangular_matrix(true, n, x); + create_matrix(n, n, y); + copy_matrix(n, n, y, y1); + + // Compute the solution (Y = alpha * X**T * X + beta * Y) + flag = la_mtx_mult(true, false, n, n, n, alpha, x, n, x, n, beta, y1, n); + if (flag != LA_NO_ERROR) rst = false; + + // Test + flag = la_tri_mtx_mult(true, alpha, n, x, n, beta, y, n); + if (flag != LA_NO_ERROR) rst = false; + if (!is_mtx_equal(n, n, y, y1, tol)) rst = false; + + // End + return rst; +} + +bool test_cmplx_triangular_matrix_multiply() +{ + // Variables + const int n = 50; + const int nn = n * n; + const double tol = 1.0e-8; + const double complex alpha = 0.5 + 0.0 * I; + const double complex beta = -1.0 + 0.0 * I; + double complex x[nn], y[nn], y1[nn]; + bool rst; + int flag; + + // Initialization + rst = true; + cmplx_create_triangular_matrix(true, n, x); + cmplx_create_matrix(n, n, y); + cmplx_copy_matrix(n, n, y, y1); + + // Compute the solution (Y = alpha * X**T * X + beta * Y) + flag = la_mtx_mult_cmplx(LA_TRANSPOSE, LA_NO_OPERATION, n, n, n, alpha, x, + n, x, n, beta, y1, n); + if (flag != LA_NO_ERROR) rst = false; + + // Test + flag = la_tri_mtx_mult_cmplx(true, alpha, n, x, n, beta, y, n); + if (flag != LA_NO_ERROR) rst = false; + if (!is_cmplx_mtx_equal(n, n, y, y1, tol)) rst = false; + + // End + return rst; +} + diff --git a/tests/c_test_core.c b/tests/c_test_core.c index f3b4d436..def89e54 100644 --- a/tests/c_test_core.c +++ b/tests/c_test_core.c @@ -381,3 +381,66 @@ double complex cmplx_sum(int n, const double complex *x) for (i = 0; i < n; ++i) ans += x[i]; return ans; } + + + + +void create_triangular_matrix(bool upper, int n, double *x) +{ + int i, j; + if (upper) + { + for (j = 0; j < n; ++j) + { + for (i = 0; i < n; ++i) + { + x[INDEX(i,j,n)] = i <= j ? drand(-1.0, 1.0) : 0.0; + } + } + } + else + { + for (j = 0; j < n; ++j) + { + for (i = 0; i < n; ++i) + { + x[INDEX(i,j,n)] = i >= j ? drand(-1.0, 1.0) : 0.0; + } + } + } +} + +void cmplx_create_triangular_matrix(bool upper, int n, double complex *x) +{ + int i, j; + if (upper) + { + for (j = 0; j < n; ++j) + { + for (i = 0; i < n; ++i) + { + x[INDEX(i,j,n)] = i <= j ? dcrand(-1.0, 1.0) : 0.0; + } + } + } + else + { + for (j = 0; j < n; ++j) + { + for (i = 0; i < n; ++i) + { + x[INDEX(i,j,n)] = i >= j ? dcrand(-1.0, 1.0) : 0.0; + } + } + } +} + + + + + +void zero_int_array(int n, int *x) +{ + int i; + for (i = 0; i < n; ++i) x[i] = 0; +} diff --git a/tests/c_test_core.h b/tests/c_test_core.h index a0e6b5ee..039cf22c 100644 --- a/tests/c_test_core.h +++ b/tests/c_test_core.h @@ -5,6 +5,7 @@ #include #define INDEX(i, j, lda) ((lda) * (j) + (i)) +#define MIN(a, b)((a) < (b) ? (a) : (b)) // Tests to see if two matrices are equal within the specified tolerance. bool is_mtx_equal(int m, int n, const double *x, const double *y, double tol); @@ -81,4 +82,11 @@ double complex cmplx_product(int n, const double complex * x); double sum(int n, const double *x); double complex cmplx_sum(int n, const double complex *x); +// Creates a triangular matrix. +void create_triangular_matrix(bool upper, int n, double *x); +void cmplx_create_triangular_matrix(bool upper, int n, double complex *x); + +// Zeros an array +void zero_int_array(int n, int *x); + #endif \ No newline at end of file From b6492a47be86cccef7c51354bce019a192aa114d Mon Sep 17 00:00:00 2001 From: jchristopherson Date: Sun, 11 Dec 2022 06:52:35 -0600 Subject: [PATCH 10/65] add mixed type diagonal matrix multiplication --- include/linalg.h | 38 ++++++++ src/linalg_basic.f90 | 228 +++++++++++++++++++++++++++++++++++++++++++ src/linalg_c_api.f90 | 88 +++++++++++++++++ src/linalg_core.f90 | 67 +++++++++++++ 4 files changed, 421 insertions(+) diff --git a/include/linalg.h b/include/linalg.h index 4c301d72..c71bc852 100644 --- a/include/linalg.h +++ b/include/linalg.h @@ -234,6 +234,44 @@ int la_diag_mtx_mult_cmplx(bool lside, int opb, int m, int n, int k, double complex alpha, const double complex *a, const double complex *b, int ldb, double complex beta, double complex *c, int ldc); +/** + * Computes the matrix operation: C = alpha * A * op(B) + beta * C, + * or C = alpha * op(B) * A + beta * C. + * + * @param lside Set to true to apply matrix A from the left; else, set + * to false to apply matrix A from the left. + * @param opb Set to LA_TRANSPOSE to compute op(B) as a direct transpose of B, + * set to LA_HERMITIAN_TRANSPOSE to compute op(B) as the Hermitian transpose + * of B, otherwise, set to LA_NO_OPERATION to compute op(B) as B. + * @param m The number of rows in the matrix C. + * @param n The number of columns in the matrix C. + * @param k The inner dimension of the matrix product A * op(B). + * @param alpha A scalar multiplier. + * @param a A P-element array containing the diagonal elements of matrix A + * where P = MIN(@p m, @p k) if @p lside is true; else, P = MIN(@p n, @p k) + * if @p lside is false. + * @param b The LDB-by-TDB matrix B where (LDB = leading dimension of B, + * and TDB = trailing dimension of B): + * - @p lside == true & @p trans == true: LDB = @p n, TDB = @p k + * - @p lside == true & @p trans == false: LDB = @p k, TDB = @p n + * - @p lside == false & @p trans == true: LDB = @p k, TDB = @p m + * - @p lside == false & @p trans == false: LDB = @p m, TDB = @p k + * @param ldb The leading dimension of matrix B. + * @param beta A scalar multiplier. + * @param c The @p m by @p n matrix C. + * @param ldc The leading dimension of matrix C. + * + * @return An error code. The following codes are possible. + * - LA_NO_ERROR: No error occurred. Successful operation. + * - LA_INVALID_INPUT_ERROR: Occurs if @p ldb, or @p ldc are not + * correct. + * - LA_ARRAY_SIZE_ERROR: Occurs if any of the input array sizes are + * incorrect. + */ +int la_diag_mtx_mult_mixed(bool lside, int opb, int m, int n, int k, + double complex alpha, const double *a, const double complex *b, + int ldb, double complex beta, double complex *c, int ldc); + /** * Computes the rank of a matrix. * diff --git a/src/linalg_basic.f90 b/src/linalg_basic.f90 index 3d5466ee..ae1058a7 100644 --- a/src/linalg_basic.f90 +++ b/src/linalg_basic.f90 @@ -1120,6 +1120,234 @@ module subroutine diag_mtx_mult_mtx2_cmplx(lside, alpha, a, b, err) end if end subroutine +! ------------------------------------------------------------------------------ + module subroutine diag_mtx_mult_mtx_mix(lside, opb, alpha, a, b, beta, c, err) + ! Arguments + logical, intent(in) :: lside + integer(int32), intent(in) :: opb + complex(real64) :: alpha, beta + real(real64), intent(in), dimension(:) :: a + complex(real64), intent(in), dimension(:,:) :: b + complex(real64), intent(inout), dimension(:,:) :: c + class(errors), intent(inout), optional, target :: err + + ! Parameters + complex(real64), parameter :: zero = (0.0d0, 0.0d0) + complex(real64), parameter :: one = (1.0d0, 0.0d0) + + ! Local Variables + integer(int32) :: i, m, n, k, nrowb, ncolb, flag + complex(real64) :: temp + class(errors), pointer :: errmgr + type(errors), target :: deferr + character(len = 128) :: errmsg + + ! Initialization + m = size(c, 1) + n = size(c, 2) + k = size(a) + nrowb = size(b, 1) + ncolb = size(b, 2) + if (present(err)) then + errmgr => err + else + errmgr => deferr + end if + + ! Input Check + flag = 0 + if (lside) then + if (k > m) then + flag = 4 + else + if (opb == TRANSPOSE .or. opb == HERMITIAN_TRANSPOSE) then + ! Compute C = alpha * A * B**T + beta * C + if (nrowb /= n .or. ncolb < k) flag = 5 + else + ! Compute C = alpha * A * B + beta * C + if (nrowb < k .or. ncolb /= n) flag = 5 + end if + end if + else + if (k > n) then + flag = 4 + else + if (opb == TRANSPOSE .or. opb == HERMITIAN_TRANSPOSE) then + ! Compute C = alpha * B**T * A + beta * C + if (ncolb /= m .or. nrowb < k) flag = 5 + else + ! Compute C = alpha * B * A + beta * C + if (nrowb /= m .or. ncolb < k) flag = 5 + end if + end if + end if + if (flag /= 0) then + ! ERROR: One of the input arrays is not sized correctly + write(errmsg, '(AI0A)') "Input number ", flag, & + " is not sized correctly." + call errmgr%report_error("diag_mtx_mult_mtx_mix", trim(errmsg), & + LA_ARRAY_SIZE_ERROR) + return + end if + + ! Deal with ALPHA == 0 + if (alpha == 0) then + if (beta == zero) then + c = zero + else if (beta /= one) then + c = beta * c + end if + return + end if + + ! Process + if (lside) then + if (opb == TRANSPOSE) then + ! Compute C = alpha * A * B**T + beta * C + do i = 1, k + if (beta == zero) then + c(i,:) = zero + else if (beta /= one) then + c(i,:) = beta * c(i,:) + end if + temp = alpha * a(i) + if (temp /= one) c(i,:) = c(i,:) + temp * b(:,i) + end do + else if (opb == HERMITIAN_TRANSPOSE) then + ! Compute C = alpha * A * B**H + beta * C + do i = 1, k + if (beta == zero) then + c(i,:) = zero + else if (beta /= one) then + c(i,:) = beta * c(i,:) + end if + temp = alpha * a(i) + if (temp /= one) c(i,:) = c(i,:) + temp * conjg(b(:,i)) + end do + else + ! Compute C = alpha * A * B + beta * C + do i = 1, k + if (beta == zero) then + c(i,:) = zero + else if (beta /= one) then + c(i,:) = beta * c(i,:) + end if + temp = alpha * a(i) + if (temp /= one) c(i,:) = c(i,:) + temp * b(i,:) + end do + end if + + ! Handle extra rows + if (m > k) then + if (beta == zero) then + c(k+1:m,:) = zero + else + c(k+1:m,:) = beta * c(k+1:m,:) + end if + end if + else + if (opb == TRANSPOSE) then + ! Compute C = alpha * B**T * A + beta * C + do i = 1, k + if (beta == zero) then + c(:,i) = zero + else if (beta /= one) then + c(:,i) = beta * c(:,i) + end if + temp = alpha * a(i) + if (temp /= one) c(:,i) = c(:,i) + temp * b(i,:) + end do + else if (opb == HERMITIAN_TRANSPOSE) then + ! Compute C = alpha * B**H * A + beta * C + do i = 1, k + if (beta == zero) then + c(:,i) = zero + else if (beta /= one) then + c(:,i) = beta * c(:,i) + end if + temp = alpha * a(i) + if (temp /= one) c(:,i) = c(:,i) + temp * conjg(b(i,:)) + end do + else + ! Compute C = alpha * B * A + beta * C + do i = 1, k + if (beta == zero) then + c(:,i) = zero + else if (beta /= one) then + c(:,i) = beta * c(:,i) + end if + temp = alpha * a(i) + if (temp /= one) c(:,i) = c(:,i) + temp * b(:,i) + end do + end if + + ! Handle extra columns + if (n > k) then + if (beta == zero) then + c(:,k+1:m) = zero + else if (beta /= one) then + c(:,k+1:m) = beta * c(:,k+1:m) + end if + end if + end if + end subroutine + +! ------------------------------------------------------------------------------ + module subroutine diag_mtx_mult_mtx2_mix(lside, alpha, a, b, err) + ! Arguments + logical, intent(in) :: lside + complex(real64), intent(in) :: alpha + real(real64), intent(in), dimension(:) :: a + complex(real64), intent(inout), dimension(:,:) :: b + class(errors), intent(inout), optional, target :: err + + ! Parameters + complex(real64), parameter :: zero = (0.0d0, 0.0d0) + complex(real64), parameter :: one = (1.0d0, 0.0d0) + + ! Local Variables + integer(int32) :: i, m, n, k + complex(real64) :: temp + class(errors), pointer :: errmgr + type(errors), target :: deferr + + ! Initialization + m = size(b, 1) + n = size(b, 2) + k = size(a) + if (present(err)) then + errmgr => err + else + errmgr => deferr + end if + + ! Input Check + if ((lside .and. k > m) .or. (.not.lside .and. k > n)) then + ! ERROR: One of the input arrays is not sized correctly + call errmgr%report_error("diag_mtx_mult_mtx2_cmplx", & + "Input number 3 is not sized correctly.", & + LA_ARRAY_SIZE_ERROR) + return + end if + + ! Process + if (lside) then + ! Compute B = alpha * A * B + do i = 1, k + temp = alpha * a(i) + if (temp /= one) b(i,:) = temp * b(i,:) + end do + if (m > k) b(k+1:m,:) = zero + else + ! Compute B = alpha * B * A + do i = 1, k + temp = alpha * a(i) + if (temp /= one) b(:,i) = temp * b(:,i) + end do + if (n > k) b(:,k+1:n) = zero + end if + end subroutine + ! ****************************************************************************** ! BASIC OPERATION ROUTINES ! ------------------------------------------------------------------------------ diff --git a/src/linalg_c_api.f90 b/src/linalg_c_api.f90 index e606e322..5f213ecf 100644 --- a/src/linalg_c_api.f90 +++ b/src/linalg_c_api.f90 @@ -393,6 +393,94 @@ function la_diag_mtx_mult(lside, transb, m, n, k, alpha, a, b, ldb, & if (err%has_error_occurred()) flag = err%get_error_flag() end function +! ------------------------------------------------------------------------------ + !> @brief Computes the matrix operation: C = alpha * A * op(B) + beta * C, + !! or C = alpha * op(B) * A + beta * C. + !! + !! @param lside Set to true to apply matrix A from the left; else, set + !! to false to apply matrix A from the left. + !! @param opb Set to TRANSPOSE to compute op(B) as a direct transpose of B, + !! set to HERMITIAN_TRANSPOSE to compute op(B) as the Hermitian transpose + !! of B, otherwise, set to NO_OPERATION to compute op(B) as B. + !! @param m The number of rows in the matrix C. + !! @param n The number of columns in the matrix C. + !! @param k The inner dimension of the matrix product A * op(B). + !! @param alpha A scalar multiplier. + !! @param a A P-element array containing the diagonal elements of matrix A + !! where P = MIN(@p m, @p k) if @p lside is true; else, P = MIN(@p n, @p k) + !! if @p lside is false. + !! @param b The LDB-by-TDB matrix B where (LDB = leading dimension of B, + !! and TDB = trailing dimension of B): + !! - @p lside == true & @p trans == true: LDB = @p n, TDB = @p k + !! - @p lside == true & @p trans == false: LDB = @p k, TDB = @p n + !! - @p lside == false & @p trans == true: LDB = @p k, TDB = @p m + !! - @p lside == false & @p trans == false: LDB = @p m, TDB = @p k + !! @param ldb The leading dimension of matrix B. + !! @param beta A scalar multiplier. + !! @param c The @p m by @p n matrix C. + !! @param ldc The leading dimension of matrix C. + !! + !! @return An error code. The following codes are possible. + !! - LA_NO_ERROR: No error occurred. Successful operation. + !! - LA_INVALID_INPUT_ERROR: Occurs if @p ldb, or @p ldc are not + !! correct. + !! - LA_ARRAY_SIZE_ERROR: Occurs if any of the input array sizes are + !! incorrect. + function la_diag_mtx_mult_mixed(lside, opb, m, n, k, alpha, a, b, ldb, & + beta, c, ldc) bind(C, name = "la_diag_mtx_mult_mixed") result(flag) + ! Arguments + logical(c_bool), intent(in), value :: lside + integer(c_int), intent(in), value :: opb, m, n, k, ldb, ldc + complex(c_double), intent(in), value :: alpha, beta + real(c_double), intent(in) :: a(*) + complex(c_double), intent(in) :: b(ldb,*) + complex(c_double), intent(inout) :: c(ldc,*) + integer(c_int) :: flag + + ! Local Variabes + integer(c_int) :: nrows, ncols, p + logical :: ls, tb + type(errors) :: err + + ! Initialization + call err%set_exit_on_error(.false.) + flag = LA_NO_ERROR + tb = .false. + if (opb == TRANSPOSE .or. opb == HERMITIAN_TRANSPOSE) tb = .true. + if (lside .and. tb) then + nrows = n + ncols = k + p = min(k, m) + ls = .true. + else if (lside .and. .not. tb) then + nrows = k + ncols = n + p = min(k, m) + ls = .true. + else if (.not. lside .and. tb) then + nrows = k + ncols = m + p = min(k, n) + ls = .false. + else + nrows = m + ncols = k + p = min(k, n) + ls = .false. + end if + + ! Error Checking + if (ldb < nrows .or. ldc < m) then + flag = LA_INVALID_INPUT_ERROR + return + end if + + ! Process + call diag_mtx_mult(ls, opb, alpha, a(1:p), b(1:nrows,1:ncols), & + beta, c(1:m,1:n)) + if (err%has_error_occurred()) flag = err%get_error_flag() + end function + ! ------------------------------------------------------------------------------ !> @brief Computes the matrix operation: C = alpha * A * op(B) + beta * C, !! or C = alpha * op(B) * A + beta * C. diff --git a/src/linalg_core.f90 b/src/linalg_core.f90 index af0a8d3a..eccbc2a8 100644 --- a/src/linalg_core.f90 +++ b/src/linalg_core.f90 @@ -148,6 +148,8 @@ module linalg_core module procedure :: diag_mtx_mult_mtx4 module procedure :: diag_mtx_mult_mtx_cmplx module procedure :: diag_mtx_mult_mtx2_cmplx + module procedure :: diag_mtx_mult_mtx_mix + module procedure :: diag_mtx_mult_mtx2_mix end interface ! ------------------------------------------------------------------------------ @@ -2026,6 +2028,71 @@ module subroutine diag_mtx_mult_mtx2_cmplx(lside, alpha, a, b, err) class(errors), intent(inout), optional, target :: err end subroutine + !> @brief Computes the matrix operation: C = alpha * A * op(B) + beta * C, + !! or C = alpha * op(B) * A + beta * C. + !! + !! @param[in] lside Set to true to apply matrix A from the left; else, set + !! to false to apply matrix A from the left. + !! @param[in] opb Set to TRANSPOSE if op(B) = B**T, set to + !! HERMITIAN_TRANSPOSE if op(B) == B**H, otherwise set to + !! NO_OPERATION if op(B) == B. + !! @param[in] alpha A scalar multiplier. + !! @param[in] a A K-element array containing the diagonal elements of A + !! where K = MIN(M,P) if @p lside is true; else, if @p lside is + !! false, K = MIN(N,P). + !! @param[in] b The LDB-by-TDB matrix B where (LDB = leading dimension of B, + !! and TDB = trailing dimension of B): + !! - @p lside == true & @p trans == true: LDB = N, TDB = P + !! - @p lside == true & @p trans == false: LDB = P, TDB = N + !! - @p lside == false & @p trans == true: LDB = P, TDB = M + !! - @p lside == false & @p trans == false: LDB = M, TDB = P + !! @param[in] beta A scalar multiplier. + !! @param[in,out] c On input, the M-by-N matrix C. On output, the resulting + !! M-by-N matrix. + !! @param[out] err An optional errors-based object that if provided can be + !! used to retrieve information relating to any errors encountered during + !! execution. If not provided, a default implementation of the errors + !! class is used internally to provide error handling. Possible errors and + !! warning messages that may be encountered are as follows. + !! - LA_ARRAY_SIZE_ERROR: Occurs if any of the input array sizes are + !! incorrect. + module subroutine diag_mtx_mult_mtx_mix(lside, opb, alpha, a, b, beta, c, err) + logical, intent(in) :: lside + integer(int32), intent(in) :: opb + complex(real64) :: alpha, beta + real(real64), intent(in), dimension(:) :: a + complex(real64), intent(in), dimension(:,:) :: b + complex(real64), intent(inout), dimension(:,:) :: c + class(errors), intent(inout), optional, target :: err + end subroutine + + !> @brief Computes the matrix operation: B = alpha * A * B, or + !! B = alpha * B * A. + !! + !! @param[in] lside Set to true to apply matrix A from the left; else, set + !! to false to apply matrix A from the left. + !! @param[in] alpha A scalar multiplier. + !! @param[in] a A K-element array containing the diagonal elements of A + !! where K = MIN(M,P) if @p lside is true; else, if @p lside is + !! false, K = MIN(N,P). + !! @param[in] b On input, the M-by-N matrix B. On output, the resulting + !! M-by-N matrix. + !! @param[out] err An optional errors-based object that if provided can be + !! used to retrieve information relating to any errors encountered during + !! execution. If not provided, a default implementation of the errors + !! class is used internally to provide error handling. Possible errors and + !! warning messages that may be encountered are as follows. + !! - LA_ARRAY_SIZE_ERROR: Occurs if any of the input array sizes are + !! incorrect. + module subroutine diag_mtx_mult_mtx2_mix(lside, alpha, a, b, err) + logical, intent(in) :: lside + complex(real64), intent(in) :: alpha + real(real64), intent(in), dimension(:) :: a + complex(real64), intent(inout), dimension(:,:) :: b + class(errors), intent(inout), optional, target :: err + end subroutine + + !> @brief Computes the trace of a matrix (the sum of the main diagonal !! elements). !! From b9d11d8ef9e7a84c06f3b2608869323f5c2d984f Mon Sep 17 00:00:00 2001 From: jchristopherson Date: Sun, 11 Dec 2022 07:24:27 -0600 Subject: [PATCH 11/65] Add C API tests --- tests/CMakeLists.txt | 1 + tests/c_linalg_test.c | 25 ++++ tests/c_linalg_test.h | 12 ++ tests/c_linalg_test_eigen.c | 116 +++++++++++++++ tests/c_linalg_test_factor.c | 265 +++++++++++++++++++++++++++++++++++ tests/c_test_core.c | 13 +- tests/c_test_core.h | 3 + 7 files changed, 434 insertions(+), 1 deletion(-) create mode 100644 tests/c_linalg_test_eigen.c diff --git a/tests/CMakeLists.txt b/tests/CMakeLists.txt index 342c8153..fbd84252 100644 --- a/tests/CMakeLists.txt +++ b/tests/CMakeLists.txt @@ -36,6 +36,7 @@ set(linalg_c_test_sources c_test_core.c c_linalg_test_misc.c c_linalg_test_factor.c + c_linalg_test_eigen.c ) # Build the C API tests diff --git a/tests/c_linalg_test.c b/tests/c_linalg_test.c index e06f9858..ad66b8bc 100644 --- a/tests/c_linalg_test.c +++ b/tests/c_linalg_test.c @@ -50,6 +50,31 @@ int main() check = test_cholesky(); if (!check) flag = 9; + check = test_cmplx_cholesky(); + if (!check) flag = -9; + + check = test_cholesky_rank1_update(); + if (!check) flag = 10; + // check = test_cmplx_cholesky_rank1_update(); + // if (!check) flag = -10; + + check = test_svd(); + if (!check) flag = 11; + check = test_cmplx_svd(); + if (!check) flag = -11; + + check = test_inverse(); + if (!check) flag = 12; + check = test_cmplx_inverse(); + if (!check) flag = -12; + + check = test_eigen_symm(); + if (!check) flag = 13; + + check = test_eigen_asymm(); + if (!check) flag = 14; + check = test_cmplx_eigen_asymm(); + if (!check) flag = -14; // End return flag; diff --git a/tests/c_linalg_test.h b/tests/c_linalg_test.h index acc9386c..8b834739 100644 --- a/tests/c_linalg_test.h +++ b/tests/c_linalg_test.h @@ -26,5 +26,17 @@ bool test_cmplx_qr_pivot(); bool test_qr_rank1_update(); bool test_cmplx_qr_rank1_update(); bool test_cholesky(); +bool test_cmplx_cholesky(); +bool test_cholesky_rank1_update(); +bool test_cmplx_cholesky_rank1_update(); +bool test_svd(); +bool test_cmplx_svd(); +bool test_inverse(); +bool test_cmplx_inverse(); + +// c_linalg_test_eigen.c +bool test_eigen_symm(); +bool test_eigen_asymm(); +bool test_cmplx_eigen_asymm(); #endif diff --git a/tests/c_linalg_test_eigen.c b/tests/c_linalg_test_eigen.c new file mode 100644 index 00000000..8fb257fa --- /dev/null +++ b/tests/c_linalg_test_eigen.c @@ -0,0 +1,116 @@ +#include "linalg.h" +#include "c_linalg_test.h" +#include "c_test_core.h" + + +bool test_eigen_symm() +{ + // Variables + const int n = 50; + const int nn = n * n; + const double tol = 1.0e-8; + double zero = 0.0; + double one = 1.0; + double a[nn], a1[nn], vals[n], t[nn], t1[nn]; + bool rst; + int flag; + + // Initialization + rst = true; + create_symmetric_matrix(n, a); + copy_matrix(n, n, a, a1); + + // Compute the eigenvalues and eigenvectors + flag = la_eigen_symm(true, n, a, n, vals); + if (flag != LA_NO_ERROR) rst = false; + + // Compute A1 * VECS = VECS * VALS + flag = la_mtx_mult(false, false, n, n, n, one, a1, n, a, n, zero, t, n); + if (flag != LA_NO_ERROR) rst = false; + + flag = la_diag_mtx_mult(false, false, n, n, n, one, vals, a, n, zero, t1, n); + if (flag != LA_NO_ERROR) rst = false; + + // Test + if (!is_mtx_equal(n, n, t, t1, tol)) rst = false; + return rst; +} + + + + + +bool test_eigen_asymm() +{ + // Variables + const int n = 50; + const int nn = n * n; + const double tol = 1.0e-8; + const double zero = 0.0; + const double one = 1.0; + double a[nn]; + double complex a1[nn], vals[n], vecs[nn], t[nn], t1[nn]; + bool rst; + int flag; + + // Initialization + rst = true; + create_matrix(n, n, a); + to_complex(nn, a, a1); + + // Compute the eigenvalues and eigenvectors + flag = la_eigen_asymm(true, n, a, n, vals, vecs, n); + if (flag != LA_NO_ERROR) rst = false; + + // Compute A1 * VECS = VECS * VALS + flag = la_mtx_mult_cmplx(LA_NO_OPERATION, LA_NO_OPERATION, n, n, n, one, + a1, n, vecs, n, zero, t, n); + if (flag != LA_NO_ERROR) rst = false; + + flag = la_diag_mtx_mult_cmplx(false, LA_NO_OPERATION, n, n, n, one, vals, + vecs, n, zero, t1, n); + if (flag != LA_NO_ERROR) rst = false; + + // Test + if (!is_cmplx_mtx_equal(n, n, t, t1, tol)) rst = false; + return rst; +} + +bool test_cmplx_eigen_asymm() +{ + // Variables + const int n = 50; + const int nn = n * n; + const double tol = 1.0e-8; + const double complex zero = 0.0 + 0.0 * I; + const double complex one = 1.0 + 0.0 * I; + double complex a[nn], a1[nn], vals[n], vecs[nn], t[nn], t1[nn]; + bool rst; + int flag; + + // Initialization + rst = true; + cmplx_create_matrix(n, n, a); + cmplx_copy_matrix(n, n, a, a1); + + // Compute the eigenvalues and eigenvectors + flag = la_eigen_cmplx(true, n, a, n, vals, vecs, n); + if (flag != LA_NO_ERROR) rst = false; + + // Compute A1 * VECS = VECS * VALS + flag = la_mtx_mult_cmplx(LA_NO_OPERATION, LA_NO_OPERATION, n, n, n, one, + a1, n, vecs, n, zero, t, n); + if (flag != LA_NO_ERROR) rst = false; + + flag = la_diag_mtx_mult_cmplx(false, LA_NO_OPERATION, n, n, n, one, vals, + vecs, n, zero, t1, n); + if (flag != LA_NO_ERROR) rst = false; + + // Test + if (!is_cmplx_mtx_equal(n, n, t, t1, tol)) rst = false; + return rst; +} + + + + diff --git a/tests/c_linalg_test_factor.c b/tests/c_linalg_test_factor.c index 3c972b34..2daf69f3 100644 --- a/tests/c_linalg_test_factor.c +++ b/tests/c_linalg_test_factor.c @@ -384,3 +384,268 @@ bool test_cholesky() // End return rst; } + +bool test_cmplx_cholesky() +{ + // Variables + const int n = 50; + const int nrhs = 20; + const int nn = n * n; + const int nnrhs = n * nrhs; + const double tol = 1.0e-8; + const double complex zero = 0.0 + 0.0 * I; + const double complex one = 1.0 + 0.0 * I; + double complex a[nn], a1[nn], b[nnrhs], b1[nnrhs], bref[nnrhs]; + bool rst; + int flag; + + // Initialization + rst = true; + cmplx_create_symmetric_matrix(n, a); + cmplx_copy_matrix(n, n, a, a1); + cmplx_create_matrix(n, nrhs, b); + cmplx_copy_matrix(n, nrhs, b, b1); + + // Factor A + flag = la_cholesky_factor_cmplx(true, n, a, n); + if (flag != LA_NO_ERROR) rst = false; + + // Solve A * X = B for X + flag = la_solve_cholesky_cmplx(true, n, nrhs, a, n, b, n); + if (flag != LA_NO_ERROR) rst = false; + + // Check A * X = B + flag = la_mtx_mult_cmplx(LA_NO_OPERATION, LA_NO_OPERATION, n, nrhs, n, one, + a1, n, b, n, zero, bref, n); + if (flag != LA_NO_ERROR) rst = false; + + // Test + if (!is_cmplx_mtx_equal(n, nrhs, b1, bref, tol)) rst = false; + + // End + return rst; +} + + + + +bool test_cholesky_rank1_update() +{ + // Variables + const int n = 50; + const int nn = n * n; + const double tol = 1.0e-8; + const double zero = 0.0; + const double one = 1.0; + double a[nn], a1[nn], u[n], c[nn]; + bool rst; + int flag; + + // Initialization + rst = true; + create_symmetric_matrix(n, a); + copy_matrix(n, n, a, a1); + create_array(n, u); + + // Compute the factorization + flag = la_cholesky_factor(true, n, a, n); + if (flag != LA_NO_ERROR) rst = false; + + // Perform the rank 1 update to matrix A + flag = la_rank1_update(n, n, one, u, u, a1, n); + if (flag != LA_NO_ERROR) rst = false; + + // Update the factorization + flag = la_cholesky_rank1_update(n, a, n, u); + if (flag != LA_NO_ERROR) rst = false; + + // Ensure R**T * R = A + flag = la_mtx_mult(true, false, n, n, n, one, a, n, a, n, zero, c, n); + if (flag != LA_NO_ERROR) rst = false; + if (!is_mtx_equal(n, n, c, a1, tol)) rst = false; + + // End + return rst; +} + +bool test_cmplx_cholesky_rank1_update() +{ + // Variables + const int n = 50; + const int nn = n * n; + const double tol = 1.0e-8; + const double complex zero = 0.0 + 0.0 * I; + const double complex one = 1.0 + 0.0 * I; + double complex a[nn], a1[nn], u[n], c[nn]; + bool rst; + int flag; + + // Initialization + rst = true; + cmplx_create_symmetric_matrix(n, a); + cmplx_copy_matrix(n, n, a, a1); + cmplx_create_array(n, u); + + // Compute the factorization + flag = la_cholesky_factor_cmplx(true, n, a, n); + if (flag != LA_NO_ERROR) rst = false; + + // Perform the rank 1 update to matrix A + flag = la_rank1_update_cmplx(n, n, one, u, u, a1, n); + if (flag != LA_NO_ERROR) rst = false; + + // Update the factorization + flag = la_cholesky_rank1_update_cmplx(n, a, n, u); + if (flag != LA_NO_ERROR) rst = false; + + // Ensure R**T * R = A + flag = la_mtx_mult_cmplx(LA_TRANSPOSE, LA_NO_OPERATION, n, n, n, + one, a, n, a, n, zero, c, n); + if (flag != LA_NO_ERROR) rst = false; + if (!is_cmplx_mtx_equal(n, n, c, a1, tol)) rst = false; + + // End + return rst; +} + + + + +bool test_svd() +{ + // Variables + const int m = 60; + const int n = 50; + const int mn = m * n; + const int mm = m * m; + const int nn = n * n; + const int minmn = MIN(m, n); + const double tol = 1.0e-8; + const double zero = 0.0; + const double one = 1.0; + double a[mn], a1[mn], u[mm], s[minmn], vt[nn], us[mn]; + bool rst; + int flag; + + // Initialization + rst = true; + create_matrix(m, n, a); + copy_matrix(m, n, a, a1); + + // Compute the SVD + flag = la_svd(m, n, a, m, s, u, m, vt, n); + if (flag != LA_NO_ERROR) rst = false; + + // Compute U * S * V**T + flag = la_diag_mtx_mult(false, false, m, n, minmn, one, s, u, m, zero, us, m); + if (flag != LA_NO_ERROR) rst = false; + + // Compute (U * S) * V**T + flag = la_mtx_mult(false, false, m, n, n, one, us, m, vt, n, zero, a, m); + if (flag != LA_NO_ERROR) rst = false; + + // Test + if (!is_mtx_equal(m, n, a, a1, tol)) rst = false; + return rst; +} + +bool test_cmplx_svd() +{ + // Variables + const int m = 60; + const int n = 50; + const int mn = m * n; + const int mm = m * m; + const int nn = n * n; + const int minmn = MIN(m, n); + const double tol = 1.0e-8; + const double complex zero = 0.0 + 0.0 * I; + const double complex one = 1.0 + 0.0 * I; + double complex a[mn], a1[mn], u[mm], vt[nn], us[mn]; + double s[minmn]; + bool rst; + int flag; + + // Initialization + rst = true; + cmplx_create_matrix(m, n, a); + cmplx_copy_matrix(m, n, a, a1); + + // Compute the SVD + flag = la_svd_cmplx(m, n, a, m, s, u, m, vt, n); + if (flag != LA_NO_ERROR) rst = false; + + // Compute U * S * V**T + flag = la_diag_mtx_mult_mixed(false, LA_NO_OPERATION, m, n, minmn, one, s, + u, m, zero, us, m); + if (flag != LA_NO_ERROR) rst = false; + + // Compute (U * S) * V**T + flag = la_mtx_mult_cmplx(LA_NO_OPERATION, LA_NO_OPERATION, m, n, n, one, + us, m, vt, n, zero, a, m); + if (flag != LA_NO_ERROR) rst = false; + + // Test + if (!is_cmplx_mtx_equal(m, n, a, a1, tol)) rst = false; + return rst; +} + + + + + +bool test_inverse() +{ + // Variables + const int n = 50; + const int nn = n * n; + const double tol = 1.0e-8; + double a[nn], a1[nn], ainv[nn]; + bool rst; + int flag; + + // Initialization + rst = true; + create_matrix(n, n, a); + copy_matrix(n, n, a, a1); + + // Compute the inverse (traditional) + flag = la_inverse(n, a, n); + if (flag != LA_NO_ERROR) rst = false; + + // Compute the inverse using the Moore-Penrose approach + flag = la_pinverse(n, n, a1, n, ainv, n); + if (flag != LA_NO_ERROR) rst = false; + + // Test + if (!is_mtx_equal(n, n, a, ainv, tol)) rst = false; + return rst; +} + +bool test_cmplx_inverse() +{ + // Variables + const int n = 50; + const int nn = n * n; + const double tol = 1.0e-8; + double complex a[nn], a1[nn], ainv[nn]; + bool rst; + int flag; + + // Initialization + rst = true; + cmplx_create_matrix(n, n, a); + cmplx_copy_matrix(n, n, a, a1); + + // Compute the inverse (traditional) + flag = la_inverse_cmplx(n, a, n); + if (flag != LA_NO_ERROR) rst = false; + + // Compute the inverse using the Moore-Penrose approach + flag = la_pinverse_cmplx(n, n, a1, n, ainv, n); + if (flag != LA_NO_ERROR) rst = false; + + // Test + if (!is_cmplx_mtx_equal(n, n, a, ainv, tol)) rst = false; + return rst; +} diff --git a/tests/c_test_core.c b/tests/c_test_core.c index def89e54..0206eb75 100644 --- a/tests/c_test_core.c +++ b/tests/c_test_core.c @@ -188,7 +188,7 @@ void cmplx_create_symmetric_matrix(int n, double complex *x) temp2 = (double complex*)malloc((size_t)(n * n * sizeof(double complex))); if (!temp2) return; cmplx_create_matrix(n, n, temp1); - cmplx_transpose(n, n, temp1, temp2); + conj_transpose(n, n, temp1, temp2); cmplx_mtx_mult(n, n, n, temp1, temp2, x); free(temp1); free(temp2); @@ -444,3 +444,14 @@ void zero_int_array(int n, int *x) int i; for (i = 0; i < n; ++i) x[i] = 0; } + + + + + + +void to_complex(int n, const double *src, double complex *dst) +{ + int i; + for (i = 0; i < n; ++i) dst[i] = src[i] + 0.0 * I; +} diff --git a/tests/c_test_core.h b/tests/c_test_core.h index 039cf22c..41572f99 100644 --- a/tests/c_test_core.h +++ b/tests/c_test_core.h @@ -89,4 +89,7 @@ void cmplx_create_triangular_matrix(bool upper, int n, double complex *x); // Zeros an array void zero_int_array(int n, int *x); +// Convert from double to complex +void to_complex(int n, const double *src, double complex *dst); + #endif \ No newline at end of file From 45217cc74af74b64b336bd23961cf29ba05bcc6d Mon Sep 17 00:00:00 2001 From: jchristopherson Date: Sun, 11 Dec 2022 07:39:41 -0600 Subject: [PATCH 12/65] Add tests to C API --- include/linalg.h | 11 ++++------ tests/c_linalg_test.c | 3 +++ tests/c_linalg_test.h | 1 + tests/c_linalg_test_eigen.c | 44 +++++++++++++++++++++++++++++++++++++ 4 files changed, 52 insertions(+), 7 deletions(-) diff --git a/include/linalg.h b/include/linalg.h index c71bc852..7289509c 100644 --- a/include/linalg.h +++ b/include/linalg.h @@ -1461,17 +1461,14 @@ int la_eigen_asymm(bool vecs, int n, double *a, int lda, * @param b On input, the N-by-N matrix B. On output, the contents * of this matrix are overwritten. * @param ldb The leading dimension of matrix B. - * @param alpha An N-element array that, if @p beta is not supplied, - * contains the eigenvalues. If @p beta is supplied however, the + * @param alpha An N-element array a factor of the eigenvalues. The * eigenvalues must be computed as ALPHA / BETA. This however, is not as * trivial as it seems as it is entirely possible, and likely, that * ALPHA / BETA can overflow or underflow. With that said, the values in * ALPHA will always be less than and usually comparable with the NORM(A). - * @param beta An optional N-element array that if provided forces - * @p alpha to return the numerator, and this array contains the - * denominator used to determine the eigenvalues as ALPHA / BETA. If used, - * the values in this array will always be less than and usually comparable - * with the NORM(B). + * @param beta An N-element array that contains the denominator used to + * determine the eigenvalues as ALPHA / BETA. If used, the values in this + * array will always be less than and usually comparable with the NORM(B). * @param v An N-by-N matrix where the right eigenvectors will be * written (one per column). * diff --git a/tests/c_linalg_test.c b/tests/c_linalg_test.c index ad66b8bc..651f4615 100644 --- a/tests/c_linalg_test.c +++ b/tests/c_linalg_test.c @@ -76,6 +76,9 @@ int main() check = test_cmplx_eigen_asymm(); if (!check) flag = -14; + check = test_eigen_gen(); + if (!check) flag = 15; + // End return flag; } diff --git a/tests/c_linalg_test.h b/tests/c_linalg_test.h index 8b834739..e50c61d5 100644 --- a/tests/c_linalg_test.h +++ b/tests/c_linalg_test.h @@ -38,5 +38,6 @@ bool test_cmplx_inverse(); bool test_eigen_symm(); bool test_eigen_asymm(); bool test_cmplx_eigen_asymm(); +bool test_eigen_gen(); #endif diff --git a/tests/c_linalg_test_eigen.c b/tests/c_linalg_test_eigen.c index 8fb257fa..2b9a1da9 100644 --- a/tests/c_linalg_test_eigen.c +++ b/tests/c_linalg_test_eigen.c @@ -114,3 +114,47 @@ bool test_cmplx_eigen_asymm() +bool test_eigen_gen() +{ + // Variables + const int n = 50; + const int nn = n * n; + const double tol = 1.0e-8; + const double complex zero = 0.0 + 0.0 * I; + const double complex one = 1.0 + 0.0 * I; + double a[nn], b[nn], beta[n]; + double complex alpha[n], vecs[nn], vals[n], ac[nn], bc[nn], av[nn], bv[nn], + bvn[nn]; + bool rst; + int i, flag; + + // Initialization + rst = true; + create_matrix(n, n, a); + create_matrix(n, n, b); + to_complex(nn, a, ac); + to_complex(nn, b, bc); + + // Compute the eigenvalues and eigenvectors + flag = la_eigen_gen(true, n, a, n, b, n, alpha, beta, vecs, n); + if (flag != LA_NO_ERROR) rst = false; + + // Compute alpha / beta - may over or underflow + for (i = 0; i < n; ++i) vals[i] = alpha[i] / beta[i]; + + // Compute A * VECS = B * VECS * VALS + flag = la_mtx_mult_cmplx(LA_NO_OPERATION, LA_NO_OPERATION, n, n, n, one, + ac, n, vecs, n, zero, av, n); + if (flag != LA_NO_ERROR) rst = false; + + flag = la_mtx_mult_cmplx(LA_NO_OPERATION, LA_NO_OPERATION, n, n, n, one, + bc, n, vecs, n, zero, bv, n); + if (flag != LA_NO_ERROR) rst = false; + flag = la_diag_mtx_mult_cmplx(false, LA_NO_OPERATION, n, n, n, one, vals, + bv, n, zero, bvn, n); + if (flag != LA_NO_ERROR) rst = false; + + // Test + if (!is_cmplx_mtx_equal(n, n, av, bvn, tol)) rst = false; + return rst; +} From 00f33b89cfe6bee0cb0cdf5dd00254d510f41480 Mon Sep 17 00:00:00 2001 From: jchristopherson Date: Sun, 11 Dec 2022 21:05:33 -0600 Subject: [PATCH 13/65] Update documentation --- doc/Doxyfile | 657 +- doc/html/annotated.html | 109 +- doc/html/annotated_dup.js | 52 +- doc/html/bc_sd.png | Bin 0 -> 635 bytes doc/html/classes.html | 179 +- .../dir_68267d1309a1af8e8297ef4c3efbcdba.html | 83 +- .../dir_d44c64559bbebec7f509842c48db8b23.html | 67 +- doc/html/docd.png | Bin 0 -> 756 bytes doc/html/doxygen.css | 1135 +-- doc/html/doxygen.svg | 26 + doc/html/dynsections.js | 37 +- doc/html/files.html | 71 +- doc/html/functions.html | 213 +- doc/html/functions_func.html | 160 +- doc/html/functions_vars.html | 103 +- doc/html/graph_legend.dot | 39 +- doc/html/graph_legend.html | 127 +- doc/html/index.html | 67 +- ...alg__core_1_1cholesky__factor-members.html | 64 +- ...rfacelinalg__core_1_1cholesky__factor.html | 94 +- ..._1_1cholesky__rank1__downdate-members.html | 64 +- ...lg__core_1_1cholesky__rank1__downdate.html | 94 +- ...re_1_1cholesky__rank1__update-members.html | 64 +- ...nalg__core_1_1cholesky__rank1__update.html | 94 +- .../interfacelinalg__core_1_1det-members.html | 64 +- doc/html/interfacelinalg__core_1_1det.html | 76 +- ...nalg__core_1_1diag__mtx__mult-members.html | 68 +- ...erfacelinalg__core_1_1diag__mtx__mult.html | 132 +- ...nterfacelinalg__core_1_1eigen-members.html | 66 +- doc/html/interfacelinalg__core_1_1eigen.html | 90 +- ...rfacelinalg__core_1_1form__lu-members.html | 66 +- .../interfacelinalg__core_1_1form__lu.html | 100 +- ...rfacelinalg__core_1_1form__qr-members.html | 66 +- .../interfacelinalg__core_1_1form__qr.html | 98 +- ...acelinalg__core_1_1lu__factor-members.html | 64 +- .../interfacelinalg__core_1_1lu__factor.html | 88 +- ...elinalg__core_1_1mtx__inverse-members.html | 64 +- ...interfacelinalg__core_1_1mtx__inverse.html | 84 +- ...facelinalg__core_1_1mtx__mult-members.html | 66 +- .../interfacelinalg__core_1_1mtx__mult.html | 122 +- ...linalg__core_1_1mtx__pinverse-members.html | 64 +- ...nterfacelinalg__core_1_1mtx__pinverse.html | 84 +- ...facelinalg__core_1_1mtx__rank-members.html | 64 +- .../interfacelinalg__core_1_1mtx__rank.html | 76 +- ...rfacelinalg__core_1_1mult__qr-members.html | 66 +- .../interfacelinalg__core_1_1mult__qr.html | 98 +- ...rfacelinalg__core_1_1mult__rz-members.html | 66 +- .../interfacelinalg__core_1_1mult__rz.html | 82 +- ...acelinalg__core_1_1qr__factor-members.html | 66 +- .../interfacelinalg__core_1_1qr__factor.html | 94 +- ...lg__core_1_1qr__rank1__update-members.html | 64 +- ...facelinalg__core_1_1qr__rank1__update.html | 100 +- ...linalg__core_1_1rank1__update-members.html | 64 +- ...nterfacelinalg__core_1_1rank1__update.html | 95 +- ...g__core_1_1recip__mult__array-members.html | 63 +- ...acelinalg__core_1_1recip__mult__array.html | 73 +- ...acelinalg__core_1_1rz__factor-members.html | 64 +- .../interfacelinalg__core_1_1rz__factor.html | 76 +- ...nalg__core_1_1solve__cholesky-members.html | 66 +- ...erfacelinalg__core_1_1solve__cholesky.html | 100 +- ...core_1_1solve__least__squares-members.html | 66 +- ...linalg__core_1_1solve__least__squares.html | 90 +- ..._1solve__least__squares__full-members.html | 66 +- ...__core_1_1solve__least__squares__full.html | 90 +- ...1_1solve__least__squares__svd-members.html | 64 +- ...g__core_1_1solve__least__squares__svd.html | 84 +- ...facelinalg__core_1_1solve__lu-members.html | 66 +- .../interfacelinalg__core_1_1solve__lu.html | 94 +- ...facelinalg__core_1_1solve__qr-members.html | 70 +- .../interfacelinalg__core_1_1solve__qr.html | 106 +- ..._1_1solve__triangular__system-members.html | 66 +- ...lg__core_1_1solve__triangular__system.html | 100 +- ...interfacelinalg__core_1_1sort-members.html | 68 +- doc/html/interfacelinalg__core_1_1sort.html | 88 +- .../interfacelinalg__core_1_1svd-members.html | 64 +- doc/html/interfacelinalg__core_1_1svd.html | 88 +- ...interfacelinalg__core_1_1swap-members.html | 64 +- doc/html/interfacelinalg__core_1_1swap.html | 76 +- ...nterfacelinalg__core_1_1trace-members.html | 64 +- doc/html/interfacelinalg__core_1_1trace.html | 76 +- ...inalg__core_1_1tri__mtx__mult-members.html | 64 +- ...terfacelinalg__core_1_1tri__mtx__mult.html | 76 +- ...nalg__immutable_1_1mat__eigen-members.html | 64 +- ...erfacelinalg__immutable_1_1mat__eigen.html | 162 +- ...elinalg__immutable_1_1mat__lu-members.html | 64 +- ...interfacelinalg__immutable_1_1mat__lu.html | 151 +- ..._immutable_1_1mat__mult__diag-members.html | 68 +- ...elinalg__immutable_1_1mat__mult__diag.html | 377 +- ...able_1_1mat__mult__lower__tri-members.html | 66 +- ...g__immutable_1_1mat__mult__lower__tri.html | 275 +- ...able_1_1mat__mult__upper__tri-members.html | 66 +- ...g__immutable_1_1mat__mult__upper__tri.html | 275 +- ...ble_1_1mat__solve__lower__tri-members.html | 66 +- ...__immutable_1_1mat__solve__lower__tri.html | 275 +- ...ble_1_1mat__solve__upper__tri-members.html | 66 +- ...__immutable_1_1mat__solve__upper__tri.html | 275 +- doc/html/jquery.js | 11 +- doc/html/linalg_8h_source.html | 582 +- doc/html/linalg__basic_8f90_source.html | 4197 +++++----- doc/html/linalg__c__api_8f90_source.html | 3905 +++++----- doc/html/linalg__constants_8f90_source.html | 113 +- doc/html/linalg__core_8f90_source.html | 2449 +++--- doc/html/linalg__eigen_8f90_source.html | 1241 +-- doc/html/linalg__factor_8f90_source.html | 5585 +++++++------- doc/html/linalg__immutable_8f90_source.html | 1613 ++-- doc/html/linalg__solve_8f90_source.html | 6825 +++++++++-------- doc/html/linalg__sorting_8f90_source.html | 1149 +-- doc/html/menu.js | 130 +- doc/html/menudata.js | 43 +- doc/html/namespacelinalg__c__api.html | 547 +- doc/html/namespacelinalg__constants.html | 319 +- doc/html/namespacelinalg__core.html | 67 +- doc/html/namespacelinalg__core.js | 64 +- doc/html/namespacelinalg__immutable.html | 1490 +--- doc/html/namespacelinalg__immutable.js | 27 +- doc/html/namespacemembers.html | 475 +- doc/html/namespacemembers_func.html | 425 +- doc/html/namespacemembers_vars.html | 100 +- doc/html/namespaces.html | 113 +- doc/html/namespaces_dup.js | 82 +- doc/html/nav_fd.png | Bin 0 -> 169 bytes doc/html/nav_hd.png | Bin 0 -> 114 bytes doc/html/navtree.css | 22 +- doc/html/navtree.js | 41 +- doc/html/navtreedata.js | 33 +- doc/html/navtreeindex0.js | 283 +- doc/html/navtreeindex1.js | 75 + doc/html/resize.js | 133 +- doc/html/search/all_1.js | 4 +- doc/html/search/all_2.js | 4 +- doc/html/search/all_3.js | 4 +- doc/html/search/all_4.js | 2 +- doc/html/search/all_5.js | 2 +- doc/html/search/all_6.js | 154 +- doc/html/search/all_7.js | 72 +- doc/html/search/all_8.js | 2 +- doc/html/search/all_9.js | 2 +- doc/html/search/all_a.js | 10 +- doc/html/search/all_b.js | 8 +- doc/html/search/all_c.js | 26 +- doc/html/search/all_d.js | 6 +- doc/html/search/all_e.js | 2 +- doc/html/search/all_f.js | 6 +- doc/html/search/classes_0.js | 6 +- doc/html/search/classes_1.js | 4 +- doc/html/search/classes_2.js | 4 +- doc/html/search/classes_3.js | 4 +- doc/html/search/classes_4.js | 6 +- doc/html/search/classes_5.js | 26 +- doc/html/search/classes_6.js | 8 +- doc/html/search/classes_7.js | 6 +- doc/html/search/classes_8.js | 24 +- doc/html/search/classes_9.js | 4 +- doc/html/search/close.svg | 31 + doc/html/search/functions_0.js | 2 +- doc/html/search/functions_1.js | 121 +- doc/html/search/functions_2.js | 46 +- doc/html/search/mag.svg | 37 + doc/html/search/mag_d.svg | 37 + doc/html/search/mag_sel.svg | 74 + doc/html/search/mag_seld.svg | 74 + doc/html/search/namespaces_0.js | 8 +- doc/html/search/pages_0.js | 4 + doc/html/search/search.css | 178 +- doc/html/search/search.js | 200 +- doc/html/search/searchdata.js | 9 +- doc/html/search/variables_0.js | 2 +- doc/html/search/variables_1.js | 18 +- doc/html/search/variables_2.js | 2 +- doc/html/search/variables_3.js | 2 +- doc/html/search/variables_4.js | 2 +- doc/html/search/variables_5.js | 2 +- doc/html/search/variables_6.js | 2 +- doc/html/search/variables_7.js | 2 +- doc/html/search/variables_8.js | 2 +- doc/html/search/variables_9.js | 6 +- doc/html/splitbard.png | Bin 0 -> 282 bytes ...__immutable_1_1eigen__results-members.html | 63 +- ...ctlinalg__immutable_1_1eigen__results.html | 118 +- ...alg__immutable_1_1lu__results-members.html | 65 +- ...tructlinalg__immutable_1_1lu__results.html | 141 +- ...mutable_1_1lu__results__cmplx-members.html | 65 +- ...nalg__immutable_1_1lu__results__cmplx.html | 141 +- ...alg__immutable_1_1qr__results-members.html | 65 +- ...tructlinalg__immutable_1_1qr__results.html | 141 +- ...mutable_1_1qr__results__cmplx-members.html | 65 +- ...nalg__immutable_1_1qr__results__cmplx.html | 141 +- ...lg__immutable_1_1svd__results-members.html | 65 +- ...ructlinalg__immutable_1_1svd__results.html | 141 +- ...utable_1_1svd__results__cmplx-members.html | 65 +- ...alg__immutable_1_1svd__results__cmplx.html | 141 +- doc/html/tab_ad.png | Bin 0 -> 135 bytes doc/html/tab_bd.png | Bin 0 -> 173 bytes doc/html/tab_hd.png | Bin 0 -> 180 bytes doc/html/tab_sd.png | Bin 0 -> 188 bytes doc/html/tabs.css | 2 +- src/linalg_core.f90 | 502 +- 197 files changed, 22240 insertions(+), 23455 deletions(-) create mode 100644 doc/html/bc_sd.png create mode 100644 doc/html/docd.png create mode 100644 doc/html/doxygen.svg create mode 100644 doc/html/nav_fd.png create mode 100644 doc/html/nav_hd.png create mode 100644 doc/html/navtreeindex1.js create mode 100644 doc/html/search/close.svg create mode 100644 doc/html/search/mag.svg create mode 100644 doc/html/search/mag_d.svg create mode 100644 doc/html/search/mag_sel.svg create mode 100644 doc/html/search/mag_seld.svg create mode 100644 doc/html/search/pages_0.js create mode 100644 doc/html/splitbard.png create mode 100644 doc/html/tab_ad.png create mode 100644 doc/html/tab_bd.png create mode 100644 doc/html/tab_hd.png create mode 100644 doc/html/tab_sd.png diff --git a/doc/Doxyfile b/doc/Doxyfile index fd5215f8..0510c5ea 100644 --- a/doc/Doxyfile +++ b/doc/Doxyfile @@ -1,4 +1,4 @@ -# Doxyfile 1.8.16 +# Doxyfile 1.9.5 # This file describes the settings to be used by the documentation system # doxygen (www.doxygen.org) for a project. @@ -12,6 +12,16 @@ # For lists, items can also be appended using: # TAG += value [value, ...] # Values that contain spaces should be placed between quotes (\" \"). +# +# Note: +# +# Use doxygen to compare the used configuration file with the template +# configuration file: +# doxygen -x [configFile] +# Use doxygen to compare the used configuration file with the template +# configuration file without replacing the environment variables or CMake type +# replacement variables: +# doxygen -x_noenv [configFile] #--------------------------------------------------------------------------- # Project related configuration options @@ -38,7 +48,7 @@ PROJECT_NAME = linalg # could be handy for archiving the generated documentation or if some version # control system is used. -PROJECT_NUMBER = 1.6.0 +PROJECT_NUMBER = 1.6.1 # Using the PROJECT_BRIEF tag one can provide an optional one line description # for a project that appears at the top of each page and should give viewer a @@ -60,16 +70,28 @@ PROJECT_LOGO = OUTPUT_DIRECTORY = . -# If the CREATE_SUBDIRS tag is set to YES then doxygen will create 4096 sub- -# directories (in 2 levels) under the output directory of each output format and -# will distribute the generated files over these directories. Enabling this +# If the CREATE_SUBDIRS tag is set to YES then doxygen will create up to 4096 +# sub-directories (in 2 levels) under the output directory of each output format +# and will distribute the generated files over these directories. Enabling this # option can be useful when feeding doxygen a huge amount of source files, where # putting all generated files in the same directory would otherwise causes -# performance problems for the file system. +# performance problems for the file system. Adapt CREATE_SUBDIRS_LEVEL to +# control the number of sub-directories. # The default value is: NO. CREATE_SUBDIRS = NO +# Controls the number of sub-directories that will be created when +# CREATE_SUBDIRS tag is set to YES. Level 0 represents 16 directories, and every +# level increment doubles the number of directories, resulting in 4096 +# directories at level 8 which is the default and also the maximum value. The +# sub-directories are organized in 2 levels, the first level always has a fixed +# numer of 16 directories. +# Minimum value: 0, maximum value: 8, default value: 8. +# This tag requires that the tag CREATE_SUBDIRS is set to YES. + +CREATE_SUBDIRS_LEVEL = 8 + # If the ALLOW_UNICODE_NAMES tag is set to YES, doxygen will allow non-ASCII # characters to appear in the names of generated files. If set to NO, non-ASCII # characters will be escaped, for example _xE3_x81_x84 will be used for Unicode @@ -81,26 +103,18 @@ ALLOW_UNICODE_NAMES = NO # The OUTPUT_LANGUAGE tag is used to specify the language in which all # documentation generated by doxygen is written. Doxygen will use this # information to generate all constant output in the proper language. -# Possible values are: Afrikaans, Arabic, Armenian, Brazilian, Catalan, Chinese, -# Chinese-Traditional, Croatian, Czech, Danish, Dutch, English (United States), -# Esperanto, Farsi (Persian), Finnish, French, German, Greek, Hungarian, -# Indonesian, Italian, Japanese, Japanese-en (Japanese with English messages), -# Korean, Korean-en (Korean with English messages), Latvian, Lithuanian, -# Macedonian, Norwegian, Persian (Farsi), Polish, Portuguese, Romanian, Russian, -# Serbian, Serbian-Cyrillic, Slovak, Slovene, Spanish, Swedish, Turkish, -# Ukrainian and Vietnamese. +# Possible values are: Afrikaans, Arabic, Armenian, Brazilian, Bulgarian, +# Catalan, Chinese, Chinese-Traditional, Croatian, Czech, Danish, Dutch, English +# (United States), Esperanto, Farsi (Persian), Finnish, French, German, Greek, +# Hindi, Hungarian, Indonesian, Italian, Japanese, Japanese-en (Japanese with +# English messages), Korean, Korean-en (Korean with English messages), Latvian, +# Lithuanian, Macedonian, Norwegian, Persian (Farsi), Polish, Portuguese, +# Romanian, Russian, Serbian, Serbian-Cyrillic, Slovak, Slovene, Spanish, +# Swedish, Turkish, Ukrainian and Vietnamese. # The default value is: English. OUTPUT_LANGUAGE = English -# The OUTPUT_TEXT_DIRECTION tag is used to specify the direction in which all -# documentation generated by doxygen is written. Doxygen will use this -# information to generate all generated output in the proper direction. -# Possible values are: None, LTR, RTL and Context. -# The default value is: None. - -OUTPUT_TEXT_DIRECTION = None - # If the BRIEF_MEMBER_DESC tag is set to YES, doxygen will include brief member # descriptions after the members that are listed in the file and class # documentation (similar to Javadoc). Set to NO to disable this. @@ -227,6 +241,14 @@ QT_AUTOBRIEF = NO MULTILINE_CPP_IS_BRIEF = NO +# By default Python docstrings are displayed as preformatted text and doxygen's +# special commands cannot be used. By setting PYTHON_DOCSTRING to NO the +# doxygen's special commands can be used and the contents of the docstring +# documentation blocks is shown as doxygen documentation. +# The default value is: YES. + +PYTHON_DOCSTRING = YES + # If the INHERIT_DOCS tag is set to YES then an undocumented member inherits the # documentation from any documented member that it re-implements. # The default value is: YES. @@ -250,25 +272,19 @@ TAB_SIZE = 4 # the documentation. An alias has the form: # name=value # For example adding -# "sideeffect=@par Side Effects:\n" +# "sideeffect=@par Side Effects:^^" # will allow you to put the command \sideeffect (or @sideeffect) in the # documentation, which will result in a user-defined paragraph with heading -# "Side Effects:". You can put \n's in the value part of an alias to insert -# newlines (in the resulting output). You can put ^^ in the value part of an -# alias to insert a newline as if a physical newline was in the original file. -# When you need a literal { or } or , in the value part of an alias you have to -# escape them by means of a backslash (\), this can lead to conflicts with the -# commands \{ and \} for these it is advised to use the version @{ and @} or use -# a double escape (\\{ and \\}) +# "Side Effects:". Note that you cannot put \n's in the value part of an alias +# to insert newlines (in the resulting output). You can put ^^ in the value part +# of an alias to insert a newline as if a physical newline was in the original +# file. When you need a literal { or } or , in the value part of an alias you +# have to escape them by means of a backslash (\), this can lead to conflicts +# with the commands \{ and \} for these it is advised to use the version @{ and +# @} or use a double escape (\\{ and \\}) ALIASES = -# This tag can be used to specify a number of word-keyword mappings (TCL only). -# A mapping has the form "name=value". For example adding "class=itcl::class" -# will allow you to use the command class in the itcl::class meaning. - -TCL_SUBST = - # Set the OPTIMIZE_OUTPUT_FOR_C tag to YES if your project consists of C sources # only. Doxygen will then generate output that is more tailored for C. For # instance, some of the names that are used will be different. The list of all @@ -309,19 +325,22 @@ OPTIMIZE_OUTPUT_SLICE = NO # parses. With this tag you can assign which parser to use for a given # extension. Doxygen has a built-in mapping, but you can override or extend it # using this tag. The format is ext=language, where ext is a file extension, and -# language is one of the parsers supported by doxygen: IDL, Java, Javascript, -# Csharp (C#), C, C++, D, PHP, md (Markdown), Objective-C, Python, Slice, -# Fortran (fixed format Fortran: FortranFixed, free formatted Fortran: +# language is one of the parsers supported by doxygen: IDL, Java, JavaScript, +# Csharp (C#), C, C++, Lex, D, PHP, md (Markdown), Objective-C, Python, Slice, +# VHDL, Fortran (fixed format Fortran: FortranFixed, free formatted Fortran: # FortranFree, unknown formatted Fortran: Fortran. In the later case the parser # tries to guess whether the code is fixed or free formatted code, this is the -# default for Fortran type files), VHDL, tcl. For instance to make doxygen treat -# .inc files as Fortran files (default is PHP), and .f files as C (default is -# Fortran), use: inc=Fortran f=C. +# default for Fortran type files). For instance to make doxygen treat .inc files +# as Fortran files (default is PHP), and .f files as C (default is Fortran), +# use: inc=Fortran f=C. # # Note: For files without extension you can use no_extension as a placeholder. # # Note that for custom extensions you also need to set FILE_PATTERNS otherwise -# the files are not read by doxygen. +# the files are not read by doxygen. When specifying no_extension you should add +# * to the FILE_PATTERNS. +# +# Note see also the list of default file extension mappings. EXTENSION_MAPPING = @@ -455,6 +474,19 @@ TYPEDEF_HIDES_STRUCT = NO LOOKUP_CACHE_SIZE = 0 +# The NUM_PROC_THREADS specifies the number of threads doxygen is allowed to use +# during processing. When set to 0 doxygen will based this on the number of +# cores available in the system. You can set it explicitly to a value larger +# than 0 to get more control over the balance between CPU load and processing +# speed. At this moment only the input processing can be done using multiple +# threads. Since this is still an experimental feature the default is set to 1, +# which effectively disables parallel processing. Please report any issues you +# encounter. Generating dot graphs in parallel is controlled by the +# DOT_NUM_THREADS setting. +# Minimum value: 0, maximum value: 32, default value: 1. + +NUM_PROC_THREADS = 1 + #--------------------------------------------------------------------------- # Build related configuration options #--------------------------------------------------------------------------- @@ -473,7 +505,7 @@ EXTRACT_ALL = NO # be included in the documentation. # The default value is: NO. -EXTRACT_PRIVATE = YES +EXTRACT_PRIVATE = NO # If the EXTRACT_PRIV_VIRTUAL tag is set to YES, documented private virtual # methods of a class will be included in the documentation. @@ -518,6 +550,13 @@ EXTRACT_LOCAL_METHODS = NO EXTRACT_ANON_NSPACES = NO +# If this flag is set to YES, the name of an unnamed parameter in a declaration +# will be determined by the corresponding definition. By default unnamed +# parameters remain unnamed in the output. +# The default value is: YES. + +RESOLVE_UNNAMED_PARAMS = YES + # If the HIDE_UNDOC_MEMBERS tag is set to YES, doxygen will hide all # undocumented members inside documented classes or files. If set to NO these # members will be included in the various overviews, but no documentation @@ -535,8 +574,8 @@ HIDE_UNDOC_MEMBERS = NO HIDE_UNDOC_CLASSES = NO # If the HIDE_FRIEND_COMPOUNDS tag is set to YES, doxygen will hide all friend -# (class|struct|union) declarations. If set to NO, these declarations will be -# included in the documentation. +# declarations. If set to NO, these declarations will be included in the +# documentation. # The default value is: NO. HIDE_FRIEND_COMPOUNDS = NO @@ -555,12 +594,20 @@ HIDE_IN_BODY_DOCS = NO INTERNAL_DOCS = NO -# If the CASE_SENSE_NAMES tag is set to NO then doxygen will only generate file -# names in lower-case letters. If set to YES, upper-case letters are also -# allowed. This is useful if you have classes or files whose names only differ -# in case and if your file system supports case sensitive file names. Windows -# (including Cygwin) ands Mac users are advised to set this option to NO. -# The default value is: system dependent. +# With the correct setting of option CASE_SENSE_NAMES doxygen will better be +# able to match the capabilities of the underlying filesystem. In case the +# filesystem is case sensitive (i.e. it supports files in the same directory +# whose names only differ in casing), the option must be set to YES to properly +# deal with such files in case they appear in the input. For filesystems that +# are not case sensitive the option should be set to NO to properly deal with +# output files written for symbols that only differ in casing, such as for two +# classes, one named CLASS and the other named Class, and to also support +# references to files without having to specify the exact matching casing. On +# Windows (including Cygwin) and MacOS, users should typically set this option +# to NO, whereas on Linux or other Unix flavors it should typically be set to +# YES. +# Possible values are: SYSTEM, NO and YES. +# The default value is: SYSTEM. CASE_SENSE_NAMES = NO @@ -578,6 +625,12 @@ HIDE_SCOPE_NAMES = NO HIDE_COMPOUND_REFERENCE= NO +# If the SHOW_HEADERFILE tag is set to YES then the documentation for a class +# will show which file needs to be included to use the class. +# The default value is: YES. + +SHOW_HEADERFILE = YES + # If the SHOW_INCLUDE_FILES tag is set to YES then doxygen will put a list of # the files that are included by a file in the documentation of that file. # The default value is: YES. @@ -735,7 +788,8 @@ FILE_VERSION_FILTER = # output files in an output format independent way. To create the layout file # that represents doxygen's defaults, run doxygen with the -l option. You can # optionally specify a file name after the option, if omitted DoxygenLayout.xml -# will be used as the name of the layout file. +# will be used as the name of the layout file. See also section "Changing the +# layout of pages" for information. # # Note that if you run doxygen from a directory containing a file called # DoxygenLayout.xml, doxygen will parse it automatically even if the LAYOUT_FILE @@ -781,24 +835,35 @@ WARNINGS = YES WARN_IF_UNDOCUMENTED = YES # If the WARN_IF_DOC_ERROR tag is set to YES, doxygen will generate warnings for -# potential errors in the documentation, such as not documenting some parameters -# in a documented function, or documenting parameters that don't exist or using -# markup commands wrongly. +# potential errors in the documentation, such as documenting some parameters in +# a documented function twice, or documenting parameters that don't exist or +# using markup commands wrongly. # The default value is: YES. WARN_IF_DOC_ERROR = YES +# If WARN_IF_INCOMPLETE_DOC is set to YES, doxygen will warn about incomplete +# function parameter documentation. If set to NO, doxygen will accept that some +# parameters have no documentation without warning. +# The default value is: YES. + +WARN_IF_INCOMPLETE_DOC = YES + # This WARN_NO_PARAMDOC option can be enabled to get warnings for functions that # are documented, but have no documentation for their parameters or return -# value. If set to NO, doxygen will only warn about wrong or incomplete -# parameter documentation, but not about the absence of documentation. If -# EXTRACT_ALL is set to YES then this flag will automatically be disabled. +# value. If set to NO, doxygen will only warn about wrong parameter +# documentation, but not about the absence of documentation. If EXTRACT_ALL is +# set to YES then this flag will automatically be disabled. See also +# WARN_IF_INCOMPLETE_DOC # The default value is: NO. WARN_NO_PARAMDOC = NO # If the WARN_AS_ERROR tag is set to YES then doxygen will immediately stop when -# a warning is encountered. +# a warning is encountered. If the WARN_AS_ERROR tag is set to FAIL_ON_WARNINGS +# then doxygen will continue running as if WARN_AS_ERROR tag is set to NO, but +# at the end of the doxygen process doxygen will return with a non-zero status. +# Possible values are: NO, YES and FAIL_ON_WARNINGS. # The default value is: NO. WARN_AS_ERROR = NO @@ -809,13 +874,27 @@ WARN_AS_ERROR = NO # and the warning text. Optionally the format may contain $version, which will # be replaced by the version of the file (if it could be obtained via # FILE_VERSION_FILTER) +# See also: WARN_LINE_FORMAT # The default value is: $file:$line: $text. WARN_FORMAT = "$file:$line: $text" +# In the $text part of the WARN_FORMAT command it is possible that a reference +# to a more specific place is given. To make it easier to jump to this place +# (outside of doxygen) the user can define a custom "cut" / "paste" string. +# Example: +# WARN_LINE_FORMAT = "'vi $file +$line'" +# See also: WARN_FORMAT +# The default value is: at line $line of file $file. + +WARN_LINE_FORMAT = "at line $line of file $file" + # The WARN_LOGFILE tag can be used to specify a file to which warning and error # messages should be written. If left blank the output is written to standard -# error (stderr). +# error (stderr). In case the file specified cannot be opened for writing the +# warning and error messages are written to standard error. When as file - is +# specified the warning and error messages are written to standard output +# (stdout). WARN_LOGFILE = @@ -835,12 +914,23 @@ INPUT = ../src \ # This tag can be used to specify the character encoding of the source files # that doxygen parses. Internally doxygen uses the UTF-8 encoding. Doxygen uses # libiconv (or the iconv built into libc) for the transcoding. See the libiconv -# documentation (see: https://www.gnu.org/software/libiconv/) for the list of -# possible encodings. +# documentation (see: +# https://www.gnu.org/software/libiconv/) for the list of possible encodings. +# See also: INPUT_FILE_ENCODING # The default value is: UTF-8. INPUT_ENCODING = UTF-8 +# This tag can be used to specify the character encoding of the source files +# that doxygen parses The INPUT_FILE_ENCODING tag can be used to specify +# character encoding on a per file pattern basis. Doxygen will compare the file +# name with each pattern and apply the encoding instead of the default +# INPUT_ENCODING) if there is a match. The character encodings are a list of the +# form: pattern=encoding (like *.php=ISO-8859-1). See cfg_input_encoding +# "INPUT_ENCODING" for further information on supported encodings. + +INPUT_FILE_ENCODING = + # If the value of the INPUT tag contains directories, you can use the # FILE_PATTERNS tag to specify one or more wildcard patterns (like *.cpp and # *.h) to filter out the source-files in the directories. @@ -849,11 +939,15 @@ INPUT_ENCODING = UTF-8 # need to set EXTENSION_MAPPING for the extension otherwise the files are not # read by doxygen. # +# Note the list of default checked file patterns might differ from the list of +# default file extension mappings. +# # If left blank the following patterns are tested:*.c, *.cc, *.cxx, *.cpp, # *.c++, *.java, *.ii, *.ixx, *.ipp, *.i++, *.inl, *.idl, *.ddl, *.odl, *.h, -# *.hh, *.hxx, *.hpp, *.h++, *.cs, *.d, *.php, *.php4, *.php5, *.phtml, *.inc, -# *.m, *.markdown, *.md, *.mm, *.dox, *.py, *.pyw, *.f90, *.f95, *.f03, *.f08, -# *.f, *.for, *.tcl, *.vhd, *.vhdl, *.ucf, *.qsf and *.ice. +# *.hh, *.hxx, *.hpp, *.h++, *.l, *.cs, *.d, *.php, *.php4, *.php5, *.phtml, +# *.inc, *.m, *.markdown, *.md, *.mm, *.dox (to be provided as doxygen C +# comment), *.py, *.pyw, *.f90, *.f95, *.f03, *.f08, *.f18, *.f, *.for, *.vhd, +# *.vhdl, *.ucf, *.qsf and *.ice. FILE_PATTERNS = *.c \ *.cc \ @@ -940,7 +1034,7 @@ EXCLUDE_PATTERNS = # (namespaces, classes, functions, etc.) that should be excluded from the # output. The symbol name can be a fully qualified name, a word, or if the # wildcard * is used, a substring. Examples: ANamespace, AClass, -# AClass::ANamespace, ANamespace::*Test +# ANamespace::AClass, ANamespace::*Test # # Note that the wildcards are matched against the file with absolute path, so to # exclude all test directories use the pattern */test/* @@ -988,6 +1082,11 @@ IMAGE_PATH = # code is scanned, but not when the output code is generated. If lines are added # or removed, the anchors will not be placed correctly. # +# Note that doxygen will use the data processed and written to standard output +# for further processing, therefore nothing else, like debug statements or used +# commands (so in case of a Windows batch file always use @echo OFF), should be +# written to standard output. +# # Note that for custom extensions or not directly supported extensions you also # need to set EXTENSION_MAPPING for the extension otherwise the files are not # properly processed by doxygen. @@ -1029,6 +1128,15 @@ FILTER_SOURCE_PATTERNS = USE_MDFILE_AS_MAINPAGE = +# The Fortran standard specifies that for fixed formatted Fortran code all +# characters from position 72 are to be considered as comment. A common +# extension is to allow longer lines before the automatic comment starts. The +# setting FORTRAN_COMMENT_AFTER will also make it possible that longer lines can +# be processed before the automatic comment starts. +# Minimum value: 7, maximum value: 10000, default value: 72. + +FORTRAN_COMMENT_AFTER = 72 + #--------------------------------------------------------------------------- # Configuration options related to source browsing #--------------------------------------------------------------------------- @@ -1116,16 +1224,24 @@ USE_HTAGS = NO VERBATIM_HEADERS = YES # If the CLANG_ASSISTED_PARSING tag is set to YES then doxygen will use the -# clang parser (see: http://clang.llvm.org/) for more accurate parsing at the -# cost of reduced performance. This can be particularly helpful with template -# rich C++ code for which doxygen's built-in parser lacks the necessary type -# information. +# clang parser (see: +# http://clang.llvm.org/) for more accurate parsing at the cost of reduced +# performance. This can be particularly helpful with template rich C++ code for +# which doxygen's built-in parser lacks the necessary type information. # Note: The availability of this option depends on whether or not doxygen was # generated with the -Duse_libclang=ON option for CMake. # The default value is: NO. CLANG_ASSISTED_PARSING = NO +# If the CLANG_ASSISTED_PARSING tag is set to YES and the CLANG_ADD_INC_PATHS +# tag is set to YES then doxygen will add the directory of each input to the +# include path. +# The default value is: YES. +# This tag requires that the tag CLANG_ASSISTED_PARSING is set to YES. + +CLANG_ADD_INC_PATHS = YES + # If clang assisted parsing is enabled you can provide the compiler with command # line options that you would normally use when invoking the compiler. Note that # the include paths will already be set by doxygen for the files and directories @@ -1135,10 +1251,13 @@ CLANG_ASSISTED_PARSING = NO CLANG_OPTIONS = # If clang assisted parsing is enabled you can provide the clang parser with the -# path to the compilation database (see: -# http://clang.llvm.org/docs/HowToSetupToolingForLLVM.html) used when the files -# were built. This is equivalent to specifying the "-p" option to a clang tool, -# such as clang-check. These options will then be passed to the parser. +# path to the directory containing a file called compile_commands.json. This +# file is the compilation database (see: +# http://clang.llvm.org/docs/HowToSetupToolingForLLVM.html) containing the +# options used when the source files were built. This is equivalent to +# specifying the -p option to a clang tool, such as clang-check. These options +# will then be passed to the parser. Any options specified with CLANG_OPTIONS +# will be added as well. # Note: The availability of this option depends on whether or not doxygen was # generated with the -Duse_libclang=ON option for CMake. @@ -1155,13 +1274,6 @@ CLANG_DATABASE_PATH = ALPHABETICAL_INDEX = YES -# The COLS_IN_ALPHA_INDEX tag can be used to specify the number of columns in -# which the alphabetical index list will be split. -# Minimum value: 1, maximum value: 20, default value: 5. -# This tag requires that the tag ALPHABETICAL_INDEX is set to YES. - -COLS_IN_ALPHA_INDEX = 5 - # In case all classes in a project start with a common prefix, all classes will # be put under the same header in the alphabetical index. The IGNORE_PREFIX tag # can be used to specify a prefix (or a list of prefixes) that should be ignored @@ -1259,9 +1371,26 @@ HTML_EXTRA_STYLESHEET = HTML_EXTRA_FILES = +# The HTML_COLORSTYLE tag can be used to specify if the generated HTML output +# should be rendered with a dark or light theme. Default setting AUTO_LIGHT +# enables light output unless the user preference is dark output. Other options +# are DARK to always use dark mode, LIGHT to always use light mode, AUTO_DARK to +# default to dark mode unless the user prefers light mode, and TOGGLE to let the +# user toggle between dark and light mode via a button. +# Possible values are: LIGHT Always generate light output., DARK Always generate +# dark output., AUTO_LIGHT Automatically set the mode according to the user +# preference, use light mode if no preference is set (the default)., AUTO_DARK +# Automatically set the mode according to the user preference, use dark mode if +# no preference is set. and TOGGLE Allow to user to switch between light and +# dark mode via a button.. +# The default value is: AUTO_LIGHT. +# This tag requires that the tag GENERATE_HTML is set to YES. + +HTML_COLORSTYLE = AUTO_LIGHT + # The HTML_COLORSTYLE_HUE tag controls the color of the HTML output. Doxygen # will adjust the colors in the style sheet and background images according to -# this color. Hue is specified as an angle on a colorwheel, see +# this color. Hue is specified as an angle on a color-wheel, see # https://en.wikipedia.org/wiki/Hue for more information. For instance the value # 0 represents red, 60 is yellow, 120 is green, 180 is cyan, 240 is blue, 300 # purple, and 360 is red again. @@ -1271,7 +1400,7 @@ HTML_EXTRA_FILES = HTML_COLORSTYLE_HUE = 220 # The HTML_COLORSTYLE_SAT tag controls the purity (or saturation) of the colors -# in the HTML output. For a value of 0 the output will use grayscales only. A +# in the HTML output. For a value of 0 the output will use gray-scales only. A # value of 255 will produce the most vivid colors. # Minimum value: 0, maximum value: 255, default value: 100. # This tag requires that the tag GENERATE_HTML is set to YES. @@ -1300,9 +1429,9 @@ HTML_TIMESTAMP = NO # If the HTML_DYNAMIC_MENUS tag is set to YES then the generated HTML # documentation will contain a main index with vertical navigation menus that -# are dynamically created via Javascript. If disabled, the navigation index will +# are dynamically created via JavaScript. If disabled, the navigation index will # consists of multiple levels of tabs that are statically embedded in every HTML -# page. Disable this option to support browsers that do not have Javascript, +# page. Disable this option to support browsers that do not have JavaScript, # like the Qt help browser. # The default value is: YES. # This tag requires that the tag GENERATE_HTML is set to YES. @@ -1332,10 +1461,11 @@ HTML_INDEX_NUM_ENTRIES = 100 # If the GENERATE_DOCSET tag is set to YES, additional index files will be # generated that can be used as input for Apple's Xcode 3 integrated development -# environment (see: https://developer.apple.com/xcode/), introduced with OSX -# 10.5 (Leopard). To create a documentation set, doxygen will generate a -# Makefile in the HTML output directory. Running make will produce the docset in -# that directory and running make install will install the docset in +# environment (see: +# https://developer.apple.com/xcode/), introduced with OSX 10.5 (Leopard). To +# create a documentation set, doxygen will generate a Makefile in the HTML +# output directory. Running make will produce the docset in that directory and +# running make install will install the docset in # ~/Library/Developer/Shared/Documentation/DocSets so that Xcode will find it at # startup. See https://developer.apple.com/library/archive/featuredarticles/Doxy # genXcode/_index.html for more information. @@ -1352,6 +1482,13 @@ GENERATE_DOCSET = NO DOCSET_FEEDNAME = "Doxygen generated docs" +# This tag determines the URL of the docset feed. A documentation feed provides +# an umbrella under which multiple documentation sets from a single provider +# (such as a company or product suite) can be grouped. +# This tag requires that the tag GENERATE_DOCSET is set to YES. + +DOCSET_FEEDURL = + # This tag specifies a string that should uniquely identify the documentation # set bundle. This should be a reverse domain-name style string, e.g. # com.mycompany.MyDocSet. Doxygen will append .docset to the name. @@ -1377,8 +1514,12 @@ DOCSET_PUBLISHER_NAME = Publisher # If the GENERATE_HTMLHELP tag is set to YES then doxygen generates three # additional HTML index files: index.hhp, index.hhc, and index.hhk. The # index.hhp is a project file that can be read by Microsoft's HTML Help Workshop -# (see: https://www.microsoft.com/en-us/download/details.aspx?id=21138) on -# Windows. +# on Windows. In the beginning of 2021 Microsoft took the original page, with +# a.o. the download links, offline the HTML help workshop was already many years +# in maintenance mode). You can download the HTML help workshop from the web +# archives at Installation executable (see: +# http://web.archive.org/web/20160201063255/http://download.microsoft.com/downlo +# ad/0/A/9/0A939EF6-E31C-430F-A3DF-DFAE7960D564/htmlhelp.exe). # # The HTML Help Workshop contains a compiler that can convert all HTML output # generated by doxygen into a single compiled HTML file (.chm). Compiled HTML @@ -1408,7 +1549,7 @@ CHM_FILE = HHC_LOCATION = # The GENERATE_CHI flag controls if a separate .chi index file is generated -# (YES) or that it should be included in the master .chm file (NO). +# (YES) or that it should be included in the main .chm file (NO). # The default value is: NO. # This tag requires that the tag GENERATE_HTMLHELP is set to YES. @@ -1453,7 +1594,8 @@ QCH_FILE = # The QHP_NAMESPACE tag specifies the namespace to use when generating Qt Help # Project output. For more information please see Qt Help Project / Namespace -# (see: https://doc.qt.io/archives/qt-4.8/qthelpproject.html#namespace). +# (see: +# https://doc.qt.io/archives/qt-4.8/qthelpproject.html#namespace). # The default value is: org.doxygen.Project. # This tag requires that the tag GENERATE_QHP is set to YES. @@ -1461,8 +1603,8 @@ QHP_NAMESPACE = org.doxygen.Project # The QHP_VIRTUAL_FOLDER tag specifies the namespace to use when generating Qt # Help Project output. For more information please see Qt Help Project / Virtual -# Folders (see: https://doc.qt.io/archives/qt-4.8/qthelpproject.html#virtual- -# folders). +# Folders (see: +# https://doc.qt.io/archives/qt-4.8/qthelpproject.html#virtual-folders). # The default value is: doc. # This tag requires that the tag GENERATE_QHP is set to YES. @@ -1470,16 +1612,16 @@ QHP_VIRTUAL_FOLDER = doc # If the QHP_CUST_FILTER_NAME tag is set, it specifies the name of a custom # filter to add. For more information please see Qt Help Project / Custom -# Filters (see: https://doc.qt.io/archives/qt-4.8/qthelpproject.html#custom- -# filters). +# Filters (see: +# https://doc.qt.io/archives/qt-4.8/qthelpproject.html#custom-filters). # This tag requires that the tag GENERATE_QHP is set to YES. QHP_CUST_FILTER_NAME = # The QHP_CUST_FILTER_ATTRS tag specifies the list of the attributes of the # custom filter to add. For more information please see Qt Help Project / Custom -# Filters (see: https://doc.qt.io/archives/qt-4.8/qthelpproject.html#custom- -# filters). +# Filters (see: +# https://doc.qt.io/archives/qt-4.8/qthelpproject.html#custom-filters). # This tag requires that the tag GENERATE_QHP is set to YES. QHP_CUST_FILTER_ATTRS = @@ -1491,9 +1633,9 @@ QHP_CUST_FILTER_ATTRS = QHP_SECT_FILTER_ATTRS = -# The QHG_LOCATION tag can be used to specify the location of Qt's -# qhelpgenerator. If non-empty doxygen will try to run qhelpgenerator on the -# generated .qhp file. +# The QHG_LOCATION tag can be used to specify the location (absolute path +# including file name) of Qt's qhelpgenerator. If non-empty doxygen will try to +# run qhelpgenerator on the generated .qhp file. # This tag requires that the tag GENERATE_QHP is set to YES. QHG_LOCATION = @@ -1536,16 +1678,28 @@ DISABLE_INDEX = NO # to work a browser that supports JavaScript, DHTML, CSS and frames is required # (i.e. any modern browser). Windows users are probably better off using the # HTML help feature. Via custom style sheets (see HTML_EXTRA_STYLESHEET) one can -# further fine-tune the look of the index. As an example, the default style -# sheet generated by doxygen has an example that shows how to put an image at -# the root of the tree instead of the PROJECT_NAME. Since the tree basically has -# the same information as the tab index, you could consider setting -# DISABLE_INDEX to YES when enabling this option. +# further fine tune the look of the index (see "Fine-tuning the output"). As an +# example, the default style sheet generated by doxygen has an example that +# shows how to put an image at the root of the tree instead of the PROJECT_NAME. +# Since the tree basically has the same information as the tab index, you could +# consider setting DISABLE_INDEX to YES when enabling this option. # The default value is: NO. # This tag requires that the tag GENERATE_HTML is set to YES. GENERATE_TREEVIEW = YES +# When both GENERATE_TREEVIEW and DISABLE_INDEX are set to YES, then the +# FULL_SIDEBAR option determines if the side bar is limited to only the treeview +# area (value NO) or if it should extend to the full height of the window (value +# YES). Setting this to YES gives a layout similar to +# https://docs.readthedocs.io with more room for contents, but less room for the +# project logo, title, and description. If either GENERATE_TREEVIEW or +# DISABLE_INDEX is set to NO, this option has no effect. +# The default value is: NO. +# This tag requires that the tag GENERATE_HTML is set to YES. + +FULL_SIDEBAR = NO + # The ENUM_VALUES_PER_LINE tag can be used to set the number of enum values that # doxygen will group on one line in the generated HTML documentation. # @@ -1570,6 +1724,24 @@ TREEVIEW_WIDTH = 250 EXT_LINKS_IN_WINDOW = NO +# If the OBFUSCATE_EMAILS tag is set to YES, doxygen will obfuscate email +# addresses. +# The default value is: YES. +# This tag requires that the tag GENERATE_HTML is set to YES. + +OBFUSCATE_EMAILS = YES + +# If the HTML_FORMULA_FORMAT option is set to svg, doxygen will use the pdf2svg +# tool (see https://github.com/dawbarton/pdf2svg) or inkscape (see +# https://inkscape.org) to generate formulas as SVG images instead of PNGs for +# the HTML output. These images will generally look nicer at scaled resolutions. +# Possible values are: png (the default) and svg (looks nicer but requires the +# pdf2svg or inkscape tool). +# The default value is: png. +# This tag requires that the tag GENERATE_HTML is set to YES. + +HTML_FORMULA_FORMAT = png + # Use this tag to change the font size of LaTeX formulas included as images in # the HTML documentation. When you change the font size after a successful # doxygen run you need to manually remove any form_*.png images from the HTML @@ -1579,19 +1751,14 @@ EXT_LINKS_IN_WINDOW = NO FORMULA_FONTSIZE = 10 -# Use the FORMULA_TRANSPARENT tag to determine whether or not the images -# generated for formulas are transparent PNGs. Transparent PNGs are not -# supported properly for IE 6.0, but are supported on all modern browsers. -# -# Note that when changing this option you need to delete any form_*.png files in -# the HTML output directory before the changes have effect. -# The default value is: YES. -# This tag requires that the tag GENERATE_HTML is set to YES. +# The FORMULA_MACROFILE can contain LaTeX \newcommand and \renewcommand commands +# to create new LaTeX commands to be used in formulas as building blocks. See +# the section "Including formulas" for details. -FORMULA_TRANSPARENT = YES +FORMULA_MACROFILE = # Enable the USE_MATHJAX option to render LaTeX formulas using MathJax (see -# https://www.mathjax.org) which uses client side Javascript for the rendering +# https://www.mathjax.org) which uses client side JavaScript for the rendering # instead of using pre-rendered bitmaps. Use this if you do not have LaTeX # installed or if you want to formulas look prettier in the HTML output. When # enabled you may also need to install MathJax separately and configure the path @@ -1599,13 +1766,31 @@ FORMULA_TRANSPARENT = YES # The default value is: NO. # This tag requires that the tag GENERATE_HTML is set to YES. -USE_MATHJAX = NO +USE_MATHJAX = YES + +# With MATHJAX_VERSION it is possible to specify the MathJax version to be used. +# Note that the different versions of MathJax have different requirements with +# regards to the different settings, so it is possible that also other MathJax +# settings have to be changed when switching between the different MathJax +# versions. +# Possible values are: MathJax_2 and MathJax_3. +# The default value is: MathJax_2. +# This tag requires that the tag USE_MATHJAX is set to YES. + +MATHJAX_VERSION = MathJax_2 # When MathJax is enabled you can set the default output format to be used for -# the MathJax output. See the MathJax site (see: -# http://docs.mathjax.org/en/latest/output.html) for more details. +# the MathJax output. For more details about the output format see MathJax +# version 2 (see: +# http://docs.mathjax.org/en/v2.7-latest/output.html) and MathJax version 3 +# (see: +# http://docs.mathjax.org/en/latest/web/components/output.html). # Possible values are: HTML-CSS (which is slower, but has the best -# compatibility), NativeMML (i.e. MathML) and SVG. +# compatibility. This is the name for Mathjax version 2, for MathJax version 3 +# this will be translated into chtml), NativeMML (i.e. MathML. Only supported +# for NathJax 2. For MathJax version 3 chtml will be used instead.), chtml (This +# is the name for Mathjax version 3, for MathJax version 2 this will be +# translated into HTML-CSS) and SVG. # The default value is: HTML-CSS. # This tag requires that the tag USE_MATHJAX is set to YES. @@ -1618,22 +1803,29 @@ MATHJAX_FORMAT = HTML-CSS # MATHJAX_RELPATH should be ../mathjax. The default value points to the MathJax # Content Delivery Network so you can quickly see the result without installing # MathJax. However, it is strongly recommended to install a local copy of -# MathJax from https://www.mathjax.org before deployment. -# The default value is: https://cdnjs.cloudflare.com/ajax/libs/mathjax/2.7.5/. +# MathJax from https://www.mathjax.org before deployment. The default value is: +# - in case of MathJax version 2: https://cdn.jsdelivr.net/npm/mathjax@2 +# - in case of MathJax version 3: https://cdn.jsdelivr.net/npm/mathjax@3 # This tag requires that the tag USE_MATHJAX is set to YES. MATHJAX_RELPATH = http://cdn.mathjax.org/mathjax/latest # The MATHJAX_EXTENSIONS tag can be used to specify one or more MathJax # extension names that should be enabled during MathJax rendering. For example +# for MathJax version 2 (see +# https://docs.mathjax.org/en/v2.7-latest/tex.html#tex-and-latex-extensions): # MATHJAX_EXTENSIONS = TeX/AMSmath TeX/AMSsymbols +# For example for MathJax version 3 (see +# http://docs.mathjax.org/en/latest/input/tex/extensions/index.html): +# MATHJAX_EXTENSIONS = ams # This tag requires that the tag USE_MATHJAX is set to YES. MATHJAX_EXTENSIONS = # The MATHJAX_CODEFILE tag can be used to specify a file with javascript pieces # of code that will be used on startup of the MathJax code. See the MathJax site -# (see: http://docs.mathjax.org/en/latest/output.html) for more details. For an +# (see: +# http://docs.mathjax.org/en/v2.7-latest/output.html) for more details. For an # example see the documentation. # This tag requires that the tag USE_MATHJAX is set to YES. @@ -1661,7 +1853,7 @@ MATHJAX_CODEFILE = SEARCHENGINE = YES # When the SERVER_BASED_SEARCH tag is enabled the search engine will be -# implemented using a web server instead of a web client using Javascript. There +# implemented using a web server instead of a web client using JavaScript. There # are two flavors of web server based searching depending on the EXTERNAL_SEARCH # setting. When disabled, doxygen will generate a PHP script for searching and # an index file used by the script. When EXTERNAL_SEARCH is enabled the indexing @@ -1680,7 +1872,8 @@ SERVER_BASED_SEARCH = NO # # Doxygen ships with an example indexer (doxyindexer) and search engine # (doxysearch.cgi) which are based on the open source search engine library -# Xapian (see: https://xapian.org/). +# Xapian (see: +# https://xapian.org/). # # See the section "External Indexing and Searching" for details. # The default value is: NO. @@ -1693,8 +1886,9 @@ EXTERNAL_SEARCH = NO # # Doxygen ships with an example indexer (doxyindexer) and search engine # (doxysearch.cgi) which are based on the open source search engine library -# Xapian (see: https://xapian.org/). See the section "External Indexing and -# Searching" for details. +# Xapian (see: +# https://xapian.org/). See the section "External Indexing and Searching" for +# details. # This tag requires that the tag SEARCHENGINE is set to YES. SEARCHENGINE_URL = @@ -1803,29 +1997,31 @@ PAPER_TYPE = a4 EXTRA_PACKAGES = -# The LATEX_HEADER tag can be used to specify a personal LaTeX header for the -# generated LaTeX document. The header should contain everything until the first -# chapter. If it is left blank doxygen will generate a standard header. See -# section "Doxygen usage" for information on how to let doxygen write the -# default header to a separate file. +# The LATEX_HEADER tag can be used to specify a user-defined LaTeX header for +# the generated LaTeX document. The header should contain everything until the +# first chapter. If it is left blank doxygen will generate a standard header. It +# is highly recommended to start with a default header using +# doxygen -w latex new_header.tex new_footer.tex new_stylesheet.sty +# and then modify the file new_header.tex. See also section "Doxygen usage" for +# information on how to generate the default header that doxygen normally uses. # -# Note: Only use a user-defined header if you know what you are doing! The -# following commands have a special meaning inside the header: $title, -# $datetime, $date, $doxygenversion, $projectname, $projectnumber, -# $projectbrief, $projectlogo. Doxygen will replace $title with the empty -# string, for the replacement values of the other commands the user is referred -# to HTML_HEADER. +# Note: Only use a user-defined header if you know what you are doing! +# Note: The header is subject to change so you typically have to regenerate the +# default header when upgrading to a newer version of doxygen. The following +# commands have a special meaning inside the header (and footer): For a +# description of the possible markers and block names see the documentation. # This tag requires that the tag GENERATE_LATEX is set to YES. LATEX_HEADER = -# The LATEX_FOOTER tag can be used to specify a personal LaTeX footer for the -# generated LaTeX document. The footer should contain everything after the last -# chapter. If it is left blank doxygen will generate a standard footer. See +# The LATEX_FOOTER tag can be used to specify a user-defined LaTeX footer for +# the generated LaTeX document. The footer should contain everything after the +# last chapter. If it is left blank doxygen will generate a standard footer. See # LATEX_HEADER for more information on how to generate a default footer and what -# special commands can be used inside the footer. -# -# Note: Only use a user-defined footer if you know what you are doing! +# special commands can be used inside the footer. See also section "Doxygen +# usage" for information on how to generate the default footer that doxygen +# normally uses. Note: Only use a user-defined footer if you know what you are +# doing! # This tag requires that the tag GENERATE_LATEX is set to YES. LATEX_FOOTER = @@ -1858,9 +2054,11 @@ LATEX_EXTRA_FILES = PDF_HYPERLINKS = YES -# If the USE_PDFLATEX tag is set to YES, doxygen will use pdflatex to generate -# the PDF file directly from the LaTeX files. Set this option to YES, to get a -# higher quality PDF documentation. +# If the USE_PDFLATEX tag is set to YES, doxygen will use the engine as +# specified with LATEX_CMD_NAME to generate the PDF file directly from the LaTeX +# files. Set this option to YES, to get a higher quality PDF documentation. +# +# See also section LATEX_CMD_NAME for selecting the engine. # The default value is: YES. # This tag requires that the tag GENERATE_LATEX is set to YES. @@ -1868,8 +2066,7 @@ USE_PDFLATEX = YES # If the LATEX_BATCHMODE tag is set to YES, doxygen will add the \batchmode # command to the generated LaTeX files. This will instruct LaTeX to keep running -# if errors occur, instead of asking the user for help. This option is also used -# when generating formulas in HTML. +# if errors occur, instead of asking the user for help. # The default value is: NO. # This tag requires that the tag GENERATE_LATEX is set to YES. @@ -1882,16 +2079,6 @@ LATEX_BATCHMODE = NO LATEX_HIDE_INDICES = NO -# If the LATEX_SOURCE_CODE tag is set to YES then doxygen will include source -# code with syntax highlighting in the LaTeX output. -# -# Note that which sources are shown also depends on other settings such as -# SOURCE_BROWSER. -# The default value is: NO. -# This tag requires that the tag GENERATE_LATEX is set to YES. - -LATEX_SOURCE_CODE = NO - # The LATEX_BIB_STYLE tag can be used to specify the style to use for the # bibliography, e.g. plainnat, or ieeetr. See # https://en.wikipedia.org/wiki/BibTeX and \cite for more info. @@ -1972,16 +2159,6 @@ RTF_STYLESHEET_FILE = RTF_EXTENSIONS_FILE = -# If the RTF_SOURCE_CODE tag is set to YES then doxygen will include source code -# with syntax highlighting in the RTF output. -# -# Note that which sources are shown also depends on other settings such as -# SOURCE_BROWSER. -# The default value is: NO. -# This tag requires that the tag GENERATE_RTF is set to YES. - -RTF_SOURCE_CODE = NO - #--------------------------------------------------------------------------- # Configuration options related to the man page output #--------------------------------------------------------------------------- @@ -2078,15 +2255,6 @@ GENERATE_DOCBOOK = NO DOCBOOK_OUTPUT = docbook -# If the DOCBOOK_PROGRAMLISTING tag is set to YES, doxygen will include the -# program listings (including syntax highlighting and cross-referencing -# information) to the DOCBOOK output. Note that enabling this will significantly -# increase the size of the DOCBOOK output. -# The default value is: NO. -# This tag requires that the tag GENERATE_DOCBOOK is set to YES. - -DOCBOOK_PROGRAMLISTING = NO - #--------------------------------------------------------------------------- # Configuration options for the AutoGen Definitions output #--------------------------------------------------------------------------- @@ -2099,6 +2267,10 @@ DOCBOOK_PROGRAMLISTING = NO GENERATE_AUTOGEN_DEF = NO +#--------------------------------------------------------------------------- +# Configuration options related to Sqlite3 output +#--------------------------------------------------------------------------- + #--------------------------------------------------------------------------- # Configuration options related to the Perl module output #--------------------------------------------------------------------------- @@ -2173,7 +2345,8 @@ SEARCH_INCLUDES = YES # The INCLUDE_PATH tag can be used to specify one or more directories that # contain include files that are not input files but should be processed by the -# preprocessor. +# preprocessor. Note that the INCLUDE_PATH is not recursive, so the setting of +# RECURSIVE has no effect here. # This tag requires that the tag SEARCH_INCLUDES is set to YES. INCLUDE_PATH = @@ -2265,15 +2438,6 @@ EXTERNAL_PAGES = YES # Configuration options related to the dot tool #--------------------------------------------------------------------------- -# If the CLASS_DIAGRAMS tag is set to YES, doxygen will generate a class diagram -# (in HTML and LaTeX) for classes with base or super classes. Setting the tag to -# NO turns the diagrams off. Note that this option also works with HAVE_DOT -# disabled, but it is recommended to install and use dot, since it yields more -# powerful graphs. -# The default value is: YES. - -CLASS_DIAGRAMS = YES - # You can include diagrams made with dia in doxygen documentation. Doxygen will # then run dia to produce the diagram and insert it in the documentation. The # DIA_PATH tag allows you to specify the directory where the dia binary resides. @@ -2306,35 +2470,50 @@ HAVE_DOT = YES DOT_NUM_THREADS = 0 -# When you want a differently looking font in the dot files that doxygen -# generates you can specify the font name using DOT_FONTNAME. You need to make -# sure dot is able to find the font, which can be done by putting it in a -# standard location or by setting the DOTFONTPATH environment variable or by -# setting DOT_FONTPATH to the directory containing the font. -# The default value is: Helvetica. +# DOT_COMMON_ATTR is common attributes for nodes, edges and labels of +# subgraphs. When you want a differently looking font in the dot files that +# doxygen generates you can specify fontname, fontcolor and fontsize attributes. +# For details please see Node, +# Edge and Graph Attributes specification You need to make sure dot is able +# to find the font, which can be done by putting it in a standard location or by +# setting the DOTFONTPATH environment variable or by setting DOT_FONTPATH to the +# directory containing the font. Default graphviz fontsize is 14. +# The default value is: fontname=Helvetica,fontsize=10. +# This tag requires that the tag HAVE_DOT is set to YES. + +DOT_COMMON_ATTR = "fontname=Helvetica,fontsize=10" + +# DOT_EDGE_ATTR is concatenated with DOT_COMMON_ATTR. For elegant style you can +# add 'arrowhead=open, arrowtail=open, arrowsize=0.5'. Complete documentation about +# arrows shapes. +# The default value is: labelfontname=Helvetica,labelfontsize=10. # This tag requires that the tag HAVE_DOT is set to YES. -DOT_FONTNAME = Helvetica +DOT_EDGE_ATTR = "labelfontname=Helvetica,labelfontsize=10" -# The DOT_FONTSIZE tag can be used to set the size (in points) of the font of -# dot graphs. -# Minimum value: 4, maximum value: 24, default value: 10. +# DOT_NODE_ATTR is concatenated with DOT_COMMON_ATTR. For view without boxes +# around nodes set 'shape=plain' or 'shape=plaintext' Shapes specification +# The default value is: shape=box,height=0.2,width=0.4. # This tag requires that the tag HAVE_DOT is set to YES. -DOT_FONTSIZE = 10 +DOT_NODE_ATTR = "shape=box,height=0.2,width=0.4" -# By default doxygen will tell dot to use the default font as specified with -# DOT_FONTNAME. If you specify a different font using DOT_FONTNAME you can set -# the path where dot can find it using this tag. +# You can set the path where dot can find font specified with fontname in +# DOT_COMMON_ATTR and others dot attributes. # This tag requires that the tag HAVE_DOT is set to YES. DOT_FONTPATH = -# If the CLASS_GRAPH tag is set to YES then doxygen will generate a graph for -# each documented class showing the direct and indirect inheritance relations. -# Setting this tag to YES will force the CLASS_DIAGRAMS tag to NO. +# If the CLASS_GRAPH tag is set to YES (or GRAPH) then doxygen will generate a +# graph for each documented class showing the direct and indirect inheritance +# relations. In case HAVE_DOT is set as well dot will be used to draw the graph, +# otherwise the built-in generator will be used. If the CLASS_GRAPH tag is set +# to TEXT the direct and indirect inheritance relations will be shown as texts / +# links. +# Possible values are: NO, YES, TEXT and GRAPH. # The default value is: YES. -# This tag requires that the tag HAVE_DOT is set to YES. CLASS_GRAPH = YES @@ -2348,7 +2527,8 @@ CLASS_GRAPH = YES COLLABORATION_GRAPH = YES # If the GROUP_GRAPHS tag is set to YES then doxygen will generate a graph for -# groups, showing the direct groups dependencies. +# groups, showing the direct groups dependencies. See also the chapter Grouping +# in the manual. # The default value is: YES. # This tag requires that the tag HAVE_DOT is set to YES. @@ -2371,10 +2551,32 @@ UML_LOOK = NO # but if the number exceeds 15, the total amount of fields shown is limited to # 10. # Minimum value: 0, maximum value: 100, default value: 10. -# This tag requires that the tag HAVE_DOT is set to YES. +# This tag requires that the tag UML_LOOK is set to YES. UML_LIMIT_NUM_FIELDS = 10 +# If the DOT_UML_DETAILS tag is set to NO, doxygen will show attributes and +# methods without types and arguments in the UML graphs. If the DOT_UML_DETAILS +# tag is set to YES, doxygen will add type and arguments for attributes and +# methods in the UML graphs. If the DOT_UML_DETAILS tag is set to NONE, doxygen +# will not generate fields with class member information in the UML graphs. The +# class diagrams will look similar to the default class diagrams but using UML +# notation for the relationships. +# Possible values are: NO, YES and NONE. +# The default value is: NO. +# This tag requires that the tag UML_LOOK is set to YES. + +DOT_UML_DETAILS = NO + +# The DOT_WRAP_THRESHOLD tag can be used to set the maximum number of characters +# to display on a single line. If the actual line length exceeds this threshold +# significantly it will wrapped across multiple lines. Some heuristics are apply +# to avoid ugly line breaks. +# Minimum value: 0, maximum value: 1000, default value: 17. +# This tag requires that the tag HAVE_DOT is set to YES. + +DOT_WRAP_THRESHOLD = 17 + # If the TEMPLATE_RELATIONS tag is set to YES then the inheritance and # collaboration graphs will show the relations between templates and their # instances. @@ -2441,6 +2643,13 @@ GRAPHICAL_HIERARCHY = YES DIRECTORY_GRAPH = YES +# The DIR_GRAPH_MAX_DEPTH tag can be used to limit the maximum number of levels +# of child directories generated in directory dependency graphs by dot. +# Minimum value: 1, maximum value: 25, default value: 1. +# This tag requires that the tag DIRECTORY_GRAPH is set to YES. + +DIR_GRAPH_MAX_DEPTH = 1 + # The DOT_IMAGE_FORMAT tag can be used to set the image format of the images # generated by dot. For an explanation of the image formats see the section # output formats in the documentation of the dot tool (Graphviz (see: @@ -2494,10 +2703,10 @@ MSCFILE_DIRS = DIAFILE_DIRS = # When using plantuml, the PLANTUML_JAR_PATH tag should be used to specify the -# path where java can find the plantuml.jar file. If left blank, it is assumed -# PlantUML is not used or called during a preprocessing step. Doxygen will -# generate a warning when it encounters a \startuml command in this case and -# will not generate output for the diagram. +# path where java can find the plantuml.jar file or to the filename of jar file +# to be used. If left blank, it is assumed PlantUML is not used or called during +# a preprocessing step. Doxygen will generate a warning when it encounters a +# \startuml command in this case and will not generate output for the diagram. PLANTUML_JAR_PATH = @@ -2535,18 +2744,6 @@ DOT_GRAPH_MAX_NODES = 50 MAX_DOT_GRAPH_DEPTH = 0 -# Set the DOT_TRANSPARENT tag to YES to generate images with a transparent -# background. This is disabled by default, because dot on Windows does not seem -# to support this out of the box. -# -# Warning: Depending on the platform used, enabling this option may lead to -# badly anti-aliased labels on the edges of a graph (i.e. they become hard to -# read). -# The default value is: NO. -# This tag requires that the tag HAVE_DOT is set to YES. - -DOT_TRANSPARENT = NO - # Set the DOT_MULTI_TARGETS tag to YES to allow dot to generate multiple output # files in one run (i.e. multiple -o and -T options on the command line). This # makes dot run faster, but since only newer versions of dot (>1.8.10) support @@ -2559,14 +2756,18 @@ DOT_MULTI_TARGETS = NO # If the GENERATE_LEGEND tag is set to YES doxygen will generate a legend page # explaining the meaning of the various boxes and arrows in the dot generated # graphs. +# Note: This tag requires that UML_LOOK isn't set, i.e. the doxygen internal +# graphical representation for inheritance and collaboration diagrams is used. # The default value is: YES. # This tag requires that the tag HAVE_DOT is set to YES. GENERATE_LEGEND = YES -# If the DOT_CLEANUP tag is set to YES, doxygen will remove the intermediate dot +# If the DOT_CLEANUP tag is set to YES, doxygen will remove the intermediate # files that are used to generate the various graphs. +# +# Note: This setting is not only used for dot files but also for msc temporary +# files. # The default value is: YES. -# This tag requires that the tag HAVE_DOT is set to YES. DOT_CLEANUP = YES diff --git a/doc/html/annotated.html b/doc/html/annotated.html index 23a57bd3..ae371314 100644 --- a/doc/html/annotated.html +++ b/doc/html/annotated.html @@ -1,9 +1,9 @@ - + - - + + linalg: Data Types List @@ -13,13 +13,16 @@ - + + @@ -27,10 +30,9 @@
- - + @@ -39,21 +41,22 @@
-
linalg -  1.6.0 +
+
linalg 1.6.1
A linear algebra library that provides a user-friendly interface to several BLAS and LAPACK routines.
- + +/* @license-end */ +
@@ -67,8 +70,8 @@
@@ -81,66 +84,72 @@
- +
+
+
+
+
Loading...
+
Searching...
+
No Matches
+
+
+
-
-
Data Types List
+
Data Types List
Here are the data types with brief descriptions:
[detail level 12]
- + - + - + - + - + - + - + - + - - - + + + - + - + - + - + - + - + - + - + - + - + - + - + - + - +
 Nlinalg_coreProvides a set of common linear algebra routines
 Ccholesky_factorComputes the Cholesky factorization of a symmetric, positive definite matrix
 Ccholesky_factorComputes the Cholesky factorization of a symmetric, positive definite matrix
 Ccholesky_rank1_downdateComputes the rank 1 downdate to a Cholesky factored matrix (upper triangular)
 Ccholesky_rank1_updateComputes the rank 1 update to a Cholesky factored matrix (upper triangular)
 Ccholesky_rank1_updateComputes the rank 1 update to a Cholesky factored matrix (upper triangular)
 CdetComputes the determinant of a square matrix
 Cdiag_mtx_multMultiplies a diagonal matrix with another matrix or array
 Cdiag_mtx_multMultiplies a diagonal matrix with another matrix or array
 CeigenComputes the eigenvalues, and optionally the eigenvectors, of a matrix
 Cform_luExtracts the L and U matrices from the condensed [L\U] storage format used by the lu_factor
 Cform_luExtracts the L and U matrices from the condensed [L\U] storage format used by the lu_factor
 Cform_qrForms the full M-by-M orthogonal matrix Q from the elementary reflectors returned by the base QR factorization algorithm
 Clu_factorComputes the LU factorization of an M-by-N matrix
 Clu_factorComputes the LU factorization of an M-by-N matrix
 Cmtx_inverseComputes the inverse of a square matrix
 Cmtx_multPerforms the matrix operation: C = alpha * op(A) * op(B) + beta * C
 Cmtx_multPerforms the matrix operation: \( C = \alpha op(A) op(B) + \beta C \)
 Cmtx_pinverseComputes the Moore-Penrose pseudo-inverse of a M-by-N matrix using the singular value decomposition of the matrix
 Cmtx_rankComputes the rank of a matrix
 Cmtx_rankComputes the rank of a matrix
 Cmult_qrMultiplies a general matrix by the orthogonal matrix Q from a QR factorization
 Cmult_rzMultiplies a general matrix by the orthogonal matrix Z from an RZ factorization
 Cmult_rzMultiplies a general matrix by the orthogonal matrix Z from an RZ factorization
 Cqr_factorComputes the QR factorization of an M-by-N matrix
 Cqr_rank1_updateComputes the rank 1 update to an M-by-N QR factored matrix A (M >= N) where A = Q * R, and A1 = A + U * V**T such that A1 = Q1 * R1
 Crank1_updatePerforms the rank-1 update to matrix A such that: A = alpha * X * Y**T + A, where A is an M-by-N matrix, alpha is a scalar, X is an M-element array, and N is an N-element array. In the event that Y is complex, Y**H is used instead of Y**T
 Crecip_mult_arrayMultiplies a vector by the reciprocal of a real scalar
 Cqr_rank1_updateComputes the rank 1 update to an M-by-N QR factored matrix A (M >= N) where A = Q * R, and A1 = A + U * V**T such that A1 = Q1 * R1
 Crank1_updatePerforms the rank-1 update to matrix A such that: \( A = \alpha X Y^T + A \), where \( A \) is an M-by-N matrix, \( \alpha \)is a scalar, \( X \) is an M-element array, and \( Y \) is an N-element array. In the event that \( Y \) is complex, \( Y^H \) is used instead of \( Y^T \)
 Crecip_mult_arrayMultiplies a vector by the reciprocal of a real scalar
 Crz_factorFactors an upper trapezoidal matrix by means of orthogonal transformations such that A = R * Z = (R 0) * Z. Z is an orthogonal matrix of dimension N-by-N, and R is an M-by-M upper triangular matrix
 Csolve_choleskySolves a system of Cholesky factored equations
 Csolve_choleskySolves a system of Cholesky factored equations
 Csolve_least_squaresSolves the overdetermined or underdetermined system (A*X = B) of M equations of N unknowns
 Csolve_least_squares_fullSolves the overdetermined or underdetermined system (A*X = B) of M equations of N unknowns, but uses a full orthogonal factorization of the system
 Csolve_least_squares_fullSolves the overdetermined or underdetermined system (A*X = B) of M equations of N unknowns, but uses a full orthogonal factorization of the system
 Csolve_least_squares_svdSolves the overdetermined or underdetermined system (A*X = B) of M equations of N unknowns using a singular value decomposition of matrix A
 Csolve_luSolves a system of LU-factored equations
 Csolve_luSolves a system of LU-factored equations
 Csolve_qrSolves a system of M QR-factored equations of N unknowns
 Csolve_triangular_systemSolves a triangular system of equations
 Csolve_triangular_systemSolves a triangular system of equations
 CsortSorts an array
 CsvdComputes the singular value decomposition of a matrix A. The SVD is defined as: A = U * S * V**T, where U is an M-by-M orthogonal matrix, S is an M-by-N diagonal matrix, and V is an N-by-N orthogonal matrix
 CsvdComputes the singular value decomposition of a matrix A. The SVD is defined as: A = U * S * V**T, where U is an M-by-M orthogonal matrix, S is an M-by-N diagonal matrix, and V is an N-by-N orthogonal matrix
 CswapSwaps the contents of two arrays
 CtraceComputes the trace of a matrix (the sum of the main diagonal elements)
 CtraceComputes the trace of a matrix (the sum of the main diagonal elements)
 Ctri_mtx_multComputes the triangular matrix operation: B = alpha * A**T * A + beta * B, or B = alpha * A * A**T + beta * B, where A is a triangular matrix
 Nlinalg_immutableProvides an immutable interface to many of the core linear algebra routines in this library. The intent is to allow for ease of use in situations where memory allocation, or absolute speed are of lesser importance to code readability
 Nlinalg_immutableProvides an immutable interface to many of the core linear algebra routines in this library. The intent is to allow for ease of use in situations where memory allocation, or absolute speed are of lesser importance to code readability
 Ceigen_resultsDefines a container for the output of an Eigen analysis of a square matrix
 Clu_resultsDefines a container for the output of an LU factorization
 Clu_resultsDefines a container for the output of an LU factorization
 Clu_results_cmplxDefines a container for the output of an LU factorization
 Cmat_eigenComputes the eigenvalues and eigenvectors (right) of a general N-by-N matrix
 Cmat_eigenComputes the eigenvalues and eigenvectors (right) of a general N-by-N matrix
 Cmat_luComputes the LU factorization of a square matrix. Notice, partial row pivoting is utilized
 Cmat_mult_diagComputes the matrix operation: C = A * B, where A is a diagonal matrix
 Cmat_mult_diagComputes the matrix operation: C = A * B, where A is a diagonal matrix
 Cmat_mult_lower_triComputes the matrix operation C = A * B, where A is a lower triangular matrix
 Cmat_mult_upper_triComputes the matrix operation C = A * B, where A is an upper triangular matrix
 Cmat_mult_upper_triComputes the matrix operation C = A * B, where A is an upper triangular matrix
 Cmat_solve_lower_triSolves the lower triangular system A X = B, where A is a lower triangular matrix
 Cmat_solve_upper_triSolves the upper triangular system A X = B, where A is an upper triangular matrix
 Cmat_solve_upper_triSolves the upper triangular system A X = B, where A is an upper triangular matrix
 Cqr_resultsDefines a container for the output of a QR factorization
 Cqr_results_cmplxDefines a container for the output of a QR factorization
 Cqr_results_cmplxDefines a container for the output of a QR factorization
 Csvd_resultsDefines a container for the output of a singular value decomposition of a matrix
 Csvd_results_cmplxDefines a container for the output of a singular value decomposition of a matrix
 Csvd_results_cmplxDefines a container for the output of a singular value decomposition of a matrix
@@ -148,9 +157,7 @@ diff --git a/doc/html/annotated_dup.js b/doc/html/annotated_dup.js index 4b321bbe..729b90c4 100644 --- a/doc/html/annotated_dup.js +++ b/doc/html/annotated_dup.js @@ -1,5 +1,53 @@ var annotated_dup = [ - [ "linalg_core", "namespacelinalg__core.html", "namespacelinalg__core" ], - [ "linalg_immutable", "namespacelinalg__immutable.html", "namespacelinalg__immutable" ] + [ "linalg_core", "namespacelinalg__core.html", [ + [ "cholesky_factor", "interfacelinalg__core_1_1cholesky__factor.html", null ], + [ "cholesky_rank1_downdate", "interfacelinalg__core_1_1cholesky__rank1__downdate.html", null ], + [ "cholesky_rank1_update", "interfacelinalg__core_1_1cholesky__rank1__update.html", null ], + [ "det", "interfacelinalg__core_1_1det.html", null ], + [ "diag_mtx_mult", "interfacelinalg__core_1_1diag__mtx__mult.html", null ], + [ "eigen", "interfacelinalg__core_1_1eigen.html", null ], + [ "form_lu", "interfacelinalg__core_1_1form__lu.html", null ], + [ "form_qr", "interfacelinalg__core_1_1form__qr.html", null ], + [ "lu_factor", "interfacelinalg__core_1_1lu__factor.html", null ], + [ "mtx_inverse", "interfacelinalg__core_1_1mtx__inverse.html", null ], + [ "mtx_mult", "interfacelinalg__core_1_1mtx__mult.html", null ], + [ "mtx_pinverse", "interfacelinalg__core_1_1mtx__pinverse.html", null ], + [ "mtx_rank", "interfacelinalg__core_1_1mtx__rank.html", null ], + [ "mult_qr", "interfacelinalg__core_1_1mult__qr.html", null ], + [ "mult_rz", "interfacelinalg__core_1_1mult__rz.html", null ], + [ "qr_factor", "interfacelinalg__core_1_1qr__factor.html", null ], + [ "qr_rank1_update", "interfacelinalg__core_1_1qr__rank1__update.html", null ], + [ "rank1_update", "interfacelinalg__core_1_1rank1__update.html", null ], + [ "recip_mult_array", "interfacelinalg__core_1_1recip__mult__array.html", null ], + [ "rz_factor", "interfacelinalg__core_1_1rz__factor.html", null ], + [ "solve_cholesky", "interfacelinalg__core_1_1solve__cholesky.html", null ], + [ "solve_least_squares", "interfacelinalg__core_1_1solve__least__squares.html", null ], + [ "solve_least_squares_full", "interfacelinalg__core_1_1solve__least__squares__full.html", null ], + [ "solve_least_squares_svd", "interfacelinalg__core_1_1solve__least__squares__svd.html", null ], + [ "solve_lu", "interfacelinalg__core_1_1solve__lu.html", null ], + [ "solve_qr", "interfacelinalg__core_1_1solve__qr.html", null ], + [ "solve_triangular_system", "interfacelinalg__core_1_1solve__triangular__system.html", null ], + [ "sort", "interfacelinalg__core_1_1sort.html", null ], + [ "svd", "interfacelinalg__core_1_1svd.html", null ], + [ "swap", "interfacelinalg__core_1_1swap.html", null ], + [ "trace", "interfacelinalg__core_1_1trace.html", null ], + [ "tri_mtx_mult", "interfacelinalg__core_1_1tri__mtx__mult.html", null ] + ] ], + [ "linalg_immutable", "namespacelinalg__immutable.html", [ + [ "eigen_results", "structlinalg__immutable_1_1eigen__results.html", "structlinalg__immutable_1_1eigen__results" ], + [ "lu_results", "structlinalg__immutable_1_1lu__results.html", "structlinalg__immutable_1_1lu__results" ], + [ "lu_results_cmplx", "structlinalg__immutable_1_1lu__results__cmplx.html", "structlinalg__immutable_1_1lu__results__cmplx" ], + [ "mat_eigen", "interfacelinalg__immutable_1_1mat__eigen.html", null ], + [ "mat_lu", "interfacelinalg__immutable_1_1mat__lu.html", null ], + [ "mat_mult_diag", "interfacelinalg__immutable_1_1mat__mult__diag.html", null ], + [ "mat_mult_lower_tri", "interfacelinalg__immutable_1_1mat__mult__lower__tri.html", null ], + [ "mat_mult_upper_tri", "interfacelinalg__immutable_1_1mat__mult__upper__tri.html", null ], + [ "mat_solve_lower_tri", "interfacelinalg__immutable_1_1mat__solve__lower__tri.html", null ], + [ "mat_solve_upper_tri", "interfacelinalg__immutable_1_1mat__solve__upper__tri.html", null ], + [ "qr_results", "structlinalg__immutable_1_1qr__results.html", "structlinalg__immutable_1_1qr__results" ], + [ "qr_results_cmplx", "structlinalg__immutable_1_1qr__results__cmplx.html", "structlinalg__immutable_1_1qr__results__cmplx" ], + [ "svd_results", "structlinalg__immutable_1_1svd__results.html", "structlinalg__immutable_1_1svd__results" ], + [ "svd_results_cmplx", "structlinalg__immutable_1_1svd__results__cmplx.html", "structlinalg__immutable_1_1svd__results__cmplx" ] + ] ] ]; \ No newline at end of file diff --git a/doc/html/bc_sd.png b/doc/html/bc_sd.png new file mode 100644 index 0000000000000000000000000000000000000000..31ca888dc71049713b35c351933a8d0f36180bf1 GIT binary patch literal 635 zcmV->0)+jEP)Jwi0r1~gdSq#w{Bu1q z`craw(p2!hu$4C_$Oc3X(sI6e=9QSTwPt{G) z=htT&^~&c~L2~e{r5_5SYe7#Is-$ln>~Kd%$F#tC65?{LvQ}8O`A~RBB0N~`2M+waajO;5>3B&-viHGJeEK2TQOiPRa zfDKyqwMc4wfaEh4jt>H`nW_Zidwk@Bowp`}(VUaj-pSI(-1L>FJVsX}Yl9~JsqgsZ zUD9(rMwf23Gez6KPa|wwInZodP-2}9@fK0Ga_9{8SOjU&4l`pH4@qlQp83>>HT$xW zER^U>)MyV%t(Lu=`d=Y?{k1@}&r7ZGkFQ%z%N+sE9BtYjovzxyxCPxN6&@wLK{soQ zSmkj$aLI}miuE^p@~4}mg9OjDfGEkgY4~^XzLRUBB*O{+&vq<3v(E%+k_i%=`~j%{ Vj14gnt9}3g002ovPDHLkV1n!oC4m3{ literal 0 HcmV?d00001 diff --git a/doc/html/classes.html b/doc/html/classes.html index 36c1ff91..8805fbbe 100644 --- a/doc/html/classes.html +++ b/doc/html/classes.html @@ -1,9 +1,9 @@ - + - - + + linalg: Data Types @@ -13,13 +13,16 @@ - + + @@ -27,10 +30,9 @@
- - + @@ -39,21 +41,22 @@
-
linalg -  1.6.0 +
+
linalg 1.6.1
A linear algebra library that provides a user-friendly interface to several BLAS and LAPACK routines.
- + +/* @license-end */ +
@@ -67,8 +70,8 @@
@@ -81,111 +84,61 @@
- +
+
+
+
+
Loading...
+
Searching...
+
No Matches
+
+
+
-
-
Data Types
+
Data Types
-
c | d | e | f | l | m | q | r | s | t
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  c  
-
form_qr (linalg_core)   mat_solve_upper_tri (linalg_immutable)   recip_mult_array (linalg_core)   svd_results_cmplx (linalg_immutable)   
  l  
-
mtx_inverse (linalg_core)   rz_factor (linalg_core)   swap (linalg_core)   
cholesky_factor (linalg_core)   mtx_mult (linalg_core)   
  s  
-
  t  
-
cholesky_rank1_downdate (linalg_core)   lu_factor (linalg_core)   mtx_pinverse (linalg_core)   
cholesky_rank1_update (linalg_core)   lu_results (linalg_immutable)   mtx_rank (linalg_core)   solve_cholesky (linalg_core)   trace (linalg_core)   
  d  
-
lu_results_cmplx (linalg_immutable)   mult_qr (linalg_core)   solve_least_squares (linalg_core)   tri_mtx_mult (linalg_core)   
  m  
-
mult_rz (linalg_core)   solve_least_squares_full (linalg_core)   
det (linalg_core)   
  q  
-
solve_least_squares_svd (linalg_core)   
diag_mtx_mult (linalg_core)   mat_eigen (linalg_immutable)   solve_lu (linalg_core)   
  e  
-
mat_lu (linalg_immutable)   qr_factor (linalg_core)   solve_qr (linalg_core)   
mat_mult_diag (linalg_immutable)   qr_rank1_update (linalg_core)   solve_triangular_system (linalg_core)   
eigen (linalg_core)   mat_mult_lower_tri (linalg_immutable)   qr_results (linalg_immutable)   sort (linalg_core)   
eigen_results (linalg_immutable)   mat_mult_upper_tri (linalg_immutable)   qr_results_cmplx (linalg_immutable)   svd (linalg_core)   
  f  
-
mat_solve_lower_tri (linalg_immutable)   
  r  
-
svd_results (linalg_immutable)   
form_lu (linalg_core)   rank1_update (linalg_core)   
-
c | d | e | f | l | m | q | r | s | t
+
C | D | E | F | L | M | Q | R | S | T
+
diff --git a/doc/html/dir_68267d1309a1af8e8297ef4c3efbcdba.html b/doc/html/dir_68267d1309a1af8e8297ef4c3efbcdba.html index e9764d94..42eca553 100644 --- a/doc/html/dir_68267d1309a1af8e8297ef4c3efbcdba.html +++ b/doc/html/dir_68267d1309a1af8e8297ef4c3efbcdba.html @@ -1,11 +1,11 @@ - + - - + + -linalg: C:/Users/jchri/Documents/github/linalg/src Directory Reference +linalg: D:/Code/linalg/src Directory Reference @@ -13,13 +13,16 @@ - + + @@ -27,10 +30,9 @@
- - + @@ -39,21 +41,22 @@
-
linalg -  1.6.0 +
+
linalg 1.6.1
A linear algebra library that provides a user-friendly interface to several BLAS and LAPACK routines.
- + +/* @license-end */ +
@@ -67,8 +70,8 @@
@@ -81,25 +84,51 @@
- +
+
+
+
+
Loading...
+
Searching...
+
No Matches
+
+
+
-
-
src Directory Reference
+
src Directory Reference
+ + + + + + + + + + + + + + + + + + + + +

+Files

file  linalg_basic.f90 [code]
 
file  linalg_c_api.f90 [code]
 
file  linalg_constants.f90 [code]
 
file  linalg_core.f90 [code]
 
file  linalg_eigen.f90 [code]
 
file  linalg_factor.f90 [code]
 
file  linalg_immutable.f90 [code]
 
file  linalg_solve.f90 [code]
 
file  linalg_sorting.f90 [code]
 
diff --git a/doc/html/dir_d44c64559bbebec7f509842c48db8b23.html b/doc/html/dir_d44c64559bbebec7f509842c48db8b23.html index 2d940a50..57ba2d5b 100644 --- a/doc/html/dir_d44c64559bbebec7f509842c48db8b23.html +++ b/doc/html/dir_d44c64559bbebec7f509842c48db8b23.html @@ -1,11 +1,11 @@ - + - - + + -linalg: C:/Users/jchri/Documents/github/linalg/include Directory Reference +linalg: D:/Code/linalg/include Directory Reference @@ -13,13 +13,16 @@ - + + @@ -27,10 +30,9 @@
- - + @@ -39,21 +41,22 @@
-
linalg -  1.6.0 +
+
linalg 1.6.1
A linear algebra library that provides a user-friendly interface to several BLAS and LAPACK routines.
- + +/* @license-end */ +
@@ -67,8 +70,8 @@
@@ -81,25 +84,35 @@
- +
+
+
+
+
Loading...
+
Searching...
+
No Matches
+
+
+
-
-
include Directory Reference
+
include Directory Reference
+ + + + +

+Files

file  linalg.h [code]
 
diff --git a/doc/html/docd.png b/doc/html/docd.png new file mode 100644 index 0000000000000000000000000000000000000000..d7c94fda9bf08ecc02c7190d968452b7a2dbf04b GIT binary patch literal 756 zcmV1wr-rhpn+wxm%q2)IkAYsr{iGq<}_z5JCD4J;FN?6Qh;@TCubdp(_XdD-^ zG_#)IP7_z6hKNdx5^+FGArwLWTWCG!j+oKji?U!hxA#d-ljgkN`+e^@-P+RWG{Bx= z2iQyYTtEf*o~ySWrIVW}HWHi0_hd4~$E6Jx1U`>Owo}EYJ1O>iZvS?!z8}B}QwLMA zC3Keqf1c}K@?C`X>68b(EUzYUYAS&OH^VPteZLPr{S&|nQvp@6W4GH-1U8!u&7l~A zx~RUSNH+>7@q38W6!BzirtjLFCzc|XGx)EF#G%^pWION*k@?vP<2O>|XkCD3ujl%1 z{55JSVkw{~HbX>iEZ2%yJ2eHj5Yh8OTpzs0A2;tZ^x!#5D+y-es{k1&0|Ns9-|+Xt ziGiTsZ8(^nUo#wdTpIDkb-Zp(3|A*FzW}GZ5SQD-r^R`&X@`26E3W|GyrwDIZjtQ& z$g5f8Sv=VgVtDien@J(!^BK+#l;s-LgP--p7C;7;E!ysXcXK6?+9D>_-B(?Wm(U zQbNm-5TyYxIU=rs0+)!ixqzhuxw(AqKc3?KKX32{D~Qibp*r0x&Wux5-9WCMMRi3U zTd6dOCQlj>a;gr;gLwRKulT&(m@^L{&HkSC(qH05HSSf$YEhynGvH zWNez``Z8FJXE+BSg=%ak{OR z+Nylcb{?evLYLuE1_HngYw0g%LC#=$a@?4~Tx>F9295Q>9UJ|_6v-KMw;!YZSgGj@ zR8fRov=hJ#QvsO@xw*{0%zH@OKVEUr + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/doc/html/dynsections.js b/doc/html/dynsections.js index c8e84aaa..1f4cd14a 100644 --- a/doc/html/dynsections.js +++ b/doc/html/dynsections.js @@ -1,25 +1,26 @@ /* - @licstart The following is the entire license notice for the - JavaScript code in this file. + @licstart The following is the entire license notice for the JavaScript code in this file. - Copyright (C) 1997-2017 by Dimitri van Heesch + The MIT License (MIT) - This program is free software; you can redistribute it and/or modify - it under the terms of the GNU General Public License as published by - the Free Software Foundation; either version 2 of the License, or - (at your option) any later version. + Copyright (C) 1997-2020 by Dimitri van Heesch - This program is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. + Permission is hereby granted, free of charge, to any person obtaining a copy of this software + and associated documentation files (the "Software"), to deal in the Software without restriction, + including without limitation the rights to use, copy, modify, merge, publish, distribute, + sublicense, and/or sell copies of the Software, and to permit persons to whom the Software is + furnished to do so, subject to the following conditions: - You should have received a copy of the GNU General Public License along - with this program; if not, write to the Free Software Foundation, Inc., - 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. + The above copyright notice and this permission notice shall be included in all copies or + substantial portions of the Software. - @licend The above is the entire license notice - for the JavaScript code in this file + THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING + BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND + NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, + DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, + OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. + + @licend The above is the entire license notice for the JavaScript code in this file */ function toggleVisibility(linkObj) { @@ -46,6 +47,8 @@ function updateStripes() { $('table.directory tr'). removeClass('even').filter(':visible:even').addClass('even'); + $('table.directory tr'). + removeClass('odd').filter(':visible:odd').addClass('odd'); } function toggleLevel(level) @@ -118,10 +121,10 @@ function toggleInherit(id) } } /* @license-end */ - $(document).ready(function() { $('.code,.codeRef').each(function() { $(this).data('powertip',$('#a'+$(this).attr('href').replace(/.*\//,'').replace(/[^a-z_A-Z0-9]/g,'_')).html()); + $.fn.powerTip.smartPlacementLists.s = [ 's', 'n', 'ne', 'se' ]; $(this).powerTip({ placement: 's', smartPlacement: true, mouseOnToPopup: true }); }); }); diff --git a/doc/html/files.html b/doc/html/files.html index 2eea7d4b..1696e0a6 100644 --- a/doc/html/files.html +++ b/doc/html/files.html @@ -1,9 +1,9 @@ - + - - + + linalg: File List @@ -13,13 +13,16 @@ - + + @@ -27,10 +30,9 @@
- - + @@ -39,21 +41,22 @@
-
linalg -  1.6.0 +
+
linalg 1.6.1
A linear algebra library that provides a user-friendly interface to several BLAS and LAPACK routines.
- + +/* @license-end */ +
@@ -67,8 +70,8 @@
@@ -81,30 +84,36 @@
- +
+
+
+
+
Loading...
+
Searching...
+
No Matches
+
+
+
-
-
File List
+
File List
Here is a list of all documented files with brief descriptions:
[detail level 12]
- + - + - + - + - + - +
  include
 linalg.h
 linalg.h
  src
 linalg_basic.f90
 linalg_basic.f90
 linalg_c_api.f90
 linalg_constants.f90
 linalg_constants.f90
 linalg_core.f90
 linalg_eigen.f90
 linalg_eigen.f90
 linalg_factor.f90
 linalg_immutable.f90
 linalg_immutable.f90
 linalg_solve.f90
 linalg_sorting.f90
 linalg_sorting.f90
@@ -112,9 +121,7 @@ diff --git a/doc/html/functions.html b/doc/html/functions.html index 5b0ec663..8f414088 100644 --- a/doc/html/functions.html +++ b/doc/html/functions.html @@ -1,9 +1,9 @@ - + - - + + linalg: Data Fields @@ -13,13 +13,16 @@ - + + @@ -27,10 +30,9 @@
- - + @@ -39,21 +41,22 @@
-
linalg -  1.6.0 +
+
linalg 1.6.1
A linear algebra library that provides a user-friendly interface to several BLAS and LAPACK routines.
- + +/* @license-end */ +
@@ -67,8 +70,8 @@
@@ -81,168 +84,36 @@
- +
+
+
+
+
Loading...
+
Searching...
+
No Matches
+
+
+
-
Here is a list of all documented data types members with links to the data structure documentation for each member
- -

- l -

- - -

- m -

- - -

- p -

- - -

- q -

- - -

- r -

- - -

- s -

- - -

- u -

- - -

- v -

diff --git a/doc/html/functions_func.html b/doc/html/functions_func.html index a22e9030..4611922d 100644 --- a/doc/html/functions_func.html +++ b/doc/html/functions_func.html @@ -1,9 +1,9 @@ - + - - + + linalg: Data Fields - Functions/Subroutines @@ -13,13 +13,16 @@ - + + @@ -27,10 +30,9 @@
- - + @@ -39,21 +41,22 @@
-
linalg -  1.6.0 +
+
linalg 1.6.1
A linear algebra library that provides a user-friendly interface to several BLAS and LAPACK routines.
- + +/* @license-end */ +
@@ -67,8 +70,8 @@
@@ -81,100 +84,53 @@
- +
+
+
+
+
Loading...
+
Searching...
+
No Matches
+
+
+
 
diff --git a/doc/html/functions_vars.html b/doc/html/functions_vars.html index cf17084e..25091ab9 100644 --- a/doc/html/functions_vars.html +++ b/doc/html/functions_vars.html @@ -1,9 +1,9 @@ - + - - + + linalg: Data Fields - Variables @@ -13,13 +13,16 @@ - + + @@ -27,10 +30,9 @@
- - + @@ -39,21 +41,22 @@
-
linalg -  1.6.0 +
+
linalg 1.6.1
A linear algebra library that provides a user-friendly interface to several BLAS and LAPACK routines.
- + +/* @license-end */ +
@@ -67,8 +70,8 @@
@@ -81,60 +84,36 @@
- +
+
+
+
+
Loading...
+
Searching...
+
No Matches
+
+
+
diff --git a/doc/html/graph_legend.dot b/doc/html/graph_legend.dot index 3b0e7469..7c26c6c6 100644 --- a/doc/html/graph_legend.dot +++ b/doc/html/graph_legend.dot @@ -1,23 +1,24 @@ digraph "Graph Legend" { // LATEX_PDF_SIZE - edge [fontname="Helvetica",fontsize="10",labelfontname="Helvetica",labelfontsize="10"]; - node [fontname="Helvetica",fontsize="10",shape=record]; - Node9 [shape="box",label="Inherited",fontsize="10",height=0.2,width=0.4,fontname="Helvetica",fillcolor="grey75",style="filled" fontcolor="black"]; - Node10 -> Node9 [dir="back",color="midnightblue",fontsize="10",style="solid",fontname="Helvetica"]; - Node10 [shape="box",label="PublicBase",fontsize="10",height=0.2,width=0.4,fontname="Helvetica",color="black",URL="$classPublicBase.html"]; - Node11 -> Node10 [dir="back",color="midnightblue",fontsize="10",style="solid",fontname="Helvetica"]; - Node11 [shape="box",label="Truncated",fontsize="10",height=0.2,width=0.4,fontname="Helvetica",color="red",URL="$classTruncated.html"]; - Node13 -> Node9 [dir="back",color="darkgreen",fontsize="10",style="solid",fontname="Helvetica"]; - Node13 [shape="box",label="ProtectedBase",fontsize="10",height=0.2,width=0.4,fontname="Helvetica",color="black",URL="$classProtectedBase.html"]; - Node14 -> Node9 [dir="back",color="firebrick4",fontsize="10",style="solid",fontname="Helvetica"]; - Node14 [shape="box",label="PrivateBase",fontsize="10",height=0.2,width=0.4,fontname="Helvetica",color="black",URL="$classPrivateBase.html"]; - Node15 -> Node9 [dir="back",color="midnightblue",fontsize="10",style="solid",fontname="Helvetica"]; - Node15 [shape="box",label="Undocumented",fontsize="10",height=0.2,width=0.4,fontname="Helvetica",color="grey75"]; - Node16 -> Node9 [dir="back",color="midnightblue",fontsize="10",style="solid",fontname="Helvetica"]; - Node16 [shape="box",label="Templ< int >",fontsize="10",height=0.2,width=0.4,fontname="Helvetica",color="black",URL="$classTempl.html"]; - Node17 -> Node16 [dir="back",color="orange",fontsize="10",style="dashed",label="< int >",fontname="Helvetica"]; - Node17 [shape="box",label="Templ< T >",fontsize="10",height=0.2,width=0.4,fontname="Helvetica",color="black",URL="$classTempl.html"]; - Node18 -> Node9 [dir="back",color="darkorchid3",fontsize="10",style="dashed",label="m_usedClass",fontname="Helvetica"]; - Node18 [shape="box",label="Used",fontsize="10",height=0.2,width=0.4,fontname="Helvetica",color="black",URL="$classUsed.html"]; + bgcolor="transparent"; + edge [fontname=Helvetica,fontsize=10,labelfontname=Helvetica,labelfontsize=10]; + node [fontname=Helvetica,fontsize=10,shape=box,height=0.2,width=0.4]; + Node9 [label="Inherited",height=0.2,width=0.4,color="gray40", fillcolor="grey60", style="filled", fontcolor="black",tooltip=" "]; + Node10 -> Node9 [dir="back",color="steelblue1",style="solid"]; + Node10 [label="PublicBase",height=0.2,width=0.4,color="grey40", fillcolor="white", style="filled",URL="url.html",tooltip=" "]; + Node11 -> Node10 [dir="back",color="steelblue1",style="solid"]; + Node11 [label="Truncated",height=0.2,width=0.4,color="red", fillcolor="#FFF0F0", style="filled",URL="url.html",tooltip=" "]; + Node13 -> Node9 [dir="back",color="darkgreen",style="solid"]; + Node13 [label="ProtectedBase",color="gray40",fillcolor="white",style="filled"]; + Node14 -> Node9 [dir="back",color="firebrick4",style="solid"]; + Node14 [label="PrivateBase",color="gray40",fillcolor="white",style="filled"]; + Node15 -> Node9 [dir="back",color="steelblue1",style="solid"]; + Node15 [label="Undocumented",height=0.2,width=0.4,color="grey60", fillcolor="#E0E0E0", style="filled",tooltip=" "]; + Node16 -> Node9 [dir="back",color="steelblue1",style="solid"]; + Node16 [label="Templ\< int \>",color="gray40",fillcolor="white",style="filled"]; + Node17 -> Node16 [dir="back",color="orange",style="dashed",label="< int >",]; + Node17 [label="Templ\< T \>",color="gray40",fillcolor="white",style="filled"]; + Node18 -> Node9 [dir="back",color="darkorchid3",style="dashed",label="m_usedClass",]; + Node18 [label="Used",color="gray40",fillcolor="white",style="filled"]; } diff --git a/doc/html/graph_legend.html b/doc/html/graph_legend.html index 6b41f1b2..7929fef5 100644 --- a/doc/html/graph_legend.html +++ b/doc/html/graph_legend.html @@ -1,9 +1,9 @@ - + - - + + linalg: Graph Legend @@ -13,13 +13,16 @@ - + + @@ -27,10 +30,9 @@
- - + @@ -39,21 +41,22 @@
-
linalg -  1.6.0 +
+
linalg 1.6.1
A linear algebra library that provides a user-friendly interface to several BLAS and LAPACK routines.
- + +/* @license-end */ +
@@ -67,8 +70,8 @@
@@ -81,53 +84,59 @@
- +
+
+
+
+
Loading...
+
Searching...
+
No Matches
+
+
+
-
-
Graph Legend
+
Graph Legend
-

This page explains how to interpret the graphs that are generated by doxygen.

-

Consider the following example:

/*! Invisible class because of truncation */
-
class Invisible { };
-
-
/*! Truncated class, inheritance relation is hidden */
-
class Truncated : public Invisible { };
-
-
/* Class not documented with doxygen comments */
-
class Undocumented { };
-
-
/*! Class that is inherited using public inheritance */
-
class PublicBase : public Truncated { };
-
-
/*! A template class */
-
template<class T> class Templ { };
-
-
/*! Class that is inherited using protected inheritance */
-
class ProtectedBase { };
-
-
/*! Class that is inherited using private inheritance */
-
class PrivateBase { };
-
-
/*! Class that is used by the Inherited class */
-
class Used { };
+

This page explains how to interpret the graphs that are generated by doxygen.

+

Consider the following example:

/*! Invisible class because of truncation */
+
class Invisible { };
+
+
/*! Truncated class, inheritance relation is hidden */
+
class Truncated : public Invisible { };
-
/*! Super class that inherits a number of other classes */
-
class Inherited : public PublicBase,
-
protected ProtectedBase,
-
private PrivateBase,
-
public Undocumented,
-
public Templ<int>
+
/* Class not documented with doxygen comments */
+
class Undocumented { };
+
+
/*! Class that is inherited using public inheritance */
+
class PublicBase : public Truncated { };
+
+
/*! A template class */
+
template<class T> class Templ { };
+
+
/*! Class that is inherited using protected inheritance */
+
class ProtectedBase { };
+
+
/*! Class that is inherited using private inheritance */
+
class PrivateBase { };
+
+
/*! Class that is used by the Inherited class */
+
class Used { };
+
+
/*! Super class that inherits a number of other classes */
+
class Inherited : public PublicBase,
+
protected ProtectedBase,
+
private PrivateBase,
+
public Undocumented,
+
public Templ<int>
{
-
private:
+
private:
Used *m_usedClass;
};

This will result in the following graph:

-

The boxes in the above graph have the following meaning:

+

The boxes in the above graph have the following meaning:

  • A filled gray box represents the struct or class for which the graph is generated.
  • @@ -138,10 +147,10 @@
  • A box with a red border denotes a documented struct or class forwhich not all inheritance/containment relations are shown. A graph is truncated if it does not fit within the specified boundaries.
-

The arrows have the following meaning:

+

The arrows have the following meaning:

  • -A dark blue arrow is used to visualize a public inheritance relation between two classes.
  • +A blue arrow is used to visualize a public inheritance relation between two classes.
  • A dark green arrow is used for protected inheritance.
  • @@ -156,9 +165,7 @@ diff --git a/doc/html/index.html b/doc/html/index.html index 59defe48..96fc1481 100644 --- a/doc/html/index.html +++ b/doc/html/index.html @@ -1,11 +1,11 @@ - + - - + + -linalg: Main Page +linalg: linalg @@ -13,13 +13,16 @@ - + + @@ -27,10 +30,9 @@
    - - + @@ -39,21 +41,22 @@
    -
    linalg -  1.6.0 +
    +
    linalg 1.6.1
    A linear algebra library that provides a user-friendly interface to several BLAS and LAPACK routines.
    - + +/* @license-end */ +
@@ -67,8 +70,8 @@
@@ -81,30 +84,34 @@
- +
+
+
+
+
Loading...
+
Searching...
+
No Matches
+
+
+
-
-
-
linalg Documentation
+
+
linalg

Introduction

-

LINALG is a linear algebra library that provides a user-friendly interface to several BLAS and LAPACK routines.

+

LINALG is a linear algebra library that provides a user-friendly interface to several BLAS and LAPACK routines.

Author
Jason Christopherson
-
Version
1.6.0
+
Version
1.6.1
diff --git a/doc/html/interfacelinalg__core_1_1cholesky__factor-members.html b/doc/html/interfacelinalg__core_1_1cholesky__factor-members.html index ad67c49c..58ff7ace 100644 --- a/doc/html/interfacelinalg__core_1_1cholesky__factor-members.html +++ b/doc/html/interfacelinalg__core_1_1cholesky__factor-members.html @@ -1,9 +1,9 @@ - + - - + + linalg: Member List @@ -13,13 +13,16 @@ - + + @@ -27,10 +30,9 @@
- - + @@ -39,21 +41,22 @@
-
linalg -  1.6.0 +
+
linalg 1.6.1
A linear algebra library that provides a user-friendly interface to several BLAS and LAPACK routines.
- + +/* @license-end */ +
@@ -67,8 +70,8 @@
@@ -81,29 +84,30 @@
- +
+
+
+
+
Loading...
+
Searching...
+
No Matches
+
+
+
-
-
linalg_core::cholesky_factor Member List
+
linalg_core::cholesky_factor Member List

This is the complete list of members for linalg_core::cholesky_factor, including all inherited members.

- - - -
cholesky_factor_cmplx (defined in linalg_core::cholesky_factor)linalg_core::cholesky_factorprivate
cholesky_factor_dbl (defined in linalg_core::cholesky_factor)linalg_core::cholesky_factorprivate
+
diff --git a/doc/html/interfacelinalg__core_1_1cholesky__factor.html b/doc/html/interfacelinalg__core_1_1cholesky__factor.html index 9b72f827..e6bf814b 100644 --- a/doc/html/interfacelinalg__core_1_1cholesky__factor.html +++ b/doc/html/interfacelinalg__core_1_1cholesky__factor.html @@ -1,9 +1,9 @@ - + - - + + linalg: linalg_core::cholesky_factor Interface Reference @@ -13,13 +13,16 @@ - + + @@ -27,10 +30,9 @@
- - + @@ -39,21 +41,22 @@
-
linalg -  1.6.0 +
+
linalg 1.6.1
A linear algebra library that provides a user-friendly interface to several BLAS and LAPACK routines.
- + +/* @license-end */ +
@@ -67,8 +70,8 @@
@@ -81,37 +84,32 @@
- +
+
+
+
+
Loading...
+
Searching...
+
No Matches
+
+
+
-
-
linalg_core::cholesky_factor Interface Reference
+
linalg_core::cholesky_factor Interface Reference

Computes the Cholesky factorization of a symmetric, positive definite matrix. More...

- - - - - - -

-Private Member Functions

cholesky_factor_dbl
 
cholesky_factor_cmplx
 

Detailed Description

-

Computes the Cholesky factorization of a symmetric, positive definite matrix.

+

Computes the Cholesky factorization of a symmetric, positive definite matrix.

Usage
The following example illustrates the solution of a positive-definite system of equations via Cholesky factorization.
program example
use iso_fortran_env, only : real64, int32
- +
implicit none
! Variables
@@ -137,10 +135,10 @@
! Compute the Cholesky factorization of A considering only the upper
! triangular portion of A (the default configuration).
- +
! Compute the solution
-
call solve_cholesky(.true., a, b)
+
call solve_cholesky(.true., a, b)
! Display the results
print '(A)', "Cholesky Solution: X = "
@@ -150,15 +148,19 @@
! factorization causes A = U**T * U. Then U**T * U * X = B.
! Step 1 would then be to solve the problem U**T * Y = B, for Y.
-
call solve_triangular_system(.true., .true., .true., a, bu)
+
call solve_triangular_system(.true., .true., .true., a, bu)
! Now, solve the problem U * X = Y, for X
-
call solve_triangular_system(.true., .false., .true., a, bu)
+
call solve_triangular_system(.true., .false., .true., a, bu)
! Display the results
print '(A)', "Cholesky Solution (Manual Approach): X = "
print '(F8.4)', (bu(i), i = 1, size(bu))
end program
+
Computes the Cholesky factorization of a symmetric, positive definite matrix.
+
Solves a system of Cholesky factored equations.
+
Solves a triangular system of equations.
+
Provides a set of common linear algebra routines.
Definition: linalg_core.f90:15
The above program produces the following output.
Cholesky Solution: X =
239.5833
-65.6667
@@ -169,23 +171,17 @@
10.3333
-

Definition at line 726 of file linalg_core.f90.

+

Definition at line 857 of file linalg_core.f90.


The documentation for this interface was generated from the following file:
-
Provides a set of common linear algebra routines.
Definition: linalg_core.f90:15
-
Computes the Cholesky factorization of a symmetric, positive definite matrix.
-
Solves a system of Cholesky factored equations.
-
Solves a triangular system of equations.
diff --git a/doc/html/interfacelinalg__core_1_1cholesky__rank1__downdate-members.html b/doc/html/interfacelinalg__core_1_1cholesky__rank1__downdate-members.html index 62d1d0a1..aac664e5 100644 --- a/doc/html/interfacelinalg__core_1_1cholesky__rank1__downdate-members.html +++ b/doc/html/interfacelinalg__core_1_1cholesky__rank1__downdate-members.html @@ -1,9 +1,9 @@ - + - - + + linalg: Member List @@ -13,13 +13,16 @@ - + + @@ -27,10 +30,9 @@
- - + @@ -39,21 +41,22 @@
-
linalg -  1.6.0 +
+
linalg 1.6.1
A linear algebra library that provides a user-friendly interface to several BLAS and LAPACK routines.
- + +/* @license-end */ +
@@ -67,8 +70,8 @@
@@ -81,29 +84,30 @@
- +
+
+
+
+
Loading...
+
Searching...
+
No Matches
+
+
+
-
-
linalg_core::cholesky_rank1_downdate Member List
+
linalg_core::cholesky_rank1_downdate Member List

This is the complete list of members for linalg_core::cholesky_rank1_downdate, including all inherited members.

- - - -
cholesky_rank1_downdate_cmplx (defined in linalg_core::cholesky_rank1_downdate)linalg_core::cholesky_rank1_downdateprivate
cholesky_rank1_downdate_dbl (defined in linalg_core::cholesky_rank1_downdate)linalg_core::cholesky_rank1_downdateprivate
+
diff --git a/doc/html/interfacelinalg__core_1_1cholesky__rank1__downdate.html b/doc/html/interfacelinalg__core_1_1cholesky__rank1__downdate.html index 768d6c4c..368b18b2 100644 --- a/doc/html/interfacelinalg__core_1_1cholesky__rank1__downdate.html +++ b/doc/html/interfacelinalg__core_1_1cholesky__rank1__downdate.html @@ -1,9 +1,9 @@ - + - - + + linalg: linalg_core::cholesky_rank1_downdate Interface Reference @@ -13,13 +13,16 @@ - + + @@ -27,10 +30,9 @@
- - + @@ -39,21 +41,22 @@
-
linalg -  1.6.0 +
+
linalg 1.6.1
A linear algebra library that provides a user-friendly interface to several BLAS and LAPACK routines.
- + +/* @license-end */ +
@@ -67,8 +70,8 @@
@@ -81,38 +84,33 @@
- +
+
+
+
+
Loading...
+
Searching...
+
No Matches
+
+
+
-
-
linalg_core::cholesky_rank1_downdate Interface Reference
+
linalg_core::cholesky_rank1_downdate Interface Reference

Computes the rank 1 downdate to a Cholesky factored matrix (upper triangular). More...

- - - - - - -

-Private Member Functions

cholesky_rank1_downdate_dbl
 
cholesky_rank1_downdate_cmplx
 

Detailed Description

-

Computes the rank 1 downdate to a Cholesky factored matrix (upper triangular).

+

Computes the rank 1 downdate to a Cholesky factored matrix (upper triangular).

Usage
The following example illustrates the use of the rank 1 Cholesky downdate, and compares the results to factoring the original rank 1 downdated matrix.
program example
use iso_fortran_env, only : real64, int32
use linalg_factor, only : cholesky_factor, cholesky_rank1_downdate
- +
implicit none
! Variables
@@ -134,16 +132,16 @@
! Compute the rank 1 downdate of A
ad = a
-
call rank1_update(-1.0d0, u, u, ad)
+
call rank1_update(-1.0d0, u, u, ad)
! Compute the Cholesky factorization of the original matrix
- +
! Apply the rank 1 downdate to the factored matrix
- +
! Compute the Cholesky factorization of the downdate to the original matrix
-
call cholesky_factor(ad)
+
call cholesky_factor(ad)
! Display the matrices
print '(A)', "Downdating the Factored Form:"
@@ -156,6 +154,10 @@
print *, ad(i,:)
end do
end program
+
Computes the Cholesky factorization of a symmetric, positive definite matrix.
+
Computes the rank 1 downdate to a Cholesky factored matrix (upper triangular).
+
Performs the rank-1 update to matrix A such that: , where is an M-by-N matrix, is a scalar,...
+
Provides a set of common linear algebra routines.
Definition: linalg_core.f90:15
The above program produces the following output.
Downdating the Factored Form:
2.0000000000000000 6.0000000000000000 -8.0000000000000000
0.0000000000000000 1.0000000000000000 4.9999999999999973
@@ -166,23 +168,17 @@
0.0000000000000000 0.0000000000000000 3.0000000000000000
-

Definition at line 867 of file linalg_core.f90.

+

Definition at line 998 of file linalg_core.f90.


The documentation for this interface was generated from the following file:
-
Provides a set of common linear algebra routines.
Definition: linalg_core.f90:15
-
Computes the Cholesky factorization of a symmetric, positive definite matrix.
-
Computes the rank 1 downdate to a Cholesky factored matrix (upper triangular).
-
Performs the rank-1 update to matrix A such that: A = alpha * X * Y**T + A, where A is an M-by-N matr...
Definition: linalg_core.f90:72
diff --git a/doc/html/interfacelinalg__core_1_1cholesky__rank1__update-members.html b/doc/html/interfacelinalg__core_1_1cholesky__rank1__update-members.html index be60d81e..2bcbd080 100644 --- a/doc/html/interfacelinalg__core_1_1cholesky__rank1__update-members.html +++ b/doc/html/interfacelinalg__core_1_1cholesky__rank1__update-members.html @@ -1,9 +1,9 @@ - + - - + + linalg: Member List @@ -13,13 +13,16 @@ - + + @@ -27,10 +30,9 @@
- - + @@ -39,21 +41,22 @@
-
linalg -  1.6.0 +
+
linalg 1.6.1
A linear algebra library that provides a user-friendly interface to several BLAS and LAPACK routines.
- + +/* @license-end */ +
@@ -67,8 +70,8 @@
@@ -81,29 +84,30 @@
- +
+
+
+
+
Loading...
+
Searching...
+
No Matches
+
+
+
-
-
linalg_core::cholesky_rank1_update Member List
+
linalg_core::cholesky_rank1_update Member List

This is the complete list of members for linalg_core::cholesky_rank1_update, including all inherited members.

- - - -
cholesky_rank1_update_cmplx (defined in linalg_core::cholesky_rank1_update)linalg_core::cholesky_rank1_updateprivate
cholesky_rank1_update_dbl (defined in linalg_core::cholesky_rank1_update)linalg_core::cholesky_rank1_updateprivate
+
diff --git a/doc/html/interfacelinalg__core_1_1cholesky__rank1__update.html b/doc/html/interfacelinalg__core_1_1cholesky__rank1__update.html index 15f9ca09..57511999 100644 --- a/doc/html/interfacelinalg__core_1_1cholesky__rank1__update.html +++ b/doc/html/interfacelinalg__core_1_1cholesky__rank1__update.html @@ -1,9 +1,9 @@ - + - - + + linalg: linalg_core::cholesky_rank1_update Interface Reference @@ -13,13 +13,16 @@ - + + @@ -27,10 +30,9 @@
- - + @@ -39,21 +41,22 @@
-
linalg -  1.6.0 +
+
linalg 1.6.1
A linear algebra library that provides a user-friendly interface to several BLAS and LAPACK routines.
- + +/* @license-end */ +
@@ -67,8 +70,8 @@
@@ -81,37 +84,32 @@
- +
+
+
+
+
Loading...
+
Searching...
+
No Matches
+
+
+
-
-
linalg_core::cholesky_rank1_update Interface Reference
+
linalg_core::cholesky_rank1_update Interface Reference

Computes the rank 1 update to a Cholesky factored matrix (upper triangular). More...

- - - - - - -

-Private Member Functions

cholesky_rank1_update_dbl
 
cholesky_rank1_update_cmplx
 

Detailed Description

-

Computes the rank 1 update to a Cholesky factored matrix (upper triangular).

+

Computes the rank 1 update to a Cholesky factored matrix (upper triangular).

Usage
The following example illustrates the use of the rank 1 Cholesky update, and compares the results to factoring the original rank 1 updated matrix.
program example
use iso_fortran_env, only : real64, int32
- +
implicit none
! Variables
@@ -130,16 +128,16 @@
! Compute the rank 1 update of A
au = a
-
call rank1_update(1.0d0, u, u, au)
+
call rank1_update(1.0d0, u, u, au)
! Compute the Cholesky factorization of the original matrix
- +
! Apply the rank 1 update to the factored matrix
- +
! Compute the Cholesky factorization of the update of the original matrix
-
call cholesky_factor(au)
+
call cholesky_factor(au)
! Display the matrices
print '(A)', "Updating the Factored Form:"
@@ -152,6 +150,10 @@
print *, au(i,:)
end do
end program
+
Computes the Cholesky factorization of a symmetric, positive definite matrix.
+
Computes the rank 1 update to a Cholesky factored matrix (upper triangular).
+
Performs the rank-1 update to matrix A such that: , where is an M-by-N matrix, is a scalar,...
+
Provides a set of common linear algebra routines.
Definition: linalg_core.f90:15
The above program produces the following output.
Updating the Factored Form:
2.0615528128088303 5.4570515633174921 -7.2760687510899889
0.0000000000000000 3.0774320845949008 -2.0452498947307731
@@ -162,23 +164,17 @@
0.0000000000000000 0.0000000000000000 6.6989384530323557
-

Definition at line 794 of file linalg_core.f90.

+

Definition at line 925 of file linalg_core.f90.


The documentation for this interface was generated from the following file:
-
Provides a set of common linear algebra routines.
Definition: linalg_core.f90:15
-
Computes the Cholesky factorization of a symmetric, positive definite matrix.
-
Performs the rank-1 update to matrix A such that: A = alpha * X * Y**T + A, where A is an M-by-N matr...
Definition: linalg_core.f90:72
-
Computes the rank 1 update to a Cholesky factored matrix (upper triangular).
diff --git a/doc/html/interfacelinalg__core_1_1det-members.html b/doc/html/interfacelinalg__core_1_1det-members.html index e8d82e13..034d8979 100644 --- a/doc/html/interfacelinalg__core_1_1det-members.html +++ b/doc/html/interfacelinalg__core_1_1det-members.html @@ -1,9 +1,9 @@ - + - - + + linalg: Member List @@ -13,13 +13,16 @@ - + + @@ -27,10 +30,9 @@
- - + @@ -39,21 +41,22 @@
-
linalg -  1.6.0 +
+
linalg 1.6.1
A linear algebra library that provides a user-friendly interface to several BLAS and LAPACK routines.
- + +/* @license-end */ +
@@ -67,8 +70,8 @@
@@ -81,29 +84,30 @@
- +
+
+
+
+
Loading...
+
Searching...
+
No Matches
+
+
+
-
-
linalg_core::det Member List
+
linalg_core::det Member List

This is the complete list of members for linalg_core::det, including all inherited members.

- - - -
det_cmplx (defined in linalg_core::det)linalg_core::detprivate
det_dbl (defined in linalg_core::det)linalg_core::detprivate
+
diff --git a/doc/html/interfacelinalg__core_1_1det.html b/doc/html/interfacelinalg__core_1_1det.html index c1c33a0b..05803a9f 100644 --- a/doc/html/interfacelinalg__core_1_1det.html +++ b/doc/html/interfacelinalg__core_1_1det.html @@ -1,9 +1,9 @@ - + - - + + linalg: linalg_core::det Interface Reference @@ -13,13 +13,16 @@ - + + @@ -27,10 +30,9 @@
- - + @@ -39,21 +41,22 @@
-
linalg -  1.6.0 +
+
linalg 1.6.1
A linear algebra library that provides a user-friendly interface to several BLAS and LAPACK routines.
- + +/* @license-end */ +
@@ -67,8 +70,8 @@
@@ -81,38 +84,33 @@
- +
+
+
+
+
Loading...
+
Searching...
+
No Matches
+
+
+
-
-
linalg_core::det Interface Reference
+
linalg_core::det Interface Reference

Computes the determinant of a square matrix. More...

- - - - - - -

-Private Member Functions

det_dbl
 
det_cmplx
 

Detailed Description

-

Computes the determinant of a square matrix.

+

Computes the determinant of a square matrix.

-

Definition at line 170 of file linalg_core.f90.

+

Definition at line 301 of file linalg_core.f90.


The documentation for this interface was generated from the following file:
@@ -120,9 +118,7 @@ diff --git a/doc/html/interfacelinalg__core_1_1diag__mtx__mult-members.html b/doc/html/interfacelinalg__core_1_1diag__mtx__mult-members.html index 6008e242..5875e9ab 100644 --- a/doc/html/interfacelinalg__core_1_1diag__mtx__mult-members.html +++ b/doc/html/interfacelinalg__core_1_1diag__mtx__mult-members.html @@ -1,9 +1,9 @@ - + - - + + linalg: Member List @@ -13,13 +13,16 @@ - + + @@ -27,10 +30,9 @@
- - + @@ -39,21 +41,22 @@
-
linalg -  1.6.0 +
+
linalg 1.6.1
A linear algebra library that provides a user-friendly interface to several BLAS and LAPACK routines.
- + +/* @license-end */ +
@@ -67,8 +70,8 @@
@@ -81,33 +84,30 @@
- +
+
+
+
+
Loading...
+
Searching...
+
No Matches
+
+
+
-
-
linalg_core::diag_mtx_mult Member List
+
linalg_core::diag_mtx_mult Member List

This is the complete list of members for linalg_core::diag_mtx_mult, including all inherited members.

- - - - - - - -
diag_mtx_mult_mtx (defined in linalg_core::diag_mtx_mult)linalg_core::diag_mtx_multprivate
diag_mtx_mult_mtx2 (defined in linalg_core::diag_mtx_mult)linalg_core::diag_mtx_multprivate
diag_mtx_mult_mtx2_cmplx (defined in linalg_core::diag_mtx_mult)linalg_core::diag_mtx_multprivate
diag_mtx_mult_mtx3 (defined in linalg_core::diag_mtx_mult)linalg_core::diag_mtx_multprivate
diag_mtx_mult_mtx4 (defined in linalg_core::diag_mtx_mult)linalg_core::diag_mtx_multprivate
diag_mtx_mult_mtx_cmplx (defined in linalg_core::diag_mtx_mult)linalg_core::diag_mtx_multprivate
+
diff --git a/doc/html/interfacelinalg__core_1_1diag__mtx__mult.html b/doc/html/interfacelinalg__core_1_1diag__mtx__mult.html index 002f433e..7437e01b 100644 --- a/doc/html/interfacelinalg__core_1_1diag__mtx__mult.html +++ b/doc/html/interfacelinalg__core_1_1diag__mtx__mult.html @@ -1,9 +1,9 @@ - + - - + + linalg: linalg_core::diag_mtx_mult Interface Reference @@ -13,13 +13,16 @@ - + + @@ -27,10 +30,9 @@
- - + @@ -39,21 +41,22 @@
-
linalg -  1.6.0 +
+
linalg 1.6.1
A linear algebra library that provides a user-friendly interface to several BLAS and LAPACK routines.
- + +/* @license-end */ +
@@ -67,8 +70,8 @@
@@ -81,49 +84,64 @@
- +
+
+
+
+
Loading...
+
Searching...
+
No Matches
+
+
+
-
-
linalg_core::diag_mtx_mult Interface Reference
+
linalg_core::diag_mtx_mult Interface Reference

Multiplies a diagonal matrix with another matrix or array. More...

- - - - - - - - - - - - - - -

-Private Member Functions

diag_mtx_mult_mtx
 
diag_mtx_mult_mtx2
 
diag_mtx_mult_mtx3
 
diag_mtx_mult_mtx4
 
diag_mtx_mult_mtx_cmplx
 
diag_mtx_mult_mtx2_cmplx
 

Detailed Description

-

Multiplies a diagonal matrix with another matrix or array.

+

Multiplies a diagonal matrix with another matrix or array.

+
Syntax 1
Computes the matrix operation: \( C = \alpha A op(B) + \beta C \), or \( C = \alpha op(B) A + \beta C \).
subroutine diag_mtx_mult(logical lside, logical trans, real(real64) alpha, real(real64) a(:), real(real64) b(:,:), real(real64) beta, real(real64) c(:,:), optional class(errors) err)
+
subroutine diag_mtx_mult(logical lside, logical trans, real(real64) alpha, complex(real64) a(:), complex(real64) b(:,:), real(real64) beta, complex(real64) c(:,:), optional class(errors) err)
+
subroutine diag_mtx_mult(logical lside, logical trans, real(real64) alpha, complex(real64) a(:), real(real64) b(:,:), real(real64) beta, complex(real64) c(:,:), optional class(errors) err)
+
subroutine diag_mtx_mult(logical lside, logical trans, complex(real64) alpha, complex(real64) a(:), complex(real64) b(:,:), complex(real64) beta, complex(real64) c(:,:), optional class(errors) err)
+
subroutine diag_mtx_mult(logical lside, logical trans, complex(real64) alpha, real(real64) a(:), complex(real64) b(:,:), complex(real64) beta, complex(real64) c(:,:), optional class(errors) err)
+
+
Parameters
+ + + + + + + + + +
[in]lsideSet to true to apply matrix A from the left; else, set to false to apply matrix A from the left.
[in]transSet to true if \( op(B) = B^T \); else, set to false for \( op(B) = B\). In the complex case set to LA_TRANSPOSE if \( op(B) = B^T \), set to LA_HERMITIAN_TRANSPOSE if \( op(B) = B^H \), otherwise set to LA_NO_OPERATION if \( op(B) = B \).
[in]alphaA scalar multiplier.
[in]aA K-element array containing the diagonal elements of A where K = MIN(M,P) if lside is true; else, if lside is false, K = MIN(N,P).
[in]bThe LDB-by-TDB matrix B where (LDB = leading dimension of B, and TDB = trailing dimension of B):
    +
  • lside == true & trans == true: LDB = N, TDB = P
  • +
  • lside == true & trans == false: LDB = P, TDB = N
  • +
  • lside == false & trans == true: LDB = P, TDB = M
  • +
  • lside == false & trans == false: LDB = M, TDB = P
  • +
+
[in]betaA scalar multiplier.
[in,out]cOn input, the M-by-N matrix C. On output, the resulting M-by-N matrix.
[out]errAn optional errors-based object that if provided can be used to retrieve information relating to any errors encountered during execution. If not provided, a default implementation of the errors class is used internally to provide error handling. Possible errors and warning messages that may be encountered are as follows.
    +
  • LA_ARRAY_SIZE_ERROR: Occurs if any of the input array sizes are incorrect.
  • +
+
+
+
+
Syntax 2
Computes the matrix operation: \( B = \alpha A op(B) \), or \( B = \alpha op(B) * A \).
subroutine diag_mtx_mult(logical lside, real(real64) alpha, real(real64) a(:), real(real64) b(:,:), optional class(errors) err)
+
subroutine diag_mtx_mult(logical lside, complex(real64) alpha, complex(real64) a(:), complex(real64) b(:,:), optional class(errors) err)
+
subroutine diag_mtx_mult(logical lside, complex(real64) alpha, real(real64) a(:), complex(real64) b(:,:), optional class(errors) err)
+
Usage
The following example illustrates the use of the diagonal matrix multiplication routine to compute the S * V**T component of a singular value decomposition.
program example
use iso_fortran_env, only : int32, real64
- +
implicit none
! Variables
@@ -138,7 +156,7 @@
! Compute the singular value decomposition of A. Notice, V**T is returned
! instead of V. Also note, A is overwritten.
-
call svd(a, s, u, vt)
+
call svd(a, s, u, vt)
! Display the results
print '(A)', "U ="
@@ -155,13 +173,16 @@
end do
! Compute U * S * V**T, but first establish S in full form
-
call diag_mtx_mult(.true., 1.0d0, s, vt) ! Compute: VT = S * V**T
+
call diag_mtx_mult(.true., 1.0d0, s, vt) ! Compute: VT = S * V**T
ac = matmul(u(:,1:2), vt)
print '(A)', "U * S * V**T ="
do i = 1, size(ac, 1)
print *, ac(i,:)
end do
end program
+
Multiplies a diagonal matrix with another matrix or array.
+
Computes the singular value decomposition of a matrix A. The SVD is defined as: A = U * S * V**T,...
+
Provides a set of common linear algebra routines.
Definition: linalg_core.f90:15
The above program produces the following output.
U =
-0.47411577501825380 -0.81850539032073777 -0.32444284226152509
0.82566838523833064 -0.28535874325972488 -0.48666426339228758
@@ -178,22 +199,17 @@
-1.0000000000000000 0.99999999999999967
-

Definition at line 144 of file linalg_core.f90.

+

Definition at line 273 of file linalg_core.f90.


The documentation for this interface was generated from the following file:
-
Provides a set of common linear algebra routines.
Definition: linalg_core.f90:15
-
Computes the singular value decomposition of a matrix A. The SVD is defined as: A = U * S * V**T,...
-
Multiplies a diagonal matrix with another matrix or array.
diff --git a/doc/html/interfacelinalg__core_1_1eigen-members.html b/doc/html/interfacelinalg__core_1_1eigen-members.html index 2947c361..be7fc220 100644 --- a/doc/html/interfacelinalg__core_1_1eigen-members.html +++ b/doc/html/interfacelinalg__core_1_1eigen-members.html @@ -1,9 +1,9 @@ - + - - + + linalg: Member List @@ -13,13 +13,16 @@ - + + @@ -27,10 +30,9 @@
- - + @@ -39,21 +41,22 @@
-
linalg -  1.6.0 +
+
linalg 1.6.1
A linear algebra library that provides a user-friendly interface to several BLAS and LAPACK routines.
- + +/* @license-end */ +
@@ -67,8 +70,8 @@
@@ -81,31 +84,30 @@
- +
+
+
+
+
Loading...
+
Searching...
+
No Matches
+
+
+
-
-
linalg_core::eigen Member List
+
linalg_core::eigen Member List

This is the complete list of members for linalg_core::eigen, including all inherited members.

- - - - - -
eigen_asymm (defined in linalg_core::eigen)linalg_core::eigenprivate
eigen_cmplx (defined in linalg_core::eigen)linalg_core::eigenprivate
eigen_gen (defined in linalg_core::eigen)linalg_core::eigenprivate
eigen_symm (defined in linalg_core::eigen)linalg_core::eigenprivate
+
diff --git a/doc/html/interfacelinalg__core_1_1eigen.html b/doc/html/interfacelinalg__core_1_1eigen.html index d899611d..53209ed6 100644 --- a/doc/html/interfacelinalg__core_1_1eigen.html +++ b/doc/html/interfacelinalg__core_1_1eigen.html @@ -1,9 +1,9 @@ - + - - + + linalg: linalg_core::eigen Interface Reference @@ -13,13 +13,16 @@ - + + @@ -27,10 +30,9 @@
- - + @@ -39,21 +41,22 @@
-
linalg -  1.6.0 +
+
linalg 1.6.1
A linear algebra library that provides a user-friendly interface to several BLAS and LAPACK routines.
- + +/* @license-end */ +
@@ -67,8 +70,8 @@
@@ -81,40 +84,29 @@
- +
+
+
+
+
Loading...
+
Searching...
+
No Matches
+
+
+
-
-
linalg_core::eigen Interface Reference
+
linalg_core::eigen Interface Reference

Computes the eigenvalues, and optionally the eigenvectors, of a matrix. More...

- - - - - - - - - - -

-Private Member Functions

eigen_symm
 
eigen_asymm
 
eigen_gen
 
eigen_cmplx
 

Detailed Description

-

Computes the eigenvalues, and optionally the eigenvectors, of a matrix.

+

Computes the eigenvalues, and optionally the eigenvectors, of a matrix.

Usage
As an example, consider the eigenvalue problem arising from a mechanical system of masses and springs such that the masses are described by a mass matrix M, and the arrangement of springs are described by a stiffness matrix K.
! This is an example illustrating the use of the eigenvalue and eigenvector
! routines to solve a free vibration problem of 3 masses connected by springs.
!
@@ -132,7 +124,7 @@
! Notice: x1" = the second time derivative of x1.
program example
use iso_fortran_env, only : int32, real64
- +
implicit none
! Define the model parameters
@@ -158,7 +150,7 @@
[3, 3])
! Compute the eigenvalues and eigenvectors.
-
call eigen(k, m, vals, vecs = modeshapes)
+
call eigen(k, m, vals, vecs = modeshapes)
! Compute the natural frequency values, and return them with units of Hz.
! Notice, all eigenvalues and eigenvectors are real for this example.
@@ -172,6 +164,8 @@
print '(F10.3)', (real(modeshapes(j,i)), j = 1, size(natfreq))
end do
end program
+
Computes the eigenvalues, and optionally the eigenvectors, of a matrix.
+
Provides a set of common linear algebra routines.
Definition: linalg_core.f90:15
The above program produces the following output.
Modal Information:
Mode 1: (232.9225 Hz)
-0.718
@@ -193,21 +187,17 @@
-

Definition at line 1621 of file linalg_core.f90.

+

Definition at line 1752 of file linalg_core.f90.


The documentation for this interface was generated from the following file:
-
Provides a set of common linear algebra routines.
Definition: linalg_core.f90:15
-
Computes the eigenvalues, and optionally the eigenvectors, of a matrix.
diff --git a/doc/html/interfacelinalg__core_1_1form__lu-members.html b/doc/html/interfacelinalg__core_1_1form__lu-members.html index db85d3dd..d71cd6e1 100644 --- a/doc/html/interfacelinalg__core_1_1form__lu-members.html +++ b/doc/html/interfacelinalg__core_1_1form__lu-members.html @@ -1,9 +1,9 @@ - + - - + + linalg: Member List @@ -13,13 +13,16 @@ - + + @@ -27,10 +30,9 @@
- - + @@ -39,21 +41,22 @@
-
linalg -  1.6.0 +
+
linalg 1.6.1
A linear algebra library that provides a user-friendly interface to several BLAS and LAPACK routines.
- + +/* @license-end */ +
@@ -67,8 +70,8 @@
@@ -81,31 +84,30 @@
- +
+
+
+
+
Loading...
+
Searching...
+
No Matches
+
+
+
-
-
linalg_core::form_lu Member List
+
linalg_core::form_lu Member List

This is the complete list of members for linalg_core::form_lu, including all inherited members.

- - - - - -
form_lu_all (defined in linalg_core::form_lu)linalg_core::form_luprivate
form_lu_all_cmplx (defined in linalg_core::form_lu)linalg_core::form_luprivate
form_lu_only (defined in linalg_core::form_lu)linalg_core::form_luprivate
form_lu_only_cmplx (defined in linalg_core::form_lu)linalg_core::form_luprivate
+
diff --git a/doc/html/interfacelinalg__core_1_1form__lu.html b/doc/html/interfacelinalg__core_1_1form__lu.html index 9bffcc14..44ca558d 100644 --- a/doc/html/interfacelinalg__core_1_1form__lu.html +++ b/doc/html/interfacelinalg__core_1_1form__lu.html @@ -1,9 +1,9 @@ - + - - + + linalg: linalg_core::form_lu Interface Reference @@ -13,13 +13,16 @@ - + + @@ -27,10 +30,9 @@
- - + @@ -39,21 +41,22 @@
-
linalg -  1.6.0 +
+
linalg 1.6.1
A linear algebra library that provides a user-friendly interface to several BLAS and LAPACK routines.
- + +/* @license-end */ +
@@ -67,8 +70,8 @@
@@ -81,43 +84,32 @@
- +
+
+
+
+
Loading...
+
Searching...
+
No Matches
+
+
+
-
-
linalg_core::form_lu Interface Reference
+
linalg_core::form_lu Interface Reference

Extracts the L and U matrices from the condensed [L\U] storage format used by the lu_factor. More...

- - - - - - - - - - -

-Private Member Functions

form_lu_all
 
form_lu_all_cmplx
 
form_lu_only
 
form_lu_only_cmplx
 

Detailed Description

-

Extracts the L and U matrices from the condensed [L\U] storage format used by the lu_factor.

+

Extracts the L and U matrices from the condensed [L\U] storage format used by the lu_factor.

Usage
The following example illustrates how to extract the L, U, and P matrices in order to solve a system of LU factored equations.
program example
use iso_fortran_env, only : real64, int32
- +
implicit none
! Variables
@@ -144,10 +136,10 @@
! | 0 |
! Compute the LU factorization
-
call lu_factor(a, pvt)
+
call lu_factor(a, pvt)
! Extract the L and U matrices. A is overwritten with L.
-
call form_lu(a, pvt, u, p)
+
call form_lu(a, pvt, u, p)
! Solve the lower triangular system L * Y = P * B for Y, but first compute
! P * B, and store the results in B
@@ -155,38 +147,36 @@
! Now, compute the solution to the lower triangular system. Store the
! result in B. Remember, L is unit diagonal (ones on its diagonal)
-
call solve_triangular_system(.false., .false., .false., a, b)
+
call solve_triangular_system(.false., .false., .false., a, b)
! Solve the upper triangular system U * X = Y for X.
-
call solve_triangular_system(.true., .false., .true., u, b)
+
call solve_triangular_system(.true., .false., .true., u, b)
! Display the results.
print '(A)', "LU Solution: X = "
print '(F8.4)', (b(i), i = 1, size(b))
end program
+
Extracts the L and U matrices from the condensed [L\U] storage format used by the lu_factor.
+
Computes the LU factorization of an M-by-N matrix.
+
Solves a triangular system of equations.
+
Provides a set of common linear algebra routines.
Definition: linalg_core.f90:15
The above program produces the following output.
LU Solution: X =
0.3333
-0.6667
0.0000
-

Definition at line 319 of file linalg_core.f90.

+

Definition at line 450 of file linalg_core.f90.


The documentation for this interface was generated from the following file:
-
Provides a set of common linear algebra routines.
Definition: linalg_core.f90:15
-
Computes the LU factorization of an M-by-N matrix.
-
Extracts the L and U matrices from the condensed [L\U] storage format used by the lu_factor.
-
Solves a triangular system of equations.
diff --git a/doc/html/interfacelinalg__core_1_1form__qr-members.html b/doc/html/interfacelinalg__core_1_1form__qr-members.html index 2b5c0527..0c9e3dc2 100644 --- a/doc/html/interfacelinalg__core_1_1form__qr-members.html +++ b/doc/html/interfacelinalg__core_1_1form__qr-members.html @@ -1,9 +1,9 @@ - + - - + + linalg: Member List @@ -13,13 +13,16 @@ - + + @@ -27,10 +30,9 @@
- - + @@ -39,21 +41,22 @@
-
linalg -  1.6.0 +
+
linalg 1.6.1
A linear algebra library that provides a user-friendly interface to several BLAS and LAPACK routines.
- + +/* @license-end */ +
@@ -67,8 +70,8 @@
@@ -81,31 +84,30 @@
- +
+
+
+
+
Loading...
+
Searching...
+
No Matches
+
+
+
-
-
linalg_core::form_qr Member List
+
linalg_core::form_qr Member List

This is the complete list of members for linalg_core::form_qr, including all inherited members.

- - - - - -
form_qr_no_pivot (defined in linalg_core::form_qr)linalg_core::form_qrprivate
form_qr_no_pivot_cmplx (defined in linalg_core::form_qr)linalg_core::form_qrprivate
form_qr_pivot (defined in linalg_core::form_qr)linalg_core::form_qrprivate
form_qr_pivot_cmplx (defined in linalg_core::form_qr)linalg_core::form_qrprivate
+
diff --git a/doc/html/interfacelinalg__core_1_1form__qr.html b/doc/html/interfacelinalg__core_1_1form__qr.html index deb60783..7f5f4525 100644 --- a/doc/html/interfacelinalg__core_1_1form__qr.html +++ b/doc/html/interfacelinalg__core_1_1form__qr.html @@ -1,9 +1,9 @@ - + - - + + linalg: linalg_core::form_qr Interface Reference @@ -13,13 +13,16 @@ - + + @@ -27,10 +30,9 @@
- - + @@ -39,21 +41,22 @@
-
linalg -  1.6.0 +
+
linalg 1.6.1
A linear algebra library that provides a user-friendly interface to several BLAS and LAPACK routines.
- + +/* @license-end */ +
@@ -67,8 +70,8 @@
@@ -81,43 +84,32 @@
- +
+
+
+
+
Loading...
+
Searching...
+
No Matches
+
+
+
-
-
linalg_core::form_qr Interface Reference
+
linalg_core::form_qr Interface Reference

Forms the full M-by-M orthogonal matrix Q from the elementary reflectors returned by the base QR factorization algorithm. More...

- - - - - - - - - - -

-Private Member Functions

form_qr_no_pivot
 
form_qr_no_pivot_cmplx
 
form_qr_pivot
 
form_qr_pivot_cmplx
 

Detailed Description

-

Forms the full M-by-M orthogonal matrix Q from the elementary reflectors returned by the base QR factorization algorithm.

+

Forms the full M-by-M orthogonal matrix Q from the elementary reflectors returned by the base QR factorization algorithm.

Usage
The following example illustrates how to explicitly form the Q and R matrices from the output of qr_factor, and then use the resulting matrices to solve a system of linear equations.
program example
use iso_fortran_env, only : real64, int32
- +
implicit none
! Variables
@@ -144,10 +136,10 @@
! | 0 |
! Compute the QR factorization without column pivoting
-
call qr_factor(a, tau)
+
call qr_factor(a, tau)
! Build Q and R. A is overwritten with R
-
call form_qr(a, tau, q)
+
call form_qr(a, tau, q)
! As this system is square, matrix R is upper triangular. Also, Q is
! always orthogonal such that it's inverse and transpose are equal. As the
@@ -159,7 +151,7 @@
b = matmul(transpose(q), b)
! Solve the upper triangular system R * X = Q**T * B for X
-
call solve_triangular_system(.true., .false., .true., a, b)
+
call solve_triangular_system(.true., .false., .true., a, b)
! Display the results
print '(A)', "QR Solution: X = "
@@ -170,6 +162,10 @@
! for by noting that Q * R = A * P, where P is an N-by-N matrix describing
! the column pivoting operations.
end program
+
Forms the full M-by-M orthogonal matrix Q from the elementary reflectors returned by the base QR fact...
+
Computes the QR factorization of an M-by-N matrix.
+
Solves a triangular system of equations.
+
Provides a set of common linear algebra routines.
Definition: linalg_core.f90:15
The above program produces the following output.
QR Solution: X =
0.3333
-0.6667
@@ -181,23 +177,17 @@
-

Definition at line 472 of file linalg_core.f90.

+

Definition at line 603 of file linalg_core.f90.


The documentation for this interface was generated from the following file:
-
Provides a set of common linear algebra routines.
Definition: linalg_core.f90:15
-
Forms the full M-by-M orthogonal matrix Q from the elementary reflectors returned by the base QR fact...
-
Solves a triangular system of equations.
-
Computes the QR factorization of an M-by-N matrix.
diff --git a/doc/html/interfacelinalg__core_1_1lu__factor-members.html b/doc/html/interfacelinalg__core_1_1lu__factor-members.html index e5ec84d2..9f755b9f 100644 --- a/doc/html/interfacelinalg__core_1_1lu__factor-members.html +++ b/doc/html/interfacelinalg__core_1_1lu__factor-members.html @@ -1,9 +1,9 @@ - + - - + + linalg: Member List @@ -13,13 +13,16 @@ - + + @@ -27,10 +30,9 @@
- - + @@ -39,21 +41,22 @@
-
linalg -  1.6.0 +
+
linalg 1.6.1
A linear algebra library that provides a user-friendly interface to several BLAS and LAPACK routines.
- + +/* @license-end */ +
@@ -67,8 +70,8 @@
@@ -81,29 +84,30 @@
- +
+
+
+
+
Loading...
+
Searching...
+
No Matches
+
+
+
-
-
linalg_core::lu_factor Member List
+
linalg_core::lu_factor Member List

This is the complete list of members for linalg_core::lu_factor, including all inherited members.

- - - -
lu_factor_cmplx (defined in linalg_core::lu_factor)linalg_core::lu_factorprivate
lu_factor_dbl (defined in linalg_core::lu_factor)linalg_core::lu_factorprivate
+
diff --git a/doc/html/interfacelinalg__core_1_1lu__factor.html b/doc/html/interfacelinalg__core_1_1lu__factor.html index bc5b32c8..37915c9f 100644 --- a/doc/html/interfacelinalg__core_1_1lu__factor.html +++ b/doc/html/interfacelinalg__core_1_1lu__factor.html @@ -1,9 +1,9 @@ - + - - + + linalg: linalg_core::lu_factor Interface Reference @@ -13,13 +13,16 @@ - + + @@ -27,10 +30,9 @@
- - + @@ -39,21 +41,22 @@
-
linalg -  1.6.0 +
+
linalg 1.6.1
A linear algebra library that provides a user-friendly interface to several BLAS and LAPACK routines.
- + +/* @license-end */ +
@@ -67,8 +70,8 @@
@@ -81,37 +84,32 @@
- +
+
+
+
+
Loading...
+
Searching...
+
No Matches
+
+
+
-
-
linalg_core::lu_factor Interface Reference
+
linalg_core::lu_factor Interface Reference

Computes the LU factorization of an M-by-N matrix. More...

- - - - - - -

-Private Member Functions

lu_factor_dbl
 
lu_factor_cmplx
 

Detailed Description

-

Computes the LU factorization of an M-by-N matrix.

+

Computes the LU factorization of an M-by-N matrix.

Usage
To solve a system of 3 equations of 3 unknowns using LU factorization, the following code will suffice.
program example
use iso_fortran_env
- +
implicit none
! Local Variables
@@ -138,37 +136,35 @@
! | 0 |
! Compute the LU factorization
-
call lu_factor(a, pvt)
+
call lu_factor(a, pvt)
! Compute the solution. The results overwrite b.
-
call solve_lu(a, pvt, b)
+
call solve_lu(a, pvt, b)
! Display the results.
print '(A)', "LU Solution: X = "
print '(F8.4)', (b(i), i = 1, size(b))
end program
+
Computes the LU factorization of an M-by-N matrix.
+
Solves a system of LU-factored equations.
+
Provides a set of common linear algebra routines.
Definition: linalg_core.f90:15
The program generates the following output.
LU Solution: X =
0.3333
-0.6667
0.0000
-

Definition at line 250 of file linalg_core.f90.

+

Definition at line 381 of file linalg_core.f90.


The documentation for this interface was generated from the following file:
-
Provides a set of common linear algebra routines.
Definition: linalg_core.f90:15
-
Computes the LU factorization of an M-by-N matrix.
-
Solves a system of LU-factored equations.
diff --git a/doc/html/interfacelinalg__core_1_1mtx__inverse-members.html b/doc/html/interfacelinalg__core_1_1mtx__inverse-members.html index c20c9953..885e442c 100644 --- a/doc/html/interfacelinalg__core_1_1mtx__inverse-members.html +++ b/doc/html/interfacelinalg__core_1_1mtx__inverse-members.html @@ -1,9 +1,9 @@ - + - - + + linalg: Member List @@ -13,13 +13,16 @@ - + + @@ -27,10 +30,9 @@
- - + @@ -39,21 +41,22 @@
-
linalg -  1.6.0 +
+
linalg 1.6.1
A linear algebra library that provides a user-friendly interface to several BLAS and LAPACK routines.
- + +/* @license-end */ +
@@ -67,8 +70,8 @@
@@ -81,29 +84,30 @@
- +
+
+
+
+
Loading...
+
Searching...
+
No Matches
+
+
+
-
-
linalg_core::mtx_inverse Member List
+
linalg_core::mtx_inverse Member List

This is the complete list of members for linalg_core::mtx_inverse, including all inherited members.

- - - -
mtx_inverse_cmplx (defined in linalg_core::mtx_inverse)linalg_core::mtx_inverseprivate
mtx_inverse_dbl (defined in linalg_core::mtx_inverse)linalg_core::mtx_inverseprivate
+
diff --git a/doc/html/interfacelinalg__core_1_1mtx__inverse.html b/doc/html/interfacelinalg__core_1_1mtx__inverse.html index 2ede201c..785dd2e6 100644 --- a/doc/html/interfacelinalg__core_1_1mtx__inverse.html +++ b/doc/html/interfacelinalg__core_1_1mtx__inverse.html @@ -1,9 +1,9 @@ - + - - + + linalg: linalg_core::mtx_inverse Interface Reference @@ -13,13 +13,16 @@ - + + @@ -27,10 +30,9 @@
- - + @@ -39,21 +41,22 @@
-
linalg -  1.6.0 +
+
linalg 1.6.1
A linear algebra library that provides a user-friendly interface to several BLAS and LAPACK routines.
- + +/* @license-end */ +
@@ -67,8 +70,8 @@
@@ -81,37 +84,32 @@
- +
+
+
+
+
Loading...
+
Searching...
+
No Matches
+
+
+
-
-
linalg_core::mtx_inverse Interface Reference
+
linalg_core::mtx_inverse Interface Reference

Computes the inverse of a square matrix. More...

- - - - - - -

-Private Member Functions

mtx_inverse_dbl
 
mtx_inverse_cmplx
 

Detailed Description

-

Computes the inverse of a square matrix.

+

Computes the inverse of a square matrix.

Usage
The following example illustrates the inversion of a 3-by-3 matrix.
program example
use iso_fortran_env, only : real64, int32
- +
implicit none
! Variables
@@ -128,7 +126,7 @@
! Compute the inverse of A. Notice, the original matrix is overwritten
! with it's inverse.
ai = a
-
call mtx_inverse(ai)
+
call mtx_inverse(ai)
! Show that A * inv(A) = I
c = matmul(a, ai)
@@ -145,6 +143,8 @@
print *, c(i,:)
end do
end program
+
Computes the inverse of a square matrix.
+
Provides a set of common linear algebra routines.
Definition: linalg_core.f90:15
The above program produces the following output.
Inverse:
-1.7777777777777777 0.88888888888888884 -0.11111111111111110
1.5555555555555556 -0.77777777777777779 0.22222222222222221
@@ -155,21 +155,17 @@
1.7763568394002505E-015 -8.8817841970012523E-016 1.0000000000000000
-

Definition at line 1466 of file linalg_core.f90.

+

Definition at line 1597 of file linalg_core.f90.


The documentation for this interface was generated from the following file:
-
Provides a set of common linear algebra routines.
Definition: linalg_core.f90:15
-
Computes the inverse of a square matrix.
diff --git a/doc/html/interfacelinalg__core_1_1mtx__mult-members.html b/doc/html/interfacelinalg__core_1_1mtx__mult-members.html index 377581b2..06173bc7 100644 --- a/doc/html/interfacelinalg__core_1_1mtx__mult-members.html +++ b/doc/html/interfacelinalg__core_1_1mtx__mult-members.html @@ -1,9 +1,9 @@ - + - - + + linalg: Member List @@ -13,13 +13,16 @@ - + + @@ -27,10 +30,9 @@
- - + @@ -39,21 +41,22 @@
-
linalg -  1.6.0 +
+
linalg 1.6.1
A linear algebra library that provides a user-friendly interface to several BLAS and LAPACK routines.
- + +/* @license-end */ +
@@ -67,8 +70,8 @@
@@ -81,31 +84,30 @@
- +
+
+
+
+
Loading...
+
Searching...
+
No Matches
+
+
+
-
-
linalg_core::mtx_mult Member List
+
linalg_core::mtx_mult Member List

This is the complete list of members for linalg_core::mtx_mult, including all inherited members.

- - - - - -
cmtx_mult_mtx (defined in linalg_core::mtx_mult)linalg_core::mtx_multprivate
cmtx_mult_vec (defined in linalg_core::mtx_mult)linalg_core::mtx_multprivate
mtx_mult_mtx (defined in linalg_core::mtx_mult)linalg_core::mtx_multprivate
mtx_mult_vec (defined in linalg_core::mtx_mult)linalg_core::mtx_multprivate
+
diff --git a/doc/html/interfacelinalg__core_1_1mtx__mult.html b/doc/html/interfacelinalg__core_1_1mtx__mult.html index d0a22beb..16b5d827 100644 --- a/doc/html/interfacelinalg__core_1_1mtx__mult.html +++ b/doc/html/interfacelinalg__core_1_1mtx__mult.html @@ -1,9 +1,9 @@ - + - - + + linalg: linalg_core::mtx_mult Interface Reference @@ -13,13 +13,16 @@ - + + @@ -27,10 +30,9 @@
- - + @@ -39,21 +41,22 @@
-
linalg -  1.6.0 +
+
linalg 1.6.1
A linear algebra library that provides a user-friendly interface to several BLAS and LAPACK routines.
- + +/* @license-end */ +
@@ -67,8 +70,8 @@
@@ -81,44 +84,71 @@
- +
+
+
+
+
Loading...
+
Searching...
+
No Matches
+
+
+
-
-
linalg_core::mtx_mult Interface Reference
+
linalg_core::mtx_mult Interface Reference
-

Performs the matrix operation: C = alpha * op(A) * op(B) + beta * C. +

Performs the matrix operation: \( C = \alpha op(A) op(B) + \beta C \). More...

- - - - - - - - - - -

-Private Member Functions

mtx_mult_mtx
 
mtx_mult_vec
 
cmtx_mult_mtx
 
cmtx_mult_vec
 

Detailed Description

-

Performs the matrix operation: C = alpha * op(A) * op(B) + beta * C.

+

Performs the matrix operation: \( C = \alpha op(A) op(B) + \beta C \).

+
Syntax 1
subroutine mtx_mult(logical transa, logical transb, real(real64) alpha, real(real64) a(:,:), real(real64) b(:,:), real(real64) beta, real(real64) c(:,:), optional class(errors) err)
+
subroutine mtx_mult(integer(int32) transa, integer(int32) transb, complex(real64) alpha, complex(real64) a(:,:), complex(real64) b(:,:), complex(real64) beta, complex(real64) c(:,:), optional class(errors) err)
+
+
Parameters
+ + + + + + + + + +
[in]transaSet to true if \( op(A) = A^T \); else, set to false for \( op(A) = A\). In the complex case set to LA_TRANSPOSE if \( op(A) = A^T \), set to LA_HERMITIAN_TRANSPOSE if \( op(A) = A^H \), otherwise set to LA_NO_OPERATION if \( op(A) = A \).
[in]transbSet to true if \( op(B) = B^T \); else, set to false for \( op(B) = B\). In the complex case set to LA_TRANSPOSE if \( op(B) = B^T \), set to LA_HERMITIAN_TRANSPOSE if \( op(B) = B^H \), otherwise set to LA_NO_OPERATION if \( op(B) = B \).
[in]alphaA scalar multiplier.
[in]aIf transa is set to true, an K-by-M matrix; else, if transa is set to false, an M-by-K matrix.
[in]bIf transb is set to true, an N-by-K matrix; else, if transb is set to false, a K-by-N matrix.
[in]betaA scalar multiplier.
[in,out]cOn input, the M-by-N matrix C. On output, the M-by-N result.
[in,out]errAn optional errors-based object that if provided can be used to retrieve information relating to any errors encountered during execution. If not provided, a default implementation of the errors class is used internally to provide error handling. Possible errors and warning messages that may be encountered are as follows.
    +
  • LA_ARRAY_SIZE_ERROR: Occurs if any of the input array sizes are incorrect.
  • +
+
+
+
+
Syntax 2
subroutine mtx_mult(logical trans, real(real64) alpha, real(real64) a(:,:), real(real64) b(:), real(real64) beta, real(real64) c(:))
+
subroutine mtx_mult(logical trans, complex(real64) alpha, complex(real64) a(:,:), complex(real64) b(:), complex(real64) beta, complex(real64) c(:))
+
+
Parameters
+ + + + + + + + +
[in]transSet to true if \( op(A) = A^T \); else, set to false for \( op(A) = A\). In the complex case set to LA_TRANSPOSE if \( op(A) = A^T \), set to LA_HERMITIAN_TRANSPOSE if \( op(A) = A^H \), otherwise set to LA_NO_OPERATION if \( op(A) = A \).
[in]alphaA scalar multiplier.
[in]aThe M-by-N matrix A.
[in]bIf trans is set to true, an M-element array; else, if trans is set to false, an N-element array.
[in]betaA scalar multiplier.
[in,out]cOn input, if trans is set to true, an N-element array; else, if trans is set to false, an M-element array. On output, the results of the operation.
[in,out]errAn optional errors-based object that if provided can be used to retrieve information relating to any errors encountered during execution. If not provided, a default implementation of the errors class is used internally to provide error handling. Possible errors and warning messages that may be encountered are as follows.
    +
  • LA_ARRAY_SIZE_ERROR: Occurs if any of the input array sizes are incorrect.
  • +
+
+
+
+
Notes
This routine utilizes the BLAS routines DGEMM, ZGEMM, DGEMV, or ZGEMV.
-

Definition at line 60 of file linalg_core.f90.

+

Definition at line 119 of file linalg_core.f90.


The documentation for this interface was generated from the following file:
@@ -126,9 +156,7 @@ diff --git a/doc/html/interfacelinalg__core_1_1mtx__pinverse-members.html b/doc/html/interfacelinalg__core_1_1mtx__pinverse-members.html index 3d431ee8..837fce34 100644 --- a/doc/html/interfacelinalg__core_1_1mtx__pinverse-members.html +++ b/doc/html/interfacelinalg__core_1_1mtx__pinverse-members.html @@ -1,9 +1,9 @@ - + - - + + linalg: Member List @@ -13,13 +13,16 @@ - + + @@ -27,10 +30,9 @@
- - + @@ -39,21 +41,22 @@
-
linalg -  1.6.0 +
+
linalg 1.6.1
A linear algebra library that provides a user-friendly interface to several BLAS and LAPACK routines.
- + +/* @license-end */ +
@@ -67,8 +70,8 @@
@@ -81,29 +84,30 @@
- +
+
+
+
+
Loading...
+
Searching...
+
No Matches
+
+
+
-
-
linalg_core::mtx_pinverse Member List
+
linalg_core::mtx_pinverse Member List

This is the complete list of members for linalg_core::mtx_pinverse, including all inherited members.

- - - -
mtx_pinverse_cmplx (defined in linalg_core::mtx_pinverse)linalg_core::mtx_pinverseprivate
mtx_pinverse_dbl (defined in linalg_core::mtx_pinverse)linalg_core::mtx_pinverseprivate
+
diff --git a/doc/html/interfacelinalg__core_1_1mtx__pinverse.html b/doc/html/interfacelinalg__core_1_1mtx__pinverse.html index 8c2cf909..3a0ab9f7 100644 --- a/doc/html/interfacelinalg__core_1_1mtx__pinverse.html +++ b/doc/html/interfacelinalg__core_1_1mtx__pinverse.html @@ -1,9 +1,9 @@ - + - - + + linalg: linalg_core::mtx_pinverse Interface Reference @@ -13,13 +13,16 @@ - + + @@ -27,10 +30,9 @@
- - + @@ -39,21 +41,22 @@
-
linalg -  1.6.0 +
+
linalg 1.6.1
A linear algebra library that provides a user-friendly interface to several BLAS and LAPACK routines.
- + +/* @license-end */ +
@@ -67,8 +70,8 @@
@@ -81,37 +84,32 @@
- +
+
+
+
+
Loading...
+
Searching...
+
No Matches
+
+
+
-
-
linalg_core::mtx_pinverse Interface Reference
+
linalg_core::mtx_pinverse Interface Reference

Computes the Moore-Penrose pseudo-inverse of a M-by-N matrix using the singular value decomposition of the matrix. More...

- - - - - - -

-Private Member Functions

mtx_pinverse_dbl
 
mtx_pinverse_cmplx
 

Detailed Description

-

Computes the Moore-Penrose pseudo-inverse of a M-by-N matrix using the singular value decomposition of the matrix.

+

Computes the Moore-Penrose pseudo-inverse of a M-by-N matrix using the singular value decomposition of the matrix.

Usage
The following example illustrates how to compute the Moore-Penrose pseudo-inverse of a matrix.
program example
use iso_fortran_env, only : int32, real64
- +
implicit none
! Variables
@@ -130,7 +128,7 @@
! | 1 0 0 |
! A**-1 = | |
! | 0 1/2 1/2 |
-
call mtx_pinverse(a, ai)
+
call mtx_pinverse(a, ai)
! Notice, A**-1 * A is an identity matrix.
c = matmul(ai, ao)
@@ -147,6 +145,8 @@
print *, c(i,:)
end do
end program
+
Computes the Moore-Penrose pseudo-inverse of a M-by-N matrix using the singular value decomposition o...
+
Provides a set of common linear algebra routines.
Definition: linalg_core.f90:15
The above program produces the following output.
Inverse:
1.0000000000000000 0.0000000000000000 0.0000000000000000
0.0000000000000000 0.49999999999999978 0.49999999999999989
@@ -155,21 +155,17 @@
0.0000000000000000 0.99999999999999967
-

Definition at line 1527 of file linalg_core.f90.

+

Definition at line 1658 of file linalg_core.f90.


The documentation for this interface was generated from the following file:
-
Provides a set of common linear algebra routines.
Definition: linalg_core.f90:15
-
Computes the Moore-Penrose pseudo-inverse of a M-by-N matrix using the singular value decomposition o...
diff --git a/doc/html/interfacelinalg__core_1_1mtx__rank-members.html b/doc/html/interfacelinalg__core_1_1mtx__rank-members.html index ba75e00a..975b0b6c 100644 --- a/doc/html/interfacelinalg__core_1_1mtx__rank-members.html +++ b/doc/html/interfacelinalg__core_1_1mtx__rank-members.html @@ -1,9 +1,9 @@ - + - - + + linalg: Member List @@ -13,13 +13,16 @@ - + + @@ -27,10 +30,9 @@
- - + @@ -39,21 +41,22 @@
-
linalg -  1.6.0 +
+
linalg 1.6.1
A linear algebra library that provides a user-friendly interface to several BLAS and LAPACK routines.
- + +/* @license-end */ +
@@ -67,8 +70,8 @@
@@ -81,29 +84,30 @@
- +
+
+
+
+
Loading...
+
Searching...
+
No Matches
+
+
+
-
-
linalg_core::mtx_rank Member List
+
linalg_core::mtx_rank Member List

This is the complete list of members for linalg_core::mtx_rank, including all inherited members.

- - - -
mtx_rank_cmplx (defined in linalg_core::mtx_rank)linalg_core::mtx_rankprivate
mtx_rank_dbl (defined in linalg_core::mtx_rank)linalg_core::mtx_rankprivate
+
diff --git a/doc/html/interfacelinalg__core_1_1mtx__rank.html b/doc/html/interfacelinalg__core_1_1mtx__rank.html index 3ce46bc1..bb748d83 100644 --- a/doc/html/interfacelinalg__core_1_1mtx__rank.html +++ b/doc/html/interfacelinalg__core_1_1mtx__rank.html @@ -1,9 +1,9 @@ - + - - + + linalg: linalg_core::mtx_rank Interface Reference @@ -13,13 +13,16 @@ - + + @@ -27,10 +30,9 @@
- - + @@ -39,21 +41,22 @@
-
linalg -  1.6.0 +
+
linalg 1.6.1
A linear algebra library that provides a user-friendly interface to several BLAS and LAPACK routines.
- + +/* @license-end */ +
@@ -67,8 +70,8 @@
@@ -81,38 +84,33 @@
- +
+
+
+
+
Loading...
+
Searching...
+
No Matches
+
+
+
-
-
linalg_core::mtx_rank Interface Reference
+
linalg_core::mtx_rank Interface Reference

Computes the rank of a matrix. More...

- - - - - - -

-Private Member Functions

mtx_rank_dbl
 
mtx_rank_cmplx
 

Detailed Description

-

Computes the rank of a matrix.

+

Computes the rank of a matrix.

-

Definition at line 163 of file linalg_core.f90.

+

Definition at line 294 of file linalg_core.f90.


The documentation for this interface was generated from the following file:
@@ -120,9 +118,7 @@ diff --git a/doc/html/interfacelinalg__core_1_1mult__qr-members.html b/doc/html/interfacelinalg__core_1_1mult__qr-members.html index e01f4ddb..15661e50 100644 --- a/doc/html/interfacelinalg__core_1_1mult__qr-members.html +++ b/doc/html/interfacelinalg__core_1_1mult__qr-members.html @@ -1,9 +1,9 @@ - + - - + + linalg: Member List @@ -13,13 +13,16 @@ - + + @@ -27,10 +30,9 @@
- - + @@ -39,21 +41,22 @@
-
linalg -  1.6.0 +
+
linalg 1.6.1
A linear algebra library that provides a user-friendly interface to several BLAS and LAPACK routines.
- + +/* @license-end */ +
@@ -67,8 +70,8 @@
@@ -81,31 +84,30 @@
- +
+
+
+
+
Loading...
+
Searching...
+
No Matches
+
+
+
-
-
linalg_core::mult_qr Member List
+
linalg_core::mult_qr Member List

This is the complete list of members for linalg_core::mult_qr, including all inherited members.

- - - - - -
mult_qr_mtx (defined in linalg_core::mult_qr)linalg_core::mult_qrprivate
mult_qr_mtx_cmplx (defined in linalg_core::mult_qr)linalg_core::mult_qrprivate
mult_qr_vec (defined in linalg_core::mult_qr)linalg_core::mult_qrprivate
mult_qr_vec_cmplx (defined in linalg_core::mult_qr)linalg_core::mult_qrprivate
+
diff --git a/doc/html/interfacelinalg__core_1_1mult__qr.html b/doc/html/interfacelinalg__core_1_1mult__qr.html index b03d9178..d0536d5a 100644 --- a/doc/html/interfacelinalg__core_1_1mult__qr.html +++ b/doc/html/interfacelinalg__core_1_1mult__qr.html @@ -1,9 +1,9 @@ - + - - + + linalg: linalg_core::mult_qr Interface Reference @@ -13,13 +13,16 @@ - + + @@ -27,10 +30,9 @@
- - + @@ -39,21 +41,22 @@
-
linalg -  1.6.0 +
+
linalg 1.6.1
A linear algebra library that provides a user-friendly interface to several BLAS and LAPACK routines.
- + +/* @license-end */ +
@@ -67,8 +70,8 @@
@@ -81,43 +84,32 @@
- +
+
+
+
+
Loading...
+
Searching...
+
No Matches
+
+
+
-
-
linalg_core::mult_qr Interface Reference
+
linalg_core::mult_qr Interface Reference

Multiplies a general matrix by the orthogonal matrix Q from a QR factorization. More...

- - - - - - - - - - -

-Private Member Functions

mult_qr_mtx
 
mult_qr_mtx_cmplx
 
mult_qr_vec
 
mult_qr_vec_cmplx
 

Detailed Description

-

Multiplies a general matrix by the orthogonal matrix Q from a QR factorization.

+

Multiplies a general matrix by the orthogonal matrix Q from a QR factorization.

Usage
The following example illustrates how to perform the multiplication Q**T * B when solving a system of QR factored equations without explicitly forming the matrix Q.
program example
use iso_fortran_env, only : real64, int32
- +
implicit none
! Variables
@@ -144,7 +136,7 @@
! | 0 |
! Compute the QR factorization without column pivoting
-
call qr_factor(a, tau)
+
call qr_factor(a, tau)
! As this system is square, matrix R is upper triangular. Also, Q is
! always orthogonal such that it's inverse and transpose are equal. As the
@@ -154,10 +146,10 @@
! Compute Q**T * B, and store the results in B. Notice, using mult_qr
! avoids direct construction of the full Q and R matrices.
-
call mult_qr(.true., a, tau, b)
+
call mult_qr(.true., a, tau, b)
! Solve the upper triangular system R * X = Q**T * B for X
-
call solve_triangular_system(.true., .false., .true., a, b)
+
call solve_triangular_system(.true., .false., .true., a, b)
! Display the results
print '(A)', "QR Solution: X = "
@@ -168,29 +160,27 @@
! for by noting that Q * R = A * P, where P is an N-by-N matrix describing
! the column pivoting operations.
end program
+
Multiplies a general matrix by the orthogonal matrix Q from a QR factorization.
+
Computes the QR factorization of an M-by-N matrix.
+
Solves a triangular system of equations.
+
Provides a set of common linear algebra routines.
Definition: linalg_core.f90:15
The above program produces the following output.
QR Solution: X =
0.3333
-0.6667
0.0000
-

Definition at line 549 of file linalg_core.f90.

+

Definition at line 680 of file linalg_core.f90.


The documentation for this interface was generated from the following file:
-
Provides a set of common linear algebra routines.
Definition: linalg_core.f90:15
-
Solves a triangular system of equations.
-
Computes the QR factorization of an M-by-N matrix.
-
Multiplies a general matrix by the orthogonal matrix Q from a QR factorization.
diff --git a/doc/html/interfacelinalg__core_1_1mult__rz-members.html b/doc/html/interfacelinalg__core_1_1mult__rz-members.html index aa288b56..c382bf68 100644 --- a/doc/html/interfacelinalg__core_1_1mult__rz-members.html +++ b/doc/html/interfacelinalg__core_1_1mult__rz-members.html @@ -1,9 +1,9 @@ - + - - + + linalg: Member List @@ -13,13 +13,16 @@ - + + @@ -27,10 +30,9 @@
- - + @@ -39,21 +41,22 @@
-
linalg -  1.6.0 +
+
linalg 1.6.1
A linear algebra library that provides a user-friendly interface to several BLAS and LAPACK routines.
- + +/* @license-end */ +
@@ -67,8 +70,8 @@
@@ -81,31 +84,30 @@
- +
+
+
+
+
Loading...
+
Searching...
+
No Matches
+
+
+
-
-
linalg_core::mult_rz Member List
+
linalg_core::mult_rz Member List

This is the complete list of members for linalg_core::mult_rz, including all inherited members.

- - - - - -
mult_rz_mtx (defined in linalg_core::mult_rz)linalg_core::mult_rzprivate
mult_rz_mtx_cmplx (defined in linalg_core::mult_rz)linalg_core::mult_rzprivate
mult_rz_vec (defined in linalg_core::mult_rz)linalg_core::mult_rzprivate
mult_rz_vec_cmplx (defined in linalg_core::mult_rz)linalg_core::mult_rzprivate
+
diff --git a/doc/html/interfacelinalg__core_1_1mult__rz.html b/doc/html/interfacelinalg__core_1_1mult__rz.html index 357de4cc..e61876ae 100644 --- a/doc/html/interfacelinalg__core_1_1mult__rz.html +++ b/doc/html/interfacelinalg__core_1_1mult__rz.html @@ -1,9 +1,9 @@ - + - - + + linalg: linalg_core::mult_rz Interface Reference @@ -13,13 +13,16 @@ - + + @@ -27,10 +30,9 @@
- - + @@ -39,21 +41,22 @@
-
linalg -  1.6.0 +
+
linalg 1.6.1
A linear algebra library that provides a user-friendly interface to several BLAS and LAPACK routines.
- + +/* @license-end */ +
@@ -67,8 +70,8 @@
@@ -81,44 +84,33 @@
- +
+
+
+
+
Loading...
+
Searching...
+
No Matches
+
+
+
-
-
linalg_core::mult_rz Interface Reference
+
linalg_core::mult_rz Interface Reference

Multiplies a general matrix by the orthogonal matrix Z from an RZ factorization. More...

- - - - - - - - - - -

-Private Member Functions

mult_rz_mtx
 
mult_rz_mtx_cmplx
 
mult_rz_vec
 
mult_rz_vec_cmplx
 

Detailed Description

-

Multiplies a general matrix by the orthogonal matrix Z from an RZ factorization.

+

Multiplies a general matrix by the orthogonal matrix Z from an RZ factorization.

-

Definition at line 885 of file linalg_core.f90.

+

Definition at line 1016 of file linalg_core.f90.


The documentation for this interface was generated from the following file:
@@ -126,9 +118,7 @@ diff --git a/doc/html/interfacelinalg__core_1_1qr__factor-members.html b/doc/html/interfacelinalg__core_1_1qr__factor-members.html index ae6edf10..9ef64da1 100644 --- a/doc/html/interfacelinalg__core_1_1qr__factor-members.html +++ b/doc/html/interfacelinalg__core_1_1qr__factor-members.html @@ -1,9 +1,9 @@ - + - - + + linalg: Member List @@ -13,13 +13,16 @@ - + + @@ -27,10 +30,9 @@
- - + @@ -39,21 +41,22 @@
-
linalg -  1.6.0 +
+
linalg 1.6.1
A linear algebra library that provides a user-friendly interface to several BLAS and LAPACK routines.
- + +/* @license-end */ +
@@ -67,8 +70,8 @@
@@ -81,31 +84,30 @@
- +
+
+
+
+
Loading...
+
Searching...
+
No Matches
+
+
+
-
-
linalg_core::qr_factor Member List
+
linalg_core::qr_factor Member List

This is the complete list of members for linalg_core::qr_factor, including all inherited members.

- - - - - -
qr_factor_no_pivot (defined in linalg_core::qr_factor)linalg_core::qr_factorprivate
qr_factor_no_pivot_cmplx (defined in linalg_core::qr_factor)linalg_core::qr_factorprivate
qr_factor_pivot (defined in linalg_core::qr_factor)linalg_core::qr_factorprivate
qr_factor_pivot_cmplx (defined in linalg_core::qr_factor)linalg_core::qr_factorprivate
+
diff --git a/doc/html/interfacelinalg__core_1_1qr__factor.html b/doc/html/interfacelinalg__core_1_1qr__factor.html index e2802ca9..3850c784 100644 --- a/doc/html/interfacelinalg__core_1_1qr__factor.html +++ b/doc/html/interfacelinalg__core_1_1qr__factor.html @@ -1,9 +1,9 @@ - + - - + + linalg: linalg_core::qr_factor Interface Reference @@ -13,13 +13,16 @@ - + + @@ -27,10 +30,9 @@
- - + @@ -39,21 +41,22 @@
-
linalg -  1.6.0 +
+
linalg 1.6.1
A linear algebra library that provides a user-friendly interface to several BLAS and LAPACK routines.
- + +/* @license-end */ +
@@ -67,8 +70,8 @@
@@ -81,43 +84,32 @@
- +
+
+
+
+
Loading...
+
Searching...
+
No Matches
+
+
+
-
-
linalg_core::qr_factor Interface Reference
+
linalg_core::qr_factor Interface Reference

Computes the QR factorization of an M-by-N matrix. More...

- - - - - - - - - - -

-Private Member Functions

qr_factor_no_pivot
 
qr_factor_no_pivot_cmplx
 
qr_factor_pivot
 
qr_factor_pivot_cmplx
 

Detailed Description

-

Computes the QR factorization of an M-by-N matrix.

+

Computes the QR factorization of an M-by-N matrix.

Usage
The following example illustrates the solution of a system of equations using QR factorization.
program example
use iso_fortran_env, only : real64, int32
- +
implicit none
! Local Variables
@@ -145,10 +137,10 @@
! Compute the QR factorization, using pivoting
pvt = 0 ! Zero every entry in order not to lock any column in place
-
call qr_factor(a, tau, pvt)
+
call qr_factor(a, tau, pvt)
! Compute the solution. The results overwrite b.
-
call solve_qr(a, tau, pvt, b)
+
call solve_qr(a, tau, pvt, b)
! Display the results.
print '(A)', "QR Solution: X = "
@@ -158,6 +150,9 @@
! same manner. The only difference is to omit the PVT array (column pivot
! tracking array).
end program
+
Computes the QR factorization of an M-by-N matrix.
+
Solves a system of M QR-factored equations of N unknowns.
+
Provides a set of common linear algebra routines.
Definition: linalg_core.f90:15
The above program produces the following output.
QR Solution: X =
0.3333
-0.6667
@@ -170,22 +165,17 @@
-

Definition at line 389 of file linalg_core.f90.

+

Definition at line 520 of file linalg_core.f90.


The documentation for this interface was generated from the following file:
-
Provides a set of common linear algebra routines.
Definition: linalg_core.f90:15
-
Solves a system of M QR-factored equations of N unknowns.
-
Computes the QR factorization of an M-by-N matrix.
diff --git a/doc/html/interfacelinalg__core_1_1qr__rank1__update-members.html b/doc/html/interfacelinalg__core_1_1qr__rank1__update-members.html index 74782375..ead600cc 100644 --- a/doc/html/interfacelinalg__core_1_1qr__rank1__update-members.html +++ b/doc/html/interfacelinalg__core_1_1qr__rank1__update-members.html @@ -1,9 +1,9 @@ - + - - + + linalg: Member List @@ -13,13 +13,16 @@ - + + @@ -27,10 +30,9 @@
- - + @@ -39,21 +41,22 @@
-
linalg -  1.6.0 +
+
linalg 1.6.1
A linear algebra library that provides a user-friendly interface to several BLAS and LAPACK routines.
- + +/* @license-end */ +
@@ -67,8 +70,8 @@
@@ -81,29 +84,30 @@
- +
+
+
+
+
Loading...
+
Searching...
+
No Matches
+
+
+
-
-
linalg_core::qr_rank1_update Member List
+
linalg_core::qr_rank1_update Member List

This is the complete list of members for linalg_core::qr_rank1_update, including all inherited members.

- - - -
qr_rank1_update_cmplx (defined in linalg_core::qr_rank1_update)linalg_core::qr_rank1_updateprivate
qr_rank1_update_dbl (defined in linalg_core::qr_rank1_update)linalg_core::qr_rank1_updateprivate
+
diff --git a/doc/html/interfacelinalg__core_1_1qr__rank1__update.html b/doc/html/interfacelinalg__core_1_1qr__rank1__update.html index 4ffe47d9..e5a56b03 100644 --- a/doc/html/interfacelinalg__core_1_1qr__rank1__update.html +++ b/doc/html/interfacelinalg__core_1_1qr__rank1__update.html @@ -1,9 +1,9 @@ - + - - + + linalg: linalg_core::qr_rank1_update Interface Reference @@ -13,13 +13,16 @@ - + + @@ -27,10 +30,9 @@
- - + @@ -39,21 +41,22 @@
-
linalg -  1.6.0 +
+
linalg 1.6.1
A linear algebra library that provides a user-friendly interface to several BLAS and LAPACK routines.
- + +/* @license-end */ +
@@ -67,8 +70,8 @@
@@ -81,37 +84,32 @@
- +
+
+
+
+
Loading...
+
Searching...
+
No Matches
+
+
+
-
-
linalg_core::qr_rank1_update Interface Reference
+
linalg_core::qr_rank1_update Interface Reference

Computes the rank 1 update to an M-by-N QR factored matrix A (M >= N) where A = Q * R, and A1 = A + U * V**T such that A1 = Q1 * R1. More...

- - - - - - -

-Private Member Functions

qr_rank1_update_dbl
 
qr_rank1_update_cmplx
 

Detailed Description

-

Computes the rank 1 update to an M-by-N QR factored matrix A (M >= N) where A = Q * R, and A1 = A + U * V**T such that A1 = Q1 * R1.

+

Computes the rank 1 update to an M-by-N QR factored matrix A (M >= N) where A = Q * R, and A1 = A + U * V**T such that A1 = Q1 * R1.

Usage
The following example illustrates a rank 1 update to a QR factored system. The results are compared to updating the original matrix, and then performing the factorization.
program example
use iso_fortran_env
- +
implicit none
! Variables
@@ -135,22 +133,22 @@
! Compute the QR factorization of the original matrix
r = a ! Making a copy as the matrix will be overwritten by qr_factor
-
call qr_factor(r, tau)
+
call qr_factor(r, tau)
! Form Q & R
-
call form_qr(r, tau, q)
+
call form_qr(r, tau, q)
! Compute the rank 1 update to the original matrix such that:
! A = A + u * v**T
-
call rank1_update(1.0d0, u, v, a)
+
call rank1_update(1.0d0, u, v, a)
! Compute the rank 1 update to the factorization. Notice, the contents
! of U & V are destroyed as part of this process.
-
call qr_rank1_update(q, r, u, v)
+
call qr_rank1_update(q, r, u, v)
! As comparison, compute the QR factorization of the rank 1 updated matrix
-
call qr_factor(a, tau)
-
call form_qr(a, tau, qu)
+
call qr_factor(a, tau)
+
call form_qr(a, tau, qu)
! Display the matrices
print '(A)', "Updating the Factored Form:"
@@ -173,6 +171,11 @@
print *, a(i,:)
end do
end program
+
Forms the full M-by-M orthogonal matrix Q from the elementary reflectors returned by the base QR fact...
+
Computes the QR factorization of an M-by-N matrix.
+
Computes the rank 1 update to an M-by-N QR factored matrix A (M >= N) where A = Q * R,...
+
Performs the rank-1 update to matrix A such that: , where is an M-by-N matrix, is a scalar,...
+
Provides a set of common linear algebra routines.
Definition: linalg_core.f90:15
The above program produces the following output.
Updating the Factored Form:
Q =
-0.13031167282892092 0.98380249683206911 -0.12309149097933236
@@ -193,24 +196,17 @@
0.0000000000000000 0.0000000000000000 -5.2929341121113058
-

Definition at line 651 of file linalg_core.f90.

+

Definition at line 782 of file linalg_core.f90.


The documentation for this interface was generated from the following file:
-
Provides a set of common linear algebra routines.
Definition: linalg_core.f90:15
-
Performs the rank-1 update to matrix A such that: A = alpha * X * Y**T + A, where A is an M-by-N matr...
Definition: linalg_core.f90:72
-
Forms the full M-by-M orthogonal matrix Q from the elementary reflectors returned by the base QR fact...
-
Computes the rank 1 update to an M-by-N QR factored matrix A (M >= N) where A = Q * R,...
-
Computes the QR factorization of an M-by-N matrix.
diff --git a/doc/html/interfacelinalg__core_1_1rank1__update-members.html b/doc/html/interfacelinalg__core_1_1rank1__update-members.html index e06c74c1..5aa69e27 100644 --- a/doc/html/interfacelinalg__core_1_1rank1__update-members.html +++ b/doc/html/interfacelinalg__core_1_1rank1__update-members.html @@ -1,9 +1,9 @@ - + - - + + linalg: Member List @@ -13,13 +13,16 @@ - + + @@ -27,10 +30,9 @@
- - + @@ -39,21 +41,22 @@
-
linalg -  1.6.0 +
+
linalg 1.6.1
A linear algebra library that provides a user-friendly interface to several BLAS and LAPACK routines.
- + +/* @license-end */ +
@@ -67,8 +70,8 @@
@@ -81,29 +84,30 @@
- +
+
+
+
+
Loading...
+
Searching...
+
No Matches
+
+
+
-
-
linalg_core::rank1_update Member List
+
linalg_core::rank1_update Member List

This is the complete list of members for linalg_core::rank1_update, including all inherited members.

- - - -
rank1_update_cmplx (defined in linalg_core::rank1_update)linalg_core::rank1_updateprivate
rank1_update_dbl (defined in linalg_core::rank1_update)linalg_core::rank1_updateprivate
+
diff --git a/doc/html/interfacelinalg__core_1_1rank1__update.html b/doc/html/interfacelinalg__core_1_1rank1__update.html index d0c7455b..56e9acf4 100644 --- a/doc/html/interfacelinalg__core_1_1rank1__update.html +++ b/doc/html/interfacelinalg__core_1_1rank1__update.html @@ -1,9 +1,9 @@ - + - - + + linalg: linalg_core::rank1_update Interface Reference @@ -13,13 +13,16 @@ - + + @@ -27,10 +30,9 @@
- - + @@ -39,21 +41,22 @@
-
linalg -  1.6.0 +
+
linalg 1.6.1
A linear algebra library that provides a user-friendly interface to several BLAS and LAPACK routines.
- + +/* @license-end */ +
@@ -67,8 +70,8 @@
@@ -81,38 +84,50 @@
- +
+
+
+
+
Loading...
+
Searching...
+
No Matches
+
+
+
-
-
linalg_core::rank1_update Interface Reference
+
linalg_core::rank1_update Interface Reference
-

Performs the rank-1 update to matrix A such that: A = alpha * X * Y**T + A, where A is an M-by-N matrix, alpha is a scalar, X is an M-element array, and N is an N-element array. In the event that Y is complex, Y**H is used instead of Y**T. +

Performs the rank-1 update to matrix A such that: \( A = \alpha X Y^T + A \), where \( A \) is an M-by-N matrix, \( \alpha \)is a scalar, \( X \) is an M-element array, and \( Y \) is an N-element array. In the event that \( Y \) is complex, \( Y^H \) is used instead of \( Y^T \). More...

- - - - - - -

-Private Member Functions

rank1_update_dbl
 
rank1_update_cmplx
 

Detailed Description

-

Performs the rank-1 update to matrix A such that: A = alpha * X * Y**T + A, where A is an M-by-N matrix, alpha is a scalar, X is an M-element array, and N is an N-element array. In the event that Y is complex, Y**H is used instead of Y**T.

+

Performs the rank-1 update to matrix A such that: \( A = \alpha X Y^T + A \), where \( A \) is an M-by-N matrix, \( \alpha \)is a scalar, \( X \) is an M-element array, and \( Y \) is an N-element array. In the event that \( Y \) is complex, \( Y^H \) is used instead of \( Y^T \).

+
Syntax
subroutine rank1_update(real(real64) alpha, real(real64) x(:), real(real64) y(:), real(real64) a(:,:), class(errors) err)
+
subroutine rank1_update(complex(real64) alpha, complex(real64) x(:), complex(real64) y(:), complex(real64) a(:,:), class(errors) err)
+
+
Parameters
+ + + + + + +
[in]alphaThe scalar multiplier.
[in]xAn M-element array.
[in]yAn N-element array.
[in,out]aOn input, the M-by-N matrix to update. On output, the updated M-by-N matrix.
[in,out]errAn optional errors-based object that if provided can be used to retrieve information relating to any errors encountered during execution. If not provided, a default implementation of the errors class is used internally to provide error handling. Possible errors and warning messages that may be encountered are as follows.
    +
  • LA_ARRAY_SIZE_ERROR: Occurs if the size of a does not match with x and y.
  • +
+
+
+
+
Notes
This routine is based upon the BLAS routine DGER or ZGER.
-

Definition at line 72 of file linalg_core.f90.

+

Definition at line 154 of file linalg_core.f90.


The documentation for this interface was generated from the following file:
@@ -120,9 +135,7 @@ diff --git a/doc/html/interfacelinalg__core_1_1recip__mult__array-members.html b/doc/html/interfacelinalg__core_1_1recip__mult__array-members.html index 05344880..cf586fba 100644 --- a/doc/html/interfacelinalg__core_1_1recip__mult__array-members.html +++ b/doc/html/interfacelinalg__core_1_1recip__mult__array-members.html @@ -1,9 +1,9 @@ - + - - + + linalg: Member List @@ -13,13 +13,16 @@ - + + @@ -27,10 +30,9 @@
- - + @@ -39,21 +41,22 @@
-
linalg -  1.6.0 +
+
linalg 1.6.1
A linear algebra library that provides a user-friendly interface to several BLAS and LAPACK routines.
- + +/* @license-end */ +
@@ -67,8 +70,8 @@
@@ -81,28 +84,30 @@
- +
+
+
+
+
Loading...
+
Searching...
+
No Matches
+
+
+
-
-
linalg_core::recip_mult_array Member List
+
linalg_core::recip_mult_array Member List

This is the complete list of members for linalg_core::recip_mult_array, including all inherited members.

- - -
recip_mult_array_dbl (defined in linalg_core::recip_mult_array)linalg_core::recip_mult_arrayprivate
+
diff --git a/doc/html/interfacelinalg__core_1_1recip__mult__array.html b/doc/html/interfacelinalg__core_1_1recip__mult__array.html index a3638aaa..01a1f1a0 100644 --- a/doc/html/interfacelinalg__core_1_1recip__mult__array.html +++ b/doc/html/interfacelinalg__core_1_1recip__mult__array.html @@ -1,9 +1,9 @@ - + - - + + linalg: linalg_core::recip_mult_array Interface Reference @@ -13,13 +13,16 @@ - + + @@ -27,10 +30,9 @@
- - + @@ -39,21 +41,22 @@
-
linalg -  1.6.0 +
+
linalg 1.6.1
A linear algebra library that provides a user-friendly interface to several BLAS and LAPACK routines.
- + +/* @license-end */ +
@@ -67,8 +70,8 @@
@@ -81,35 +84,33 @@
- +
+
+
+
+
Loading...
+
Searching...
+
No Matches
+
+
+
-
-
linalg_core::recip_mult_array Interface Reference
+
linalg_core::recip_mult_array Interface Reference

Multiplies a vector by the reciprocal of a real scalar. More...

- - - - -

-Private Member Functions

recip_mult_array_dbl
 

Detailed Description

-

Multiplies a vector by the reciprocal of a real scalar.

+

Multiplies a vector by the reciprocal of a real scalar.

-

Definition at line 184 of file linalg_core.f90.

+

Definition at line 315 of file linalg_core.f90.


The documentation for this interface was generated from the following file:
@@ -117,9 +118,7 @@ diff --git a/doc/html/interfacelinalg__core_1_1rz__factor-members.html b/doc/html/interfacelinalg__core_1_1rz__factor-members.html index 46d288d1..73fd74a4 100644 --- a/doc/html/interfacelinalg__core_1_1rz__factor-members.html +++ b/doc/html/interfacelinalg__core_1_1rz__factor-members.html @@ -1,9 +1,9 @@ - + - - + + linalg: Member List @@ -13,13 +13,16 @@ - + + @@ -27,10 +30,9 @@
- - + @@ -39,21 +41,22 @@
-
linalg -  1.6.0 +
+
linalg 1.6.1
A linear algebra library that provides a user-friendly interface to several BLAS and LAPACK routines.
- + +/* @license-end */ +
@@ -67,8 +70,8 @@
@@ -81,29 +84,30 @@
- +
+
+
+
+
Loading...
+
Searching...
+
No Matches
+
+
+
-
-
linalg_core::rz_factor Member List
+
linalg_core::rz_factor Member List

This is the complete list of members for linalg_core::rz_factor, including all inherited members.

- - - -
rz_factor_cmplx (defined in linalg_core::rz_factor)linalg_core::rz_factorprivate
rz_factor_dbl (defined in linalg_core::rz_factor)linalg_core::rz_factorprivate
+
diff --git a/doc/html/interfacelinalg__core_1_1rz__factor.html b/doc/html/interfacelinalg__core_1_1rz__factor.html index 14eee719..4f9b1e59 100644 --- a/doc/html/interfacelinalg__core_1_1rz__factor.html +++ b/doc/html/interfacelinalg__core_1_1rz__factor.html @@ -1,9 +1,9 @@ - + - - + + linalg: linalg_core::rz_factor Interface Reference @@ -13,13 +13,16 @@ - + + @@ -27,10 +30,9 @@
- - + @@ -39,21 +41,22 @@
-
linalg -  1.6.0 +
+
linalg 1.6.1
A linear algebra library that provides a user-friendly interface to several BLAS and LAPACK routines.
- + +/* @license-end */ +
@@ -67,8 +70,8 @@
@@ -81,38 +84,33 @@
- +
+
+
+
+
Loading...
+
Searching...
+
No Matches
+
+
+
-
-
linalg_core::rz_factor Interface Reference
+
linalg_core::rz_factor Interface Reference

Factors an upper trapezoidal matrix by means of orthogonal transformations such that A = R * Z = (R 0) * Z. Z is an orthogonal matrix of dimension N-by-N, and R is an M-by-M upper triangular matrix. More...

- - - - - - -

-Private Member Functions

rz_factor_dbl
 
rz_factor_cmplx
 

Detailed Description

-

Factors an upper trapezoidal matrix by means of orthogonal transformations such that A = R * Z = (R 0) * Z. Z is an orthogonal matrix of dimension N-by-N, and R is an M-by-M upper triangular matrix.

+

Factors an upper trapezoidal matrix by means of orthogonal transformations such that A = R * Z = (R 0) * Z. Z is an orthogonal matrix of dimension N-by-N, and R is an M-by-M upper triangular matrix.

-

Definition at line 877 of file linalg_core.f90.

+

Definition at line 1008 of file linalg_core.f90.


The documentation for this interface was generated from the following file:
@@ -120,9 +118,7 @@ diff --git a/doc/html/interfacelinalg__core_1_1solve__cholesky-members.html b/doc/html/interfacelinalg__core_1_1solve__cholesky-members.html index cf90afe3..c92b432b 100644 --- a/doc/html/interfacelinalg__core_1_1solve__cholesky-members.html +++ b/doc/html/interfacelinalg__core_1_1solve__cholesky-members.html @@ -1,9 +1,9 @@ - + - - + + linalg: Member List @@ -13,13 +13,16 @@ - + + @@ -27,10 +30,9 @@
- - + @@ -39,21 +41,22 @@
-
linalg -  1.6.0 +
+
linalg 1.6.1
A linear algebra library that provides a user-friendly interface to several BLAS and LAPACK routines.
- + +/* @license-end */ +
@@ -67,8 +70,8 @@
@@ -81,31 +84,30 @@
- +
+
+
+
+
Loading...
+
Searching...
+
No Matches
+
+
+
-
-
linalg_core::solve_cholesky Member List
+
linalg_core::solve_cholesky Member List

This is the complete list of members for linalg_core::solve_cholesky, including all inherited members.

- - - - - -
solve_cholesky_mtx (defined in linalg_core::solve_cholesky)linalg_core::solve_choleskyprivate
solve_cholesky_mtx_cmplx (defined in linalg_core::solve_cholesky)linalg_core::solve_choleskyprivate
solve_cholesky_vec (defined in linalg_core::solve_cholesky)linalg_core::solve_choleskyprivate
solve_cholesky_vec_cmplx (defined in linalg_core::solve_cholesky)linalg_core::solve_choleskyprivate
+
diff --git a/doc/html/interfacelinalg__core_1_1solve__cholesky.html b/doc/html/interfacelinalg__core_1_1solve__cholesky.html index 8030c2a6..7c76aba8 100644 --- a/doc/html/interfacelinalg__core_1_1solve__cholesky.html +++ b/doc/html/interfacelinalg__core_1_1solve__cholesky.html @@ -1,9 +1,9 @@ - + - - + + linalg: linalg_core::solve_cholesky Interface Reference @@ -13,13 +13,16 @@ - + + @@ -27,10 +30,9 @@
- - + @@ -39,21 +41,22 @@
-
linalg -  1.6.0 +
+
linalg 1.6.1
A linear algebra library that provides a user-friendly interface to several BLAS and LAPACK routines.
- + +/* @license-end */ +
@@ -67,8 +70,8 @@
@@ -81,43 +84,32 @@
- +
+
+
+
+
Loading...
+
Searching...
+
No Matches
+
+
+
-
-
linalg_core::solve_cholesky Interface Reference
+
linalg_core::solve_cholesky Interface Reference

Solves a system of Cholesky factored equations. More...

- - - - - - - - - - -

-Private Member Functions

solve_cholesky_mtx
 
solve_cholesky_mtx_cmplx
 
solve_cholesky_vec
 
solve_cholesky_vec_cmplx
 

Detailed Description

-

Solves a system of Cholesky factored equations.

+

Solves a system of Cholesky factored equations.

Usage
The following example illustrates the solution of a positive-definite system of equations via Cholesky factorization.
program example
use iso_fortran_env, only : real64, int32
- +
implicit none
! Variables
@@ -143,10 +135,10 @@
! Compute the Cholesky factorization of A considering only the upper
! triangular portion of A (the default configuration).
- +
! Compute the solution
-
call solve_cholesky(.true., a, b)
+
call solve_cholesky(.true., a, b)
! Display the results
print '(A)', "Cholesky Solution: X = "
@@ -156,15 +148,19 @@
! factorization causes A = U**T * U. Then U**T * U * X = B.
! Step 1 would then be to solve the problem U**T * Y = B, for Y.
-
call solve_triangular_system(.true., .true., .true., a, bu)
+
call solve_triangular_system(.true., .true., .true., a, bu)
! Now, solve the problem U * X = Y, for X
-
call solve_triangular_system(.true., .false., .true., a, bu)
+
call solve_triangular_system(.true., .false., .true., a, bu)
! Display the results
print '(A)', "Cholesky Solution (Manual Approach): X = "
print '(F8.4)', (bu(i), i = 1, size(bu))
end program
+
Computes the Cholesky factorization of a symmetric, positive definite matrix.
+
Solves a system of Cholesky factored equations.
+
Solves a triangular system of equations.
+
Provides a set of common linear algebra routines.
Definition: linalg_core.f90:15
The above program produces the following output.
Cholesky Solution: X =
239.5833
-65.6667
@@ -175,23 +171,17 @@
10.3333
-

Definition at line 1243 of file linalg_core.f90.

+

Definition at line 1374 of file linalg_core.f90.


The documentation for this interface was generated from the following file:
-
Provides a set of common linear algebra routines.
Definition: linalg_core.f90:15
-
Computes the Cholesky factorization of a symmetric, positive definite matrix.
-
Solves a system of Cholesky factored equations.
-
Solves a triangular system of equations.
diff --git a/doc/html/interfacelinalg__core_1_1solve__least__squares-members.html b/doc/html/interfacelinalg__core_1_1solve__least__squares-members.html index 330115ae..55c131e7 100644 --- a/doc/html/interfacelinalg__core_1_1solve__least__squares-members.html +++ b/doc/html/interfacelinalg__core_1_1solve__least__squares-members.html @@ -1,9 +1,9 @@ - + - - + + linalg: Member List @@ -13,13 +13,16 @@ - + + @@ -27,10 +30,9 @@
- - + @@ -39,21 +41,22 @@
-
linalg -  1.6.0 +
+
linalg 1.6.1
A linear algebra library that provides a user-friendly interface to several BLAS and LAPACK routines.
- + +/* @license-end */ +
@@ -67,8 +70,8 @@
@@ -81,31 +84,30 @@
- +
+
+
+
+
Loading...
+
Searching...
+
No Matches
+
+
+
-
-
linalg_core::solve_least_squares Member List
+
linalg_core::solve_least_squares Member List

This is the complete list of members for linalg_core::solve_least_squares, including all inherited members.

- - - - - -
solve_least_squares_mtx (defined in linalg_core::solve_least_squares)linalg_core::solve_least_squaresprivate
solve_least_squares_mtx_cmplx (defined in linalg_core::solve_least_squares)linalg_core::solve_least_squaresprivate
solve_least_squares_vec (defined in linalg_core::solve_least_squares)linalg_core::solve_least_squaresprivate
solve_least_squares_vec_cmplx (defined in linalg_core::solve_least_squares)linalg_core::solve_least_squaresprivate
+
diff --git a/doc/html/interfacelinalg__core_1_1solve__least__squares.html b/doc/html/interfacelinalg__core_1_1solve__least__squares.html index faf92632..6d8abbc1 100644 --- a/doc/html/interfacelinalg__core_1_1solve__least__squares.html +++ b/doc/html/interfacelinalg__core_1_1solve__least__squares.html @@ -1,9 +1,9 @@ - + - - + + linalg: linalg_core::solve_least_squares Interface Reference @@ -13,13 +13,16 @@ - + + @@ -27,10 +30,9 @@
- - + @@ -39,21 +41,22 @@
-
linalg -  1.6.0 +
+
linalg 1.6.1
A linear algebra library that provides a user-friendly interface to several BLAS and LAPACK routines.
- + +/* @license-end */ +
@@ -67,8 +70,8 @@
@@ -81,43 +84,32 @@
- +
+
+
+
+
Loading...
+
Searching...
+
No Matches
+
+
+
-
-
linalg_core::solve_least_squares Interface Reference
+
linalg_core::solve_least_squares Interface Reference

Solves the overdetermined or underdetermined system (A*X = B) of M equations of N unknowns. More...

- - - - - - - - - - -

-Private Member Functions

solve_least_squares_mtx
 
solve_least_squares_mtx_cmplx
 
solve_least_squares_vec
 
solve_least_squares_vec_cmplx
 

Detailed Description

-

Solves the overdetermined or underdetermined system (A*X = B) of M equations of N unknowns.

+

Solves the overdetermined or underdetermined system (A*X = B) of M equations of N unknowns.

Usage
The following example illustrates the least squares solution of an overdetermined system of linear equations.
program example
use iso_fortran_env, only : real64, int32
- +
implicit none
! Local Variables
@@ -141,32 +133,30 @@
! Compute the solution via a least-squares approach. The results overwrite
! the first 2 elements in b.
- +
! Display the results
print '(A)', "Least Squares Solution: X = "
print '(F9.5)', (b(i), i = 1, size(a, 2))
end program
+
Solves the overdetermined or underdetermined system (A*X = B) of M equations of N unknowns.
+
Provides a set of common linear algebra routines.
Definition: linalg_core.f90:15
The above program produces the following output.
Least Squares Solution: X =
0.13158
-0.57895
-

Definition at line 1297 of file linalg_core.f90.

+

Definition at line 1428 of file linalg_core.f90.


The documentation for this interface was generated from the following file:
-
Provides a set of common linear algebra routines.
Definition: linalg_core.f90:15
-
Solves the overdetermined or underdetermined system (A*X = B) of M equations of N unknowns.
diff --git a/doc/html/interfacelinalg__core_1_1solve__least__squares__full-members.html b/doc/html/interfacelinalg__core_1_1solve__least__squares__full-members.html index e967b8e1..a7055407 100644 --- a/doc/html/interfacelinalg__core_1_1solve__least__squares__full-members.html +++ b/doc/html/interfacelinalg__core_1_1solve__least__squares__full-members.html @@ -1,9 +1,9 @@ - + - - + + linalg: Member List @@ -13,13 +13,16 @@ - + + @@ -27,10 +30,9 @@
- - + @@ -39,21 +41,22 @@
-
linalg -  1.6.0 +
+
linalg 1.6.1
A linear algebra library that provides a user-friendly interface to several BLAS and LAPACK routines.
- + +/* @license-end */ +
@@ -67,8 +70,8 @@
@@ -81,31 +84,30 @@
- +
+
+
+
+
Loading...
+
Searching...
+
No Matches
+
+
+
-
-
linalg_core::solve_least_squares_full Member List
+
linalg_core::solve_least_squares_full Member List

This is the complete list of members for linalg_core::solve_least_squares_full, including all inherited members.

- - - - - -
solve_least_squares_mtx_pvt (defined in linalg_core::solve_least_squares_full)linalg_core::solve_least_squares_fullprivate
solve_least_squares_mtx_pvt_cmplx (defined in linalg_core::solve_least_squares_full)linalg_core::solve_least_squares_fullprivate
solve_least_squares_vec_pvt (defined in linalg_core::solve_least_squares_full)linalg_core::solve_least_squares_fullprivate
solve_least_squares_vec_pvt_cmplx (defined in linalg_core::solve_least_squares_full)linalg_core::solve_least_squares_fullprivate
+
diff --git a/doc/html/interfacelinalg__core_1_1solve__least__squares__full.html b/doc/html/interfacelinalg__core_1_1solve__least__squares__full.html index dc078d7d..18c5245e 100644 --- a/doc/html/interfacelinalg__core_1_1solve__least__squares__full.html +++ b/doc/html/interfacelinalg__core_1_1solve__least__squares__full.html @@ -1,9 +1,9 @@ - + - - + + linalg: linalg_core::solve_least_squares_full Interface Reference @@ -13,13 +13,16 @@ - + + @@ -27,10 +30,9 @@
- - + @@ -39,21 +41,22 @@
-
linalg -  1.6.0 +
+
linalg 1.6.1
A linear algebra library that provides a user-friendly interface to several BLAS and LAPACK routines.
- + +/* @license-end */ +
@@ -67,8 +70,8 @@
@@ -81,43 +84,32 @@
- +
+
+
+
+
Loading...
+
Searching...
+
No Matches
+
+
+
-
-
linalg_core::solve_least_squares_full Interface Reference
+
linalg_core::solve_least_squares_full Interface Reference

Solves the overdetermined or underdetermined system (A*X = B) of M equations of N unknowns, but uses a full orthogonal factorization of the system. More...

- - - - - - - - - - -

-Private Member Functions

solve_least_squares_mtx_pvt
 
solve_least_squares_mtx_pvt_cmplx
 
solve_least_squares_vec_pvt
 
solve_least_squares_vec_pvt_cmplx
 

Detailed Description

-

Solves the overdetermined or underdetermined system (A*X = B) of M equations of N unknowns, but uses a full orthogonal factorization of the system.

+

Solves the overdetermined or underdetermined system (A*X = B) of M equations of N unknowns, but uses a full orthogonal factorization of the system.

Usage
The following example illustrates the least squares solution of an overdetermined system of linear equations.
program example
use iso_fortran_env, only : real64, int32
- +
implicit none
! Local Variables
@@ -141,32 +133,30 @@
! Compute the solution via a least-squares approach. The results overwrite
! the first 2 elements in b.
- +
! Display the results
print '(A)', "Least Squares Solution: X = "
print '(F9.5)', (b(i), i = 1, size(a, 2))
end program
+
Solves the overdetermined or underdetermined system (A*X = B) of M equations of N unknowns,...
+
Provides a set of common linear algebra routines.
Definition: linalg_core.f90:15
The above program produces the following output.
Least Squares Solution: X =
0.13158
-0.57895
-

Definition at line 1352 of file linalg_core.f90.

+

Definition at line 1483 of file linalg_core.f90.


The documentation for this interface was generated from the following file:
-
Provides a set of common linear algebra routines.
Definition: linalg_core.f90:15
-
Solves the overdetermined or underdetermined system (A*X = B) of M equations of N unknowns,...
diff --git a/doc/html/interfacelinalg__core_1_1solve__least__squares__svd-members.html b/doc/html/interfacelinalg__core_1_1solve__least__squares__svd-members.html index 56fe30d4..c362de2f 100644 --- a/doc/html/interfacelinalg__core_1_1solve__least__squares__svd-members.html +++ b/doc/html/interfacelinalg__core_1_1solve__least__squares__svd-members.html @@ -1,9 +1,9 @@ - + - - + + linalg: Member List @@ -13,13 +13,16 @@ - + + @@ -27,10 +30,9 @@
- - + @@ -39,21 +41,22 @@
-
linalg -  1.6.0 +
+
linalg 1.6.1
A linear algebra library that provides a user-friendly interface to several BLAS and LAPACK routines.
- + +/* @license-end */ +
@@ -67,8 +70,8 @@
@@ -81,29 +84,30 @@
- +
+
+
+
+
Loading...
+
Searching...
+
No Matches
+
+
+
-
-
linalg_core::solve_least_squares_svd Member List
+
linalg_core::solve_least_squares_svd Member List

This is the complete list of members for linalg_core::solve_least_squares_svd, including all inherited members.

- - - -
solve_least_squares_mtx_svd (defined in linalg_core::solve_least_squares_svd)linalg_core::solve_least_squares_svdprivate
solve_least_squares_vec_svd (defined in linalg_core::solve_least_squares_svd)linalg_core::solve_least_squares_svdprivate
+
diff --git a/doc/html/interfacelinalg__core_1_1solve__least__squares__svd.html b/doc/html/interfacelinalg__core_1_1solve__least__squares__svd.html index acb930f0..524559de 100644 --- a/doc/html/interfacelinalg__core_1_1solve__least__squares__svd.html +++ b/doc/html/interfacelinalg__core_1_1solve__least__squares__svd.html @@ -1,9 +1,9 @@ - + - - + + linalg: linalg_core::solve_least_squares_svd Interface Reference @@ -13,13 +13,16 @@ - + + @@ -27,10 +30,9 @@
- - + @@ -39,21 +41,22 @@
-
linalg -  1.6.0 +
+
linalg 1.6.1
A linear algebra library that provides a user-friendly interface to several BLAS and LAPACK routines.
- + +/* @license-end */ +
@@ -67,8 +70,8 @@
@@ -81,37 +84,32 @@
- +
+
+
+
+
Loading...
+
Searching...
+
No Matches
+
+
+
-
-
linalg_core::solve_least_squares_svd Interface Reference
+
linalg_core::solve_least_squares_svd Interface Reference

Solves the overdetermined or underdetermined system (A*X = B) of M equations of N unknowns using a singular value decomposition of matrix A. More...

- - - - - - -

-Private Member Functions

solve_least_squares_mtx_svd
 
solve_least_squares_vec_svd
 

Detailed Description

-

Solves the overdetermined or underdetermined system (A*X = B) of M equations of N unknowns using a singular value decomposition of matrix A.

+

Solves the overdetermined or underdetermined system (A*X = B) of M equations of N unknowns using a singular value decomposition of matrix A.

Usage
The following example illustrates the least squares solution of an overdetermined system of linear equations.
program example
use iso_fortran_env, only : real64, int32
- +
implicit none
! Local Variables
@@ -135,32 +133,30 @@
! Compute the solution via a least-squares approach. The results overwrite
! the first 2 elements in b.
- +
! Display the results
print '(A)', "Least Squares Solution: X = "
print '(F9.5)', (b(i), i = 1, size(a, 2))
end program
+
Solves the overdetermined or underdetermined system (A*X = B) of M equations of N unknowns using a si...
+
Provides a set of common linear algebra routines.
Definition: linalg_core.f90:15
The above program produces the following output.
Least Squares Solution: X =
0.13158
-0.57895
-

Definition at line 1407 of file linalg_core.f90.

+

Definition at line 1538 of file linalg_core.f90.


The documentation for this interface was generated from the following file:
-
Solves the overdetermined or underdetermined system (A*X = B) of M equations of N unknowns using a si...
-
Provides a set of common linear algebra routines.
Definition: linalg_core.f90:15
diff --git a/doc/html/interfacelinalg__core_1_1solve__lu-members.html b/doc/html/interfacelinalg__core_1_1solve__lu-members.html index dad88760..aeb2911d 100644 --- a/doc/html/interfacelinalg__core_1_1solve__lu-members.html +++ b/doc/html/interfacelinalg__core_1_1solve__lu-members.html @@ -1,9 +1,9 @@ - + - - + + linalg: Member List @@ -13,13 +13,16 @@ - + + @@ -27,10 +30,9 @@
- - + @@ -39,21 +41,22 @@
-
linalg -  1.6.0 +
+
linalg 1.6.1
A linear algebra library that provides a user-friendly interface to several BLAS and LAPACK routines.
- + +/* @license-end */ +
@@ -67,8 +70,8 @@
@@ -81,31 +84,30 @@
- +
+
+
+
+
Loading...
+
Searching...
+
No Matches
+
+
+
-
-
linalg_core::solve_lu Member List
+
linalg_core::solve_lu Member List

This is the complete list of members for linalg_core::solve_lu, including all inherited members.

- - - - - -
solve_lu_mtx (defined in linalg_core::solve_lu)linalg_core::solve_luprivate
solve_lu_mtx_cmplx (defined in linalg_core::solve_lu)linalg_core::solve_luprivate
solve_lu_vec (defined in linalg_core::solve_lu)linalg_core::solve_luprivate
solve_lu_vec_cmplx (defined in linalg_core::solve_lu)linalg_core::solve_luprivate
+
diff --git a/doc/html/interfacelinalg__core_1_1solve__lu.html b/doc/html/interfacelinalg__core_1_1solve__lu.html index d70537bc..cf8dc610 100644 --- a/doc/html/interfacelinalg__core_1_1solve__lu.html +++ b/doc/html/interfacelinalg__core_1_1solve__lu.html @@ -1,9 +1,9 @@ - + - - + + linalg: linalg_core::solve_lu Interface Reference @@ -13,13 +13,16 @@ - + + @@ -27,10 +30,9 @@
- - + @@ -39,21 +41,22 @@
-
linalg -  1.6.0 +
+
linalg 1.6.1
A linear algebra library that provides a user-friendly interface to several BLAS and LAPACK routines.
- + +/* @license-end */ +
@@ -67,8 +70,8 @@
@@ -81,43 +84,32 @@
- +
+
+
+
+
Loading...
+
Searching...
+
No Matches
+
+
+
-
-
linalg_core::solve_lu Interface Reference
+
linalg_core::solve_lu Interface Reference

Solves a system of LU-factored equations. More...

- - - - - - - - - - -

-Private Member Functions

solve_lu_mtx
 
solve_lu_mtx_cmplx
 
solve_lu_vec
 
solve_lu_vec_cmplx
 

Detailed Description

-

Solves a system of LU-factored equations.

+

Solves a system of LU-factored equations.

Usage
To solve a system of 3 equations of 3 unknowns using LU factorization, the following code will suffice.
program example
use iso_fortran_env
- +
implicit none
! Local Variables
@@ -144,15 +136,18 @@
! | 0 |
! Compute the LU factorization
-
call lu_factor(a, pvt)
+
call lu_factor(a, pvt)
! Compute the solution. The results overwrite b.
-
call solve_lu(a, pvt, b)
+
call solve_lu(a, pvt, b)
! Display the results.
print '(A)', "LU Solution: X = "
print '(F8.4)', (b(i), i = 1, size(b))
end program
+
Computes the LU factorization of an M-by-N matrix.
+
Solves a system of LU-factored equations.
+
Provides a set of common linear algebra routines.
Definition: linalg_core.f90:15
The program generates the following output.
LU Solution: X =
0.3333
-0.6667
@@ -164,22 +159,17 @@
-

Definition at line 1094 of file linalg_core.f90.

+

Definition at line 1225 of file linalg_core.f90.


The documentation for this interface was generated from the following file:
-
Provides a set of common linear algebra routines.
Definition: linalg_core.f90:15
-
Computes the LU factorization of an M-by-N matrix.
-
Solves a system of LU-factored equations.
diff --git a/doc/html/interfacelinalg__core_1_1solve__qr-members.html b/doc/html/interfacelinalg__core_1_1solve__qr-members.html index 0e2c84d6..ae21d3ca 100644 --- a/doc/html/interfacelinalg__core_1_1solve__qr-members.html +++ b/doc/html/interfacelinalg__core_1_1solve__qr-members.html @@ -1,9 +1,9 @@ - + - - + + linalg: Member List @@ -13,13 +13,16 @@ - + + @@ -27,10 +30,9 @@
- - + @@ -39,21 +41,22 @@
-
linalg -  1.6.0 +
+
linalg 1.6.1
A linear algebra library that provides a user-friendly interface to several BLAS and LAPACK routines.
- + +/* @license-end */ +
@@ -67,8 +70,8 @@
@@ -81,35 +84,30 @@
- +
+
+
+
+
Loading...
+
Searching...
+
No Matches
+
+
+
-
-
linalg_core::solve_qr Member List
+
linalg_core::solve_qr Member List

This is the complete list of members for linalg_core::solve_qr, including all inherited members.

- - - - - - - - - -
solve_qr_no_pivot_mtx (defined in linalg_core::solve_qr)linalg_core::solve_qrprivate
solve_qr_no_pivot_mtx_cmplx (defined in linalg_core::solve_qr)linalg_core::solve_qrprivate
solve_qr_no_pivot_vec (defined in linalg_core::solve_qr)linalg_core::solve_qrprivate
solve_qr_no_pivot_vec_cmplx (defined in linalg_core::solve_qr)linalg_core::solve_qrprivate
solve_qr_pivot_mtx (defined in linalg_core::solve_qr)linalg_core::solve_qrprivate
solve_qr_pivot_mtx_cmplx (defined in linalg_core::solve_qr)linalg_core::solve_qrprivate
solve_qr_pivot_vec (defined in linalg_core::solve_qr)linalg_core::solve_qrprivate
solve_qr_pivot_vec_cmplx (defined in linalg_core::solve_qr)linalg_core::solve_qrprivate
+
diff --git a/doc/html/interfacelinalg__core_1_1solve__qr.html b/doc/html/interfacelinalg__core_1_1solve__qr.html index 3d7d3052..9838ddee 100644 --- a/doc/html/interfacelinalg__core_1_1solve__qr.html +++ b/doc/html/interfacelinalg__core_1_1solve__qr.html @@ -1,9 +1,9 @@ - + - - + + linalg: linalg_core::solve_qr Interface Reference @@ -13,13 +13,16 @@ - + + @@ -27,10 +30,9 @@
- - + @@ -39,21 +41,22 @@
-
linalg -  1.6.0 +
+
linalg 1.6.1
A linear algebra library that provides a user-friendly interface to several BLAS and LAPACK routines.
- + +/* @license-end */ +
@@ -67,8 +70,8 @@
@@ -81,55 +84,32 @@
- +
+
+
+
+
Loading...
+
Searching...
+
No Matches
+
+
+
-
-
linalg_core::solve_qr Interface Reference
+
linalg_core::solve_qr Interface Reference

Solves a system of M QR-factored equations of N unknowns. More...

- - - - - - - - - - - - - - - - - - -

-Private Member Functions

solve_qr_no_pivot_mtx
 
solve_qr_no_pivot_mtx_cmplx
 
solve_qr_no_pivot_vec
 
solve_qr_no_pivot_vec_cmplx
 
solve_qr_pivot_mtx
 
solve_qr_pivot_mtx_cmplx
 
solve_qr_pivot_vec
 
solve_qr_pivot_vec_cmplx
 

Detailed Description

-

Solves a system of M QR-factored equations of N unknowns.

+

Solves a system of M QR-factored equations of N unknowns.

Usage
The following example illustrates the solution of a system of equations using QR factorization.
program example
use iso_fortran_env, only : real64, int32
- +
implicit none
! Local Variables
@@ -157,10 +137,10 @@
! Compute the QR factorization, using pivoting
pvt = 0 ! Zero every entry in order not to lock any column in place
-
call qr_factor(a, tau, pvt)
+
call qr_factor(a, tau, pvt)
! Compute the solution. The results overwrite b.
-
call solve_qr(a, tau, pvt, b)
+
call solve_qr(a, tau, pvt, b)
! Display the results.
print '(A)', "QR Solution: X = "
@@ -170,6 +150,9 @@
! same manner. The only difference is to omit the PVT array (column pivot
! tracking array).
end program
+
Computes the QR factorization of an M-by-N matrix.
+
Solves a system of M QR-factored equations of N unknowns.
+
Provides a set of common linear algebra routines.
Definition: linalg_core.f90:15
The above program produces the following output.
QR Solution: X =
0.3333
-0.6667
@@ -181,22 +164,17 @@
-

Definition at line 1163 of file linalg_core.f90.

+

Definition at line 1294 of file linalg_core.f90.


The documentation for this interface was generated from the following file:
-
Provides a set of common linear algebra routines.
Definition: linalg_core.f90:15
-
Solves a system of M QR-factored equations of N unknowns.
-
Computes the QR factorization of an M-by-N matrix.
diff --git a/doc/html/interfacelinalg__core_1_1solve__triangular__system-members.html b/doc/html/interfacelinalg__core_1_1solve__triangular__system-members.html index 4c923d1c..dfd71e17 100644 --- a/doc/html/interfacelinalg__core_1_1solve__triangular__system-members.html +++ b/doc/html/interfacelinalg__core_1_1solve__triangular__system-members.html @@ -1,9 +1,9 @@ - + - - + + linalg: Member List @@ -13,13 +13,16 @@ - + + @@ -27,10 +30,9 @@
- - + @@ -39,21 +41,22 @@
-
linalg -  1.6.0 +
+
linalg 1.6.1
A linear algebra library that provides a user-friendly interface to several BLAS and LAPACK routines.
- + +/* @license-end */ +
@@ -67,8 +70,8 @@
@@ -81,31 +84,30 @@
- +
+
+
+
+
Loading...
+
Searching...
+
No Matches
+
+
+
-
-
linalg_core::solve_triangular_system Member List
+
linalg_core::solve_triangular_system Member List

This is the complete list of members for linalg_core::solve_triangular_system, including all inherited members.

- - - - - -
solve_tri_mtx (defined in linalg_core::solve_triangular_system)linalg_core::solve_triangular_systemprivate
solve_tri_mtx_cmplx (defined in linalg_core::solve_triangular_system)linalg_core::solve_triangular_systemprivate
solve_tri_vec (defined in linalg_core::solve_triangular_system)linalg_core::solve_triangular_systemprivate
solve_tri_vec_cmplx (defined in linalg_core::solve_triangular_system)linalg_core::solve_triangular_systemprivate
+
diff --git a/doc/html/interfacelinalg__core_1_1solve__triangular__system.html b/doc/html/interfacelinalg__core_1_1solve__triangular__system.html index 1c6638b4..c2bd04b5 100644 --- a/doc/html/interfacelinalg__core_1_1solve__triangular__system.html +++ b/doc/html/interfacelinalg__core_1_1solve__triangular__system.html @@ -1,9 +1,9 @@ - + - - + + linalg: linalg_core::solve_triangular_system Interface Reference @@ -13,13 +13,16 @@ - + + @@ -27,10 +30,9 @@
- - + @@ -39,21 +41,22 @@
-
linalg -  1.6.0 +
+
linalg 1.6.1
A linear algebra library that provides a user-friendly interface to several BLAS and LAPACK routines.
- + +/* @license-end */ +
@@ -67,8 +70,8 @@
@@ -81,43 +84,32 @@
- +
+
+
+
+
Loading...
+
Searching...
+
No Matches
+
+
+
-
-
linalg_core::solve_triangular_system Interface Reference
+
linalg_core::solve_triangular_system Interface Reference

Solves a triangular system of equations. More...

- - - - - - - - - - -

-Private Member Functions

solve_tri_mtx
 
solve_tri_mtx_cmplx
 
solve_tri_vec
 
solve_tri_vec_cmplx
 

Detailed Description

-

Solves a triangular system of equations.

+

Solves a triangular system of equations.

Usage
The following example illustrates the solution of two triangular systems to solve a system of LU factored equations.
program example
use iso_fortran_env, only : real64, int32
- +
implicit none
! Variables
@@ -144,10 +136,10 @@
! | 0 |
! Compute the LU factorization
-
call lu_factor(a, pvt)
+
call lu_factor(a, pvt)
! Extract the L and U matrices. A is overwritten with L.
-
call form_lu(a, pvt, u, p)
+
call form_lu(a, pvt, u, p)
! Solve the lower triangular system L * Y = P * B for Y, but first compute
! P * B, and store the results in B
@@ -155,38 +147,36 @@
! Now, compute the solution to the lower triangular system. Store the
! result in B. Remember, L is unit diagonal (ones on its diagonal)
-
call solve_triangular_system(.false., .false., .false., a, b)
+
call solve_triangular_system(.false., .false., .false., a, b)
! Solve the upper triangular system U * X = Y for X.
-
call solve_triangular_system(.true., .false., .true., u, b)
+
call solve_triangular_system(.true., .false., .true., u, b)
! Display the results.
print '(A)', "LU Solution: X = "
print '(F8.4)', (b(i), i = 1, size(b))
end program
+
Extracts the L and U matrices from the condensed [L\U] storage format used by the lu_factor.
+
Computes the LU factorization of an M-by-N matrix.
+
Solves a triangular system of equations.
+
Provides a set of common linear algebra routines.
Definition: linalg_core.f90:15
The above program produces the following output.
LU Solution: X =
0.3333
-0.6667
0.0000
-

Definition at line 1030 of file linalg_core.f90.

+

Definition at line 1161 of file linalg_core.f90.


The documentation for this interface was generated from the following file:
-
Provides a set of common linear algebra routines.
Definition: linalg_core.f90:15
-
Computes the LU factorization of an M-by-N matrix.
-
Extracts the L and U matrices from the condensed [L\U] storage format used by the lu_factor.
-
Solves a triangular system of equations.
diff --git a/doc/html/interfacelinalg__core_1_1sort-members.html b/doc/html/interfacelinalg__core_1_1sort-members.html index 3e3579fd..97368f32 100644 --- a/doc/html/interfacelinalg__core_1_1sort-members.html +++ b/doc/html/interfacelinalg__core_1_1sort-members.html @@ -1,9 +1,9 @@ - + - - + + linalg: Member List @@ -13,13 +13,16 @@ - + + @@ -27,10 +30,9 @@
- - + @@ -39,21 +41,22 @@
-
linalg -  1.6.0 +
+
linalg 1.6.1
A linear algebra library that provides a user-friendly interface to several BLAS and LAPACK routines.
- + +/* @license-end */ +
@@ -67,8 +70,8 @@
@@ -81,33 +84,30 @@
- +
+
+
+
+
Loading...
+
Searching...
+
No Matches
+
+
+
-
-
linalg_core::sort Member List
+
linalg_core::sort Member List

This is the complete list of members for linalg_core::sort, including all inherited members.

- - - - - - - -
sort_cmplx_array (defined in linalg_core::sort)linalg_core::sortprivate
sort_cmplx_array_ind (defined in linalg_core::sort)linalg_core::sortprivate
sort_dbl_array (defined in linalg_core::sort)linalg_core::sortprivate
sort_dbl_array_ind (defined in linalg_core::sort)linalg_core::sortprivate
sort_eigen_cmplx (defined in linalg_core::sort)linalg_core::sortprivate
sort_eigen_dbl (defined in linalg_core::sort)linalg_core::sortprivate
+
diff --git a/doc/html/interfacelinalg__core_1_1sort.html b/doc/html/interfacelinalg__core_1_1sort.html index be3ac4ff..ee6fb0b6 100644 --- a/doc/html/interfacelinalg__core_1_1sort.html +++ b/doc/html/interfacelinalg__core_1_1sort.html @@ -1,9 +1,9 @@ - + - - + + linalg: linalg_core::sort Interface Reference @@ -13,13 +13,16 @@ - + + @@ -27,10 +30,9 @@
- - + @@ -39,21 +41,22 @@
-
linalg -  1.6.0 +
+
linalg 1.6.1
A linear algebra library that provides a user-friendly interface to several BLAS and LAPACK routines.
- + +/* @license-end */ +
@@ -67,8 +70,8 @@
@@ -81,50 +84,33 @@
- +
+
+
+
+
Loading...
+
Searching...
+
No Matches
+
+
+
-
-
linalg_core::sort Interface Reference
+
linalg_core::sort Interface Reference

Sorts an array. More...

- - - - - - - - - - - - - - -

-Private Member Functions

sort_dbl_array
 
sort_dbl_array_ind
 
sort_cmplx_array
 
sort_cmplx_array_ind
 
sort_eigen_cmplx
 
sort_eigen_dbl
 

Detailed Description

-

Sorts an array.

+

Sorts an array.

-

Definition at line 1630 of file linalg_core.f90.

+

Definition at line 1761 of file linalg_core.f90.


The documentation for this interface was generated from the following file:
@@ -132,9 +118,7 @@ diff --git a/doc/html/interfacelinalg__core_1_1svd-members.html b/doc/html/interfacelinalg__core_1_1svd-members.html index be38bde8..6344ae0e 100644 --- a/doc/html/interfacelinalg__core_1_1svd-members.html +++ b/doc/html/interfacelinalg__core_1_1svd-members.html @@ -1,9 +1,9 @@ - + - - + + linalg: Member List @@ -13,13 +13,16 @@ - + + @@ -27,10 +30,9 @@
- - + @@ -39,21 +41,22 @@
-
linalg -  1.6.0 +
+
linalg 1.6.1
A linear algebra library that provides a user-friendly interface to several BLAS and LAPACK routines.
- + +/* @license-end */ +
@@ -67,8 +70,8 @@
@@ -81,29 +84,30 @@
- +
+
+
+
+
Loading...
+
Searching...
+
No Matches
+
+
+
-
-
linalg_core::svd Member List
+
linalg_core::svd Member List

This is the complete list of members for linalg_core::svd, including all inherited members.

- - - -
svd_cmplx (defined in linalg_core::svd)linalg_core::svdprivate
svd_dbl (defined in linalg_core::svd)linalg_core::svdprivate
+
diff --git a/doc/html/interfacelinalg__core_1_1svd.html b/doc/html/interfacelinalg__core_1_1svd.html index e4acfd75..c2cfc76a 100644 --- a/doc/html/interfacelinalg__core_1_1svd.html +++ b/doc/html/interfacelinalg__core_1_1svd.html @@ -1,9 +1,9 @@ - + - - + + linalg: linalg_core::svd Interface Reference @@ -13,13 +13,16 @@ - + + @@ -27,10 +30,9 @@
- - + @@ -39,21 +41,22 @@
-
linalg -  1.6.0 +
+
linalg 1.6.1
A linear algebra library that provides a user-friendly interface to several BLAS and LAPACK routines.
- + +/* @license-end */ +
@@ -67,8 +70,8 @@
@@ -81,37 +84,32 @@
- +
+
+
+
+
Loading...
+
Searching...
+
No Matches
+
+
+
-
-
linalg_core::svd Interface Reference
+
linalg_core::svd Interface Reference

Computes the singular value decomposition of a matrix A. The SVD is defined as: A = U * S * V**T, where U is an M-by-M orthogonal matrix, S is an M-by-N diagonal matrix, and V is an N-by-N orthogonal matrix. More...

- - - - - - -

-Private Member Functions

svd_dbl
 
svd_cmplx
 

Detailed Description

-

Computes the singular value decomposition of a matrix A. The SVD is defined as: A = U * S * V**T, where U is an M-by-M orthogonal matrix, S is an M-by-N diagonal matrix, and V is an N-by-N orthogonal matrix.

+

Computes the singular value decomposition of a matrix A. The SVD is defined as: A = U * S * V**T, where U is an M-by-M orthogonal matrix, S is an M-by-N diagonal matrix, and V is an N-by-N orthogonal matrix.

Usage
The following example illustrates the calculation of the singular value decomposition of an overdetermined system.
program example
use iso_fortran_env, only : int32, real64
- +
implicit none
! Variables
@@ -126,7 +124,7 @@
! Compute the singular value decomposition of A. Notice, V**T is returned
! instead of V. Also note, A is overwritten.
-
call svd(a, s, u, vt)
+
call svd(a, s, u, vt)
! Display the results
print '(A)', "U ="
@@ -143,13 +141,16 @@
end do
! Compute U * S * V**T, but first establish S in full form
-
call diag_mtx_mult(.true., 1.0d0, s, vt) ! Compute: VT = S * V**T
+
call diag_mtx_mult(.true., 1.0d0, s, vt) ! Compute: VT = S * V**T
ac = matmul(u(:,1:2), vt)
print '(A)', "U * S * V**T ="
do i = 1, size(ac, 1)
print *, ac(i,:)
end do
end program
+
Multiplies a diagonal matrix with another matrix or array.
+
Computes the singular value decomposition of a matrix A. The SVD is defined as: A = U * S * V**T,...
+
Provides a set of common linear algebra routines.
Definition: linalg_core.f90:15
The above program produces the following output.
U =
-0.47411577501825380 -0.81850539032073777 -0.32444284226152509
0.82566838523833064 -0.28535874325972488 -0.48666426339228758
@@ -166,22 +167,17 @@
-1.0000000000000000 0.99999999999999967
-

Definition at line 961 of file linalg_core.f90.

+

Definition at line 1092 of file linalg_core.f90.


The documentation for this interface was generated from the following file:
-
Provides a set of common linear algebra routines.
Definition: linalg_core.f90:15
-
Computes the singular value decomposition of a matrix A. The SVD is defined as: A = U * S * V**T,...
-
Multiplies a diagonal matrix with another matrix or array.
diff --git a/doc/html/interfacelinalg__core_1_1swap-members.html b/doc/html/interfacelinalg__core_1_1swap-members.html index e2208cdf..699a2baa 100644 --- a/doc/html/interfacelinalg__core_1_1swap-members.html +++ b/doc/html/interfacelinalg__core_1_1swap-members.html @@ -1,9 +1,9 @@ - + - - + + linalg: Member List @@ -13,13 +13,16 @@ - + + @@ -27,10 +30,9 @@
- - + @@ -39,21 +41,22 @@
-
linalg -  1.6.0 +
+
linalg 1.6.1
A linear algebra library that provides a user-friendly interface to several BLAS and LAPACK routines.
- + +/* @license-end */ +
@@ -67,8 +70,8 @@
@@ -81,29 +84,30 @@
- +
+
+
+
+
Loading...
+
Searching...
+
No Matches
+
+
+
-
-
linalg_core::swap Member List
+
linalg_core::swap Member List

This is the complete list of members for linalg_core::swap, including all inherited members.

- - - -
swap_cmplx (defined in linalg_core::swap)linalg_core::swapprivate
swap_dbl (defined in linalg_core::swap)linalg_core::swapprivate
+
diff --git a/doc/html/interfacelinalg__core_1_1swap.html b/doc/html/interfacelinalg__core_1_1swap.html index 815662a2..40874aeb 100644 --- a/doc/html/interfacelinalg__core_1_1swap.html +++ b/doc/html/interfacelinalg__core_1_1swap.html @@ -1,9 +1,9 @@ - + - - + + linalg: linalg_core::swap Interface Reference @@ -13,13 +13,16 @@ - + + @@ -27,10 +30,9 @@
- - + @@ -39,21 +41,22 @@
-
linalg -  1.6.0 +
+
linalg 1.6.1
A linear algebra library that provides a user-friendly interface to several BLAS and LAPACK routines.
- + +/* @license-end */ +
@@ -67,8 +70,8 @@
@@ -81,38 +84,33 @@
- +
+
+
+
+
Loading...
+
Searching...
+
No Matches
+
+
+
-
-
linalg_core::swap Interface Reference
+
linalg_core::swap Interface Reference

Swaps the contents of two arrays. More...

- - - - - - -

-Private Member Functions

swap_dbl
 
swap_cmplx
 

Detailed Description

-

Swaps the contents of two arrays.

+

Swaps the contents of two arrays.

-

Definition at line 177 of file linalg_core.f90.

+

Definition at line 308 of file linalg_core.f90.


The documentation for this interface was generated from the following file:
@@ -120,9 +118,7 @@ diff --git a/doc/html/interfacelinalg__core_1_1trace-members.html b/doc/html/interfacelinalg__core_1_1trace-members.html index 8ed76c3d..4d2dfc5a 100644 --- a/doc/html/interfacelinalg__core_1_1trace-members.html +++ b/doc/html/interfacelinalg__core_1_1trace-members.html @@ -1,9 +1,9 @@ - + - - + + linalg: Member List @@ -13,13 +13,16 @@ - + + @@ -27,10 +30,9 @@
- - + @@ -39,21 +41,22 @@
-
linalg -  1.6.0 +
+
linalg 1.6.1
A linear algebra library that provides a user-friendly interface to several BLAS and LAPACK routines.
- + +/* @license-end */ +
@@ -67,8 +70,8 @@
@@ -81,29 +84,30 @@
- +
+
+
+
+
Loading...
+
Searching...
+
No Matches
+
+
+
-
-
linalg_core::trace Member List
+
linalg_core::trace Member List

This is the complete list of members for linalg_core::trace, including all inherited members.

- - - -
trace_cmplx (defined in linalg_core::trace)linalg_core::traceprivate
trace_dbl (defined in linalg_core::trace)linalg_core::traceprivate
+
diff --git a/doc/html/interfacelinalg__core_1_1trace.html b/doc/html/interfacelinalg__core_1_1trace.html index 3fe681b4..a3805911 100644 --- a/doc/html/interfacelinalg__core_1_1trace.html +++ b/doc/html/interfacelinalg__core_1_1trace.html @@ -1,9 +1,9 @@ - + - - + + linalg: linalg_core::trace Interface Reference @@ -13,13 +13,16 @@ - + + @@ -27,10 +30,9 @@
- - + @@ -39,21 +41,22 @@
-
linalg -  1.6.0 +
+
linalg 1.6.1
A linear algebra library that provides a user-friendly interface to several BLAS and LAPACK routines.
- + +/* @license-end */ +
@@ -67,8 +70,8 @@
@@ -81,38 +84,33 @@
- +
+
+
+
+
Loading...
+
Searching...
+
No Matches
+
+
+
-
-
linalg_core::trace Interface Reference
+
linalg_core::trace Interface Reference

Computes the trace of a matrix (the sum of the main diagonal elements). More...

- - - - - - -

-Private Member Functions

trace_dbl
 
trace_cmplx
 

Detailed Description

-

Computes the trace of a matrix (the sum of the main diagonal elements).

+

Computes the trace of a matrix (the sum of the main diagonal elements).

-

Definition at line 156 of file linalg_core.f90.

+

Definition at line 287 of file linalg_core.f90.


The documentation for this interface was generated from the following file:
@@ -120,9 +118,7 @@ diff --git a/doc/html/interfacelinalg__core_1_1tri__mtx__mult-members.html b/doc/html/interfacelinalg__core_1_1tri__mtx__mult-members.html index 6e3b2981..7a49b130 100644 --- a/doc/html/interfacelinalg__core_1_1tri__mtx__mult-members.html +++ b/doc/html/interfacelinalg__core_1_1tri__mtx__mult-members.html @@ -1,9 +1,9 @@ - + - - + + linalg: Member List @@ -13,13 +13,16 @@ - + + @@ -27,10 +30,9 @@
- - + @@ -39,21 +41,22 @@
-
linalg -  1.6.0 +
+
linalg 1.6.1
A linear algebra library that provides a user-friendly interface to several BLAS and LAPACK routines.
- + +/* @license-end */ +
@@ -67,8 +70,8 @@
@@ -81,29 +84,30 @@
- +
+
+
+
+
Loading...
+
Searching...
+
No Matches
+
+
+
-
-
linalg_core::tri_mtx_mult Member List
+
linalg_core::tri_mtx_mult Member List

This is the complete list of members for linalg_core::tri_mtx_mult, including all inherited members.

- - - -
tri_mtx_mult_cmplx (defined in linalg_core::tri_mtx_mult)linalg_core::tri_mtx_multprivate
tri_mtx_mult_dbl (defined in linalg_core::tri_mtx_mult)linalg_core::tri_mtx_multprivate
+
diff --git a/doc/html/interfacelinalg__core_1_1tri__mtx__mult.html b/doc/html/interfacelinalg__core_1_1tri__mtx__mult.html index 24a1041c..03db1b51 100644 --- a/doc/html/interfacelinalg__core_1_1tri__mtx__mult.html +++ b/doc/html/interfacelinalg__core_1_1tri__mtx__mult.html @@ -1,9 +1,9 @@ - + - - + + linalg: linalg_core::tri_mtx_mult Interface Reference @@ -13,13 +13,16 @@ - + + @@ -27,10 +30,9 @@
- - + @@ -39,21 +41,22 @@
-
linalg -  1.6.0 +
+
linalg 1.6.1
A linear algebra library that provides a user-friendly interface to several BLAS and LAPACK routines.
- + +/* @license-end */ +
@@ -67,8 +70,8 @@
@@ -81,38 +84,33 @@
- +
+
+
+
+
Loading...
+
Searching...
+
No Matches
+
+
+
-
-
linalg_core::tri_mtx_mult Interface Reference
+
linalg_core::tri_mtx_mult Interface Reference

Computes the triangular matrix operation: B = alpha * A**T * A + beta * B, or B = alpha * A * A**T + beta * B, where A is a triangular matrix. More...

- - - - - - -

-Private Member Functions

tri_mtx_mult_dbl
 
tri_mtx_mult_cmplx
 

Detailed Description

-

Computes the triangular matrix operation: B = alpha * A**T * A + beta * B, or B = alpha * A * A**T + beta * B, where A is a triangular matrix.

+

Computes the triangular matrix operation: B = alpha * A**T * A + beta * B, or B = alpha * A * A**T + beta * B, where A is a triangular matrix.

-

Definition at line 192 of file linalg_core.f90.

+

Definition at line 323 of file linalg_core.f90.


The documentation for this interface was generated from the following file:
@@ -120,9 +118,7 @@ diff --git a/doc/html/interfacelinalg__immutable_1_1mat__eigen-members.html b/doc/html/interfacelinalg__immutable_1_1mat__eigen-members.html index 283fe27a..8cd8a68b 100644 --- a/doc/html/interfacelinalg__immutable_1_1mat__eigen-members.html +++ b/doc/html/interfacelinalg__immutable_1_1mat__eigen-members.html @@ -1,9 +1,9 @@ - + - - + + linalg: Member List @@ -13,13 +13,16 @@ - + + @@ -27,10 +30,9 @@
- - + @@ -39,21 +41,22 @@
-
linalg -  1.6.0 +
+
linalg 1.6.1
A linear algebra library that provides a user-friendly interface to several BLAS and LAPACK routines.
- + +/* @license-end */ +
@@ -67,8 +70,8 @@
@@ -81,29 +84,30 @@
- +
+
+
+
+
Loading...
+
Searching...
+
No Matches
+
+
+
-
-
linalg_immutable::mat_eigen Member List
+
linalg_immutable::mat_eigen Member List

This is the complete list of members for linalg_immutable::mat_eigen, including all inherited members.

- - - -
mat_eigen_1(a)linalg_immutable::mat_eigenprivate
mat_eigen_2(a, b)linalg_immutable::mat_eigenprivate
+
diff --git a/doc/html/interfacelinalg__immutable_1_1mat__eigen.html b/doc/html/interfacelinalg__immutable_1_1mat__eigen.html index 7d6872c2..83e9898a 100644 --- a/doc/html/interfacelinalg__immutable_1_1mat__eigen.html +++ b/doc/html/interfacelinalg__immutable_1_1mat__eigen.html @@ -1,9 +1,9 @@ - + - - + + linalg: linalg_immutable::mat_eigen Interface Reference @@ -13,13 +13,16 @@ - + + @@ -27,10 +30,9 @@
- - + @@ -39,21 +41,22 @@
-
linalg -  1.6.0 +
+
linalg 1.6.1
A linear algebra library that provides a user-friendly interface to several BLAS and LAPACK routines.
- + +/* @license-end */ +
@@ -67,8 +70,8 @@
@@ -81,124 +84,33 @@
- +
+
+
+
+
Loading...
+
Searching...
+
No Matches
+
+
+
-
-
linalg_immutable::mat_eigen Interface Reference
+
linalg_immutable::mat_eigen Interface Reference

Computes the eigenvalues and eigenvectors (right) of a general N-by-N matrix. More...

- - - - - - - - -

-Private Member Functions

type(eigen_results) function mat_eigen_1 (a)
 Computes the eigenvalues and eigenvectors (right) of a general N-by-N matrix. More...
 
type(eigen_results) function mat_eigen_2 (a, b)
 Computes eigenvalues and eigenvectors (right) from the eigenvalue problem: A X = lambda B X. More...
 

Detailed Description

-

Computes the eigenvalues and eigenvectors (right) of a general N-by-N matrix.

+

Computes the eigenvalues and eigenvectors (right) of a general N-by-N matrix.

Definition at line 109 of file linalg_immutable.f90.

-

Member Function/Subroutine Documentation

- -

◆ mat_eigen_1()

- -
-
- - - - - -
- - - - - - - - -
type(eigen_results) function linalg_immutable::mat_eigen::mat_eigen_1 (real(real64), dimension(:,:), intent(in) a)
-
-private
-
- -

Computes the eigenvalues and eigenvectors (right) of a general N-by-N matrix.

-
Parameters
- - -
[in]aThe N-by-N matrix on which to operate.
-
-
-
Returns
The eigenvalues and eigenvectors of the matrix. The results are sorted into ascending order.
- -

Definition at line 960 of file linalg_immutable.f90.

- -
-
- -

◆ mat_eigen_2()

- -
-
- - - - - -
- - - - - - - - - - - - - - - - - - -
type(eigen_results) function linalg_immutable::mat_eigen::mat_eigen_2 (real(real64), dimension(:,:), intent(in) a,
real(real64), dimension(:,:), intent(in) b 
)
-
-private
-
- -

Computes eigenvalues and eigenvectors (right) from the eigenvalue problem: A X = lambda B X.

-
Parameters
- - - -
[in]aThe N-by-N matrix A.
[in]bThe N-by-N matrix B.
-
-
-
Returns
The eigenvalues and eigenvectors. The results are sorted into ascending order.
- -

Definition at line 990 of file linalg_immutable.f90.

- -
-
-
The documentation for this interface was generated from the following file:

The documentation for this interface was generated from the following file:
@@ -206,9 +118,7 @@

diff --git a/doc/html/interfacelinalg__immutable_1_1mat__lu-members.html b/doc/html/interfacelinalg__immutable_1_1mat__lu-members.html index 8c870876..263f6255 100644 --- a/doc/html/interfacelinalg__immutable_1_1mat__lu-members.html +++ b/doc/html/interfacelinalg__immutable_1_1mat__lu-members.html @@ -1,9 +1,9 @@ - + - - + + linalg: Member List @@ -13,13 +13,16 @@ - + + @@ -27,10 +30,9 @@
- - + @@ -39,21 +41,22 @@
-
linalg -  1.6.0 +
+
linalg 1.6.1
A linear algebra library that provides a user-friendly interface to several BLAS and LAPACK routines.
- + +/* @license-end */ +
@@ -67,8 +70,8 @@
@@ -81,29 +84,30 @@
- +
+
+
+
+
Loading...
+
Searching...
+
No Matches
+
+
+
-
-
linalg_immutable::mat_lu Member List
+
linalg_immutable::mat_lu Member List

This is the complete list of members for linalg_immutable::mat_lu, including all inherited members.

- - - -
mat_lu_cmplx(a)linalg_immutable::mat_luprivate
mat_lu_dbl(a)linalg_immutable::mat_luprivate
+
diff --git a/doc/html/interfacelinalg__immutable_1_1mat__lu.html b/doc/html/interfacelinalg__immutable_1_1mat__lu.html index 24391c19..4a24d75e 100644 --- a/doc/html/interfacelinalg__immutable_1_1mat__lu.html +++ b/doc/html/interfacelinalg__immutable_1_1mat__lu.html @@ -1,9 +1,9 @@ - + - - + + linalg: linalg_immutable::mat_lu Interface Reference @@ -13,13 +13,16 @@ - + + @@ -27,10 +30,9 @@
- - + @@ -39,21 +41,22 @@
-
linalg -  1.6.0 +
+
linalg 1.6.1
A linear algebra library that provides a user-friendly interface to several BLAS and LAPACK routines.
- + +/* @license-end */ +
@@ -67,8 +70,8 @@
@@ -81,113 +84,33 @@
- +
+
+
+
+
Loading...
+
Searching...
+
No Matches
+
+
+
-
-
linalg_immutable::mat_lu Interface Reference
+
linalg_immutable::mat_lu Interface Reference

Computes the LU factorization of a square matrix. Notice, partial row pivoting is utilized. More...

- - - - - - - - -

-Private Member Functions

type(lu_results) function mat_lu_dbl (a)
 Computes the LU factorization of a square matrix. Notice, partial row pivoting is utilized. More...
 
type(lu_results_cmplx) function mat_lu_cmplx (a)
 Computes the LU factorization of a square matrix. Notice, partial row pivoting is utilized. More...
 

Detailed Description

-

Computes the LU factorization of a square matrix. Notice, partial row pivoting is utilized.

+

Computes the LU factorization of a square matrix. Notice, partial row pivoting is utilized.

Definition at line 101 of file linalg_immutable.f90.

-

Member Function/Subroutine Documentation

- -

◆ mat_lu_cmplx()

- -
-
- - - - - -
- - - - - - - - -
type(lu_results_cmplx) function linalg_immutable::mat_lu::mat_lu_cmplx (complex(real64), dimension(:,:), intent(in) a)
-
-private
-
- -

Computes the LU factorization of a square matrix. Notice, partial row pivoting is utilized.

-
Parameters
- - -
[in]aThe N-by-N matrix to factor.
-
-
-
Returns
The L, U, and P matrices resulting from the factorization.
- -

Definition at line 559 of file linalg_immutable.f90.

- -
-
- -

◆ mat_lu_dbl()

- -
-
- - - - - -
- - - - - - - - -
type(lu_results) function linalg_immutable::mat_lu::mat_lu_dbl (real(real64), dimension(:,:), intent(in) a)
-
-private
-
- -

Computes the LU factorization of a square matrix. Notice, partial row pivoting is utilized.

-
Parameters
- - -
[in]aThe N-by-N matrix to factor.
-
-
-
Returns
The L, U, and P matrices resulting from the factorization.
- -

Definition at line 529 of file linalg_immutable.f90.

- -
-
-
The documentation for this interface was generated from the following file:

The documentation for this interface was generated from the following file:
@@ -195,9 +118,7 @@

diff --git a/doc/html/interfacelinalg__immutable_1_1mat__mult__diag-members.html b/doc/html/interfacelinalg__immutable_1_1mat__mult__diag-members.html index 293af7c5..42a0887f 100644 --- a/doc/html/interfacelinalg__immutable_1_1mat__mult__diag-members.html +++ b/doc/html/interfacelinalg__immutable_1_1mat__mult__diag-members.html @@ -1,9 +1,9 @@ - + - - + + linalg: Member List @@ -13,13 +13,16 @@ - + + @@ -27,10 +30,9 @@
- - + @@ -39,21 +41,22 @@
-
linalg -  1.6.0 +
+
linalg 1.6.1
A linear algebra library that provides a user-friendly interface to several BLAS and LAPACK routines.
- + +/* @license-end */ +
@@ -67,8 +70,8 @@
@@ -81,33 +84,30 @@
- +
+
+
+
+
Loading...
+
Searching...
+
No Matches
+
+
+
-
-
linalg_immutable::mat_mult_diag Member List
+
linalg_immutable::mat_mult_diag Member List
+
diff --git a/doc/html/interfacelinalg__immutable_1_1mat__mult__diag.html b/doc/html/interfacelinalg__immutable_1_1mat__mult__diag.html index 83cca25c..da25cc0c 100644 --- a/doc/html/interfacelinalg__immutable_1_1mat__mult__diag.html +++ b/doc/html/interfacelinalg__immutable_1_1mat__mult__diag.html @@ -1,9 +1,9 @@ - + - - + + linalg: linalg_immutable::mat_mult_diag Interface Reference @@ -13,13 +13,16 @@ - + + @@ -27,10 +30,9 @@
- - + @@ -39,21 +41,22 @@
-
linalg -  1.6.0 +
+
linalg 1.6.1
A linear algebra library that provides a user-friendly interface to several BLAS and LAPACK routines.
- + +/* @license-end */ +
@@ -67,8 +70,8 @@
@@ -81,339 +84,33 @@
- +
+
+
+
+
Loading...
+
Searching...
+
No Matches
+
+
+
-
-
linalg_immutable::mat_mult_diag Interface Reference
+
linalg_immutable::mat_mult_diag Interface Reference

Computes the matrix operation: C = A * B, where A is a diagonal matrix. More...

- - - - - - - - - - - - - - - - - - - - -

-Private Member Functions

real(real64) function, dimension(size(a), size(b, 2)) mat_mult_diag_1 (a, b)
 Computes the matrix operation: C = A * B, where A is a diagonal matrix. More...
 
real(real64) function, dimension(size(a)) mat_mult_diag_2 (a, b)
 Computes the matrix operation: C = A * B, where A is a diagonal matrix. More...
 
real(real64) function, dimension(size(a, 1), size(b)) mat_mult_diag_3 (a, b)
 Computes the matrix operation: C = A * B, where B is a diagonal matrix. More...
 
complex(real64) function, dimension(size(a), size(b, 2)) mat_mult_diag_1_cmplx (a, b)
 Computes the matrix operation: C = A * B, where A is a diagonal matrix. More...
 
complex(real64) function, dimension(size(a)) mat_mult_diag_2_cmplx (a, b)
 Computes the matrix operation: C = A * B, where A is a diagonal matrix. More...
 
complex(real64) function, dimension(size(a, 1), size(b)) mat_mult_diag_3_cmplx (a, b)
 Computes the matrix operation: C = A * B, where B is a diagonal matrix. More...
 

Detailed Description

-

Computes the matrix operation: C = A * B, where A is a diagonal matrix.

+

Computes the matrix operation: C = A * B, where A is a diagonal matrix.

Definition at line 49 of file linalg_immutable.f90.

-

Member Function/Subroutine Documentation

- -

◆ mat_mult_diag_1()

- -
-
- - - - - -
- - - - - - - - - - - - - - - - - - -
real(real64) function, dimension(size(a), size(b, 2)) linalg_immutable::mat_mult_diag::mat_mult_diag_1 (real(real64), dimension(:), intent(in) a,
real(real64), dimension(:,:), intent(in) b 
)
-
-private
-
- -

Computes the matrix operation: C = A * B, where A is a diagonal matrix.

-
Parameters
- - - -
[in]aThe M-element array containing the diagonal elements of the matrix A.
[in]bThe P-by-N matrix B where P is greater than or equal to M.
-
-
-
Returns
The resulting M-by-N matrix.
- -

Definition at line 225 of file linalg_immutable.f90.

- -
-
- -

◆ mat_mult_diag_1_cmplx()

- -
-
- - - - - -
- - - - - - - - - - - - - - - - - - -
complex(real64) function, dimension(size(a), size(b, 2)) linalg_immutable::mat_mult_diag::mat_mult_diag_1_cmplx (complex(real64), dimension(:), intent(in) a,
complex(real64), dimension(:,:), intent(in) b 
)
-
-private
-
- -

Computes the matrix operation: C = A * B, where A is a diagonal matrix.

-
Parameters
- - - -
[in]aThe M-element array containing the diagonal elements of the matrix A.
[in]bThe P-by-N matrix B where P is greater than or equal to M.
-
-
-
Returns
The resulting M-by-N matrix.
- -

Definition at line 293 of file linalg_immutable.f90.

- -
-
- -

◆ mat_mult_diag_2()

- -
-
- - - - - -
- - - - - - - - - - - - - - - - - - -
real(real64) function, dimension(size(a)) linalg_immutable::mat_mult_diag::mat_mult_diag_2 (real(real64), dimension(:), intent(in) a,
real(real64), dimension(:), intent(in) b 
)
-
-private
-
- -

Computes the matrix operation: C = A * B, where A is a diagonal matrix.

-
Parameters
- - - -
[in]aThe M-element array containing the diagonal elements of the matrix A.
[in]bThe P-element array B where P is greater than or equal to M.
-
-
-
Returns
The resulting M-element array.
- -

Definition at line 248 of file linalg_immutable.f90.

- -
-
- -

◆ mat_mult_diag_2_cmplx()

- -
-
- - - - - -
- - - - - - - - - - - - - - - - - - -
complex(real64) function, dimension(size(a)) linalg_immutable::mat_mult_diag::mat_mult_diag_2_cmplx (complex(real64), dimension(:), intent(in) a,
complex(real64), dimension(:), intent(in) b 
)
-
-private
-
- -

Computes the matrix operation: C = A * B, where A is a diagonal matrix.

-
Parameters
- - - -
[in]aThe M-element array containing the diagonal elements of the matrix A.
[in]bThe P-element array B where P is greater than or equal to M.
-
-
-
Returns
The resulting M-element array.
- -

Definition at line 320 of file linalg_immutable.f90.

- -
-
- -

◆ mat_mult_diag_3()

- -
-
- - - - - -
- - - - - - - - - - - - - - - - - - -
real(real64) function, dimension(size(a, 1), size(b)) linalg_immutable::mat_mult_diag::mat_mult_diag_3 (real(real64), dimension(:,:), intent(in) a,
real(real64), dimension(:), intent(in) b 
)
-
-private
-
- -

Computes the matrix operation: C = A * B, where B is a diagonal matrix.

-
Parameters
- - - -
[in]aThe M-by-N matrix A.
[in]bThe P-element array containing the diagonal matrix B where P is at least N.
-
-
-
Returns
The resulting M-by-P matrix.
- -

Definition at line 270 of file linalg_immutable.f90.

- -
-
- -

◆ mat_mult_diag_3_cmplx()

- -
-
- - - - - -
- - - - - - - - - - - - - - - - - - -
complex(real64) function, dimension(size(a, 1), size(b)) linalg_immutable::mat_mult_diag::mat_mult_diag_3_cmplx (complex(real64), dimension(:,:), intent(in) a,
complex(real64), dimension(:), intent(in) b 
)
-
-private
-
- -

Computes the matrix operation: C = A * B, where B is a diagonal matrix.

-
Parameters
- - - -
[in]aThe M-by-N matrix A.
[in]bThe P-element array containing the diagonal matrix B where P is at least N.
-
-
-
Returns
The resulting M-by-P matrix.
- -

Definition at line 346 of file linalg_immutable.f90.

- -
-
-
The documentation for this interface was generated from the following file:

The documentation for this interface was generated from the following file:
@@ -421,9 +118,7 @@

diff --git a/doc/html/interfacelinalg__immutable_1_1mat__mult__lower__tri-members.html b/doc/html/interfacelinalg__immutable_1_1mat__mult__lower__tri-members.html index 4249a542..dd51e377 100644 --- a/doc/html/interfacelinalg__immutable_1_1mat__mult__lower__tri-members.html +++ b/doc/html/interfacelinalg__immutable_1_1mat__mult__lower__tri-members.html @@ -1,9 +1,9 @@ - + - - + + linalg: Member List @@ -13,13 +13,16 @@ - + + @@ -27,10 +30,9 @@
- - + @@ -39,21 +41,22 @@
-
linalg -  1.6.0 +
+
linalg 1.6.1
A linear algebra library that provides a user-friendly interface to several BLAS and LAPACK routines.
- + +/* @license-end */ +
@@ -67,8 +70,8 @@
@@ -81,31 +84,30 @@
- +
+
+
+
+
Loading...
+
Searching...
+
No Matches
+
+
+
-
-
linalg_immutable::mat_mult_lower_tri Member List
+
linalg_immutable::mat_mult_lower_tri Member List
+
diff --git a/doc/html/interfacelinalg__immutable_1_1mat__mult__lower__tri.html b/doc/html/interfacelinalg__immutable_1_1mat__mult__lower__tri.html index 04cc22ae..c0c567ac 100644 --- a/doc/html/interfacelinalg__immutable_1_1mat__mult__lower__tri.html +++ b/doc/html/interfacelinalg__immutable_1_1mat__mult__lower__tri.html @@ -1,9 +1,9 @@ - + - - + + linalg: linalg_immutable::mat_mult_lower_tri Interface Reference @@ -13,13 +13,16 @@ - + + @@ -27,10 +30,9 @@
- - + @@ -39,21 +41,22 @@
-
linalg -  1.6.0 +
+
linalg 1.6.1
A linear algebra library that provides a user-friendly interface to several BLAS and LAPACK routines.
- + +/* @license-end */ +
@@ -67,8 +70,8 @@
@@ -81,237 +84,33 @@
- +
+
+
+
+
Loading...
+
Searching...
+
No Matches
+
+
+
-
-
linalg_immutable::mat_mult_lower_tri Interface Reference
+
linalg_immutable::mat_mult_lower_tri Interface Reference

Computes the matrix operation C = A * B, where A is a lower triangular matrix. More...

- - - - - - - - - - - - - - -

-Private Member Functions

real(real64) function, dimension(size(a, 1), size(b, 2)) mat_mult_lower_tri_1 (a, b)
 Computes the matrix operation C = A * B, where A is a lower triangular matrix. More...
 
real(real64) function, dimension(size(a, 1)) mat_mult_lower_tri_2 (a, b)
 Computes the matrix operation C = A * B, where A is a lower triangular matrix. More...
 
complex(real64) function, dimension(size(a, 1), size(b, 2)) mat_mult_lower_tri_1_cmplx (a, b)
 Computes the matrix operation C = A * B, where A is a lower triangular matrix. More...
 
complex(real64) function, dimension(size(a, 1)) mat_mult_lower_tri_2_cmplx (a, b)
 Computes the matrix operation C = A * B, where A is a lower triangular matrix. More...
 

Detailed Description

-

Computes the matrix operation C = A * B, where A is a lower triangular matrix.

+

Computes the matrix operation C = A * B, where A is a lower triangular matrix.

Definition at line 71 of file linalg_immutable.f90.

-

Member Function/Subroutine Documentation

- -

◆ mat_mult_lower_tri_1()

- -
-
- - - - - -
- - - - - - - - - - - - - - - - - - -
real(real64) function, dimension(size(a, 1), size(b, 2)) linalg_immutable::mat_mult_lower_tri::mat_mult_lower_tri_1 (real(real64), dimension(:,:), intent(in) a,
real(real64), dimension(:,:), intent(in) b 
)
-
-private
-
- -

Computes the matrix operation C = A * B, where A is a lower triangular matrix.

-
Parameters
- - - -
[in]aThe M-by-M triangular matrix A.
[in]bThe M-by-N matrix B.
-
-
-
Returns
The resulting M-by-N matrix.
- -

Definition at line 404 of file linalg_immutable.f90.

- -
-
- -

◆ mat_mult_lower_tri_1_cmplx()

- -
-
- - - - - -
- - - - - - - - - - - - - - - - - - -
complex(real64) function, dimension(size(a, 1), size(b, 2)) linalg_immutable::mat_mult_lower_tri::mat_mult_lower_tri_1_cmplx (complex(real64), dimension(:,:), intent(in) a,
complex(real64), dimension(:,:), intent(in) b 
)
-
-private
-
- -

Computes the matrix operation C = A * B, where A is a lower triangular matrix.

-
Parameters
- - - -
[in]aThe M-by-M triangular matrix A.
[in]bThe M-by-N matrix B.
-
-
-
Returns
The resulting M-by-N matrix.
- -

Definition at line 476 of file linalg_immutable.f90.

- -
-
- -

◆ mat_mult_lower_tri_2()

- -
-
- - - - - -
- - - - - - - - - - - - - - - - - - -
real(real64) function, dimension(size(a, 1)) linalg_immutable::mat_mult_lower_tri::mat_mult_lower_tri_2 (real(real64), dimension(:,:), intent(in) a,
real(real64), dimension(:), intent(in) b 
)
-
-private
-
- -

Computes the matrix operation C = A * B, where A is a lower triangular matrix.

-
Parameters
- - - -
[in]aThe M-by-M triangular matrix A.
[in]bThe M-element array B.
-
-
-
Returns
The resulting M-element array.
- -

Definition at line 422 of file linalg_immutable.f90.

- -
-
- -

◆ mat_mult_lower_tri_2_cmplx()

- -
-
- - - - - -
- - - - - - - - - - - - - - - - - - -
complex(real64) function, dimension(size(a, 1)) linalg_immutable::mat_mult_lower_tri::mat_mult_lower_tri_2_cmplx (complex(real64), dimension(:,:), intent(in) a,
complex(real64), dimension(:), intent(in) b 
)
-
-private
-
- -

Computes the matrix operation C = A * B, where A is a lower triangular matrix.

-
Parameters
- - - -
[in]aThe M-by-M triangular matrix A.
[in]bThe M-element array B.
-
-
-
Returns
The resulting M-element array.
- -

Definition at line 494 of file linalg_immutable.f90.

- -
-
-
The documentation for this interface was generated from the following file:

The documentation for this interface was generated from the following file:
@@ -319,9 +118,7 @@

diff --git a/doc/html/interfacelinalg__immutable_1_1mat__mult__upper__tri-members.html b/doc/html/interfacelinalg__immutable_1_1mat__mult__upper__tri-members.html index f33a599d..7f2f614c 100644 --- a/doc/html/interfacelinalg__immutable_1_1mat__mult__upper__tri-members.html +++ b/doc/html/interfacelinalg__immutable_1_1mat__mult__upper__tri-members.html @@ -1,9 +1,9 @@ - + - - + + linalg: Member List @@ -13,13 +13,16 @@ - + + @@ -27,10 +30,9 @@
- - + @@ -39,21 +41,22 @@
-
linalg -  1.6.0 +
+
linalg 1.6.1
A linear algebra library that provides a user-friendly interface to several BLAS and LAPACK routines.
- + +/* @license-end */ +
@@ -67,8 +70,8 @@
@@ -81,31 +84,30 @@
- +
+
+
+
+
Loading...
+
Searching...
+
No Matches
+
+
+
-
-
linalg_immutable::mat_mult_upper_tri Member List
+
linalg_immutable::mat_mult_upper_tri Member List
+
diff --git a/doc/html/interfacelinalg__immutable_1_1mat__mult__upper__tri.html b/doc/html/interfacelinalg__immutable_1_1mat__mult__upper__tri.html index 168a8cb6..3331637c 100644 --- a/doc/html/interfacelinalg__immutable_1_1mat__mult__upper__tri.html +++ b/doc/html/interfacelinalg__immutable_1_1mat__mult__upper__tri.html @@ -1,9 +1,9 @@ - + - - + + linalg: linalg_immutable::mat_mult_upper_tri Interface Reference @@ -13,13 +13,16 @@ - + + @@ -27,10 +30,9 @@
- - + @@ -39,21 +41,22 @@
-
linalg -  1.6.0 +
+
linalg 1.6.1
A linear algebra library that provides a user-friendly interface to several BLAS and LAPACK routines.
- + +/* @license-end */ +
@@ -67,8 +70,8 @@
@@ -81,237 +84,33 @@
- +
+
+
+
+
Loading...
+
Searching...
+
No Matches
+
+
+
-
-
linalg_immutable::mat_mult_upper_tri Interface Reference
+
linalg_immutable::mat_mult_upper_tri Interface Reference

Computes the matrix operation C = A * B, where A is an upper triangular matrix. More...

- - - - - - - - - - - - - - -

-Private Member Functions

real(real64) function, dimension(size(a, 1), size(b, 2)) mat_mult_upper_tri_1 (a, b)
 Computes the matrix operation C = A * B, where A is an upper triangular matrix. More...
 
real(real64) function, dimension(size(a, 1)) mat_mult_upper_tri_2 (a, b)
 Computes the matrix operation C = A * B, where A is an upper triangular matrix. More...
 
complex(real64) function, dimension(size(a, 1), size(b, 2)) mat_mult_upper_tri_1_cmplx (a, b)
 Computes the matrix operation C = A * B, where A is an upper triangular matrix. More...
 
complex(real64) function, dimension(size(a, 1)) mat_mult_upper_tri_2_cmplx (a, b)
 Computes the matrix operation C = A * B, where A is an upper triangular matrix. More...
 

Detailed Description

-

Computes the matrix operation C = A * B, where A is an upper triangular matrix.

+

Computes the matrix operation C = A * B, where A is an upper triangular matrix.

Definition at line 61 of file linalg_immutable.f90.

-

Member Function/Subroutine Documentation

- -

◆ mat_mult_upper_tri_1()

- -
-
- - - - - -
- - - - - - - - - - - - - - - - - - -
real(real64) function, dimension(size(a, 1), size(b, 2)) linalg_immutable::mat_mult_upper_tri::mat_mult_upper_tri_1 (real(real64), dimension(:,:), intent(in) a,
real(real64), dimension(:,:), intent(in) b 
)
-
-private
-
- -

Computes the matrix operation C = A * B, where A is an upper triangular matrix.

-
Parameters
- - - -
[in]aThe M-by-M triangular matrix A.
[in]bThe M-by-N matrix B.
-
-
-
Returns
The resulting M-by-N matrix.
- -

Definition at line 368 of file linalg_immutable.f90.

- -
-
- -

◆ mat_mult_upper_tri_1_cmplx()

- -
-
- - - - - -
- - - - - - - - - - - - - - - - - - -
complex(real64) function, dimension(size(a, 1), size(b, 2)) linalg_immutable::mat_mult_upper_tri::mat_mult_upper_tri_1_cmplx (complex(real64), dimension(:,:), intent(in) a,
complex(real64), dimension(:,:), intent(in) b 
)
-
-private
-
- -

Computes the matrix operation C = A * B, where A is an upper triangular matrix.

-
Parameters
- - - -
[in]aThe M-by-M triangular matrix A.
[in]bThe M-by-N matrix B.
-
-
-
Returns
The resulting M-by-N matrix.
- -

Definition at line 440 of file linalg_immutable.f90.

- -
-
- -

◆ mat_mult_upper_tri_2()

- -
-
- - - - - -
- - - - - - - - - - - - - - - - - - -
real(real64) function, dimension(size(a, 1)) linalg_immutable::mat_mult_upper_tri::mat_mult_upper_tri_2 (real(real64), dimension(:,:), intent(in) a,
real(real64), dimension(:), intent(in) b 
)
-
-private
-
- -

Computes the matrix operation C = A * B, where A is an upper triangular matrix.

-
Parameters
- - - -
[in]aThe M-by-M triangular matrix A.
[in]bThe M-element array B.
-
-
-
Returns
The resulting M-element array.
- -

Definition at line 386 of file linalg_immutable.f90.

- -
-
- -

◆ mat_mult_upper_tri_2_cmplx()

- -
-
- - - - - -
- - - - - - - - - - - - - - - - - - -
complex(real64) function, dimension(size(a, 1)) linalg_immutable::mat_mult_upper_tri::mat_mult_upper_tri_2_cmplx (complex(real64), dimension(:,:), intent(in) a,
complex(real64), dimension(:), intent(in) b 
)
-
-private
-
- -

Computes the matrix operation C = A * B, where A is an upper triangular matrix.

-
Parameters
- - - -
[in]aThe M-by-M triangular matrix A.
[in]bThe M-element array B.
-
-
-
Returns
The resulting M-element array.
- -

Definition at line 458 of file linalg_immutable.f90.

- -
-
-
The documentation for this interface was generated from the following file:

The documentation for this interface was generated from the following file:
@@ -319,9 +118,7 @@

diff --git a/doc/html/interfacelinalg__immutable_1_1mat__solve__lower__tri-members.html b/doc/html/interfacelinalg__immutable_1_1mat__solve__lower__tri-members.html index 24d12a1b..14e8faa6 100644 --- a/doc/html/interfacelinalg__immutable_1_1mat__solve__lower__tri-members.html +++ b/doc/html/interfacelinalg__immutable_1_1mat__solve__lower__tri-members.html @@ -1,9 +1,9 @@ - + - - + + linalg: Member List @@ -13,13 +13,16 @@ - + + @@ -27,10 +30,9 @@
- - + @@ -39,21 +41,22 @@
-
linalg -  1.6.0 +
+
linalg 1.6.1
A linear algebra library that provides a user-friendly interface to several BLAS and LAPACK routines.
- + +/* @license-end */ +
@@ -67,8 +70,8 @@
@@ -81,31 +84,30 @@
- +
+
+
+
+
Loading...
+
Searching...
+
No Matches
+
+
+
-
-
linalg_immutable::mat_solve_lower_tri Member List
+
linalg_immutable::mat_solve_lower_tri Member List
+
diff --git a/doc/html/interfacelinalg__immutable_1_1mat__solve__lower__tri.html b/doc/html/interfacelinalg__immutable_1_1mat__solve__lower__tri.html index 1ee80a0f..d746efa7 100644 --- a/doc/html/interfacelinalg__immutable_1_1mat__solve__lower__tri.html +++ b/doc/html/interfacelinalg__immutable_1_1mat__solve__lower__tri.html @@ -1,9 +1,9 @@ - + - - + + linalg: linalg_immutable::mat_solve_lower_tri Interface Reference @@ -13,13 +13,16 @@ - + + @@ -27,10 +30,9 @@
- - + @@ -39,21 +41,22 @@
-
linalg -  1.6.0 +
+
linalg 1.6.1
A linear algebra library that provides a user-friendly interface to several BLAS and LAPACK routines.
- + +/* @license-end */ +
@@ -67,8 +70,8 @@
@@ -81,237 +84,33 @@
- +
+
+
+
+
Loading...
+
Searching...
+
No Matches
+
+
+
-
-
linalg_immutable::mat_solve_lower_tri Interface Reference
+
linalg_immutable::mat_solve_lower_tri Interface Reference

Solves the lower triangular system A X = B, where A is a lower triangular matrix. More...

- - - - - - - - - - - - - - -

-Private Member Functions

real(real64) function, dimension(size(b, 1), size(b, 2)) mat_solve_lower_tri_1 (a, b)
 Solves the lower triangular system A X = B, where A is a lower triangular matrix. More...
 
real(real64) function, dimension(size(b)) mat_solve_lower_tri_2 (a, b)
 Solves the lower triangular system A X = B, where A is a lower triangular matrix. More...
 
complex(real64) function, dimension(size(b, 1), size(b, 2)) mat_solve_lower_tri_1_cmplx (a, b)
 Solves the lower triangular system A X = B, where A is a lower triangular matrix. More...
 
complex(real64) function, dimension(size(b)) mat_solve_lower_tri_2_cmplx (a, b)
 Solves the lower triangular system A X = B, where A is a lower triangular matrix. More...
 

Detailed Description

-

Solves the lower triangular system A X = B, where A is a lower triangular matrix.

+

Solves the lower triangular system A X = B, where A is a lower triangular matrix.

Definition at line 91 of file linalg_immutable.f90.

-

Member Function/Subroutine Documentation

- -

◆ mat_solve_lower_tri_1()

- -
-
- - - - - -
- - - - - - - - - - - - - - - - - - -
real(real64) function, dimension(size(b, 1), size(b, 2)) linalg_immutable::mat_solve_lower_tri::mat_solve_lower_tri_1 (real(real64), dimension(:,:), intent(in) a,
real(real64), dimension(:,:), intent(in) b 
)
-
-private
-
- -

Solves the lower triangular system A X = B, where A is a lower triangular matrix.

-
Parameters
- - - -
[in]aThe M-by-M lower triangluar matrix A.
[in]bThe M-by-NRHS matrix B.
-
-
-
Returns
The M-by-NRHS solution matrix X.
- -

Definition at line 888 of file linalg_immutable.f90.

- -
-
- -

◆ mat_solve_lower_tri_1_cmplx()

- -
-
- - - - - -
- - - - - - - - - - - - - - - - - - -
complex(real64) function, dimension(size(b, 1), size(b, 2)) linalg_immutable::mat_solve_lower_tri::mat_solve_lower_tri_1_cmplx (complex(real64), dimension(:,:), intent(in) a,
complex(real64), dimension(:,:), intent(in) b 
)
-
-private
-
- -

Solves the lower triangular system A X = B, where A is a lower triangular matrix.

-
Parameters
- - - -
[in]aThe M-by-M lower triangluar matrix A.
[in]bThe M-by-NRHS matrix B.
-
-
-
Returns
The M-by-NRHS solution matrix X.
- -

Definition at line 924 of file linalg_immutable.f90.

- -
-
- -

◆ mat_solve_lower_tri_2()

- -
-
- - - - - -
- - - - - - - - - - - - - - - - - - -
real(real64) function, dimension(size(b)) linalg_immutable::mat_solve_lower_tri::mat_solve_lower_tri_2 (real(real64), dimension(:,:), intent(in) a,
real(real64), dimension(:), intent(in) b 
)
-
-private
-
- -

Solves the lower triangular system A X = B, where A is a lower triangular matrix.

-
Parameters
- - - -
[in]aThe M-by-M lower triangluar matrix A.
[in]bThe M-element array B.
-
-
-
Returns
The M-element solution array X.
- -

Definition at line 906 of file linalg_immutable.f90.

- -
-
- -

◆ mat_solve_lower_tri_2_cmplx()

- -
-
- - - - - -
- - - - - - - - - - - - - - - - - - -
complex(real64) function, dimension(size(b)) linalg_immutable::mat_solve_lower_tri::mat_solve_lower_tri_2_cmplx (complex(real64), dimension(:,:), intent(in) a,
complex(real64), dimension(:), intent(in) b 
)
-
-private
-
- -

Solves the lower triangular system A X = B, where A is a lower triangular matrix.

-
Parameters
- - - -
[in]aThe M-by-M lower triangluar matrix A.
[in]bThe M-element array B.
-
-
-
Returns
The M-element solution array X.
- -

Definition at line 942 of file linalg_immutable.f90.

- -
-
-
The documentation for this interface was generated from the following file:

The documentation for this interface was generated from the following file:
@@ -319,9 +118,7 @@

diff --git a/doc/html/interfacelinalg__immutable_1_1mat__solve__upper__tri-members.html b/doc/html/interfacelinalg__immutable_1_1mat__solve__upper__tri-members.html index 4c30b93d..d6590def 100644 --- a/doc/html/interfacelinalg__immutable_1_1mat__solve__upper__tri-members.html +++ b/doc/html/interfacelinalg__immutable_1_1mat__solve__upper__tri-members.html @@ -1,9 +1,9 @@ - + - - + + linalg: Member List @@ -13,13 +13,16 @@ - + + @@ -27,10 +30,9 @@
- - + @@ -39,21 +41,22 @@
-
linalg -  1.6.0 +
+
linalg 1.6.1
A linear algebra library that provides a user-friendly interface to several BLAS and LAPACK routines.
- + +/* @license-end */ +
@@ -67,8 +70,8 @@
@@ -81,31 +84,30 @@
- +
+
+
+
+
Loading...
+
Searching...
+
No Matches
+
+
+
-
-
linalg_immutable::mat_solve_upper_tri Member List
+
linalg_immutable::mat_solve_upper_tri Member List
+
diff --git a/doc/html/interfacelinalg__immutable_1_1mat__solve__upper__tri.html b/doc/html/interfacelinalg__immutable_1_1mat__solve__upper__tri.html index 2dceb191..c4defbc1 100644 --- a/doc/html/interfacelinalg__immutable_1_1mat__solve__upper__tri.html +++ b/doc/html/interfacelinalg__immutable_1_1mat__solve__upper__tri.html @@ -1,9 +1,9 @@ - + - - + + linalg: linalg_immutable::mat_solve_upper_tri Interface Reference @@ -13,13 +13,16 @@ - + + @@ -27,10 +30,9 @@
- - + @@ -39,21 +41,22 @@
-
linalg -  1.6.0 +
+
linalg 1.6.1
A linear algebra library that provides a user-friendly interface to several BLAS and LAPACK routines.
- + +/* @license-end */ +
@@ -67,8 +70,8 @@
@@ -81,237 +84,33 @@
- +
+
+
+
+
Loading...
+
Searching...
+
No Matches
+
+
+
-
-
linalg_immutable::mat_solve_upper_tri Interface Reference
+
linalg_immutable::mat_solve_upper_tri Interface Reference

Solves the upper triangular system A X = B, where A is an upper triangular matrix. More...

- - - - - - - - - - - - - - -

-Private Member Functions

real(real64) function, dimension(size(b, 1), size(b, 2)) mat_solve_upper_tri_1 (a, b)
 Solves the upper triangular system A X = B, where A is an upper triangular matrix. More...
 
real(real64) function, dimension(size(b)) mat_solve_upper_tri_2 (a, b)
 Solves the upper triangular system A X = B, where A is an upper triangular matrix. More...
 
complex(real64) function, dimension(size(b, 1), size(b, 2)) mat_solve_upper_tri_1_cmplx (a, b)
 Solves the upper triangular system A X = B, where A is an upper triangular matrix. More...
 
complex(real64) function, dimension(size(b)) mat_solve_upper_tri_2_cmplx (a, b)
 Solves the upper triangular system A X = B, where A is an upper triangular matrix. More...
 

Detailed Description

-

Solves the upper triangular system A X = B, where A is an upper triangular matrix.

+

Solves the upper triangular system A X = B, where A is an upper triangular matrix.

Definition at line 81 of file linalg_immutable.f90.

-

Member Function/Subroutine Documentation

- -

◆ mat_solve_upper_tri_1()

- -
-
- - - - - -
- - - - - - - - - - - - - - - - - - -
real(real64) function, dimension(size(b, 1), size(b, 2)) linalg_immutable::mat_solve_upper_tri::mat_solve_upper_tri_1 (real(real64), dimension(:,:), intent(in) a,
real(real64), dimension(:,:), intent(in) b 
)
-
-private
-
- -

Solves the upper triangular system A X = B, where A is an upper triangular matrix.

-
Parameters
- - - -
[in]aThe M-by-M upper triangluar matrix A.
[in]bThe M-by-NRHS matrix B.
-
-
-
Returns
The M-by-NRHS solution matrix X.
- -

Definition at line 816 of file linalg_immutable.f90.

- -
-
- -

◆ mat_solve_upper_tri_1_cmplx()

- -
-
- - - - - -
- - - - - - - - - - - - - - - - - - -
complex(real64) function, dimension(size(b, 1), size(b, 2)) linalg_immutable::mat_solve_upper_tri::mat_solve_upper_tri_1_cmplx (complex(real64), dimension(:,:), intent(in) a,
complex(real64), dimension(:,:), intent(in) b 
)
-
-private
-
- -

Solves the upper triangular system A X = B, where A is an upper triangular matrix.

-
Parameters
- - - -
[in]aThe M-by-M upper triangluar matrix A.
[in]bThe M-by-NRHS matrix B.
-
-
-
Returns
The M-by-NRHS solution matrix X.
- -

Definition at line 852 of file linalg_immutable.f90.

- -
-
- -

◆ mat_solve_upper_tri_2()

- -
-
- - - - - -
- - - - - - - - - - - - - - - - - - -
real(real64) function, dimension(size(b)) linalg_immutable::mat_solve_upper_tri::mat_solve_upper_tri_2 (real(real64), dimension(:,:), intent(in) a,
real(real64), dimension(:), intent(in) b 
)
-
-private
-
- -

Solves the upper triangular system A X = B, where A is an upper triangular matrix.

-
Parameters
- - - -
[in]aThe M-by-M upper triangluar matrix A.
[in]bThe M-element array B.
-
-
-
Returns
The M-element solution array X.
- -

Definition at line 834 of file linalg_immutable.f90.

- -
-
- -

◆ mat_solve_upper_tri_2_cmplx()

- -
-
- - - - - -
- - - - - - - - - - - - - - - - - - -
complex(real64) function, dimension(size(b)) linalg_immutable::mat_solve_upper_tri::mat_solve_upper_tri_2_cmplx (complex(real64), dimension(:,:), intent(in) a,
complex(real64), dimension(:), intent(in) b 
)
-
-private
-
- -

Solves the upper triangular system A X = B, where A is an upper triangular matrix.

-
Parameters
- - - -
[in]aThe M-by-M upper triangluar matrix A.
[in]bThe M-element array B.
-
-
-
Returns
The M-element solution array X.
- -

Definition at line 870 of file linalg_immutable.f90.

- -
-
-
The documentation for this interface was generated from the following file:

The documentation for this interface was generated from the following file:
@@ -319,9 +118,7 @@

diff --git a/doc/html/jquery.js b/doc/html/jquery.js index 103c32d7..1dffb65b 100644 --- a/doc/html/jquery.js +++ b/doc/html/jquery.js @@ -1,12 +1,11 @@ -/*! jQuery v3.4.1 | (c) JS Foundation and other contributors | jquery.org/license */ -!function(e,t){"use strict";"object"==typeof module&&"object"==typeof module.exports?module.exports=e.document?t(e,!0):function(e){if(!e.document)throw new Error("jQuery requires a window with a document");return t(e)}:t(e)}("undefined"!=typeof window?window:this,function(C,e){"use strict";var t=[],E=C.document,r=Object.getPrototypeOf,s=t.slice,g=t.concat,u=t.push,i=t.indexOf,n={},o=n.toString,v=n.hasOwnProperty,a=v.toString,l=a.call(Object),y={},m=function(e){return"function"==typeof e&&"number"!=typeof e.nodeType},x=function(e){return null!=e&&e===e.window},c={type:!0,src:!0,nonce:!0,noModule:!0};function b(e,t,n){var r,i,o=(n=n||E).createElement("script");if(o.text=e,t)for(r in c)(i=t[r]||t.getAttribute&&t.getAttribute(r))&&o.setAttribute(r,i);n.head.appendChild(o).parentNode.removeChild(o)}function w(e){return null==e?e+"":"object"==typeof e||"function"==typeof e?n[o.call(e)]||"object":typeof e}var f="3.4.1",k=function(e,t){return new k.fn.init(e,t)},p=/^[\s\uFEFF\xA0]+|[\s\uFEFF\xA0]+$/g;function d(e){var t=!!e&&"length"in e&&e.length,n=w(e);return!m(e)&&!x(e)&&("array"===n||0===t||"number"==typeof t&&0+~]|"+M+")"+M+"*"),U=new RegExp(M+"|>"),X=new RegExp($),V=new RegExp("^"+I+"$"),G={ID:new RegExp("^#("+I+")"),CLASS:new RegExp("^\\.("+I+")"),TAG:new RegExp("^("+I+"|[*])"),ATTR:new RegExp("^"+W),PSEUDO:new RegExp("^"+$),CHILD:new RegExp("^:(only|first|last|nth|nth-last)-(child|of-type)(?:\\("+M+"*(even|odd|(([+-]|)(\\d*)n|)"+M+"*(?:([+-]|)"+M+"*(\\d+)|))"+M+"*\\)|)","i"),bool:new RegExp("^(?:"+R+")$","i"),needsContext:new RegExp("^"+M+"*[>+~]|:(even|odd|eq|gt|lt|nth|first|last)(?:\\("+M+"*((?:-\\d)?\\d*)"+M+"*\\)|)(?=[^-]|$)","i")},Y=/HTML$/i,Q=/^(?:input|select|textarea|button)$/i,J=/^h\d$/i,K=/^[^{]+\{\s*\[native \w/,Z=/^(?:#([\w-]+)|(\w+)|\.([\w-]+))$/,ee=/[+~]/,te=new RegExp("\\\\([\\da-f]{1,6}"+M+"?|("+M+")|.)","ig"),ne=function(e,t,n){var r="0x"+t-65536;return r!=r||n?t:r<0?String.fromCharCode(r+65536):String.fromCharCode(r>>10|55296,1023&r|56320)},re=/([\0-\x1f\x7f]|^-?\d)|^-$|[^\0-\x1f\x7f-\uFFFF\w-]/g,ie=function(e,t){return t?"\0"===e?"\ufffd":e.slice(0,-1)+"\\"+e.charCodeAt(e.length-1).toString(16)+" ":"\\"+e},oe=function(){T()},ae=be(function(e){return!0===e.disabled&&"fieldset"===e.nodeName.toLowerCase()},{dir:"parentNode",next:"legend"});try{H.apply(t=O.call(m.childNodes),m.childNodes),t[m.childNodes.length].nodeType}catch(e){H={apply:t.length?function(e,t){L.apply(e,O.call(t))}:function(e,t){var n=e.length,r=0;while(e[n++]=t[r++]);e.length=n-1}}}function se(t,e,n,r){var i,o,a,s,u,l,c,f=e&&e.ownerDocument,p=e?e.nodeType:9;if(n=n||[],"string"!=typeof t||!t||1!==p&&9!==p&&11!==p)return n;if(!r&&((e?e.ownerDocument||e:m)!==C&&T(e),e=e||C,E)){if(11!==p&&(u=Z.exec(t)))if(i=u[1]){if(9===p){if(!(a=e.getElementById(i)))return n;if(a.id===i)return n.push(a),n}else if(f&&(a=f.getElementById(i))&&y(e,a)&&a.id===i)return n.push(a),n}else{if(u[2])return H.apply(n,e.getElementsByTagName(t)),n;if((i=u[3])&&d.getElementsByClassName&&e.getElementsByClassName)return H.apply(n,e.getElementsByClassName(i)),n}if(d.qsa&&!A[t+" "]&&(!v||!v.test(t))&&(1!==p||"object"!==e.nodeName.toLowerCase())){if(c=t,f=e,1===p&&U.test(t)){(s=e.getAttribute("id"))?s=s.replace(re,ie):e.setAttribute("id",s=k),o=(l=h(t)).length;while(o--)l[o]="#"+s+" "+xe(l[o]);c=l.join(","),f=ee.test(t)&&ye(e.parentNode)||e}try{return H.apply(n,f.querySelectorAll(c)),n}catch(e){A(t,!0)}finally{s===k&&e.removeAttribute("id")}}}return g(t.replace(B,"$1"),e,n,r)}function ue(){var r=[];return function e(t,n){return r.push(t+" ")>b.cacheLength&&delete e[r.shift()],e[t+" "]=n}}function le(e){return e[k]=!0,e}function ce(e){var t=C.createElement("fieldset");try{return!!e(t)}catch(e){return!1}finally{t.parentNode&&t.parentNode.removeChild(t),t=null}}function fe(e,t){var n=e.split("|"),r=n.length;while(r--)b.attrHandle[n[r]]=t}function pe(e,t){var n=t&&e,r=n&&1===e.nodeType&&1===t.nodeType&&e.sourceIndex-t.sourceIndex;if(r)return r;if(n)while(n=n.nextSibling)if(n===t)return-1;return e?1:-1}function de(t){return function(e){return"input"===e.nodeName.toLowerCase()&&e.type===t}}function he(n){return function(e){var t=e.nodeName.toLowerCase();return("input"===t||"button"===t)&&e.type===n}}function ge(t){return function(e){return"form"in e?e.parentNode&&!1===e.disabled?"label"in e?"label"in e.parentNode?e.parentNode.disabled===t:e.disabled===t:e.isDisabled===t||e.isDisabled!==!t&&ae(e)===t:e.disabled===t:"label"in e&&e.disabled===t}}function ve(a){return le(function(o){return o=+o,le(function(e,t){var n,r=a([],e.length,o),i=r.length;while(i--)e[n=r[i]]&&(e[n]=!(t[n]=e[n]))})})}function ye(e){return e&&"undefined"!=typeof e.getElementsByTagName&&e}for(e in d=se.support={},i=se.isXML=function(e){var t=e.namespaceURI,n=(e.ownerDocument||e).documentElement;return!Y.test(t||n&&n.nodeName||"HTML")},T=se.setDocument=function(e){var t,n,r=e?e.ownerDocument||e:m;return r!==C&&9===r.nodeType&&r.documentElement&&(a=(C=r).documentElement,E=!i(C),m!==C&&(n=C.defaultView)&&n.top!==n&&(n.addEventListener?n.addEventListener("unload",oe,!1):n.attachEvent&&n.attachEvent("onunload",oe)),d.attributes=ce(function(e){return e.className="i",!e.getAttribute("className")}),d.getElementsByTagName=ce(function(e){return e.appendChild(C.createComment("")),!e.getElementsByTagName("*").length}),d.getElementsByClassName=K.test(C.getElementsByClassName),d.getById=ce(function(e){return a.appendChild(e).id=k,!C.getElementsByName||!C.getElementsByName(k).length}),d.getById?(b.filter.ID=function(e){var t=e.replace(te,ne);return function(e){return e.getAttribute("id")===t}},b.find.ID=function(e,t){if("undefined"!=typeof t.getElementById&&E){var n=t.getElementById(e);return n?[n]:[]}}):(b.filter.ID=function(e){var n=e.replace(te,ne);return function(e){var t="undefined"!=typeof e.getAttributeNode&&e.getAttributeNode("id");return t&&t.value===n}},b.find.ID=function(e,t){if("undefined"!=typeof t.getElementById&&E){var n,r,i,o=t.getElementById(e);if(o){if((n=o.getAttributeNode("id"))&&n.value===e)return[o];i=t.getElementsByName(e),r=0;while(o=i[r++])if((n=o.getAttributeNode("id"))&&n.value===e)return[o]}return[]}}),b.find.TAG=d.getElementsByTagName?function(e,t){return"undefined"!=typeof t.getElementsByTagName?t.getElementsByTagName(e):d.qsa?t.querySelectorAll(e):void 0}:function(e,t){var n,r=[],i=0,o=t.getElementsByTagName(e);if("*"===e){while(n=o[i++])1===n.nodeType&&r.push(n);return r}return o},b.find.CLASS=d.getElementsByClassName&&function(e,t){if("undefined"!=typeof t.getElementsByClassName&&E)return t.getElementsByClassName(e)},s=[],v=[],(d.qsa=K.test(C.querySelectorAll))&&(ce(function(e){a.appendChild(e).innerHTML="",e.querySelectorAll("[msallowcapture^='']").length&&v.push("[*^$]="+M+"*(?:''|\"\")"),e.querySelectorAll("[selected]").length||v.push("\\["+M+"*(?:value|"+R+")"),e.querySelectorAll("[id~="+k+"-]").length||v.push("~="),e.querySelectorAll(":checked").length||v.push(":checked"),e.querySelectorAll("a#"+k+"+*").length||v.push(".#.+[+~]")}),ce(function(e){e.innerHTML="";var t=C.createElement("input");t.setAttribute("type","hidden"),e.appendChild(t).setAttribute("name","D"),e.querySelectorAll("[name=d]").length&&v.push("name"+M+"*[*^$|!~]?="),2!==e.querySelectorAll(":enabled").length&&v.push(":enabled",":disabled"),a.appendChild(e).disabled=!0,2!==e.querySelectorAll(":disabled").length&&v.push(":enabled",":disabled"),e.querySelectorAll("*,:x"),v.push(",.*:")})),(d.matchesSelector=K.test(c=a.matches||a.webkitMatchesSelector||a.mozMatchesSelector||a.oMatchesSelector||a.msMatchesSelector))&&ce(function(e){d.disconnectedMatch=c.call(e,"*"),c.call(e,"[s!='']:x"),s.push("!=",$)}),v=v.length&&new RegExp(v.join("|")),s=s.length&&new RegExp(s.join("|")),t=K.test(a.compareDocumentPosition),y=t||K.test(a.contains)?function(e,t){var n=9===e.nodeType?e.documentElement:e,r=t&&t.parentNode;return e===r||!(!r||1!==r.nodeType||!(n.contains?n.contains(r):e.compareDocumentPosition&&16&e.compareDocumentPosition(r)))}:function(e,t){if(t)while(t=t.parentNode)if(t===e)return!0;return!1},D=t?function(e,t){if(e===t)return l=!0,0;var n=!e.compareDocumentPosition-!t.compareDocumentPosition;return n||(1&(n=(e.ownerDocument||e)===(t.ownerDocument||t)?e.compareDocumentPosition(t):1)||!d.sortDetached&&t.compareDocumentPosition(e)===n?e===C||e.ownerDocument===m&&y(m,e)?-1:t===C||t.ownerDocument===m&&y(m,t)?1:u?P(u,e)-P(u,t):0:4&n?-1:1)}:function(e,t){if(e===t)return l=!0,0;var n,r=0,i=e.parentNode,o=t.parentNode,a=[e],s=[t];if(!i||!o)return e===C?-1:t===C?1:i?-1:o?1:u?P(u,e)-P(u,t):0;if(i===o)return pe(e,t);n=e;while(n=n.parentNode)a.unshift(n);n=t;while(n=n.parentNode)s.unshift(n);while(a[r]===s[r])r++;return r?pe(a[r],s[r]):a[r]===m?-1:s[r]===m?1:0}),C},se.matches=function(e,t){return se(e,null,null,t)},se.matchesSelector=function(e,t){if((e.ownerDocument||e)!==C&&T(e),d.matchesSelector&&E&&!A[t+" "]&&(!s||!s.test(t))&&(!v||!v.test(t)))try{var n=c.call(e,t);if(n||d.disconnectedMatch||e.document&&11!==e.document.nodeType)return n}catch(e){A(t,!0)}return 0":{dir:"parentNode",first:!0}," ":{dir:"parentNode"},"+":{dir:"previousSibling",first:!0},"~":{dir:"previousSibling"}},preFilter:{ATTR:function(e){return e[1]=e[1].replace(te,ne),e[3]=(e[3]||e[4]||e[5]||"").replace(te,ne),"~="===e[2]&&(e[3]=" "+e[3]+" "),e.slice(0,4)},CHILD:function(e){return e[1]=e[1].toLowerCase(),"nth"===e[1].slice(0,3)?(e[3]||se.error(e[0]),e[4]=+(e[4]?e[5]+(e[6]||1):2*("even"===e[3]||"odd"===e[3])),e[5]=+(e[7]+e[8]||"odd"===e[3])):e[3]&&se.error(e[0]),e},PSEUDO:function(e){var t,n=!e[6]&&e[2];return G.CHILD.test(e[0])?null:(e[3]?e[2]=e[4]||e[5]||"":n&&X.test(n)&&(t=h(n,!0))&&(t=n.indexOf(")",n.length-t)-n.length)&&(e[0]=e[0].slice(0,t),e[2]=n.slice(0,t)),e.slice(0,3))}},filter:{TAG:function(e){var t=e.replace(te,ne).toLowerCase();return"*"===e?function(){return!0}:function(e){return e.nodeName&&e.nodeName.toLowerCase()===t}},CLASS:function(e){var t=p[e+" "];return t||(t=new RegExp("(^|"+M+")"+e+"("+M+"|$)"))&&p(e,function(e){return t.test("string"==typeof e.className&&e.className||"undefined"!=typeof e.getAttribute&&e.getAttribute("class")||"")})},ATTR:function(n,r,i){return function(e){var t=se.attr(e,n);return null==t?"!="===r:!r||(t+="","="===r?t===i:"!="===r?t!==i:"^="===r?i&&0===t.indexOf(i):"*="===r?i&&-1:\x20\t\r\n\f]*)[\x20\t\r\n\f]*\/?>(?:<\/\1>|)$/i;function j(e,n,r){return m(n)?k.grep(e,function(e,t){return!!n.call(e,t,e)!==r}):n.nodeType?k.grep(e,function(e){return e===n!==r}):"string"!=typeof n?k.grep(e,function(e){return-1)[^>]*|#([\w-]+))$/;(k.fn.init=function(e,t,n){var r,i;if(!e)return this;if(n=n||q,"string"==typeof e){if(!(r="<"===e[0]&&">"===e[e.length-1]&&3<=e.length?[null,e,null]:L.exec(e))||!r[1]&&t)return!t||t.jquery?(t||n).find(e):this.constructor(t).find(e);if(r[1]){if(t=t instanceof k?t[0]:t,k.merge(this,k.parseHTML(r[1],t&&t.nodeType?t.ownerDocument||t:E,!0)),D.test(r[1])&&k.isPlainObject(t))for(r in t)m(this[r])?this[r](t[r]):this.attr(r,t[r]);return this}return(i=E.getElementById(r[2]))&&(this[0]=i,this.length=1),this}return e.nodeType?(this[0]=e,this.length=1,this):m(e)?void 0!==n.ready?n.ready(e):e(k):k.makeArray(e,this)}).prototype=k.fn,q=k(E);var H=/^(?:parents|prev(?:Until|All))/,O={children:!0,contents:!0,next:!0,prev:!0};function P(e,t){while((e=e[t])&&1!==e.nodeType);return e}k.fn.extend({has:function(e){var t=k(e,this),n=t.length;return this.filter(function(){for(var e=0;e\x20\t\r\n\f]*)/i,he=/^$|^module$|\/(?:java|ecma)script/i,ge={option:[1,""],thead:[1,"","
"],col:[2,"","
"],tr:[2,"","
"],td:[3,"","
"],_default:[0,"",""]};function ve(e,t){var n;return n="undefined"!=typeof e.getElementsByTagName?e.getElementsByTagName(t||"*"):"undefined"!=typeof e.querySelectorAll?e.querySelectorAll(t||"*"):[],void 0===t||t&&A(e,t)?k.merge([e],n):n}function ye(e,t){for(var n=0,r=e.length;nx",y.noCloneChecked=!!me.cloneNode(!0).lastChild.defaultValue;var Te=/^key/,Ce=/^(?:mouse|pointer|contextmenu|drag|drop)|click/,Ee=/^([^.]*)(?:\.(.+)|)/;function ke(){return!0}function Se(){return!1}function Ne(e,t){return e===function(){try{return E.activeElement}catch(e){}}()==("focus"===t)}function Ae(e,t,n,r,i,o){var a,s;if("object"==typeof t){for(s in"string"!=typeof n&&(r=r||n,n=void 0),t)Ae(e,s,n,r,t[s],o);return e}if(null==r&&null==i?(i=n,r=n=void 0):null==i&&("string"==typeof n?(i=r,r=void 0):(i=r,r=n,n=void 0)),!1===i)i=Se;else if(!i)return e;return 1===o&&(a=i,(i=function(e){return k().off(e),a.apply(this,arguments)}).guid=a.guid||(a.guid=k.guid++)),e.each(function(){k.event.add(this,t,i,r,n)})}function De(e,i,o){o?(Q.set(e,i,!1),k.event.add(e,i,{namespace:!1,handler:function(e){var t,n,r=Q.get(this,i);if(1&e.isTrigger&&this[i]){if(r.length)(k.event.special[i]||{}).delegateType&&e.stopPropagation();else if(r=s.call(arguments),Q.set(this,i,r),t=o(this,i),this[i](),r!==(n=Q.get(this,i))||t?Q.set(this,i,!1):n={},r!==n)return e.stopImmediatePropagation(),e.preventDefault(),n.value}else r.length&&(Q.set(this,i,{value:k.event.trigger(k.extend(r[0],k.Event.prototype),r.slice(1),this)}),e.stopImmediatePropagation())}})):void 0===Q.get(e,i)&&k.event.add(e,i,ke)}k.event={global:{},add:function(t,e,n,r,i){var o,a,s,u,l,c,f,p,d,h,g,v=Q.get(t);if(v){n.handler&&(n=(o=n).handler,i=o.selector),i&&k.find.matchesSelector(ie,i),n.guid||(n.guid=k.guid++),(u=v.events)||(u=v.events={}),(a=v.handle)||(a=v.handle=function(e){return"undefined"!=typeof k&&k.event.triggered!==e.type?k.event.dispatch.apply(t,arguments):void 0}),l=(e=(e||"").match(R)||[""]).length;while(l--)d=g=(s=Ee.exec(e[l])||[])[1],h=(s[2]||"").split(".").sort(),d&&(f=k.event.special[d]||{},d=(i?f.delegateType:f.bindType)||d,f=k.event.special[d]||{},c=k.extend({type:d,origType:g,data:r,handler:n,guid:n.guid,selector:i,needsContext:i&&k.expr.match.needsContext.test(i),namespace:h.join(".")},o),(p=u[d])||((p=u[d]=[]).delegateCount=0,f.setup&&!1!==f.setup.call(t,r,h,a)||t.addEventListener&&t.addEventListener(d,a)),f.add&&(f.add.call(t,c),c.handler.guid||(c.handler.guid=n.guid)),i?p.splice(p.delegateCount++,0,c):p.push(c),k.event.global[d]=!0)}},remove:function(e,t,n,r,i){var o,a,s,u,l,c,f,p,d,h,g,v=Q.hasData(e)&&Q.get(e);if(v&&(u=v.events)){l=(t=(t||"").match(R)||[""]).length;while(l--)if(d=g=(s=Ee.exec(t[l])||[])[1],h=(s[2]||"").split(".").sort(),d){f=k.event.special[d]||{},p=u[d=(r?f.delegateType:f.bindType)||d]||[],s=s[2]&&new RegExp("(^|\\.)"+h.join("\\.(?:.*\\.|)")+"(\\.|$)"),a=o=p.length;while(o--)c=p[o],!i&&g!==c.origType||n&&n.guid!==c.guid||s&&!s.test(c.namespace)||r&&r!==c.selector&&("**"!==r||!c.selector)||(p.splice(o,1),c.selector&&p.delegateCount--,f.remove&&f.remove.call(e,c));a&&!p.length&&(f.teardown&&!1!==f.teardown.call(e,h,v.handle)||k.removeEvent(e,d,v.handle),delete u[d])}else for(d in u)k.event.remove(e,d+t[l],n,r,!0);k.isEmptyObject(u)&&Q.remove(e,"handle events")}},dispatch:function(e){var t,n,r,i,o,a,s=k.event.fix(e),u=new Array(arguments.length),l=(Q.get(this,"events")||{})[s.type]||[],c=k.event.special[s.type]||{};for(u[0]=s,t=1;t\x20\t\r\n\f]*)[^>]*)\/>/gi,qe=/\s*$/g;function Oe(e,t){return A(e,"table")&&A(11!==t.nodeType?t:t.firstChild,"tr")&&k(e).children("tbody")[0]||e}function Pe(e){return e.type=(null!==e.getAttribute("type"))+"/"+e.type,e}function Re(e){return"true/"===(e.type||"").slice(0,5)?e.type=e.type.slice(5):e.removeAttribute("type"),e}function Me(e,t){var n,r,i,o,a,s,u,l;if(1===t.nodeType){if(Q.hasData(e)&&(o=Q.access(e),a=Q.set(t,o),l=o.events))for(i in delete a.handle,a.events={},l)for(n=0,r=l[i].length;n")},clone:function(e,t,n){var r,i,o,a,s,u,l,c=e.cloneNode(!0),f=oe(e);if(!(y.noCloneChecked||1!==e.nodeType&&11!==e.nodeType||k.isXMLDoc(e)))for(a=ve(c),r=0,i=(o=ve(e)).length;r").attr(n.scriptAttrs||{}).prop({charset:n.scriptCharset,src:n.url}).on("load error",i=function(e){r.remove(),i=null,e&&t("error"===e.type?404:200,e.type)}),E.head.appendChild(r[0])},abort:function(){i&&i()}}});var Vt,Gt=[],Yt=/(=)\?(?=&|$)|\?\?/;k.ajaxSetup({jsonp:"callback",jsonpCallback:function(){var e=Gt.pop()||k.expando+"_"+kt++;return this[e]=!0,e}}),k.ajaxPrefilter("json jsonp",function(e,t,n){var r,i,o,a=!1!==e.jsonp&&(Yt.test(e.url)?"url":"string"==typeof e.data&&0===(e.contentType||"").indexOf("application/x-www-form-urlencoded")&&Yt.test(e.data)&&"data");if(a||"jsonp"===e.dataTypes[0])return r=e.jsonpCallback=m(e.jsonpCallback)?e.jsonpCallback():e.jsonpCallback,a?e[a]=e[a].replace(Yt,"$1"+r):!1!==e.jsonp&&(e.url+=(St.test(e.url)?"&":"?")+e.jsonp+"="+r),e.converters["script json"]=function(){return o||k.error(r+" was not called"),o[0]},e.dataTypes[0]="json",i=C[r],C[r]=function(){o=arguments},n.always(function(){void 0===i?k(C).removeProp(r):C[r]=i,e[r]&&(e.jsonpCallback=t.jsonpCallback,Gt.push(r)),o&&m(i)&&i(o[0]),o=i=void 0}),"script"}),y.createHTMLDocument=((Vt=E.implementation.createHTMLDocument("").body).innerHTML="
",2===Vt.childNodes.length),k.parseHTML=function(e,t,n){return"string"!=typeof e?[]:("boolean"==typeof t&&(n=t,t=!1),t||(y.createHTMLDocument?((r=(t=E.implementation.createHTMLDocument("")).createElement("base")).href=E.location.href,t.head.appendChild(r)):t=E),o=!n&&[],(i=D.exec(e))?[t.createElement(i[1])]:(i=we([e],t,o),o&&o.length&&k(o).remove(),k.merge([],i.childNodes)));var r,i,o},k.fn.load=function(e,t,n){var r,i,o,a=this,s=e.indexOf(" ");return-1").append(k.parseHTML(e)).find(r):e)}).always(n&&function(e,t){a.each(function(){n.apply(this,o||[e.responseText,t,e])})}),this},k.each(["ajaxStart","ajaxStop","ajaxComplete","ajaxError","ajaxSuccess","ajaxSend"],function(e,t){k.fn[t]=function(e){return this.on(t,e)}}),k.expr.pseudos.animated=function(t){return k.grep(k.timers,function(e){return t===e.elem}).length},k.offset={setOffset:function(e,t,n){var r,i,o,a,s,u,l=k.css(e,"position"),c=k(e),f={};"static"===l&&(e.style.position="relative"),s=c.offset(),o=k.css(e,"top"),u=k.css(e,"left"),("absolute"===l||"fixed"===l)&&-1<(o+u).indexOf("auto")?(a=(r=c.position()).top,i=r.left):(a=parseFloat(o)||0,i=parseFloat(u)||0),m(t)&&(t=t.call(e,n,k.extend({},s))),null!=t.top&&(f.top=t.top-s.top+a),null!=t.left&&(f.left=t.left-s.left+i),"using"in t?t.using.call(e,f):c.css(f)}},k.fn.extend({offset:function(t){if(arguments.length)return void 0===t?this:this.each(function(e){k.offset.setOffset(this,t,e)});var e,n,r=this[0];return r?r.getClientRects().length?(e=r.getBoundingClientRect(),n=r.ownerDocument.defaultView,{top:e.top+n.pageYOffset,left:e.left+n.pageXOffset}):{top:0,left:0}:void 0},position:function(){if(this[0]){var e,t,n,r=this[0],i={top:0,left:0};if("fixed"===k.css(r,"position"))t=r.getBoundingClientRect();else{t=this.offset(),n=r.ownerDocument,e=r.offsetParent||n.documentElement;while(e&&(e===n.body||e===n.documentElement)&&"static"===k.css(e,"position"))e=e.parentNode;e&&e!==r&&1===e.nodeType&&((i=k(e).offset()).top+=k.css(e,"borderTopWidth",!0),i.left+=k.css(e,"borderLeftWidth",!0))}return{top:t.top-i.top-k.css(r,"marginTop",!0),left:t.left-i.left-k.css(r,"marginLeft",!0)}}},offsetParent:function(){return this.map(function(){var e=this.offsetParent;while(e&&"static"===k.css(e,"position"))e=e.offsetParent;return e||ie})}}),k.each({scrollLeft:"pageXOffset",scrollTop:"pageYOffset"},function(t,i){var o="pageYOffset"===i;k.fn[t]=function(e){return _(this,function(e,t,n){var r;if(x(e)?r=e:9===e.nodeType&&(r=e.defaultView),void 0===n)return r?r[i]:e[t];r?r.scrollTo(o?r.pageXOffset:n,o?n:r.pageYOffset):e[t]=n},t,e,arguments.length)}}),k.each(["top","left"],function(e,n){k.cssHooks[n]=ze(y.pixelPosition,function(e,t){if(t)return t=_e(e,n),$e.test(t)?k(e).position()[n]+"px":t})}),k.each({Height:"height",Width:"width"},function(a,s){k.each({padding:"inner"+a,content:s,"":"outer"+a},function(r,o){k.fn[o]=function(e,t){var n=arguments.length&&(r||"boolean"!=typeof e),i=r||(!0===e||!0===t?"margin":"border");return _(this,function(e,t,n){var r;return x(e)?0===o.indexOf("outer")?e["inner"+a]:e.document.documentElement["client"+a]:9===e.nodeType?(r=e.documentElement,Math.max(e.body["scroll"+a],r["scroll"+a],e.body["offset"+a],r["offset"+a],r["client"+a])):void 0===n?k.css(e,t,i):k.style(e,t,n,i)},s,n?e:void 0,n)}})}),k.each("blur focus focusin focusout resize scroll click dblclick mousedown mouseup mousemove mouseover mouseout mouseenter mouseleave change select submit keydown keypress keyup contextmenu".split(" "),function(e,n){k.fn[n]=function(e,t){return 0+~]|"+M+")"+M+"*"),U=new RegExp(M+"|>"),X=new RegExp(F),V=new RegExp("^"+I+"$"),G={ID:new RegExp("^#("+I+")"),CLASS:new RegExp("^\\.("+I+")"),TAG:new RegExp("^("+I+"|[*])"),ATTR:new RegExp("^"+W),PSEUDO:new RegExp("^"+F),CHILD:new RegExp("^:(only|first|last|nth|nth-last)-(child|of-type)(?:\\("+M+"*(even|odd|(([+-]|)(\\d*)n|)"+M+"*(?:([+-]|)"+M+"*(\\d+)|))"+M+"*\\)|)","i"),bool:new RegExp("^(?:"+R+")$","i"),needsContext:new RegExp("^"+M+"*[>+~]|:(even|odd|eq|gt|lt|nth|first|last)(?:\\("+M+"*((?:-\\d)?\\d*)"+M+"*\\)|)(?=[^-]|$)","i")},Y=/HTML$/i,Q=/^(?:input|select|textarea|button)$/i,J=/^h\d$/i,K=/^[^{]+\{\s*\[native \w/,Z=/^(?:#([\w-]+)|(\w+)|\.([\w-]+))$/,ee=/[+~]/,te=new RegExp("\\\\[\\da-fA-F]{1,6}"+M+"?|\\\\([^\\r\\n\\f])","g"),ne=function(e,t){var n="0x"+e.slice(1)-65536;return t||(n<0?String.fromCharCode(n+65536):String.fromCharCode(n>>10|55296,1023&n|56320))},re=/([\0-\x1f\x7f]|^-?\d)|^-$|[^\0-\x1f\x7f-\uFFFF\w-]/g,ie=function(e,t){return t?"\0"===e?"\ufffd":e.slice(0,-1)+"\\"+e.charCodeAt(e.length-1).toString(16)+" ":"\\"+e},oe=function(){T()},ae=be(function(e){return!0===e.disabled&&"fieldset"===e.nodeName.toLowerCase()},{dir:"parentNode",next:"legend"});try{H.apply(t=O.call(p.childNodes),p.childNodes),t[p.childNodes.length].nodeType}catch(e){H={apply:t.length?function(e,t){L.apply(e,O.call(t))}:function(e,t){var n=e.length,r=0;while(e[n++]=t[r++]);e.length=n-1}}}function se(t,e,n,r){var i,o,a,s,u,l,c,f=e&&e.ownerDocument,p=e?e.nodeType:9;if(n=n||[],"string"!=typeof t||!t||1!==p&&9!==p&&11!==p)return n;if(!r&&(T(e),e=e||C,E)){if(11!==p&&(u=Z.exec(t)))if(i=u[1]){if(9===p){if(!(a=e.getElementById(i)))return n;if(a.id===i)return n.push(a),n}else if(f&&(a=f.getElementById(i))&&y(e,a)&&a.id===i)return n.push(a),n}else{if(u[2])return H.apply(n,e.getElementsByTagName(t)),n;if((i=u[3])&&d.getElementsByClassName&&e.getElementsByClassName)return H.apply(n,e.getElementsByClassName(i)),n}if(d.qsa&&!N[t+" "]&&(!v||!v.test(t))&&(1!==p||"object"!==e.nodeName.toLowerCase())){if(c=t,f=e,1===p&&(U.test(t)||z.test(t))){(f=ee.test(t)&&ye(e.parentNode)||e)===e&&d.scope||((s=e.getAttribute("id"))?s=s.replace(re,ie):e.setAttribute("id",s=S)),o=(l=h(t)).length;while(o--)l[o]=(s?"#"+s:":scope")+" "+xe(l[o]);c=l.join(",")}try{return H.apply(n,f.querySelectorAll(c)),n}catch(e){N(t,!0)}finally{s===S&&e.removeAttribute("id")}}}return g(t.replace($,"$1"),e,n,r)}function ue(){var r=[];return function e(t,n){return r.push(t+" ")>b.cacheLength&&delete e[r.shift()],e[t+" "]=n}}function le(e){return e[S]=!0,e}function ce(e){var t=C.createElement("fieldset");try{return!!e(t)}catch(e){return!1}finally{t.parentNode&&t.parentNode.removeChild(t),t=null}}function fe(e,t){var n=e.split("|"),r=n.length;while(r--)b.attrHandle[n[r]]=t}function pe(e,t){var n=t&&e,r=n&&1===e.nodeType&&1===t.nodeType&&e.sourceIndex-t.sourceIndex;if(r)return r;if(n)while(n=n.nextSibling)if(n===t)return-1;return e?1:-1}function de(t){return function(e){return"input"===e.nodeName.toLowerCase()&&e.type===t}}function he(n){return function(e){var t=e.nodeName.toLowerCase();return("input"===t||"button"===t)&&e.type===n}}function ge(t){return function(e){return"form"in e?e.parentNode&&!1===e.disabled?"label"in e?"label"in e.parentNode?e.parentNode.disabled===t:e.disabled===t:e.isDisabled===t||e.isDisabled!==!t&&ae(e)===t:e.disabled===t:"label"in e&&e.disabled===t}}function ve(a){return le(function(o){return o=+o,le(function(e,t){var n,r=a([],e.length,o),i=r.length;while(i--)e[n=r[i]]&&(e[n]=!(t[n]=e[n]))})})}function ye(e){return e&&"undefined"!=typeof e.getElementsByTagName&&e}for(e in d=se.support={},i=se.isXML=function(e){var t=e&&e.namespaceURI,n=e&&(e.ownerDocument||e).documentElement;return!Y.test(t||n&&n.nodeName||"HTML")},T=se.setDocument=function(e){var t,n,r=e?e.ownerDocument||e:p;return r!=C&&9===r.nodeType&&r.documentElement&&(a=(C=r).documentElement,E=!i(C),p!=C&&(n=C.defaultView)&&n.top!==n&&(n.addEventListener?n.addEventListener("unload",oe,!1):n.attachEvent&&n.attachEvent("onunload",oe)),d.scope=ce(function(e){return a.appendChild(e).appendChild(C.createElement("div")),"undefined"!=typeof e.querySelectorAll&&!e.querySelectorAll(":scope fieldset div").length}),d.attributes=ce(function(e){return e.className="i",!e.getAttribute("className")}),d.getElementsByTagName=ce(function(e){return e.appendChild(C.createComment("")),!e.getElementsByTagName("*").length}),d.getElementsByClassName=K.test(C.getElementsByClassName),d.getById=ce(function(e){return a.appendChild(e).id=S,!C.getElementsByName||!C.getElementsByName(S).length}),d.getById?(b.filter.ID=function(e){var t=e.replace(te,ne);return function(e){return e.getAttribute("id")===t}},b.find.ID=function(e,t){if("undefined"!=typeof t.getElementById&&E){var n=t.getElementById(e);return n?[n]:[]}}):(b.filter.ID=function(e){var n=e.replace(te,ne);return function(e){var t="undefined"!=typeof e.getAttributeNode&&e.getAttributeNode("id");return t&&t.value===n}},b.find.ID=function(e,t){if("undefined"!=typeof t.getElementById&&E){var n,r,i,o=t.getElementById(e);if(o){if((n=o.getAttributeNode("id"))&&n.value===e)return[o];i=t.getElementsByName(e),r=0;while(o=i[r++])if((n=o.getAttributeNode("id"))&&n.value===e)return[o]}return[]}}),b.find.TAG=d.getElementsByTagName?function(e,t){return"undefined"!=typeof t.getElementsByTagName?t.getElementsByTagName(e):d.qsa?t.querySelectorAll(e):void 0}:function(e,t){var n,r=[],i=0,o=t.getElementsByTagName(e);if("*"===e){while(n=o[i++])1===n.nodeType&&r.push(n);return r}return o},b.find.CLASS=d.getElementsByClassName&&function(e,t){if("undefined"!=typeof t.getElementsByClassName&&E)return t.getElementsByClassName(e)},s=[],v=[],(d.qsa=K.test(C.querySelectorAll))&&(ce(function(e){var t;a.appendChild(e).innerHTML="",e.querySelectorAll("[msallowcapture^='']").length&&v.push("[*^$]="+M+"*(?:''|\"\")"),e.querySelectorAll("[selected]").length||v.push("\\["+M+"*(?:value|"+R+")"),e.querySelectorAll("[id~="+S+"-]").length||v.push("~="),(t=C.createElement("input")).setAttribute("name",""),e.appendChild(t),e.querySelectorAll("[name='']").length||v.push("\\["+M+"*name"+M+"*="+M+"*(?:''|\"\")"),e.querySelectorAll(":checked").length||v.push(":checked"),e.querySelectorAll("a#"+S+"+*").length||v.push(".#.+[+~]"),e.querySelectorAll("\\\f"),v.push("[\\r\\n\\f]")}),ce(function(e){e.innerHTML="";var t=C.createElement("input");t.setAttribute("type","hidden"),e.appendChild(t).setAttribute("name","D"),e.querySelectorAll("[name=d]").length&&v.push("name"+M+"*[*^$|!~]?="),2!==e.querySelectorAll(":enabled").length&&v.push(":enabled",":disabled"),a.appendChild(e).disabled=!0,2!==e.querySelectorAll(":disabled").length&&v.push(":enabled",":disabled"),e.querySelectorAll("*,:x"),v.push(",.*:")})),(d.matchesSelector=K.test(c=a.matches||a.webkitMatchesSelector||a.mozMatchesSelector||a.oMatchesSelector||a.msMatchesSelector))&&ce(function(e){d.disconnectedMatch=c.call(e,"*"),c.call(e,"[s!='']:x"),s.push("!=",F)}),v=v.length&&new RegExp(v.join("|")),s=s.length&&new RegExp(s.join("|")),t=K.test(a.compareDocumentPosition),y=t||K.test(a.contains)?function(e,t){var n=9===e.nodeType?e.documentElement:e,r=t&&t.parentNode;return e===r||!(!r||1!==r.nodeType||!(n.contains?n.contains(r):e.compareDocumentPosition&&16&e.compareDocumentPosition(r)))}:function(e,t){if(t)while(t=t.parentNode)if(t===e)return!0;return!1},j=t?function(e,t){if(e===t)return l=!0,0;var n=!e.compareDocumentPosition-!t.compareDocumentPosition;return n||(1&(n=(e.ownerDocument||e)==(t.ownerDocument||t)?e.compareDocumentPosition(t):1)||!d.sortDetached&&t.compareDocumentPosition(e)===n?e==C||e.ownerDocument==p&&y(p,e)?-1:t==C||t.ownerDocument==p&&y(p,t)?1:u?P(u,e)-P(u,t):0:4&n?-1:1)}:function(e,t){if(e===t)return l=!0,0;var n,r=0,i=e.parentNode,o=t.parentNode,a=[e],s=[t];if(!i||!o)return e==C?-1:t==C?1:i?-1:o?1:u?P(u,e)-P(u,t):0;if(i===o)return pe(e,t);n=e;while(n=n.parentNode)a.unshift(n);n=t;while(n=n.parentNode)s.unshift(n);while(a[r]===s[r])r++;return r?pe(a[r],s[r]):a[r]==p?-1:s[r]==p?1:0}),C},se.matches=function(e,t){return se(e,null,null,t)},se.matchesSelector=function(e,t){if(T(e),d.matchesSelector&&E&&!N[t+" "]&&(!s||!s.test(t))&&(!v||!v.test(t)))try{var n=c.call(e,t);if(n||d.disconnectedMatch||e.document&&11!==e.document.nodeType)return n}catch(e){N(t,!0)}return 0":{dir:"parentNode",first:!0}," ":{dir:"parentNode"},"+":{dir:"previousSibling",first:!0},"~":{dir:"previousSibling"}},preFilter:{ATTR:function(e){return e[1]=e[1].replace(te,ne),e[3]=(e[3]||e[4]||e[5]||"").replace(te,ne),"~="===e[2]&&(e[3]=" "+e[3]+" "),e.slice(0,4)},CHILD:function(e){return e[1]=e[1].toLowerCase(),"nth"===e[1].slice(0,3)?(e[3]||se.error(e[0]),e[4]=+(e[4]?e[5]+(e[6]||1):2*("even"===e[3]||"odd"===e[3])),e[5]=+(e[7]+e[8]||"odd"===e[3])):e[3]&&se.error(e[0]),e},PSEUDO:function(e){var t,n=!e[6]&&e[2];return G.CHILD.test(e[0])?null:(e[3]?e[2]=e[4]||e[5]||"":n&&X.test(n)&&(t=h(n,!0))&&(t=n.indexOf(")",n.length-t)-n.length)&&(e[0]=e[0].slice(0,t),e[2]=n.slice(0,t)),e.slice(0,3))}},filter:{TAG:function(e){var t=e.replace(te,ne).toLowerCase();return"*"===e?function(){return!0}:function(e){return e.nodeName&&e.nodeName.toLowerCase()===t}},CLASS:function(e){var t=m[e+" "];return t||(t=new RegExp("(^|"+M+")"+e+"("+M+"|$)"))&&m(e,function(e){return t.test("string"==typeof e.className&&e.className||"undefined"!=typeof e.getAttribute&&e.getAttribute("class")||"")})},ATTR:function(n,r,i){return function(e){var t=se.attr(e,n);return null==t?"!="===r:!r||(t+="","="===r?t===i:"!="===r?t!==i:"^="===r?i&&0===t.indexOf(i):"*="===r?i&&-1:\x20\t\r\n\f]*)[\x20\t\r\n\f]*\/?>(?:<\/\1>|)$/i;function j(e,n,r){return m(n)?S.grep(e,function(e,t){return!!n.call(e,t,e)!==r}):n.nodeType?S.grep(e,function(e){return e===n!==r}):"string"!=typeof n?S.grep(e,function(e){return-1)[^>]*|#([\w-]+))$/;(S.fn.init=function(e,t,n){var r,i;if(!e)return this;if(n=n||D,"string"==typeof e){if(!(r="<"===e[0]&&">"===e[e.length-1]&&3<=e.length?[null,e,null]:q.exec(e))||!r[1]&&t)return!t||t.jquery?(t||n).find(e):this.constructor(t).find(e);if(r[1]){if(t=t instanceof S?t[0]:t,S.merge(this,S.parseHTML(r[1],t&&t.nodeType?t.ownerDocument||t:E,!0)),N.test(r[1])&&S.isPlainObject(t))for(r in t)m(this[r])?this[r](t[r]):this.attr(r,t[r]);return this}return(i=E.getElementById(r[2]))&&(this[0]=i,this.length=1),this}return e.nodeType?(this[0]=e,this.length=1,this):m(e)?void 0!==n.ready?n.ready(e):e(S):S.makeArray(e,this)}).prototype=S.fn,D=S(E);var L=/^(?:parents|prev(?:Until|All))/,H={children:!0,contents:!0,next:!0,prev:!0};function O(e,t){while((e=e[t])&&1!==e.nodeType);return e}S.fn.extend({has:function(e){var t=S(e,this),n=t.length;return this.filter(function(){for(var e=0;e\x20\t\r\n\f]*)/i,he=/^$|^module$|\/(?:java|ecma)script/i;ce=E.createDocumentFragment().appendChild(E.createElement("div")),(fe=E.createElement("input")).setAttribute("type","radio"),fe.setAttribute("checked","checked"),fe.setAttribute("name","t"),ce.appendChild(fe),y.checkClone=ce.cloneNode(!0).cloneNode(!0).lastChild.checked,ce.innerHTML="",y.noCloneChecked=!!ce.cloneNode(!0).lastChild.defaultValue,ce.innerHTML="",y.option=!!ce.lastChild;var ge={thead:[1,"","
"],col:[2,"","
"],tr:[2,"","
"],td:[3,"","
"],_default:[0,"",""]};function ve(e,t){var n;return n="undefined"!=typeof e.getElementsByTagName?e.getElementsByTagName(t||"*"):"undefined"!=typeof e.querySelectorAll?e.querySelectorAll(t||"*"):[],void 0===t||t&&A(e,t)?S.merge([e],n):n}function ye(e,t){for(var n=0,r=e.length;n",""]);var me=/<|&#?\w+;/;function xe(e,t,n,r,i){for(var o,a,s,u,l,c,f=t.createDocumentFragment(),p=[],d=0,h=e.length;d\s*$/g;function je(e,t){return A(e,"table")&&A(11!==t.nodeType?t:t.firstChild,"tr")&&S(e).children("tbody")[0]||e}function De(e){return e.type=(null!==e.getAttribute("type"))+"/"+e.type,e}function qe(e){return"true/"===(e.type||"").slice(0,5)?e.type=e.type.slice(5):e.removeAttribute("type"),e}function Le(e,t){var n,r,i,o,a,s;if(1===t.nodeType){if(Y.hasData(e)&&(s=Y.get(e).events))for(i in Y.remove(t,"handle events"),s)for(n=0,r=s[i].length;n").attr(n.scriptAttrs||{}).prop({charset:n.scriptCharset,src:n.url}).on("load error",i=function(e){r.remove(),i=null,e&&t("error"===e.type?404:200,e.type)}),E.head.appendChild(r[0])},abort:function(){i&&i()}}});var _t,zt=[],Ut=/(=)\?(?=&|$)|\?\?/;S.ajaxSetup({jsonp:"callback",jsonpCallback:function(){var e=zt.pop()||S.expando+"_"+wt.guid++;return this[e]=!0,e}}),S.ajaxPrefilter("json jsonp",function(e,t,n){var r,i,o,a=!1!==e.jsonp&&(Ut.test(e.url)?"url":"string"==typeof e.data&&0===(e.contentType||"").indexOf("application/x-www-form-urlencoded")&&Ut.test(e.data)&&"data");if(a||"jsonp"===e.dataTypes[0])return r=e.jsonpCallback=m(e.jsonpCallback)?e.jsonpCallback():e.jsonpCallback,a?e[a]=e[a].replace(Ut,"$1"+r):!1!==e.jsonp&&(e.url+=(Tt.test(e.url)?"&":"?")+e.jsonp+"="+r),e.converters["script json"]=function(){return o||S.error(r+" was not called"),o[0]},e.dataTypes[0]="json",i=C[r],C[r]=function(){o=arguments},n.always(function(){void 0===i?S(C).removeProp(r):C[r]=i,e[r]&&(e.jsonpCallback=t.jsonpCallback,zt.push(r)),o&&m(i)&&i(o[0]),o=i=void 0}),"script"}),y.createHTMLDocument=((_t=E.implementation.createHTMLDocument("").body).innerHTML="
",2===_t.childNodes.length),S.parseHTML=function(e,t,n){return"string"!=typeof e?[]:("boolean"==typeof t&&(n=t,t=!1),t||(y.createHTMLDocument?((r=(t=E.implementation.createHTMLDocument("")).createElement("base")).href=E.location.href,t.head.appendChild(r)):t=E),o=!n&&[],(i=N.exec(e))?[t.createElement(i[1])]:(i=xe([e],t,o),o&&o.length&&S(o).remove(),S.merge([],i.childNodes)));var r,i,o},S.fn.load=function(e,t,n){var r,i,o,a=this,s=e.indexOf(" ");return-1").append(S.parseHTML(e)).find(r):e)}).always(n&&function(e,t){a.each(function(){n.apply(this,o||[e.responseText,t,e])})}),this},S.expr.pseudos.animated=function(t){return S.grep(S.timers,function(e){return t===e.elem}).length},S.offset={setOffset:function(e,t,n){var r,i,o,a,s,u,l=S.css(e,"position"),c=S(e),f={};"static"===l&&(e.style.position="relative"),s=c.offset(),o=S.css(e,"top"),u=S.css(e,"left"),("absolute"===l||"fixed"===l)&&-1<(o+u).indexOf("auto")?(a=(r=c.position()).top,i=r.left):(a=parseFloat(o)||0,i=parseFloat(u)||0),m(t)&&(t=t.call(e,n,S.extend({},s))),null!=t.top&&(f.top=t.top-s.top+a),null!=t.left&&(f.left=t.left-s.left+i),"using"in t?t.using.call(e,f):c.css(f)}},S.fn.extend({offset:function(t){if(arguments.length)return void 0===t?this:this.each(function(e){S.offset.setOffset(this,t,e)});var e,n,r=this[0];return r?r.getClientRects().length?(e=r.getBoundingClientRect(),n=r.ownerDocument.defaultView,{top:e.top+n.pageYOffset,left:e.left+n.pageXOffset}):{top:0,left:0}:void 0},position:function(){if(this[0]){var e,t,n,r=this[0],i={top:0,left:0};if("fixed"===S.css(r,"position"))t=r.getBoundingClientRect();else{t=this.offset(),n=r.ownerDocument,e=r.offsetParent||n.documentElement;while(e&&(e===n.body||e===n.documentElement)&&"static"===S.css(e,"position"))e=e.parentNode;e&&e!==r&&1===e.nodeType&&((i=S(e).offset()).top+=S.css(e,"borderTopWidth",!0),i.left+=S.css(e,"borderLeftWidth",!0))}return{top:t.top-i.top-S.css(r,"marginTop",!0),left:t.left-i.left-S.css(r,"marginLeft",!0)}}},offsetParent:function(){return this.map(function(){var e=this.offsetParent;while(e&&"static"===S.css(e,"position"))e=e.offsetParent;return e||re})}}),S.each({scrollLeft:"pageXOffset",scrollTop:"pageYOffset"},function(t,i){var o="pageYOffset"===i;S.fn[t]=function(e){return $(this,function(e,t,n){var r;if(x(e)?r=e:9===e.nodeType&&(r=e.defaultView),void 0===n)return r?r[i]:e[t];r?r.scrollTo(o?r.pageXOffset:n,o?n:r.pageYOffset):e[t]=n},t,e,arguments.length)}}),S.each(["top","left"],function(e,n){S.cssHooks[n]=Fe(y.pixelPosition,function(e,t){if(t)return t=We(e,n),Pe.test(t)?S(e).position()[n]+"px":t})}),S.each({Height:"height",Width:"width"},function(a,s){S.each({padding:"inner"+a,content:s,"":"outer"+a},function(r,o){S.fn[o]=function(e,t){var n=arguments.length&&(r||"boolean"!=typeof e),i=r||(!0===e||!0===t?"margin":"border");return $(this,function(e,t,n){var r;return x(e)?0===o.indexOf("outer")?e["inner"+a]:e.document.documentElement["client"+a]:9===e.nodeType?(r=e.documentElement,Math.max(e.body["scroll"+a],r["scroll"+a],e.body["offset"+a],r["offset"+a],r["client"+a])):void 0===n?S.css(e,t,i):S.style(e,t,n,i)},s,n?e:void 0,n)}})}),S.each(["ajaxStart","ajaxStop","ajaxComplete","ajaxError","ajaxSuccess","ajaxSend"],function(e,t){S.fn[t]=function(e){return this.on(t,e)}}),S.fn.extend({bind:function(e,t,n){return this.on(e,null,t,n)},unbind:function(e,t){return this.off(e,null,t)},delegate:function(e,t,n,r){return this.on(t,e,n,r)},undelegate:function(e,t,n){return 1===arguments.length?this.off(e,"**"):this.off(t,e||"**",n)},hover:function(e,t){return this.mouseenter(e).mouseleave(t||e)}}),S.each("blur focus focusin focusout resize scroll click dblclick mousedown mouseup mousemove mouseover mouseout mouseenter mouseleave change select submit keydown keypress keyup contextmenu".split(" "),function(e,n){S.fn[n]=function(e,t){return 0a;a++)for(i in o[a])n=o[a][i],o[a].hasOwnProperty(i)&&void 0!==n&&(e[i]=t.isPlainObject(n)?t.isPlainObject(e[i])?t.widget.extend({},e[i],n):t.widget.extend({},n):n);return e},t.widget.bridge=function(e,i){var n=i.prototype.widgetFullName||e;t.fn[e]=function(o){var a="string"==typeof o,r=s.call(arguments,1),h=this;return a?this.length||"instance"!==o?this.each(function(){var i,s=t.data(this,n);return"instance"===o?(h=s,!1):s?t.isFunction(s[o])&&"_"!==o.charAt(0)?(i=s[o].apply(s,r),i!==s&&void 0!==i?(h=i&&i.jquery?h.pushStack(i.get()):i,!1):void 0):t.error("no such method '"+o+"' for "+e+" widget instance"):t.error("cannot call methods on "+e+" prior to initialization; "+"attempted to call method '"+o+"'")}):h=void 0:(r.length&&(o=t.widget.extend.apply(null,[o].concat(r))),this.each(function(){var e=t.data(this,n);e?(e.option(o||{}),e._init&&e._init()):t.data(this,n,new i(o,this))})),h}},t.Widget=function(){},t.Widget._childConstructors=[],t.Widget.prototype={widgetName:"widget",widgetEventPrefix:"",defaultElement:"
",options:{classes:{},disabled:!1,create:null},_createWidget:function(e,s){s=t(s||this.defaultElement||this)[0],this.element=t(s),this.uuid=i++,this.eventNamespace="."+this.widgetName+this.uuid,this.bindings=t(),this.hoverable=t(),this.focusable=t(),this.classesElementLookup={},s!==this&&(t.data(s,this.widgetFullName,this),this._on(!0,this.element,{remove:function(t){t.target===s&&this.destroy()}}),this.document=t(s.style?s.ownerDocument:s.document||s),this.window=t(this.document[0].defaultView||this.document[0].parentWindow)),this.options=t.widget.extend({},this.options,this._getCreateOptions(),e),this._create(),this.options.disabled&&this._setOptionDisabled(this.options.disabled),this._trigger("create",null,this._getCreateEventData()),this._init()},_getCreateOptions:function(){return{}},_getCreateEventData:t.noop,_create:t.noop,_init:t.noop,destroy:function(){var e=this;this._destroy(),t.each(this.classesElementLookup,function(t,i){e._removeClass(i,t)}),this.element.off(this.eventNamespace).removeData(this.widgetFullName),this.widget().off(this.eventNamespace).removeAttr("aria-disabled"),this.bindings.off(this.eventNamespace)},_destroy:t.noop,widget:function(){return this.element},option:function(e,i){var s,n,o,a=e;if(0===arguments.length)return t.widget.extend({},this.options);if("string"==typeof e)if(a={},s=e.split("."),e=s.shift(),s.length){for(n=a[e]=t.widget.extend({},this.options[e]),o=0;s.length-1>o;o++)n[s[o]]=n[s[o]]||{},n=n[s[o]];if(e=s.pop(),1===arguments.length)return void 0===n[e]?null:n[e];n[e]=i}else{if(1===arguments.length)return void 0===this.options[e]?null:this.options[e];a[e]=i}return this._setOptions(a),this},_setOptions:function(t){var e;for(e in t)this._setOption(e,t[e]);return this},_setOption:function(t,e){return"classes"===t&&this._setOptionClasses(e),this.options[t]=e,"disabled"===t&&this._setOptionDisabled(e),this},_setOptionClasses:function(e){var i,s,n;for(i in e)n=this.classesElementLookup[i],e[i]!==this.options.classes[i]&&n&&n.length&&(s=t(n.get()),this._removeClass(n,i),s.addClass(this._classes({element:s,keys:i,classes:e,add:!0})))},_setOptionDisabled:function(t){this._toggleClass(this.widget(),this.widgetFullName+"-disabled",null,!!t),t&&(this._removeClass(this.hoverable,null,"ui-state-hover"),this._removeClass(this.focusable,null,"ui-state-focus"))},enable:function(){return this._setOptions({disabled:!1})},disable:function(){return this._setOptions({disabled:!0})},_classes:function(e){function i(i,o){var a,r;for(r=0;i.length>r;r++)a=n.classesElementLookup[i[r]]||t(),a=e.add?t(t.unique(a.get().concat(e.element.get()))):t(a.not(e.element).get()),n.classesElementLookup[i[r]]=a,s.push(i[r]),o&&e.classes[i[r]]&&s.push(e.classes[i[r]])}var s=[],n=this;return e=t.extend({element:this.element,classes:this.options.classes||{}},e),this._on(e.element,{remove:"_untrackClassesElement"}),e.keys&&i(e.keys.match(/\S+/g)||[],!0),e.extra&&i(e.extra.match(/\S+/g)||[]),s.join(" ")},_untrackClassesElement:function(e){var i=this;t.each(i.classesElementLookup,function(s,n){-1!==t.inArray(e.target,n)&&(i.classesElementLookup[s]=t(n.not(e.target).get()))})},_removeClass:function(t,e,i){return this._toggleClass(t,e,i,!1)},_addClass:function(t,e,i){return this._toggleClass(t,e,i,!0)},_toggleClass:function(t,e,i,s){s="boolean"==typeof s?s:i;var n="string"==typeof t||null===t,o={extra:n?e:i,keys:n?t:e,element:n?this.element:t,add:s};return o.element.toggleClass(this._classes(o),s),this},_on:function(e,i,s){var n,o=this;"boolean"!=typeof e&&(s=i,i=e,e=!1),s?(i=n=t(i),this.bindings=this.bindings.add(i)):(s=i,i=this.element,n=this.widget()),t.each(s,function(s,a){function r(){return e||o.options.disabled!==!0&&!t(this).hasClass("ui-state-disabled")?("string"==typeof a?o[a]:a).apply(o,arguments):void 0}"string"!=typeof a&&(r.guid=a.guid=a.guid||r.guid||t.guid++);var h=s.match(/^([\w:-]*)\s*(.*)$/),l=h[1]+o.eventNamespace,c=h[2];c?n.on(l,c,r):i.on(l,r)})},_off:function(e,i){i=(i||"").split(" ").join(this.eventNamespace+" ")+this.eventNamespace,e.off(i).off(i),this.bindings=t(this.bindings.not(e).get()),this.focusable=t(this.focusable.not(e).get()),this.hoverable=t(this.hoverable.not(e).get())},_delay:function(t,e){function i(){return("string"==typeof t?s[t]:t).apply(s,arguments)}var s=this;return setTimeout(i,e||0)},_hoverable:function(e){this.hoverable=this.hoverable.add(e),this._on(e,{mouseenter:function(e){this._addClass(t(e.currentTarget),null,"ui-state-hover")},mouseleave:function(e){this._removeClass(t(e.currentTarget),null,"ui-state-hover")}})},_focusable:function(e){this.focusable=this.focusable.add(e),this._on(e,{focusin:function(e){this._addClass(t(e.currentTarget),null,"ui-state-focus")},focusout:function(e){this._removeClass(t(e.currentTarget),null,"ui-state-focus")}})},_trigger:function(e,i,s){var n,o,a=this.options[e];if(s=s||{},i=t.Event(i),i.type=(e===this.widgetEventPrefix?e:this.widgetEventPrefix+e).toLowerCase(),i.target=this.element[0],o=i.originalEvent)for(n in o)n in i||(i[n]=o[n]);return this.element.trigger(i,s),!(t.isFunction(a)&&a.apply(this.element[0],[i].concat(s))===!1||i.isDefaultPrevented())}},t.each({show:"fadeIn",hide:"fadeOut"},function(e,i){t.Widget.prototype["_"+e]=function(s,n,o){"string"==typeof n&&(n={effect:n});var a,r=n?n===!0||"number"==typeof n?i:n.effect||i:e;n=n||{},"number"==typeof n&&(n={duration:n}),a=!t.isEmptyObject(n),n.complete=o,n.delay&&s.delay(n.delay),a&&t.effects&&t.effects.effect[r]?s[e](n):r!==e&&s[r]?s[r](n.duration,n.easing,o):s.queue(function(i){t(this)[e](),o&&o.call(s[0]),i()})}}),t.widget,function(){function e(t,e,i){return[parseFloat(t[0])*(u.test(t[0])?e/100:1),parseFloat(t[1])*(u.test(t[1])?i/100:1)]}function i(e,i){return parseInt(t.css(e,i),10)||0}function s(e){var i=e[0];return 9===i.nodeType?{width:e.width(),height:e.height(),offset:{top:0,left:0}}:t.isWindow(i)?{width:e.width(),height:e.height(),offset:{top:e.scrollTop(),left:e.scrollLeft()}}:i.preventDefault?{width:0,height:0,offset:{top:i.pageY,left:i.pageX}}:{width:e.outerWidth(),height:e.outerHeight(),offset:e.offset()}}var n,o=Math.max,a=Math.abs,r=/left|center|right/,h=/top|center|bottom/,l=/[\+\-]\d+(\.[\d]+)?%?/,c=/^\w+/,u=/%$/,d=t.fn.position;t.position={scrollbarWidth:function(){if(void 0!==n)return n;var e,i,s=t("
"),o=s.children()[0];return t("body").append(s),e=o.offsetWidth,s.css("overflow","scroll"),i=o.offsetWidth,e===i&&(i=s[0].clientWidth),s.remove(),n=e-i},getScrollInfo:function(e){var i=e.isWindow||e.isDocument?"":e.element.css("overflow-x"),s=e.isWindow||e.isDocument?"":e.element.css("overflow-y"),n="scroll"===i||"auto"===i&&e.widthi?"left":e>0?"right":"center",vertical:0>r?"top":s>0?"bottom":"middle"};l>p&&p>a(e+i)&&(u.horizontal="center"),c>f&&f>a(s+r)&&(u.vertical="middle"),u.important=o(a(e),a(i))>o(a(s),a(r))?"horizontal":"vertical",n.using.call(this,t,u)}),h.offset(t.extend(D,{using:r}))})},t.ui.position={fit:{left:function(t,e){var i,s=e.within,n=s.isWindow?s.scrollLeft:s.offset.left,a=s.width,r=t.left-e.collisionPosition.marginLeft,h=n-r,l=r+e.collisionWidth-a-n;e.collisionWidth>a?h>0&&0>=l?(i=t.left+h+e.collisionWidth-a-n,t.left+=h-i):t.left=l>0&&0>=h?n:h>l?n+a-e.collisionWidth:n:h>0?t.left+=h:l>0?t.left-=l:t.left=o(t.left-r,t.left)},top:function(t,e){var i,s=e.within,n=s.isWindow?s.scrollTop:s.offset.top,a=e.within.height,r=t.top-e.collisionPosition.marginTop,h=n-r,l=r+e.collisionHeight-a-n;e.collisionHeight>a?h>0&&0>=l?(i=t.top+h+e.collisionHeight-a-n,t.top+=h-i):t.top=l>0&&0>=h?n:h>l?n+a-e.collisionHeight:n:h>0?t.top+=h:l>0?t.top-=l:t.top=o(t.top-r,t.top)}},flip:{left:function(t,e){var i,s,n=e.within,o=n.offset.left+n.scrollLeft,r=n.width,h=n.isWindow?n.scrollLeft:n.offset.left,l=t.left-e.collisionPosition.marginLeft,c=l-h,u=l+e.collisionWidth-r-h,d="left"===e.my[0]?-e.elemWidth:"right"===e.my[0]?e.elemWidth:0,p="left"===e.at[0]?e.targetWidth:"right"===e.at[0]?-e.targetWidth:0,f=-2*e.offset[0];0>c?(i=t.left+d+p+f+e.collisionWidth-r-o,(0>i||a(c)>i)&&(t.left+=d+p+f)):u>0&&(s=t.left-e.collisionPosition.marginLeft+d+p+f-h,(s>0||u>a(s))&&(t.left+=d+p+f))},top:function(t,e){var i,s,n=e.within,o=n.offset.top+n.scrollTop,r=n.height,h=n.isWindow?n.scrollTop:n.offset.top,l=t.top-e.collisionPosition.marginTop,c=l-h,u=l+e.collisionHeight-r-h,d="top"===e.my[1],p=d?-e.elemHeight:"bottom"===e.my[1]?e.elemHeight:0,f="top"===e.at[1]?e.targetHeight:"bottom"===e.at[1]?-e.targetHeight:0,m=-2*e.offset[1];0>c?(s=t.top+p+f+m+e.collisionHeight-r-o,(0>s||a(c)>s)&&(t.top+=p+f+m)):u>0&&(i=t.top-e.collisionPosition.marginTop+p+f+m-h,(i>0||u>a(i))&&(t.top+=p+f+m))}},flipfit:{left:function(){t.ui.position.flip.left.apply(this,arguments),t.ui.position.fit.left.apply(this,arguments)},top:function(){t.ui.position.flip.top.apply(this,arguments),t.ui.position.fit.top.apply(this,arguments)}}}}(),t.ui.position,t.extend(t.expr[":"],{data:t.expr.createPseudo?t.expr.createPseudo(function(e){return function(i){return!!t.data(i,e)}}):function(e,i,s){return!!t.data(e,s[3])}}),t.fn.extend({disableSelection:function(){var t="onselectstart"in document.createElement("div")?"selectstart":"mousedown";return function(){return this.on(t+".ui-disableSelection",function(t){t.preventDefault()})}}(),enableSelection:function(){return this.off(".ui-disableSelection")}}),t.ui.focusable=function(i,s){var n,o,a,r,h,l=i.nodeName.toLowerCase();return"area"===l?(n=i.parentNode,o=n.name,i.href&&o&&"map"===n.nodeName.toLowerCase()?(a=t("img[usemap='#"+o+"']"),a.length>0&&a.is(":visible")):!1):(/^(input|select|textarea|button|object)$/.test(l)?(r=!i.disabled,r&&(h=t(i).closest("fieldset")[0],h&&(r=!h.disabled))):r="a"===l?i.href||s:s,r&&t(i).is(":visible")&&e(t(i)))},t.extend(t.expr[":"],{focusable:function(e){return t.ui.focusable(e,null!=t.attr(e,"tabindex"))}}),t.ui.focusable,t.fn.form=function(){return"string"==typeof this[0].form?this.closest("form"):t(this[0].form)},t.ui.formResetMixin={_formResetHandler:function(){var e=t(this);setTimeout(function(){var i=e.data("ui-form-reset-instances");t.each(i,function(){this.refresh()})})},_bindFormResetHandler:function(){if(this.form=this.element.form(),this.form.length){var t=this.form.data("ui-form-reset-instances")||[];t.length||this.form.on("reset.ui-form-reset",this._formResetHandler),t.push(this),this.form.data("ui-form-reset-instances",t)}},_unbindFormResetHandler:function(){if(this.form.length){var e=this.form.data("ui-form-reset-instances");e.splice(t.inArray(this,e),1),e.length?this.form.data("ui-form-reset-instances",e):this.form.removeData("ui-form-reset-instances").off("reset.ui-form-reset")}}},"1.7"===t.fn.jquery.substring(0,3)&&(t.each(["Width","Height"],function(e,i){function s(e,i,s,o){return t.each(n,function(){i-=parseFloat(t.css(e,"padding"+this))||0,s&&(i-=parseFloat(t.css(e,"border"+this+"Width"))||0),o&&(i-=parseFloat(t.css(e,"margin"+this))||0)}),i}var n="Width"===i?["Left","Right"]:["Top","Bottom"],o=i.toLowerCase(),a={innerWidth:t.fn.innerWidth,innerHeight:t.fn.innerHeight,outerWidth:t.fn.outerWidth,outerHeight:t.fn.outerHeight};t.fn["inner"+i]=function(e){return void 0===e?a["inner"+i].call(this):this.each(function(){t(this).css(o,s(this,e)+"px")})},t.fn["outer"+i]=function(e,n){return"number"!=typeof e?a["outer"+i].call(this,e):this.each(function(){t(this).css(o,s(this,e,!0,n)+"px")})}}),t.fn.addBack=function(t){return this.add(null==t?this.prevObject:this.prevObject.filter(t))}),t.ui.keyCode={BACKSPACE:8,COMMA:188,DELETE:46,DOWN:40,END:35,ENTER:13,ESCAPE:27,HOME:36,LEFT:37,PAGE_DOWN:34,PAGE_UP:33,PERIOD:190,RIGHT:39,SPACE:32,TAB:9,UP:38},t.ui.escapeSelector=function(){var t=/([!"#$%&'()*+,./:;<=>?@[\]^`{|}~])/g;return function(e){return e.replace(t,"\\$1")}}(),t.fn.labels=function(){var e,i,s,n,o;return this[0].labels&&this[0].labels.length?this.pushStack(this[0].labels):(n=this.eq(0).parents("label"),s=this.attr("id"),s&&(e=this.eq(0).parents().last(),o=e.add(e.length?e.siblings():this.siblings()),i="label[for='"+t.ui.escapeSelector(s)+"']",n=n.add(o.find(i).addBack(i))),this.pushStack(n))},t.fn.scrollParent=function(e){var i=this.css("position"),s="absolute"===i,n=e?/(auto|scroll|hidden)/:/(auto|scroll)/,o=this.parents().filter(function(){var e=t(this);return s&&"static"===e.css("position")?!1:n.test(e.css("overflow")+e.css("overflow-y")+e.css("overflow-x"))}).eq(0);return"fixed"!==i&&o.length?o:t(this[0].ownerDocument||document)},t.extend(t.expr[":"],{tabbable:function(e){var i=t.attr(e,"tabindex"),s=null!=i;return(!s||i>=0)&&t.ui.focusable(e,s)}}),t.fn.extend({uniqueId:function(){var t=0;return function(){return this.each(function(){this.id||(this.id="ui-id-"+ ++t)})}}(),removeUniqueId:function(){return this.each(function(){/^ui-id-\d+$/.test(this.id)&&t(this).removeAttr("id")})}}),t.ui.ie=!!/msie [\w.]+/.exec(navigator.userAgent.toLowerCase());var n=!1;t(document).on("mouseup",function(){n=!1}),t.widget("ui.mouse",{version:"1.12.1",options:{cancel:"input, textarea, button, select, option",distance:1,delay:0},_mouseInit:function(){var e=this;this.element.on("mousedown."+this.widgetName,function(t){return e._mouseDown(t)}).on("click."+this.widgetName,function(i){return!0===t.data(i.target,e.widgetName+".preventClickEvent")?(t.removeData(i.target,e.widgetName+".preventClickEvent"),i.stopImmediatePropagation(),!1):void 0}),this.started=!1},_mouseDestroy:function(){this.element.off("."+this.widgetName),this._mouseMoveDelegate&&this.document.off("mousemove."+this.widgetName,this._mouseMoveDelegate).off("mouseup."+this.widgetName,this._mouseUpDelegate)},_mouseDown:function(e){if(!n){this._mouseMoved=!1,this._mouseStarted&&this._mouseUp(e),this._mouseDownEvent=e;var i=this,s=1===e.which,o="string"==typeof this.options.cancel&&e.target.nodeName?t(e.target).closest(this.options.cancel).length:!1;return s&&!o&&this._mouseCapture(e)?(this.mouseDelayMet=!this.options.delay,this.mouseDelayMet||(this._mouseDelayTimer=setTimeout(function(){i.mouseDelayMet=!0},this.options.delay)),this._mouseDistanceMet(e)&&this._mouseDelayMet(e)&&(this._mouseStarted=this._mouseStart(e)!==!1,!this._mouseStarted)?(e.preventDefault(),!0):(!0===t.data(e.target,this.widgetName+".preventClickEvent")&&t.removeData(e.target,this.widgetName+".preventClickEvent"),this._mouseMoveDelegate=function(t){return i._mouseMove(t)},this._mouseUpDelegate=function(t){return i._mouseUp(t)},this.document.on("mousemove."+this.widgetName,this._mouseMoveDelegate).on("mouseup."+this.widgetName,this._mouseUpDelegate),e.preventDefault(),n=!0,!0)):!0}},_mouseMove:function(e){if(this._mouseMoved){if(t.ui.ie&&(!document.documentMode||9>document.documentMode)&&!e.button)return this._mouseUp(e);if(!e.which)if(e.originalEvent.altKey||e.originalEvent.ctrlKey||e.originalEvent.metaKey||e.originalEvent.shiftKey)this.ignoreMissingWhich=!0;else if(!this.ignoreMissingWhich)return this._mouseUp(e)}return(e.which||e.button)&&(this._mouseMoved=!0),this._mouseStarted?(this._mouseDrag(e),e.preventDefault()):(this._mouseDistanceMet(e)&&this._mouseDelayMet(e)&&(this._mouseStarted=this._mouseStart(this._mouseDownEvent,e)!==!1,this._mouseStarted?this._mouseDrag(e):this._mouseUp(e)),!this._mouseStarted)},_mouseUp:function(e){this.document.off("mousemove."+this.widgetName,this._mouseMoveDelegate).off("mouseup."+this.widgetName,this._mouseUpDelegate),this._mouseStarted&&(this._mouseStarted=!1,e.target===this._mouseDownEvent.target&&t.data(e.target,this.widgetName+".preventClickEvent",!0),this._mouseStop(e)),this._mouseDelayTimer&&(clearTimeout(this._mouseDelayTimer),delete this._mouseDelayTimer),this.ignoreMissingWhich=!1,n=!1,e.preventDefault()},_mouseDistanceMet:function(t){return Math.max(Math.abs(this._mouseDownEvent.pageX-t.pageX),Math.abs(this._mouseDownEvent.pageY-t.pageY))>=this.options.distance},_mouseDelayMet:function(){return this.mouseDelayMet},_mouseStart:function(){},_mouseDrag:function(){},_mouseStop:function(){},_mouseCapture:function(){return!0}}),t.ui.plugin={add:function(e,i,s){var n,o=t.ui[e].prototype;for(n in s)o.plugins[n]=o.plugins[n]||[],o.plugins[n].push([i,s[n]])},call:function(t,e,i,s){var n,o=t.plugins[e];if(o&&(s||t.element[0].parentNode&&11!==t.element[0].parentNode.nodeType))for(n=0;o.length>n;n++)t.options[o[n][0]]&&o[n][1].apply(t.element,i)}},t.widget("ui.resizable",t.ui.mouse,{version:"1.12.1",widgetEventPrefix:"resize",options:{alsoResize:!1,animate:!1,animateDuration:"slow",animateEasing:"swing",aspectRatio:!1,autoHide:!1,classes:{"ui-resizable-se":"ui-icon ui-icon-gripsmall-diagonal-se"},containment:!1,ghost:!1,grid:!1,handles:"e,s,se",helper:!1,maxHeight:null,maxWidth:null,minHeight:10,minWidth:10,zIndex:90,resize:null,start:null,stop:null},_num:function(t){return parseFloat(t)||0},_isNumber:function(t){return!isNaN(parseFloat(t))},_hasScroll:function(e,i){if("hidden"===t(e).css("overflow"))return!1;var s=i&&"left"===i?"scrollLeft":"scrollTop",n=!1;return e[s]>0?!0:(e[s]=1,n=e[s]>0,e[s]=0,n)},_create:function(){var e,i=this.options,s=this;this._addClass("ui-resizable"),t.extend(this,{_aspectRatio:!!i.aspectRatio,aspectRatio:i.aspectRatio,originalElement:this.element,_proportionallyResizeElements:[],_helper:i.helper||i.ghost||i.animate?i.helper||"ui-resizable-helper":null}),this.element[0].nodeName.match(/^(canvas|textarea|input|select|button|img)$/i)&&(this.element.wrap(t("
").css({position:this.element.css("position"),width:this.element.outerWidth(),height:this.element.outerHeight(),top:this.element.css("top"),left:this.element.css("left")})),this.element=this.element.parent().data("ui-resizable",this.element.resizable("instance")),this.elementIsWrapper=!0,e={marginTop:this.originalElement.css("marginTop"),marginRight:this.originalElement.css("marginRight"),marginBottom:this.originalElement.css("marginBottom"),marginLeft:this.originalElement.css("marginLeft")},this.element.css(e),this.originalElement.css("margin",0),this.originalResizeStyle=this.originalElement.css("resize"),this.originalElement.css("resize","none"),this._proportionallyResizeElements.push(this.originalElement.css({position:"static",zoom:1,display:"block"})),this.originalElement.css(e),this._proportionallyResize()),this._setupHandles(),i.autoHide&&t(this.element).on("mouseenter",function(){i.disabled||(s._removeClass("ui-resizable-autohide"),s._handles.show())}).on("mouseleave",function(){i.disabled||s.resizing||(s._addClass("ui-resizable-autohide"),s._handles.hide())}),this._mouseInit()},_destroy:function(){this._mouseDestroy();var e,i=function(e){t(e).removeData("resizable").removeData("ui-resizable").off(".resizable").find(".ui-resizable-handle").remove()};return this.elementIsWrapper&&(i(this.element),e=this.element,this.originalElement.css({position:e.css("position"),width:e.outerWidth(),height:e.outerHeight(),top:e.css("top"),left:e.css("left")}).insertAfter(e),e.remove()),this.originalElement.css("resize",this.originalResizeStyle),i(this.originalElement),this},_setOption:function(t,e){switch(this._super(t,e),t){case"handles":this._removeHandles(),this._setupHandles();break;default:}},_setupHandles:function(){var e,i,s,n,o,a=this.options,r=this;if(this.handles=a.handles||(t(".ui-resizable-handle",this.element).length?{n:".ui-resizable-n",e:".ui-resizable-e",s:".ui-resizable-s",w:".ui-resizable-w",se:".ui-resizable-se",sw:".ui-resizable-sw",ne:".ui-resizable-ne",nw:".ui-resizable-nw"}:"e,s,se"),this._handles=t(),this.handles.constructor===String)for("all"===this.handles&&(this.handles="n,e,s,w,se,sw,ne,nw"),s=this.handles.split(","),this.handles={},i=0;s.length>i;i++)e=t.trim(s[i]),n="ui-resizable-"+e,o=t("
"),this._addClass(o,"ui-resizable-handle "+n),o.css({zIndex:a.zIndex}),this.handles[e]=".ui-resizable-"+e,this.element.append(o);this._renderAxis=function(e){var i,s,n,o;e=e||this.element;for(i in this.handles)this.handles[i].constructor===String?this.handles[i]=this.element.children(this.handles[i]).first().show():(this.handles[i].jquery||this.handles[i].nodeType)&&(this.handles[i]=t(this.handles[i]),this._on(this.handles[i],{mousedown:r._mouseDown})),this.elementIsWrapper&&this.originalElement[0].nodeName.match(/^(textarea|input|select|button)$/i)&&(s=t(this.handles[i],this.element),o=/sw|ne|nw|se|n|s/.test(i)?s.outerHeight():s.outerWidth(),n=["padding",/ne|nw|n/.test(i)?"Top":/se|sw|s/.test(i)?"Bottom":/^e$/.test(i)?"Right":"Left"].join(""),e.css(n,o),this._proportionallyResize()),this._handles=this._handles.add(this.handles[i])},this._renderAxis(this.element),this._handles=this._handles.add(this.element.find(".ui-resizable-handle")),this._handles.disableSelection(),this._handles.on("mouseover",function(){r.resizing||(this.className&&(o=this.className.match(/ui-resizable-(se|sw|ne|nw|n|e|s|w)/i)),r.axis=o&&o[1]?o[1]:"se")}),a.autoHide&&(this._handles.hide(),this._addClass("ui-resizable-autohide"))},_removeHandles:function(){this._handles.remove()},_mouseCapture:function(e){var i,s,n=!1;for(i in this.handles)s=t(this.handles[i])[0],(s===e.target||t.contains(s,e.target))&&(n=!0);return!this.options.disabled&&n},_mouseStart:function(e){var i,s,n,o=this.options,a=this.element;return this.resizing=!0,this._renderProxy(),i=this._num(this.helper.css("left")),s=this._num(this.helper.css("top")),o.containment&&(i+=t(o.containment).scrollLeft()||0,s+=t(o.containment).scrollTop()||0),this.offset=this.helper.offset(),this.position={left:i,top:s},this.size=this._helper?{width:this.helper.width(),height:this.helper.height()}:{width:a.width(),height:a.height()},this.originalSize=this._helper?{width:a.outerWidth(),height:a.outerHeight()}:{width:a.width(),height:a.height()},this.sizeDiff={width:a.outerWidth()-a.width(),height:a.outerHeight()-a.height()},this.originalPosition={left:i,top:s},this.originalMousePosition={left:e.pageX,top:e.pageY},this.aspectRatio="number"==typeof o.aspectRatio?o.aspectRatio:this.originalSize.width/this.originalSize.height||1,n=t(".ui-resizable-"+this.axis).css("cursor"),t("body").css("cursor","auto"===n?this.axis+"-resize":n),this._addClass("ui-resizable-resizing"),this._propagate("start",e),!0},_mouseDrag:function(e){var i,s,n=this.originalMousePosition,o=this.axis,a=e.pageX-n.left||0,r=e.pageY-n.top||0,h=this._change[o];return this._updatePrevProperties(),h?(i=h.apply(this,[e,a,r]),this._updateVirtualBoundaries(e.shiftKey),(this._aspectRatio||e.shiftKey)&&(i=this._updateRatio(i,e)),i=this._respectSize(i,e),this._updateCache(i),this._propagate("resize",e),s=this._applyChanges(),!this._helper&&this._proportionallyResizeElements.length&&this._proportionallyResize(),t.isEmptyObject(s)||(this._updatePrevProperties(),this._trigger("resize",e,this.ui()),this._applyChanges()),!1):!1},_mouseStop:function(e){this.resizing=!1;var i,s,n,o,a,r,h,l=this.options,c=this;return this._helper&&(i=this._proportionallyResizeElements,s=i.length&&/textarea/i.test(i[0].nodeName),n=s&&this._hasScroll(i[0],"left")?0:c.sizeDiff.height,o=s?0:c.sizeDiff.width,a={width:c.helper.width()-o,height:c.helper.height()-n},r=parseFloat(c.element.css("left"))+(c.position.left-c.originalPosition.left)||null,h=parseFloat(c.element.css("top"))+(c.position.top-c.originalPosition.top)||null,l.animate||this.element.css(t.extend(a,{top:h,left:r})),c.helper.height(c.size.height),c.helper.width(c.size.width),this._helper&&!l.animate&&this._proportionallyResize()),t("body").css("cursor","auto"),this._removeClass("ui-resizable-resizing"),this._propagate("stop",e),this._helper&&this.helper.remove(),!1},_updatePrevProperties:function(){this.prevPosition={top:this.position.top,left:this.position.left},this.prevSize={width:this.size.width,height:this.size.height}},_applyChanges:function(){var t={};return this.position.top!==this.prevPosition.top&&(t.top=this.position.top+"px"),this.position.left!==this.prevPosition.left&&(t.left=this.position.left+"px"),this.size.width!==this.prevSize.width&&(t.width=this.size.width+"px"),this.size.height!==this.prevSize.height&&(t.height=this.size.height+"px"),this.helper.css(t),t},_updateVirtualBoundaries:function(t){var e,i,s,n,o,a=this.options;o={minWidth:this._isNumber(a.minWidth)?a.minWidth:0,maxWidth:this._isNumber(a.maxWidth)?a.maxWidth:1/0,minHeight:this._isNumber(a.minHeight)?a.minHeight:0,maxHeight:this._isNumber(a.maxHeight)?a.maxHeight:1/0},(this._aspectRatio||t)&&(e=o.minHeight*this.aspectRatio,s=o.minWidth/this.aspectRatio,i=o.maxHeight*this.aspectRatio,n=o.maxWidth/this.aspectRatio,e>o.minWidth&&(o.minWidth=e),s>o.minHeight&&(o.minHeight=s),o.maxWidth>i&&(o.maxWidth=i),o.maxHeight>n&&(o.maxHeight=n)),this._vBoundaries=o},_updateCache:function(t){this.offset=this.helper.offset(),this._isNumber(t.left)&&(this.position.left=t.left),this._isNumber(t.top)&&(this.position.top=t.top),this._isNumber(t.height)&&(this.size.height=t.height),this._isNumber(t.width)&&(this.size.width=t.width)},_updateRatio:function(t){var e=this.position,i=this.size,s=this.axis;return this._isNumber(t.height)?t.width=t.height*this.aspectRatio:this._isNumber(t.width)&&(t.height=t.width/this.aspectRatio),"sw"===s&&(t.left=e.left+(i.width-t.width),t.top=null),"nw"===s&&(t.top=e.top+(i.height-t.height),t.left=e.left+(i.width-t.width)),t},_respectSize:function(t){var e=this._vBoundaries,i=this.axis,s=this._isNumber(t.width)&&e.maxWidth&&e.maxWidtht.width,a=this._isNumber(t.height)&&e.minHeight&&e.minHeight>t.height,r=this.originalPosition.left+this.originalSize.width,h=this.originalPosition.top+this.originalSize.height,l=/sw|nw|w/.test(i),c=/nw|ne|n/.test(i);return o&&(t.width=e.minWidth),a&&(t.height=e.minHeight),s&&(t.width=e.maxWidth),n&&(t.height=e.maxHeight),o&&l&&(t.left=r-e.minWidth),s&&l&&(t.left=r-e.maxWidth),a&&c&&(t.top=h-e.minHeight),n&&c&&(t.top=h-e.maxHeight),t.width||t.height||t.left||!t.top?t.width||t.height||t.top||!t.left||(t.left=null):t.top=null,t},_getPaddingPlusBorderDimensions:function(t){for(var e=0,i=[],s=[t.css("borderTopWidth"),t.css("borderRightWidth"),t.css("borderBottomWidth"),t.css("borderLeftWidth")],n=[t.css("paddingTop"),t.css("paddingRight"),t.css("paddingBottom"),t.css("paddingLeft")];4>e;e++)i[e]=parseFloat(s[e])||0,i[e]+=parseFloat(n[e])||0;return{height:i[0]+i[2],width:i[1]+i[3]}},_proportionallyResize:function(){if(this._proportionallyResizeElements.length)for(var t,e=0,i=this.helper||this.element;this._proportionallyResizeElements.length>e;e++)t=this._proportionallyResizeElements[e],this.outerDimensions||(this.outerDimensions=this._getPaddingPlusBorderDimensions(t)),t.css({height:i.height()-this.outerDimensions.height||0,width:i.width()-this.outerDimensions.width||0})},_renderProxy:function(){var e=this.element,i=this.options;this.elementOffset=e.offset(),this._helper?(this.helper=this.helper||t("
"),this._addClass(this.helper,this._helper),this.helper.css({width:this.element.outerWidth(),height:this.element.outerHeight(),position:"absolute",left:this.elementOffset.left+"px",top:this.elementOffset.top+"px",zIndex:++i.zIndex}),this.helper.appendTo("body").disableSelection()):this.helper=this.element -},_change:{e:function(t,e){return{width:this.originalSize.width+e}},w:function(t,e){var i=this.originalSize,s=this.originalPosition;return{left:s.left+e,width:i.width-e}},n:function(t,e,i){var s=this.originalSize,n=this.originalPosition;return{top:n.top+i,height:s.height-i}},s:function(t,e,i){return{height:this.originalSize.height+i}},se:function(e,i,s){return t.extend(this._change.s.apply(this,arguments),this._change.e.apply(this,[e,i,s]))},sw:function(e,i,s){return t.extend(this._change.s.apply(this,arguments),this._change.w.apply(this,[e,i,s]))},ne:function(e,i,s){return t.extend(this._change.n.apply(this,arguments),this._change.e.apply(this,[e,i,s]))},nw:function(e,i,s){return t.extend(this._change.n.apply(this,arguments),this._change.w.apply(this,[e,i,s]))}},_propagate:function(e,i){t.ui.plugin.call(this,e,[i,this.ui()]),"resize"!==e&&this._trigger(e,i,this.ui())},plugins:{},ui:function(){return{originalElement:this.originalElement,element:this.element,helper:this.helper,position:this.position,size:this.size,originalSize:this.originalSize,originalPosition:this.originalPosition}}}),t.ui.plugin.add("resizable","animate",{stop:function(e){var i=t(this).resizable("instance"),s=i.options,n=i._proportionallyResizeElements,o=n.length&&/textarea/i.test(n[0].nodeName),a=o&&i._hasScroll(n[0],"left")?0:i.sizeDiff.height,r=o?0:i.sizeDiff.width,h={width:i.size.width-r,height:i.size.height-a},l=parseFloat(i.element.css("left"))+(i.position.left-i.originalPosition.left)||null,c=parseFloat(i.element.css("top"))+(i.position.top-i.originalPosition.top)||null;i.element.animate(t.extend(h,c&&l?{top:c,left:l}:{}),{duration:s.animateDuration,easing:s.animateEasing,step:function(){var s={width:parseFloat(i.element.css("width")),height:parseFloat(i.element.css("height")),top:parseFloat(i.element.css("top")),left:parseFloat(i.element.css("left"))};n&&n.length&&t(n[0]).css({width:s.width,height:s.height}),i._updateCache(s),i._propagate("resize",e)}})}}),t.ui.plugin.add("resizable","containment",{start:function(){var e,i,s,n,o,a,r,h=t(this).resizable("instance"),l=h.options,c=h.element,u=l.containment,d=u instanceof t?u.get(0):/parent/.test(u)?c.parent().get(0):u;d&&(h.containerElement=t(d),/document/.test(u)||u===document?(h.containerOffset={left:0,top:0},h.containerPosition={left:0,top:0},h.parentData={element:t(document),left:0,top:0,width:t(document).width(),height:t(document).height()||document.body.parentNode.scrollHeight}):(e=t(d),i=[],t(["Top","Right","Left","Bottom"]).each(function(t,s){i[t]=h._num(e.css("padding"+s))}),h.containerOffset=e.offset(),h.containerPosition=e.position(),h.containerSize={height:e.innerHeight()-i[3],width:e.innerWidth()-i[1]},s=h.containerOffset,n=h.containerSize.height,o=h.containerSize.width,a=h._hasScroll(d,"left")?d.scrollWidth:o,r=h._hasScroll(d)?d.scrollHeight:n,h.parentData={element:d,left:s.left,top:s.top,width:a,height:r}))},resize:function(e){var i,s,n,o,a=t(this).resizable("instance"),r=a.options,h=a.containerOffset,l=a.position,c=a._aspectRatio||e.shiftKey,u={top:0,left:0},d=a.containerElement,p=!0;d[0]!==document&&/static/.test(d.css("position"))&&(u=h),l.left<(a._helper?h.left:0)&&(a.size.width=a.size.width+(a._helper?a.position.left-h.left:a.position.left-u.left),c&&(a.size.height=a.size.width/a.aspectRatio,p=!1),a.position.left=r.helper?h.left:0),l.top<(a._helper?h.top:0)&&(a.size.height=a.size.height+(a._helper?a.position.top-h.top:a.position.top),c&&(a.size.width=a.size.height*a.aspectRatio,p=!1),a.position.top=a._helper?h.top:0),n=a.containerElement.get(0)===a.element.parent().get(0),o=/relative|absolute/.test(a.containerElement.css("position")),n&&o?(a.offset.left=a.parentData.left+a.position.left,a.offset.top=a.parentData.top+a.position.top):(a.offset.left=a.element.offset().left,a.offset.top=a.element.offset().top),i=Math.abs(a.sizeDiff.width+(a._helper?a.offset.left-u.left:a.offset.left-h.left)),s=Math.abs(a.sizeDiff.height+(a._helper?a.offset.top-u.top:a.offset.top-h.top)),i+a.size.width>=a.parentData.width&&(a.size.width=a.parentData.width-i,c&&(a.size.height=a.size.width/a.aspectRatio,p=!1)),s+a.size.height>=a.parentData.height&&(a.size.height=a.parentData.height-s,c&&(a.size.width=a.size.height*a.aspectRatio,p=!1)),p||(a.position.left=a.prevPosition.left,a.position.top=a.prevPosition.top,a.size.width=a.prevSize.width,a.size.height=a.prevSize.height)},stop:function(){var e=t(this).resizable("instance"),i=e.options,s=e.containerOffset,n=e.containerPosition,o=e.containerElement,a=t(e.helper),r=a.offset(),h=a.outerWidth()-e.sizeDiff.width,l=a.outerHeight()-e.sizeDiff.height;e._helper&&!i.animate&&/relative/.test(o.css("position"))&&t(this).css({left:r.left-n.left-s.left,width:h,height:l}),e._helper&&!i.animate&&/static/.test(o.css("position"))&&t(this).css({left:r.left-n.left-s.left,width:h,height:l})}}),t.ui.plugin.add("resizable","alsoResize",{start:function(){var e=t(this).resizable("instance"),i=e.options;t(i.alsoResize).each(function(){var e=t(this);e.data("ui-resizable-alsoresize",{width:parseFloat(e.width()),height:parseFloat(e.height()),left:parseFloat(e.css("left")),top:parseFloat(e.css("top"))})})},resize:function(e,i){var s=t(this).resizable("instance"),n=s.options,o=s.originalSize,a=s.originalPosition,r={height:s.size.height-o.height||0,width:s.size.width-o.width||0,top:s.position.top-a.top||0,left:s.position.left-a.left||0};t(n.alsoResize).each(function(){var e=t(this),s=t(this).data("ui-resizable-alsoresize"),n={},o=e.parents(i.originalElement[0]).length?["width","height"]:["width","height","top","left"];t.each(o,function(t,e){var i=(s[e]||0)+(r[e]||0);i&&i>=0&&(n[e]=i||null)}),e.css(n)})},stop:function(){t(this).removeData("ui-resizable-alsoresize")}}),t.ui.plugin.add("resizable","ghost",{start:function(){var e=t(this).resizable("instance"),i=e.size;e.ghost=e.originalElement.clone(),e.ghost.css({opacity:.25,display:"block",position:"relative",height:i.height,width:i.width,margin:0,left:0,top:0}),e._addClass(e.ghost,"ui-resizable-ghost"),t.uiBackCompat!==!1&&"string"==typeof e.options.ghost&&e.ghost.addClass(this.options.ghost),e.ghost.appendTo(e.helper)},resize:function(){var e=t(this).resizable("instance");e.ghost&&e.ghost.css({position:"relative",height:e.size.height,width:e.size.width})},stop:function(){var e=t(this).resizable("instance");e.ghost&&e.helper&&e.helper.get(0).removeChild(e.ghost.get(0))}}),t.ui.plugin.add("resizable","grid",{resize:function(){var e,i=t(this).resizable("instance"),s=i.options,n=i.size,o=i.originalSize,a=i.originalPosition,r=i.axis,h="number"==typeof s.grid?[s.grid,s.grid]:s.grid,l=h[0]||1,c=h[1]||1,u=Math.round((n.width-o.width)/l)*l,d=Math.round((n.height-o.height)/c)*c,p=o.width+u,f=o.height+d,m=s.maxWidth&&p>s.maxWidth,g=s.maxHeight&&f>s.maxHeight,_=s.minWidth&&s.minWidth>p,v=s.minHeight&&s.minHeight>f;s.grid=h,_&&(p+=l),v&&(f+=c),m&&(p-=l),g&&(f-=c),/^(se|s|e)$/.test(r)?(i.size.width=p,i.size.height=f):/^(ne)$/.test(r)?(i.size.width=p,i.size.height=f,i.position.top=a.top-d):/^(sw)$/.test(r)?(i.size.width=p,i.size.height=f,i.position.left=a.left-u):((0>=f-c||0>=p-l)&&(e=i._getPaddingPlusBorderDimensions(this)),f-c>0?(i.size.height=f,i.position.top=a.top-d):(f=c-e.height,i.size.height=f,i.position.top=a.top+o.height-f),p-l>0?(i.size.width=p,i.position.left=a.left-u):(p=l-e.width,i.size.width=p,i.position.left=a.left+o.width-p))}}),t.ui.resizable});/** +!function(t){"use strict";"function"==typeof define&&define.amd?define(["jquery"],t):t(jQuery)}(function(y){"use strict";y.ui=y.ui||{};y.ui.version="1.13.2";var n,i=0,h=Array.prototype.hasOwnProperty,a=Array.prototype.slice;y.cleanData=(n=y.cleanData,function(t){for(var e,i,s=0;null!=(i=t[s]);s++)(e=y._data(i,"events"))&&e.remove&&y(i).triggerHandler("remove");n(t)}),y.widget=function(t,i,e){var s,n,o,h={},a=t.split(".")[0],r=a+"-"+(t=t.split(".")[1]);return e||(e=i,i=y.Widget),Array.isArray(e)&&(e=y.extend.apply(null,[{}].concat(e))),y.expr.pseudos[r.toLowerCase()]=function(t){return!!y.data(t,r)},y[a]=y[a]||{},s=y[a][t],n=y[a][t]=function(t,e){if(!this||!this._createWidget)return new n(t,e);arguments.length&&this._createWidget(t,e)},y.extend(n,s,{version:e.version,_proto:y.extend({},e),_childConstructors:[]}),(o=new i).options=y.widget.extend({},o.options),y.each(e,function(e,s){function n(){return i.prototype[e].apply(this,arguments)}function o(t){return i.prototype[e].apply(this,t)}h[e]="function"==typeof s?function(){var t,e=this._super,i=this._superApply;return this._super=n,this._superApply=o,t=s.apply(this,arguments),this._super=e,this._superApply=i,t}:s}),n.prototype=y.widget.extend(o,{widgetEventPrefix:s&&o.widgetEventPrefix||t},h,{constructor:n,namespace:a,widgetName:t,widgetFullName:r}),s?(y.each(s._childConstructors,function(t,e){var i=e.prototype;y.widget(i.namespace+"."+i.widgetName,n,e._proto)}),delete s._childConstructors):i._childConstructors.push(n),y.widget.bridge(t,n),n},y.widget.extend=function(t){for(var e,i,s=a.call(arguments,1),n=0,o=s.length;n",options:{classes:{},disabled:!1,create:null},_createWidget:function(t,e){e=y(e||this.defaultElement||this)[0],this.element=y(e),this.uuid=i++,this.eventNamespace="."+this.widgetName+this.uuid,this.bindings=y(),this.hoverable=y(),this.focusable=y(),this.classesElementLookup={},e!==this&&(y.data(e,this.widgetFullName,this),this._on(!0,this.element,{remove:function(t){t.target===e&&this.destroy()}}),this.document=y(e.style?e.ownerDocument:e.document||e),this.window=y(this.document[0].defaultView||this.document[0].parentWindow)),this.options=y.widget.extend({},this.options,this._getCreateOptions(),t),this._create(),this.options.disabled&&this._setOptionDisabled(this.options.disabled),this._trigger("create",null,this._getCreateEventData()),this._init()},_getCreateOptions:function(){return{}},_getCreateEventData:y.noop,_create:y.noop,_init:y.noop,destroy:function(){var i=this;this._destroy(),y.each(this.classesElementLookup,function(t,e){i._removeClass(e,t)}),this.element.off(this.eventNamespace).removeData(this.widgetFullName),this.widget().off(this.eventNamespace).removeAttr("aria-disabled"),this.bindings.off(this.eventNamespace)},_destroy:y.noop,widget:function(){return this.element},option:function(t,e){var i,s,n,o=t;if(0===arguments.length)return y.widget.extend({},this.options);if("string"==typeof t)if(o={},t=(i=t.split(".")).shift(),i.length){for(s=o[t]=y.widget.extend({},this.options[t]),n=0;n
"),i=e.children()[0];return y("body").append(e),t=i.offsetWidth,e.css("overflow","scroll"),t===(i=i.offsetWidth)&&(i=e[0].clientWidth),e.remove(),s=t-i},getScrollInfo:function(t){var e=t.isWindow||t.isDocument?"":t.element.css("overflow-x"),i=t.isWindow||t.isDocument?"":t.element.css("overflow-y"),e="scroll"===e||"auto"===e&&t.widthx(D(s),D(n))?o.important="horizontal":o.important="vertical",p.using.call(this,t,o)}),h.offset(y.extend(l,{using:t}))})},y.ui.position={fit:{left:function(t,e){var i=e.within,s=i.isWindow?i.scrollLeft:i.offset.left,n=i.width,o=t.left-e.collisionPosition.marginLeft,h=s-o,a=o+e.collisionWidth-n-s;e.collisionWidth>n?0n?0=this.options.distance},_mouseDelayMet:function(){return this.mouseDelayMet},_mouseStart:function(){},_mouseDrag:function(){},_mouseStop:function(){},_mouseCapture:function(){return!0}}),y.ui.plugin={add:function(t,e,i){var s,n=y.ui[t].prototype;for(s in i)n.plugins[s]=n.plugins[s]||[],n.plugins[s].push([e,i[s]])},call:function(t,e,i,s){var n,o=t.plugins[e];if(o&&(s||t.element[0].parentNode&&11!==t.element[0].parentNode.nodeType))for(n=0;n
").css({overflow:"hidden",position:this.element.css("position"),width:this.element.outerWidth(),height:this.element.outerHeight(),top:this.element.css("top"),left:this.element.css("left")})),this.element=this.element.parent().data("ui-resizable",this.element.resizable("instance")),this.elementIsWrapper=!0,t={marginTop:this.originalElement.css("marginTop"),marginRight:this.originalElement.css("marginRight"),marginBottom:this.originalElement.css("marginBottom"),marginLeft:this.originalElement.css("marginLeft")},this.element.css(t),this.originalElement.css("margin",0),this.originalResizeStyle=this.originalElement.css("resize"),this.originalElement.css("resize","none"),this._proportionallyResizeElements.push(this.originalElement.css({position:"static",zoom:1,display:"block"})),this.originalElement.css(t),this._proportionallyResize()),this._setupHandles(),e.autoHide&&y(this.element).on("mouseenter",function(){e.disabled||(i._removeClass("ui-resizable-autohide"),i._handles.show())}).on("mouseleave",function(){e.disabled||i.resizing||(i._addClass("ui-resizable-autohide"),i._handles.hide())}),this._mouseInit()},_destroy:function(){this._mouseDestroy(),this._addedHandles.remove();function t(t){y(t).removeData("resizable").removeData("ui-resizable").off(".resizable")}var e;return this.elementIsWrapper&&(t(this.element),e=this.element,this.originalElement.css({position:e.css("position"),width:e.outerWidth(),height:e.outerHeight(),top:e.css("top"),left:e.css("left")}).insertAfter(e),e.remove()),this.originalElement.css("resize",this.originalResizeStyle),t(this.originalElement),this},_setOption:function(t,e){switch(this._super(t,e),t){case"handles":this._removeHandles(),this._setupHandles();break;case"aspectRatio":this._aspectRatio=!!e}},_setupHandles:function(){var t,e,i,s,n,o=this.options,h=this;if(this.handles=o.handles||(y(".ui-resizable-handle",this.element).length?{n:".ui-resizable-n",e:".ui-resizable-e",s:".ui-resizable-s",w:".ui-resizable-w",se:".ui-resizable-se",sw:".ui-resizable-sw",ne:".ui-resizable-ne",nw:".ui-resizable-nw"}:"e,s,se"),this._handles=y(),this._addedHandles=y(),this.handles.constructor===String)for("all"===this.handles&&(this.handles="n,e,s,w,se,sw,ne,nw"),i=this.handles.split(","),this.handles={},e=0;e"),this._addClass(n,"ui-resizable-handle "+s),n.css({zIndex:o.zIndex}),this.handles[t]=".ui-resizable-"+t,this.element.children(this.handles[t]).length||(this.element.append(n),this._addedHandles=this._addedHandles.add(n));this._renderAxis=function(t){var e,i,s;for(e in t=t||this.element,this.handles)this.handles[e].constructor===String?this.handles[e]=this.element.children(this.handles[e]).first().show():(this.handles[e].jquery||this.handles[e].nodeType)&&(this.handles[e]=y(this.handles[e]),this._on(this.handles[e],{mousedown:h._mouseDown})),this.elementIsWrapper&&this.originalElement[0].nodeName.match(/^(textarea|input|select|button)$/i)&&(i=y(this.handles[e],this.element),s=/sw|ne|nw|se|n|s/.test(e)?i.outerHeight():i.outerWidth(),i=["padding",/ne|nw|n/.test(e)?"Top":/se|sw|s/.test(e)?"Bottom":/^e$/.test(e)?"Right":"Left"].join(""),t.css(i,s),this._proportionallyResize()),this._handles=this._handles.add(this.handles[e])},this._renderAxis(this.element),this._handles=this._handles.add(this.element.find(".ui-resizable-handle")),this._handles.disableSelection(),this._handles.on("mouseover",function(){h.resizing||(this.className&&(n=this.className.match(/ui-resizable-(se|sw|ne|nw|n|e|s|w)/i)),h.axis=n&&n[1]?n[1]:"se")}),o.autoHide&&(this._handles.hide(),this._addClass("ui-resizable-autohide"))},_removeHandles:function(){this._addedHandles.remove()},_mouseCapture:function(t){var e,i,s=!1;for(e in this.handles)(i=y(this.handles[e])[0])!==t.target&&!y.contains(i,t.target)||(s=!0);return!this.options.disabled&&s},_mouseStart:function(t){var e,i,s=this.options,n=this.element;return this.resizing=!0,this._renderProxy(),e=this._num(this.helper.css("left")),i=this._num(this.helper.css("top")),s.containment&&(e+=y(s.containment).scrollLeft()||0,i+=y(s.containment).scrollTop()||0),this.offset=this.helper.offset(),this.position={left:e,top:i},this.size=this._helper?{width:this.helper.width(),height:this.helper.height()}:{width:n.width(),height:n.height()},this.originalSize=this._helper?{width:n.outerWidth(),height:n.outerHeight()}:{width:n.width(),height:n.height()},this.sizeDiff={width:n.outerWidth()-n.width(),height:n.outerHeight()-n.height()},this.originalPosition={left:e,top:i},this.originalMousePosition={left:t.pageX,top:t.pageY},this.aspectRatio="number"==typeof s.aspectRatio?s.aspectRatio:this.originalSize.width/this.originalSize.height||1,s=y(".ui-resizable-"+this.axis).css("cursor"),y("body").css("cursor","auto"===s?this.axis+"-resize":s),this._addClass("ui-resizable-resizing"),this._propagate("start",t),!0},_mouseDrag:function(t){var e=this.originalMousePosition,i=this.axis,s=t.pageX-e.left||0,e=t.pageY-e.top||0,i=this._change[i];return this._updatePrevProperties(),i&&(e=i.apply(this,[t,s,e]),this._updateVirtualBoundaries(t.shiftKey),(this._aspectRatio||t.shiftKey)&&(e=this._updateRatio(e,t)),e=this._respectSize(e,t),this._updateCache(e),this._propagate("resize",t),e=this._applyChanges(),!this._helper&&this._proportionallyResizeElements.length&&this._proportionallyResize(),y.isEmptyObject(e)||(this._updatePrevProperties(),this._trigger("resize",t,this.ui()),this._applyChanges())),!1},_mouseStop:function(t){this.resizing=!1;var e,i,s,n=this.options,o=this;return this._helper&&(s=(e=(i=this._proportionallyResizeElements).length&&/textarea/i.test(i[0].nodeName))&&this._hasScroll(i[0],"left")?0:o.sizeDiff.height,i=e?0:o.sizeDiff.width,e={width:o.helper.width()-i,height:o.helper.height()-s},i=parseFloat(o.element.css("left"))+(o.position.left-o.originalPosition.left)||null,s=parseFloat(o.element.css("top"))+(o.position.top-o.originalPosition.top)||null,n.animate||this.element.css(y.extend(e,{top:s,left:i})),o.helper.height(o.size.height),o.helper.width(o.size.width),this._helper&&!n.animate&&this._proportionallyResize()),y("body").css("cursor","auto"),this._removeClass("ui-resizable-resizing"),this._propagate("stop",t),this._helper&&this.helper.remove(),!1},_updatePrevProperties:function(){this.prevPosition={top:this.position.top,left:this.position.left},this.prevSize={width:this.size.width,height:this.size.height}},_applyChanges:function(){var t={};return this.position.top!==this.prevPosition.top&&(t.top=this.position.top+"px"),this.position.left!==this.prevPosition.left&&(t.left=this.position.left+"px"),this.size.width!==this.prevSize.width&&(t.width=this.size.width+"px"),this.size.height!==this.prevSize.height&&(t.height=this.size.height+"px"),this.helper.css(t),t},_updateVirtualBoundaries:function(t){var e,i,s=this.options,n={minWidth:this._isNumber(s.minWidth)?s.minWidth:0,maxWidth:this._isNumber(s.maxWidth)?s.maxWidth:1/0,minHeight:this._isNumber(s.minHeight)?s.minHeight:0,maxHeight:this._isNumber(s.maxHeight)?s.maxHeight:1/0};(this._aspectRatio||t)&&(e=n.minHeight*this.aspectRatio,i=n.minWidth/this.aspectRatio,s=n.maxHeight*this.aspectRatio,t=n.maxWidth/this.aspectRatio,e>n.minWidth&&(n.minWidth=e),i>n.minHeight&&(n.minHeight=i),st.width,h=this._isNumber(t.height)&&e.minHeight&&e.minHeight>t.height,a=this.originalPosition.left+this.originalSize.width,r=this.originalPosition.top+this.originalSize.height,l=/sw|nw|w/.test(i),i=/nw|ne|n/.test(i);return o&&(t.width=e.minWidth),h&&(t.height=e.minHeight),s&&(t.width=e.maxWidth),n&&(t.height=e.maxHeight),o&&l&&(t.left=a-e.minWidth),s&&l&&(t.left=a-e.maxWidth),h&&i&&(t.top=r-e.minHeight),n&&i&&(t.top=r-e.maxHeight),t.width||t.height||t.left||!t.top?t.width||t.height||t.top||!t.left||(t.left=null):t.top=null,t},_getPaddingPlusBorderDimensions:function(t){for(var e=0,i=[],s=[t.css("borderTopWidth"),t.css("borderRightWidth"),t.css("borderBottomWidth"),t.css("borderLeftWidth")],n=[t.css("paddingTop"),t.css("paddingRight"),t.css("paddingBottom"),t.css("paddingLeft")];e<4;e++)i[e]=parseFloat(s[e])||0,i[e]+=parseFloat(n[e])||0;return{height:i[0]+i[2],width:i[1]+i[3]}},_proportionallyResize:function(){if(this._proportionallyResizeElements.length)for(var t,e=0,i=this.helper||this.element;e").css({overflow:"hidden"}),this._addClass(this.helper,this._helper),this.helper.css({width:this.element.outerWidth(),height:this.element.outerHeight(),position:"absolute",left:this.elementOffset.left+"px",top:this.elementOffset.top+"px",zIndex:++e.zIndex}),this.helper.appendTo("body").disableSelection()):this.helper=this.element},_change:{e:function(t,e){return{width:this.originalSize.width+e}},w:function(t,e){var i=this.originalSize;return{left:this.originalPosition.left+e,width:i.width-e}},n:function(t,e,i){var s=this.originalSize;return{top:this.originalPosition.top+i,height:s.height-i}},s:function(t,e,i){return{height:this.originalSize.height+i}},se:function(t,e,i){return y.extend(this._change.s.apply(this,arguments),this._change.e.apply(this,[t,e,i]))},sw:function(t,e,i){return y.extend(this._change.s.apply(this,arguments),this._change.w.apply(this,[t,e,i]))},ne:function(t,e,i){return y.extend(this._change.n.apply(this,arguments),this._change.e.apply(this,[t,e,i]))},nw:function(t,e,i){return y.extend(this._change.n.apply(this,arguments),this._change.w.apply(this,[t,e,i]))}},_propagate:function(t,e){y.ui.plugin.call(this,t,[e,this.ui()]),"resize"!==t&&this._trigger(t,e,this.ui())},plugins:{},ui:function(){return{originalElement:this.originalElement,element:this.element,helper:this.helper,position:this.position,size:this.size,originalSize:this.originalSize,originalPosition:this.originalPosition}}}),y.ui.plugin.add("resizable","animate",{stop:function(e){var i=y(this).resizable("instance"),t=i.options,s=i._proportionallyResizeElements,n=s.length&&/textarea/i.test(s[0].nodeName),o=n&&i._hasScroll(s[0],"left")?0:i.sizeDiff.height,h=n?0:i.sizeDiff.width,n={width:i.size.width-h,height:i.size.height-o},h=parseFloat(i.element.css("left"))+(i.position.left-i.originalPosition.left)||null,o=parseFloat(i.element.css("top"))+(i.position.top-i.originalPosition.top)||null;i.element.animate(y.extend(n,o&&h?{top:o,left:h}:{}),{duration:t.animateDuration,easing:t.animateEasing,step:function(){var t={width:parseFloat(i.element.css("width")),height:parseFloat(i.element.css("height")),top:parseFloat(i.element.css("top")),left:parseFloat(i.element.css("left"))};s&&s.length&&y(s[0]).css({width:t.width,height:t.height}),i._updateCache(t),i._propagate("resize",e)}})}}),y.ui.plugin.add("resizable","containment",{start:function(){var i,s,n=y(this).resizable("instance"),t=n.options,e=n.element,o=t.containment,h=o instanceof y?o.get(0):/parent/.test(o)?e.parent().get(0):o;h&&(n.containerElement=y(h),/document/.test(o)||o===document?(n.containerOffset={left:0,top:0},n.containerPosition={left:0,top:0},n.parentData={element:y(document),left:0,top:0,width:y(document).width(),height:y(document).height()||document.body.parentNode.scrollHeight}):(i=y(h),s=[],y(["Top","Right","Left","Bottom"]).each(function(t,e){s[t]=n._num(i.css("padding"+e))}),n.containerOffset=i.offset(),n.containerPosition=i.position(),n.containerSize={height:i.innerHeight()-s[3],width:i.innerWidth()-s[1]},t=n.containerOffset,e=n.containerSize.height,o=n.containerSize.width,o=n._hasScroll(h,"left")?h.scrollWidth:o,e=n._hasScroll(h)?h.scrollHeight:e,n.parentData={element:h,left:t.left,top:t.top,width:o,height:e}))},resize:function(t){var e=y(this).resizable("instance"),i=e.options,s=e.containerOffset,n=e.position,o=e._aspectRatio||t.shiftKey,h={top:0,left:0},a=e.containerElement,t=!0;a[0]!==document&&/static/.test(a.css("position"))&&(h=s),n.left<(e._helper?s.left:0)&&(e.size.width=e.size.width+(e._helper?e.position.left-s.left:e.position.left-h.left),o&&(e.size.height=e.size.width/e.aspectRatio,t=!1),e.position.left=i.helper?s.left:0),n.top<(e._helper?s.top:0)&&(e.size.height=e.size.height+(e._helper?e.position.top-s.top:e.position.top),o&&(e.size.width=e.size.height*e.aspectRatio,t=!1),e.position.top=e._helper?s.top:0),i=e.containerElement.get(0)===e.element.parent().get(0),n=/relative|absolute/.test(e.containerElement.css("position")),i&&n?(e.offset.left=e.parentData.left+e.position.left,e.offset.top=e.parentData.top+e.position.top):(e.offset.left=e.element.offset().left,e.offset.top=e.element.offset().top),n=Math.abs(e.sizeDiff.width+(e._helper?e.offset.left-h.left:e.offset.left-s.left)),s=Math.abs(e.sizeDiff.height+(e._helper?e.offset.top-h.top:e.offset.top-s.top)),n+e.size.width>=e.parentData.width&&(e.size.width=e.parentData.width-n,o&&(e.size.height=e.size.width/e.aspectRatio,t=!1)),s+e.size.height>=e.parentData.height&&(e.size.height=e.parentData.height-s,o&&(e.size.width=e.size.height*e.aspectRatio,t=!1)),t||(e.position.left=e.prevPosition.left,e.position.top=e.prevPosition.top,e.size.width=e.prevSize.width,e.size.height=e.prevSize.height)},stop:function(){var t=y(this).resizable("instance"),e=t.options,i=t.containerOffset,s=t.containerPosition,n=t.containerElement,o=y(t.helper),h=o.offset(),a=o.outerWidth()-t.sizeDiff.width,o=o.outerHeight()-t.sizeDiff.height;t._helper&&!e.animate&&/relative/.test(n.css("position"))&&y(this).css({left:h.left-s.left-i.left,width:a,height:o}),t._helper&&!e.animate&&/static/.test(n.css("position"))&&y(this).css({left:h.left-s.left-i.left,width:a,height:o})}}),y.ui.plugin.add("resizable","alsoResize",{start:function(){var t=y(this).resizable("instance").options;y(t.alsoResize).each(function(){var t=y(this);t.data("ui-resizable-alsoresize",{width:parseFloat(t.width()),height:parseFloat(t.height()),left:parseFloat(t.css("left")),top:parseFloat(t.css("top"))})})},resize:function(t,i){var e=y(this).resizable("instance"),s=e.options,n=e.originalSize,o=e.originalPosition,h={height:e.size.height-n.height||0,width:e.size.width-n.width||0,top:e.position.top-o.top||0,left:e.position.left-o.left||0};y(s.alsoResize).each(function(){var t=y(this),s=y(this).data("ui-resizable-alsoresize"),n={},e=t.parents(i.originalElement[0]).length?["width","height"]:["width","height","top","left"];y.each(e,function(t,e){var i=(s[e]||0)+(h[e]||0);i&&0<=i&&(n[e]=i||null)}),t.css(n)})},stop:function(){y(this).removeData("ui-resizable-alsoresize")}}),y.ui.plugin.add("resizable","ghost",{start:function(){var t=y(this).resizable("instance"),e=t.size;t.ghost=t.originalElement.clone(),t.ghost.css({opacity:.25,display:"block",position:"relative",height:e.height,width:e.width,margin:0,left:0,top:0}),t._addClass(t.ghost,"ui-resizable-ghost"),!1!==y.uiBackCompat&&"string"==typeof t.options.ghost&&t.ghost.addClass(this.options.ghost),t.ghost.appendTo(t.helper)},resize:function(){var t=y(this).resizable("instance");t.ghost&&t.ghost.css({position:"relative",height:t.size.height,width:t.size.width})},stop:function(){var t=y(this).resizable("instance");t.ghost&&t.helper&&t.helper.get(0).removeChild(t.ghost.get(0))}}),y.ui.plugin.add("resizable","grid",{resize:function(){var t,e=y(this).resizable("instance"),i=e.options,s=e.size,n=e.originalSize,o=e.originalPosition,h=e.axis,a="number"==typeof i.grid?[i.grid,i.grid]:i.grid,r=a[0]||1,l=a[1]||1,u=Math.round((s.width-n.width)/r)*r,p=Math.round((s.height-n.height)/l)*l,d=n.width+u,c=n.height+p,f=i.maxWidth&&i.maxWidthd,s=i.minHeight&&i.minHeight>c;i.grid=a,m&&(d+=r),s&&(c+=l),f&&(d-=r),g&&(c-=l),/^(se|s|e)$/.test(h)?(e.size.width=d,e.size.height=c):/^(ne)$/.test(h)?(e.size.width=d,e.size.height=c,e.position.top=o.top-p):/^(sw)$/.test(h)?(e.size.width=d,e.size.height=c,e.position.left=o.left-u):((c-l<=0||d-r<=0)&&(t=e._getPaddingPlusBorderDimensions(this)),0 - + - - + + -linalg: C:/Users/jchri/Documents/github/linalg/include/linalg.h Source File +linalg: D:/Code/linalg/include/linalg.h Source File @@ -13,13 +13,16 @@ - + + @@ -27,10 +30,9 @@
- - + @@ -39,21 +41,22 @@
-
linalg -  1.6.0 +
+
linalg 1.6.1
A linear algebra library that provides a user-friendly interface to several BLAS and LAPACK routines.
- + +/* @license-end */ +
@@ -67,8 +70,8 @@
@@ -81,283 +84,292 @@
- +
+
+
+
+
Loading...
+
Searching...
+
No Matches
+
+
+
-
-
linalg.h
+
linalg.h
-
1 #ifndef LINALG_H_
-
2 #define LINALG_H_
-
3 
-
4 #include <stdbool.h>
-
5 #include <complex.h>
-
6 
-
7 #define LA_NO_OPERATION 0
-
8 #define LA_TRANSPOSE 1
-
9 #define LA_HERMITIAN_TRANSPOSE 2
-
10 #define LA_NO_ERROR 0
-
11 #define LA_INVALID_INPUT_ERROR 101
-
12 #define LA_ARRAY_SIZE_ERROR 102
-
13 #define LA_SINGULAR_MATRIX_ERROR 103
-
14 #define LA_MATRIX_FORMAT_ERROR 104
-
15 #define LA_OUT_OF_MEMORY_ERROR 105
-
16 #define LA_CONVERGENCE_ERROR 106
-
17 #define LA_INVALID_OPERATION_ERROR 107
-
18 
-
19 #ifdef __cplusplus
-
20 extern "C" {
-
21 #endif
-
22 
-
41 int la_rank1_update(int m, int n, double alpha, const double *x,
-
42  const double *y, double *a, int lda);
-
43 
-
62 int la_rank1_update_cmplx(int m, int n, double complex alpha,
-
63  const double complex *x, const double complex *y, double complex *a,
-
64  int lda);
-
65 
-
80 int la_trace(int m, int n, const double *a, int lda, double *rst);
-
81 
-
96 int la_trace_cmplx(int m, int n, const double complex *a, int lda,
-
97  double complex *rst);
-
98 
-
125 int la_mtx_mult(bool transa, bool transb, int m, int n, int k, double alpha,
-
126  const double *a, int lda, const double *b, int ldb, double beta,
-
127  double *c, int ldc);
-
128 
-
157 int la_mtx_mult_cmplx(int opa, int opb, int m, int n, int k,
-
158  double complex alpha, const double complex *a, int lda,
-
159  const double complex *b, int ldb, double complex beta, double complex *c,
-
160  int ldc);
-
161 
-
195 int la_diag_mtx_mult(bool lside, bool transb, int m, int n, int k,
-
196  double alpha, const double *a, const double *b, int ldb, double beta,
-
197  double *c, int ldc);
-
198 
-
233 int la_diag_mtx_mult_cmplx(bool lside, int opb, int m, int n, int k,
-
234  double complex alpha, const double complex *a, const double complex *b,
-
235  int ldb, double complex beta, double complex *c, int ldc);
-
236 
-
255 int la_rank(int m, int n, double *a, int lda, int *rnk);
-
256 
-
275 int la_rank_cmplx(int m, int n, double complex *a, int lda, int *rnk);
-
276 
-
292 int la_det(int n, double *a, int lda, double *d);
-
293 
-
309 int la_det_cmplx(int n, double complex *a, int lda, double complex *d);
-
310 
-
336 int la_tri_mtx_mult(bool upper, double alpha, int n, const double *a, int lda,
-
337  double beta, double *b, int ldb);
-
338 
-
364 int la_tri_mtx_mult_cmplx(bool upper, double complex alpha, int n,
-
365  const double complex *a, int lda, double complex beta,
-
366  double complex *b, int ldb);
-
367 
-
387 int la_lu_factor(int m, int n, double *a, int lda, int *ipvt);
-
388 
-
408 int la_lu_factor_cmplx(int m, int n, double complex *a, int lda, int *ipvt);
-
409 
-
431 int la_form_lu(int n, double *a, int lda, int *ipvt, double *u, int ldu,
-
432  double *p, int ldp);
-
433 
-
455 int la_form_lu_cmplx(int n, double complex *a, int lda, int *ipvt,
-
456  double complex *u, int ldu, double *p, int ldp);
-
457 
-
479 int la_qr_factor(int m, int n, double *a, int lda, double *tau);
-
480 
-
502 int la_qr_factor_cmplx(int m, int n, double complex *a, int lda,
-
503  double complex *tau);
-
504 
-
529 int la_qr_factor_pvt(int m, int n, double *a, int lda, double *tau, int *jpvt);
-
530 
-
555 int la_qr_factor_cmplx_pvt(int m, int n, double complex *a, int lda,
-
556  double complex *tau, int *jpvt);
-
557 
-
584 int la_form_qr(bool fullq, int m, int n, double *r, int ldr, const double *tau,
-
585  double *q, int ldq);
-
586 
-
613 int la_form_qr_cmplx(bool fullq, int m, int n, double complex *r, int ldr,
-
614  const double complex *tau, double complex *q, int ldq);
-
615 
-
648 int la_form_qr_pvt(bool fullq, int m, int n, double *r, int ldr,
-
649  const double *tau, const int *pvt, double *q, int ldq, double *p, int ldp);
-
650 
-
683 int la_form_qr_cmplx_pvt(bool fullq, int m, int n, double complex *r, int ldr,
-
684  const double complex *tau, const int *pvt, double complex *q, int ldq,
-
685  double complex *p, int ldp);
-
686 
-
716 int la_mult_qr(bool lside, bool trans, int m, int n, int k, double *a, int lda,
-
717  const double *tau, double *c, int ldc);
-
718 
-
748 int la_mult_qr_cmplx(bool lside, bool trans, int m, int n, int k,
-
749  double complex *a, int lda, const double complex *tau, double complex *c,
-
750  int ldc);
-
751 
-
775 int la_qr_rank1_update(int m, int n, double *q, int ldq, double *r, int ldr,
-
776  double *u, double *v);
-
777 
-
801 int la_qr_rank1_update_cmplx(int m, int n, double complex *q, int ldq,
-
802  double complex *r, int ldr, double complex *u, double complex *v);
-
803 
-
822 int la_cholesky_factor(bool upper, int n, double *a, int lda);
-
823 
-
842 int la_cholesky_factor_cmplx(bool upper, int n, double complex *a, int lda);
-
843 
-
861 int la_cholesky_rank1_update(int n, double *r, int ldr, double *u);
-
862 
-
880 int la_cholesky_rank1_update_cmplx(int n, double complex *r, int ldr,
-
881  double complex *u);
-
882 
-
902 int la_cholesky_rank1_downdate(int n, double *r, int ldr, double *u);
-
903 
-
923 int la_cholesky_rank1_downdate_cmplx(int n, double complex *r, int ldr,
-
924  double complex *u);
-
925 
-
955 int la_svd(int m, int n, double *a, int lda, double *s, double *u, int ldu,
-
956  double *vt, int ldv);
-
957 
-
987 int la_svd_cmplx(int m, int n, double complex *a, int lda, double *s,
-
988  double complex *u, int ldu, double complex *vt, int ldv);
-
989 
-
1018 int la_solve_tri_mtx(bool lside, bool upper, bool trans, bool nounit, int m,
-
1019  int n, double alpha, const double *a, int lda, double *b, int ldb);
-
1020 
-
1049 int la_solve_tri_mtx_cmplx(bool lside, bool upper, bool trans, bool nounit,
-
1050  int m, int n, double complex alpha, const double complex *a, int lda,
-
1051  double complex *b, int ldb);
-
1052 
-
1069 int la_solve_lu(int m, int n, const double *a, int lda, const int *ipvt,
-
1070  double *b, int ldb);
-
1071 
-
1088 int la_solve_lu_cmplx(int m, int n, const double complex *a, int lda,
-
1089  const int *ipvt, double complex *b, int ldb);
-
1090 
-
1114 int la_solve_qr(int m, int n, int k, double *a, int lda, const double *tau,
-
1115  double *b, int ldb);
-
1116 
-
1140 int la_solve_qr_cmplx(int m, int n, int k, double complex *a, int lda,
-
1141  const double complex *tau, double complex *b, int ldb);
-
1142 
-
1166 int la_solve_qr_pvt(int m, int n, int k, double *a, int lda, const double *tau,
-
1167  const int *jpvt, double *b, int ldb);
-
1168 
-
1192 int la_solve_qr_cmplx_pvt(int m, int n, int k, double complex *a, int lda,
-
1193  const double complex *tau, const int *jpvt, double complex *b, int ldb);
-
1194 
-
1213 int la_solve_cholesky(bool upper, int m, int n, const double *a, int lda,
-
1214  double *b, int ldb);
-
1215 
-
1234 int la_solve_cholesky_cmplx(bool upper, int m, int n, const double complex *a,
-
1235  int lda, double complex *b, int ldb);
-
1236 
-
1262 int la_solve_least_squares(int m, int n, int k, double *a, int lda, double *b,
-
1263  int ldb);
-
1264 
-
1290 int la_solve_least_squares_cmplx(int m, int n, int k, double complex *a,
-
1291  int lda, double complex *b, int ldb);
-
1292 
-
1306 int la_inverse(int n, double *a, int lda);
-
1307 
-
1321 int la_inverse_cmplx(int n, double complex *a, int lda);
-
1322 
-
1340 int la_pinverse(int m, int n, double *a, int lda, double *ainv, int ldai);
-
1341 
-
1359 int la_pinverse_cmplx(int m, int n, double complex *a, int lda,
-
1360  double complex *ainv, int ldai);
-
1361 
-
1385 int la_eigen_symm(bool vecs, int n, double *a, int lda, double *vals);
-
1386 
-
1409 int la_eigen_asymm(bool vecs, int n, double *a, int lda,
-
1410  double complex *vals, double complex *v, int ldv);
-
1411 
-
1447 int la_eigen_gen(bool vecs, int n, double *a, int lda, double *b, int ldb,
-
1448  double complex *alpha, double *beta, double complex *v, int ldv);
-
1449 
-
1472 int la_eigen_cmplx(bool vecs, int n, double complex *a, int lda,
-
1473  double complex *vals, double complex *v, int ldv);
-
1474 
-
1494 int la_sort_eigen(bool ascend, int n, double *vals, double *vecs, int ldv);
-
1495 
-
1515 int la_sort_eigen_cmplx(bool ascend, int n, double complex *vals,
-
1516  double complex *vecs, int ldv);
-
1517 
-
1518 #ifdef __cplusplus
-
1519 }
-
1520 #endif // __cplusplus
-
1521 #endif // LINALG_H_
+
1#ifndef LINALG_H_
+
2#define LINALG_H_
+
3
+
4#include <stdbool.h>
+
5#include <complex.h>
+
6
+
7#define LA_NO_OPERATION 0
+
8#define LA_TRANSPOSE 1
+
9#define LA_HERMITIAN_TRANSPOSE 2
+
10#define LA_NO_ERROR 0
+
11#define LA_INVALID_INPUT_ERROR 101
+
12#define LA_ARRAY_SIZE_ERROR 102
+
13#define LA_SINGULAR_MATRIX_ERROR 103
+
14#define LA_MATRIX_FORMAT_ERROR 104
+
15#define LA_OUT_OF_MEMORY_ERROR 105
+
16#define LA_CONVERGENCE_ERROR 106
+
17#define LA_INVALID_OPERATION_ERROR 107
+
18
+
19#ifdef __cplusplus
+
20extern "C" {
+
21#endif
+
22
+
41int la_rank1_update(int m, int n, double alpha, const double *x,
+
42 const double *y, double *a, int lda);
+
43
+
62int la_rank1_update_cmplx(int m, int n, double complex alpha,
+
63 const double complex *x, const double complex *y, double complex *a,
+
64 int lda);
+
65
+
80int la_trace(int m, int n, const double *a, int lda, double *rst);
+
81
+
96int la_trace_cmplx(int m, int n, const double complex *a, int lda,
+
97 double complex *rst);
+
98
+
125int la_mtx_mult(bool transa, bool transb, int m, int n, int k, double alpha,
+
126 const double *a, int lda, const double *b, int ldb, double beta,
+
127 double *c, int ldc);
+
128
+
157int la_mtx_mult_cmplx(int opa, int opb, int m, int n, int k,
+
158 double complex alpha, const double complex *a, int lda,
+
159 const double complex *b, int ldb, double complex beta, double complex *c,
+
160 int ldc);
+
161
+
195int la_diag_mtx_mult(bool lside, bool transb, int m, int n, int k,
+
196 double alpha, const double *a, const double *b, int ldb, double beta,
+
197 double *c, int ldc);
+
198
+
233int la_diag_mtx_mult_cmplx(bool lside, int opb, int m, int n, int k,
+
234 double complex alpha, const double complex *a, const double complex *b,
+
235 int ldb, double complex beta, double complex *c, int ldc);
+
236
+
271int la_diag_mtx_mult_mixed(bool lside, int opb, int m, int n, int k,
+
272 double complex alpha, const double *a, const double complex *b,
+
273 int ldb, double complex beta, double complex *c, int ldc);
+
274
+
293int la_rank(int m, int n, double *a, int lda, int *rnk);
+
294
+
313int la_rank_cmplx(int m, int n, double complex *a, int lda, int *rnk);
+
314
+
330int la_det(int n, double *a, int lda, double *d);
+
331
+
347int la_det_cmplx(int n, double complex *a, int lda, double complex *d);
+
348
+
374int la_tri_mtx_mult(bool upper, double alpha, int n, const double *a, int lda,
+
375 double beta, double *b, int ldb);
+
376
+
402int la_tri_mtx_mult_cmplx(bool upper, double complex alpha, int n,
+
403 const double complex *a, int lda, double complex beta,
+
404 double complex *b, int ldb);
+
405
+
425int la_lu_factor(int m, int n, double *a, int lda, int *ipvt);
+
426
+
446int la_lu_factor_cmplx(int m, int n, double complex *a, int lda, int *ipvt);
+
447
+
469int la_form_lu(int n, double *a, int lda, int *ipvt, double *u, int ldu,
+
470 double *p, int ldp);
+
471
+
493int la_form_lu_cmplx(int n, double complex *a, int lda, int *ipvt,
+
494 double complex *u, int ldu, double *p, int ldp);
+
495
+
517int la_qr_factor(int m, int n, double *a, int lda, double *tau);
+
518
+
540int la_qr_factor_cmplx(int m, int n, double complex *a, int lda,
+
541 double complex *tau);
+
542
+
567int la_qr_factor_pvt(int m, int n, double *a, int lda, double *tau, int *jpvt);
+
568
+
593int la_qr_factor_cmplx_pvt(int m, int n, double complex *a, int lda,
+
594 double complex *tau, int *jpvt);
+
595
+
622int la_form_qr(bool fullq, int m, int n, double *r, int ldr, const double *tau,
+
623 double *q, int ldq);
+
624
+
651int la_form_qr_cmplx(bool fullq, int m, int n, double complex *r, int ldr,
+
652 const double complex *tau, double complex *q, int ldq);
+
653
+
686int la_form_qr_pvt(bool fullq, int m, int n, double *r, int ldr,
+
687 const double *tau, const int *pvt, double *q, int ldq, double *p, int ldp);
+
688
+
721int la_form_qr_cmplx_pvt(bool fullq, int m, int n, double complex *r, int ldr,
+
722 const double complex *tau, const int *pvt, double complex *q, int ldq,
+
723 double complex *p, int ldp);
+
724
+
754int la_mult_qr(bool lside, bool trans, int m, int n, int k, double *a, int lda,
+
755 const double *tau, double *c, int ldc);
+
756
+
786int la_mult_qr_cmplx(bool lside, bool trans, int m, int n, int k,
+
787 double complex *a, int lda, const double complex *tau, double complex *c,
+
788 int ldc);
+
789
+
813int la_qr_rank1_update(int m, int n, double *q, int ldq, double *r, int ldr,
+
814 double *u, double *v);
+
815
+
839int la_qr_rank1_update_cmplx(int m, int n, double complex *q, int ldq,
+
840 double complex *r, int ldr, double complex *u, double complex *v);
+
841
+
860int la_cholesky_factor(bool upper, int n, double *a, int lda);
+
861
+
880int la_cholesky_factor_cmplx(bool upper, int n, double complex *a, int lda);
+
881
+
899int la_cholesky_rank1_update(int n, double *r, int ldr, double *u);
+
900
+
918int la_cholesky_rank1_update_cmplx(int n, double complex *r, int ldr,
+
919 double complex *u);
+
920
+
940int la_cholesky_rank1_downdate(int n, double *r, int ldr, double *u);
+
941
+
961int la_cholesky_rank1_downdate_cmplx(int n, double complex *r, int ldr,
+
962 double complex *u);
+
963
+
993int la_svd(int m, int n, double *a, int lda, double *s, double *u, int ldu,
+
994 double *vt, int ldv);
+
995
+
1025int la_svd_cmplx(int m, int n, double complex *a, int lda, double *s,
+
1026 double complex *u, int ldu, double complex *vt, int ldv);
+
1027
+
1056int la_solve_tri_mtx(bool lside, bool upper, bool trans, bool nounit, int m,
+
1057 int n, double alpha, const double *a, int lda, double *b, int ldb);
+
1058
+
1087int la_solve_tri_mtx_cmplx(bool lside, bool upper, bool trans, bool nounit,
+
1088 int m, int n, double complex alpha, const double complex *a, int lda,
+
1089 double complex *b, int ldb);
+
1090
+
1107int la_solve_lu(int m, int n, const double *a, int lda, const int *ipvt,
+
1108 double *b, int ldb);
+
1109
+
1126int la_solve_lu_cmplx(int m, int n, const double complex *a, int lda,
+
1127 const int *ipvt, double complex *b, int ldb);
+
1128
+
1152int la_solve_qr(int m, int n, int k, double *a, int lda, const double *tau,
+
1153 double *b, int ldb);
+
1154
+
1178int la_solve_qr_cmplx(int m, int n, int k, double complex *a, int lda,
+
1179 const double complex *tau, double complex *b, int ldb);
+
1180
+
1204int la_solve_qr_pvt(int m, int n, int k, double *a, int lda, const double *tau,
+
1205 const int *jpvt, double *b, int ldb);
+
1206
+
1230int la_solve_qr_cmplx_pvt(int m, int n, int k, double complex *a, int lda,
+
1231 const double complex *tau, const int *jpvt, double complex *b, int ldb);
+
1232
+
1251int la_solve_cholesky(bool upper, int m, int n, const double *a, int lda,
+
1252 double *b, int ldb);
+
1253
+
1272int la_solve_cholesky_cmplx(bool upper, int m, int n, const double complex *a,
+
1273 int lda, double complex *b, int ldb);
+
1274
+
1300int la_solve_least_squares(int m, int n, int k, double *a, int lda, double *b,
+
1301 int ldb);
+
1302
+
1328int la_solve_least_squares_cmplx(int m, int n, int k, double complex *a,
+
1329 int lda, double complex *b, int ldb);
+
1330
+
1344int la_inverse(int n, double *a, int lda);
+
1345
+
1359int la_inverse_cmplx(int n, double complex *a, int lda);
+
1360
+
1378int la_pinverse(int m, int n, double *a, int lda, double *ainv, int ldai);
+
1379
+
1397int la_pinverse_cmplx(int m, int n, double complex *a, int lda,
+
1398 double complex *ainv, int ldai);
+
1399
+
1423int la_eigen_symm(bool vecs, int n, double *a, int lda, double *vals);
+
1424
+
1447int la_eigen_asymm(bool vecs, int n, double *a, int lda,
+
1448 double complex *vals, double complex *v, int ldv);
+
1449
+
1482int la_eigen_gen(bool vecs, int n, double *a, int lda, double *b, int ldb,
+
1483 double complex *alpha, double *beta, double complex *v, int ldv);
+
1484
+
1507int la_eigen_cmplx(bool vecs, int n, double complex *a, int lda,
+
1508 double complex *vals, double complex *v, int ldv);
+
1509
+
1529int la_sort_eigen(bool ascend, int n, double *vals, double *vecs, int ldv);
+
1530
+
1550int la_sort_eigen_cmplx(bool ascend, int n, double complex *vals,
+
1551 double complex *vecs, int ldv);
+
1552
+
1553#ifdef __cplusplus
+
1554}
+
1555#endif // __cplusplus
+
1556#endif // LINALG_H_
+
integer(c_int) function la_qr_rank1_update_cmplx(m, n, q, ldq, r, ldr, u, v)
Computes the rank 1 update to an M-by-N QR factored matrix A (M >= N) where A = Q * R,...
+
integer(c_int) function la_qr_rank1_update(m, n, q, ldq, r, ldr, u, v)
Computes the rank 1 update to an M-by-N QR factored matrix A (M >= N) where A = Q * R,...
+
integer(c_int) function la_solve_qr_pvt(m, n, k, a, lda, tau, jpvt, b, ldb)
Solves a system of M QR-factored equations of N unknowns.
+
integer(c_int) function la_qr_factor_cmplx(m, n, a, lda, tau)
Computes the QR factorization of an M-by-N matrix without pivoting.
+
integer(c_int) function la_solve_qr(m, n, k, a, lda, tau, b, ldb)
Solves a system of M QR-factored equations of N unknowns where M >= N.
+
integer(c_int) function la_lu_factor_cmplx(m, n, a, lda, ipvt)
Computes the LU factorization of an M-by-N matrix.
+
integer(c_int) function la_solve_qr_cmplx_pvt(m, n, k, a, lda, tau, jpvt, b, ldb)
Solves a system of M QR-factored equations of N unknowns.
+
integer(c_int) function la_diag_mtx_mult_cmplx(lside, opb, m, n, k, alpha, a, b, ldb, beta, c, ldc)
Computes the matrix operation: C = alpha * A * op(B) + beta * C, or C = alpha * op(B) * A + beta * C.
+
integer(c_int) function la_mult_qr(lside, trans, m, n, k, a, lda, tau, c, ldc)
Multiplies a general matrix by the orthogonal matrix Q from a QR factorization such that: C = op(Q) *...
+
integer(c_int) function la_sort_eigen_cmplx(ascend, n, vals, vecs, ldv)
A sorting routine specifically tailored for sorting of eigenvalues and their associated eigenvectors ...
+
integer(c_int) function la_solve_least_squares_cmplx(m, n, k, a, lda, b, ldb)
Solves the overdetermined or underdetermined system (A*X = B) of M equations of N unknowns using a QR...
+
integer(c_int) function la_qr_factor(m, n, a, lda, tau)
Computes the QR factorization of an M-by-N matrix without pivoting.
+
integer(c_int) function la_inverse(n, a, lda)
Computes the inverse of a square matrix.
+
integer(c_int) function la_trace_cmplx(m, n, a, lda, rst)
Computes the trace of a matrix (the sum of the main diagonal elements).
+
integer(c_int) function la_cholesky_rank1_downdate_cmplx(n, r, ldr, u)
Computes the rank 1 downdate to a Cholesky factored matrix (upper triangular).
+
integer(c_int) function la_rank(m, n, a, lda, rnk)
Computes the rank of a matrix.
+
integer(c_int) function la_pinverse(m, n, a, lda, ainv, ldai)
Computes the Moore-Penrose pseudo-inverse of an M-by-N matrix by means of singular value decompositio...
+
integer(c_int) function la_lu_factor(m, n, a, lda, ipvt)
Computes the LU factorization of an M-by-N matrix.
+
integer(c_int) function la_mtx_mult(transa, transb, m, n, k, alpha, a, lda, b, ldb, beta, c, ldc)
Computes the matrix operation C = alpha * op(A) * op(B) + beta * C.
+
integer(c_int) function la_svd(m, n, a, lda, s, u, ldu, vt, ldv)
Computes the singular value decomposition of a matrix A. The SVD is defined as: A = U * S * V**T,...
+
integer(c_int) function la_svd_cmplx(m, n, a, lda, s, u, ldu, vt, ldv)
Computes the singular value decomposition of a matrix A. The SVD is defined as: A = U * S * V**T,...
+
integer(c_int) function la_mult_qr_cmplx(lside, trans, m, n, k, a, lda, tau, c, ldc)
Multiplies a general matrix by the orthogonal matrix Q from a QR factorization such that: C = op(Q) *...
+
integer(c_int) function la_form_qr_cmplx_pvt(fullq, m, n, r, ldr, tau, pvt, q, ldq, p, ldp)
Forms the full M-by-M orthogonal matrix Q from the elementary reflectors returned by the base QR fact...
+
integer(c_int) function la_cholesky_rank1_update_cmplx(n, r, ldr, u)
Computes the rank 1 update to a Cholesky factored matrix (upper triangular).
+
integer(c_int) function la_cholesky_rank1_downdate(n, r, ldr, u)
Computes the rank 1 downdate to a Cholesky factored matrix (upper triangular).
+
integer(c_int) function la_rank_cmplx(m, n, a, lda, rnk)
Computes the rank of a matrix.
+
integer(c_int) function la_eigen_symm(vecs, n, a, lda, vals)
Computes the eigenvalues, and optionally the eigenvectors of a real, symmetric matrix.
+
integer(c_int) function la_form_qr_pvt(fullq, m, n, r, ldr, tau, pvt, q, ldq, p, ldp)
Forms the full M-by-M orthogonal matrix Q from the elementary reflectors returned by the base QR fact...
+
integer(c_int) function la_rank1_update(m, n, alpha, x, y, a, lda)
Performs the rank-1 update to matrix A such that: A = alpha * X * Y**T + A, where A is an M-by-N matr...
+
integer(c_int) function la_inverse_cmplx(n, a, lda)
Computes the inverse of a square matrix.
+
integer(c_int) function la_tri_mtx_mult(upper, alpha, n, a, lda, beta, b, ldb)
Computes the triangular matrix operation: B = alpha * A**T * A + beta * B, or B = alpha * A * A**T + ...
+
integer(c_int) function la_solve_tri_mtx(lside, upper, trans, nounit, m, n, alpha, a, lda, b, ldb)
Solves one of the matrix equations: op(A) * X = alpha * B, or X * op(A) = alpha * B,...
+
integer(c_int) function la_solve_tri_mtx_cmplx(lside, upper, trans, nounit, m, n, alpha, a, lda, b, ldb)
Solves one of the matrix equations: op(A) * X = alpha * B, or X * op(A) = alpha * B,...
+
integer(c_int) function la_cholesky_factor_cmplx(upper, n, a, lda)
Computes the Cholesky factorization of a symmetric, positive definite matrix.
+
integer(c_int) function la_det_cmplx(n, a, lda, d)
Computes the determinant of a square matrix.
+
integer(c_int) function la_solve_cholesky_cmplx(upper, m, n, a, lda, b, ldb)
Solves a system of Cholesky factored equations.
+
integer(c_int) function la_solve_lu(m, n, a, lda, ipvt, b, ldb)
Solves a system of LU-factored equations.
+
integer(c_int) function la_eigen_gen(vecs, n, a, lda, b, ldb, alpha, beta, v, ldv)
Computes the eigenvalues, and optionally the right eigenvectors of a square matrix assuming the struc...
+
integer(c_int) function la_form_qr(fullq, m, n, r, ldr, tau, q, ldq)
Forms the full M-by-M orthogonal matrix Q from the elementary reflectors returned by the base QR fact...
+
integer(c_int) function la_qr_factor_pvt(m, n, a, lda, tau, jpvt)
Computes the QR factorization of an M-by-N matrix with column pivoting.
+
integer(c_int) function la_cholesky_factor(upper, n, a, lda)
Computes the Cholesky factorization of a symmetric, positive definite matrix.
+
integer(c_int) function la_form_qr_cmplx(fullq, m, n, r, ldr, tau, q, ldq)
Forms the full M-by-M orthogonal matrix Q from the elementary reflectors returned by the base QR fact...
+
integer(c_int) function la_qr_factor_cmplx_pvt(m, n, a, lda, tau, jpvt)
Computes the QR factorization of an M-by-N matrix with column pivoting.
+
integer(c_int) function la_solve_lu_cmplx(m, n, a, lda, ipvt, b, ldb)
Solves a system of LU-factored equations.
+
integer(c_int) function la_eigen_cmplx(vecs, n, a, lda, vals, v, ldv)
Computes the eigenvalues, and optionally the right eigenvectors of a square matrix.
+
integer(c_int) function la_sort_eigen(ascend, n, vals, vecs, ldv)
A sorting routine specifically tailored for sorting of eigenvalues and their associated eigenvectors ...
+
integer(c_int) function la_mtx_mult_cmplx(opa, opb, m, n, k, alpha, a, lda, b, ldb, beta, c, ldc)
Computes the matrix operation C = alpha * op(A) * op(B) + beta * C.
+
integer(c_int) function la_solve_cholesky(upper, m, n, a, lda, b, ldb)
Solves a system of Cholesky factored equations.
+
integer(c_int) function la_rank1_update_cmplx(m, n, alpha, x, y, a, lda)
Performs the rank-1 update to matrix A such that: A = alpha * X * Y**T + A, where A is an M-by-N matr...
+
integer(c_int) function la_solve_qr_cmplx(m, n, k, a, lda, tau, b, ldb)
Solves a system of M QR-factored equations of N unknowns where M >= N.
+
integer(c_int) function la_pinverse_cmplx(m, n, a, lda, ainv, ldai)
Computes the Moore-Penrose pseudo-inverse of an M-by-N matrix by means of singular value decompositio...
+
integer(c_int) function la_diag_mtx_mult_mixed(lside, opb, m, n, k, alpha, a, b, ldb, beta, c, ldc)
Computes the matrix operation: C = alpha * A * op(B) + beta * C, or C = alpha * op(B) * A + beta * C.
+
integer(c_int) function la_cholesky_rank1_update(n, r, ldr, u)
Computes the rank 1 update to a Cholesky factored matrix (upper triangular).
+
integer(c_int) function la_diag_mtx_mult(lside, transb, m, n, k, alpha, a, b, ldb, beta, c, ldc)
Computes the matrix operation: C = alpha * A * op(B) + beta * C, or C = alpha * op(B) * A + beta * C.
+
integer(c_int) function la_form_lu_cmplx(n, a, lda, ipvt, u, ldu, p, ldp)
Extracts the L, U, and P matrices from the LU factorization output from la_lu_factor.
+
integer(c_int) function la_form_lu(n, a, lda, ipvt, u, ldu, p, ldp)
Extracts the L, U, and P matrices from the LU factorization output from la_lu_factor.
+
integer(c_int) function la_tri_mtx_mult_cmplx(upper, alpha, n, a, lda, beta, b, ldb)
Computes the triangular matrix operation: B = alpha * A**T * A + beta * B, or B = alpha * A * A**T + ...
+
integer(c_int) function la_solve_least_squares(m, n, k, a, lda, b, ldb)
Solves the overdetermined or underdetermined system (A*X = B) of M equations of N unknowns using a QR...
+
integer(c_int) function la_eigen_asymm(vecs, n, a, lda, vals, v, ldv)
Computes the eigenvalues, and optionally the right eigenvectors of a square matrix.
+
integer(c_int) function la_trace(m, n, a, lda, rst)
Computes the trace of a matrix (the sum of the main diagonal elements).
+
integer(c_int) function la_det(n, a, lda, d)
Computes the determinant of a square matrix.
-
integer(c_int) function la_diag_mtx_mult(lside, transb, m, n, k, alpha, a, b, ldb, beta, c, ldc)
Computes the matrix operation: C = alpha * A * op(B) + beta * C, or C = alpha * op(B) * A + beta * C.
-
integer(c_int) function la_eigen_gen(vecs, n, a, lda, b, ldb, alpha, beta, v, ldv)
Computes the eigenvalues, and optionally the right eigenvectors of a square matrix assuming the struc...
-
integer(c_int) function la_rank_cmplx(m, n, a, lda, rnk)
Computes the rank of a matrix.
-
integer(c_int) function la_rank1_update(m, n, alpha, x, y, a, lda)
Performs the rank-1 update to matrix A such that: A = alpha * X * Y**T + A, where A is an M-by-N matr...
-
integer(c_int) function la_solve_cholesky(upper, m, n, a, lda, b, ldb)
Solves a system of Cholesky factored equations.
-
integer(c_int) function la_cholesky_rank1_update(n, r, ldr, u)
Computes the rank 1 update to a Cholesky factored matrix (upper triangular).
-
integer(c_int) function la_rank1_update_cmplx(m, n, alpha, x, y, a, lda)
Performs the rank-1 update to matrix A such that: A = alpha * X * Y**T + A, where A is an M-by-N matr...
-
integer(c_int) function la_solve_tri_mtx(lside, upper, trans, nounit, m, n, alpha, a, lda, b, ldb)
Solves one of the matrix equations: op(A) * X = alpha * B, or X * op(A) = alpha * B,...
-
integer(c_int) function la_solve_qr_cmplx(m, n, k, a, lda, tau, b, ldb)
Solves a system of M QR-factored equations of N unknowns where M >= N.
-
integer(c_int) function la_eigen_cmplx(vecs, n, a, lda, vals, v, ldv)
Computes the eigenvalues, and optionally the right eigenvectors of a square matrix.
-
integer(c_int) function la_sort_eigen(ascend, n, vals, vecs, ldv)
A sorting routine specifically tailored for sorting of eigenvalues and their associated eigenvectors ...
-
integer(c_int) function la_solve_qr_cmplx_pvt(m, n, k, a, lda, tau, jpvt, b, ldb)
Solves a system of M QR-factored equations of N unknowns.
-
integer(c_int) function la_trace(m, n, a, lda, rst)
Computes the trace of a matrix (the sum of the main diagonal elements).
-
integer(c_int) function la_eigen_symm(vecs, n, a, lda, vals)
Computes the eigenvalues, and optionally the eigenvectors of a real, symmetric matrix.
-
integer(c_int) function la_qr_rank1_update(m, n, q, ldq, r, ldr, u, v)
Computes the rank 1 update to an M-by-N QR factored matrix A (M >= N) where A = Q * R,...
-
integer(c_int) function la_form_qr_pvt(fullq, m, n, r, ldr, tau, pvt, q, ldq, p, ldp)
Forms the full M-by-M orthogonal matrix Q from the elementary reflectors returned by the base QR fact...
-
integer(c_int) function la_cholesky_rank1_downdate(n, r, ldr, u)
Computes the rank 1 downdate to a Cholesky factored matrix (upper triangular).
-
integer(c_int) function la_mtx_mult_cmplx(opa, opb, m, n, k, alpha, a, lda, b, ldb, beta, c, ldc)
Computes the matrix operation C = alpha * op(A) * op(B) + beta * C.
-
integer(c_int) function la_mult_qr_cmplx(lside, trans, m, n, k, a, lda, tau, c, ldc)
Multiplies a general matrix by the orthogonal matrix Q from a QR factorization such that: C = op(Q) *...
-
integer(c_int) function la_form_qr_cmplx(fullq, m, n, r, ldr, tau, q, ldq)
Forms the full M-by-M orthogonal matrix Q from the elementary reflectors returned by the base QR fact...
-
integer(c_int) function la_trace_cmplx(m, n, a, lda, rst)
Computes the trace of a matrix (the sum of the main diagonal elements).
-
integer(c_int) function la_inverse_cmplx(n, a, lda)
Computes the inverse of a square matrix.
-
integer(c_int) function la_eigen_asymm(vecs, n, a, lda, vals, v, ldv)
Computes the eigenvalues, and optionally the right eigenvectors of a square matrix.
-
integer(c_int) function la_solve_tri_mtx_cmplx(lside, upper, trans, nounit, m, n, alpha, a, lda, b, ldb)
Solves one of the matrix equations: op(A) * X = alpha * B, or X * op(A) = alpha * B,...
-
integer(c_int) function la_cholesky_rank1_update_cmplx(n, r, ldr, u)
Computes the rank 1 update to a Cholesky factored matrix (upper triangular).
-
integer(c_int) function la_cholesky_rank1_downdate_cmplx(n, r, ldr, u)
Computes the rank 1 downdate to a Cholesky factored matrix (upper triangular).
-
integer(c_int) function la_rank(m, n, a, lda, rnk)
Computes the rank of a matrix.
-
integer(c_int) function la_tri_mtx_mult_cmplx(upper, alpha, n, a, lda, beta, b, ldb)
Computes the triangular matrix operation: B = alpha * A**T * A + beta * B, or B = alpha * A * A**T + ...
-
integer(c_int) function la_svd(m, n, a, lda, s, u, ldu, vt, ldv)
Computes the singular value decomposition of a matrix A. The SVD is defined as: A = U * S * V**T,...
-
integer(c_int) function la_sort_eigen_cmplx(ascend, n, vals, vecs, ldv)
A sorting routine specifically tailored for sorting of eigenvalues and their associated eigenvectors ...
-
integer(c_int) function la_qr_rank1_update_cmplx(m, n, q, ldq, r, ldr, u, v)
Computes the rank 1 update to an M-by-N QR factored matrix A (M >= N) where A = Q * R,...
-
integer(c_int) function la_qr_factor_cmplx_pvt(m, n, a, lda, tau, jpvt)
Computes the QR factorization of an M-by-N matrix with column pivoting.
-
integer(c_int) function la_cholesky_factor(upper, n, a, lda)
Computes the Cholesky factorization of a symmetric, positive definite matrix.
-
integer(c_int) function la_solve_qr(m, n, k, a, lda, tau, b, ldb)
Solves a system of M QR-factored equations of N unknowns where M >= N.
-
integer(c_int) function la_solve_least_squares_cmplx(m, n, k, a, lda, b, ldb)
Solves the overdetermined or underdetermined system (A*X = B) of M equations of N unknowns using a QR...
-
integer(c_int) function la_form_qr_cmplx_pvt(fullq, m, n, r, ldr, tau, pvt, q, ldq, p, ldp)
Forms the full M-by-M orthogonal matrix Q from the elementary reflectors returned by the base QR fact...
-
integer(c_int) function la_solve_lu_cmplx(m, n, a, lda, ipvt, b, ldb)
Solves a system of LU-factored equations.
-
integer(c_int) function la_pinverse(m, n, a, lda, ainv, ldai)
Computes the Moore-Penrose pseudo-inverse of an M-by-N matrix by means of singular value decompositio...
-
integer(c_int) function la_qr_factor_cmplx(m, n, a, lda, tau)
Computes the QR factorization of an M-by-N matrix without pivoting.
-
integer(c_int) function la_tri_mtx_mult(upper, alpha, n, a, lda, beta, b, ldb)
Computes the triangular matrix operation: B = alpha * A**T * A + beta * B, or B = alpha * A * A**T + ...
-
integer(c_int) function la_form_lu(n, a, lda, ipvt, u, ldu, p, ldp)
Extracts the L, U, and P matrices from the LU factorization output from la_lu_factor.
-
integer(c_int) function la_pinverse_cmplx(m, n, a, lda, ainv, ldai)
Computes the Moore-Penrose pseudo-inverse of an M-by-N matrix by means of singular value decompositio...
-
integer(c_int) function la_diag_mtx_mult_cmplx(lside, opb, m, n, k, alpha, a, b, ldb, beta, c, ldc)
Computes the matrix operation: C = alpha * A * op(B) + beta * C, or C = alpha * op(B) * A + beta * C.
-
integer(c_int) function la_cholesky_factor_cmplx(upper, n, a, lda)
Computes the Cholesky factorization of a symmetric, positive definite matrix.
-
integer(c_int) function la_lu_factor(m, n, a, lda, ipvt)
Computes the LU factorization of an M-by-N matrix.
-
integer(c_int) function la_solve_lu(m, n, a, lda, ipvt, b, ldb)
Solves a system of LU-factored equations.
-
integer(c_int) function la_svd_cmplx(m, n, a, lda, s, u, ldu, vt, ldv)
Computes the singular value decomposition of a matrix A. The SVD is defined as: A = U * S * V**T,...
-
integer(c_int) function la_solve_qr_pvt(m, n, k, a, lda, tau, jpvt, b, ldb)
Solves a system of M QR-factored equations of N unknowns.
-
integer(c_int) function la_form_qr(fullq, m, n, r, ldr, tau, q, ldq)
Forms the full M-by-M orthogonal matrix Q from the elementary reflectors returned by the base QR fact...
-
integer(c_int) function la_solve_least_squares(m, n, k, a, lda, b, ldb)
Solves the overdetermined or underdetermined system (A*X = B) of M equations of N unknowns using a QR...
-
integer(c_int) function la_lu_factor_cmplx(m, n, a, lda, ipvt)
Computes the LU factorization of an M-by-N matrix.
-
integer(c_int) function la_inverse(n, a, lda)
Computes the inverse of a square matrix.
-
integer(c_int) function la_qr_factor_pvt(m, n, a, lda, tau, jpvt)
Computes the QR factorization of an M-by-N matrix with column pivoting.
-
integer(c_int) function la_solve_cholesky_cmplx(upper, m, n, a, lda, b, ldb)
Solves a system of Cholesky factored equations.
-
integer(c_int) function la_det_cmplx(n, a, lda, d)
Computes the determinant of a square matrix.
-
integer(c_int) function la_qr_factor(m, n, a, lda, tau)
Computes the QR factorization of an M-by-N matrix without pivoting.
-
integer(c_int) function la_mult_qr(lside, trans, m, n, k, a, lda, tau, c, ldc)
Multiplies a general matrix by the orthogonal matrix Q from a QR factorization such that: C = op(Q) *...
-
integer(c_int) function la_mtx_mult(transa, transb, m, n, k, alpha, a, lda, b, ldb, beta, c, ldc)
Computes the matrix operation C = alpha * op(A) * op(B) + beta * C.
-
integer(c_int) function la_form_lu_cmplx(n, a, lda, ipvt, u, ldu, p, ldp)
Extracts the L, U, and P matrices from the LU factorization output from la_lu_factor.
-
integer(c_int) function la_det(n, a, lda, d)
Computes the determinant of a square matrix.
diff --git a/doc/html/linalg__basic_8f90_source.html b/doc/html/linalg__basic_8f90_source.html index 679b0124..dd2ba0be 100644 --- a/doc/html/linalg__basic_8f90_source.html +++ b/doc/html/linalg__basic_8f90_source.html @@ -1,11 +1,11 @@ - + - - + + -linalg: C:/Users/jchri/Documents/github/linalg/src/linalg_basic.f90 Source File +linalg: D:/Code/linalg/src/linalg_basic.f90 Source File @@ -13,13 +13,16 @@ - + + @@ -27,10 +30,9 @@
- - + @@ -39,21 +41,22 @@
-
linalg -  1.6.0 +
+
linalg 1.6.1
A linear algebra library that provides a user-friendly interface to several BLAS and LAPACK routines.
- + +/* @license-end */ +
@@ -67,8 +70,8 @@
@@ -81,1979 +84,2211 @@
- +
+
+
+
+
Loading...
+
Searching...
+
No Matches
+
+
+
-
-
linalg_basic.f90
+
linalg_basic.f90
-
1 ! linalg_basic.f90
-
2 
-
3 submodule(linalg_core) linalg_basic
-
4 contains
-
5 ! ******************************************************************************
-
6 ! MATRIX MULTIPLICATION ROUTINES
-
7 ! ------------------------------------------------------------------------------
-
8  module subroutine mtx_mult_mtx(transa, transb, alpha, a, b, beta, c, err)
-
9  ! Arguments
-
10  logical, intent(in) :: transa, transb
-
11  real(real64), intent(in) :: alpha, beta
-
12  real(real64), intent(in), dimension(:,:) :: a, b
-
13  real(real64), intent(inout), dimension(:,:) :: c
-
14  class(errors), intent(inout), optional, target :: err
-
15 
-
16  ! Parameters
-
17  real(real64), parameter :: zero = 0.0d0
-
18  real(real64), parameter :: one = 1.0d0
-
19 
-
20  ! Local Variables
-
21  character :: ta, tb
-
22  integer(int32) :: m, n, k, lda, ldb, flag
-
23  class(errors), pointer :: errmgr
-
24  type(errors), target :: deferr
-
25  character(len = 128) :: errmsg
-
26 
-
27  ! Initialization
-
28  m = size(c, 1)
-
29  n = size(c, 2)
-
30  if (transa) then ! K = # of columns in op(A) (# of rows in op(B))
-
31  k = size(a, 1)
-
32  ta = 'T'
-
33  lda = k
-
34  else
-
35  k = size(a, 2)
-
36  ta = 'N'
-
37  lda = m
-
38  end if
-
39  if (transb) then
-
40  tb = 'T'
-
41  ldb = n
-
42  else
-
43  tb = 'N'
-
44  ldb = k
-
45  end if
-
46  if (present(err)) then
-
47  errmgr => err
-
48  else
-
49  errmgr => deferr
-
50  end if
-
51 
-
52  ! Input Check
-
53  flag = 0
-
54  if (transa) then
-
55  if (size(a, 2) /= m) flag = 4
-
56  else
-
57  if (size(a, 1) /= m) flag = 4
-
58  end if
-
59  if (transb) then
-
60  if (size(b, 2) /= k .or. size(b, 1) /= n) flag = 5
-
61  else
-
62  if (size(b, 1) /= k .or. size(b, 2) /= n) flag = 5
-
63  end if
-
64  if (flag /= 0) then
-
65  ! ERROR: Matrix dimensions mismatch
-
66  write(errmsg, '(AI0A)') &
-
67  "Matrix dimension mismatch. Input number ", flag, &
-
68  " was not sized correctly."
-
69  call errmgr%report_error("mtx_mult_mtx", errmsg, &
-
70  la_array_size_error)
-
71  return
-
72  end if
-
73 
-
74  ! Call DGEMM
-
75  call dgemm(ta, tb, m, n, k, alpha, a, lda, b, ldb, beta, c, m)
-
76  end subroutine
-
77 
-
78 ! ------------------------------------------------------------------------------
-
79  module subroutine mtx_mult_vec(trans, alpha, a, b, beta, c, err)
-
80  ! Arguments
-
81  logical, intent(in) :: trans
-
82  real(real64), intent(in) :: alpha, beta
-
83  real(real64), intent(in), dimension(:,:) :: a
-
84  real(real64), intent(in), dimension(:) :: b
-
85  real(real64), intent(inout), dimension(:) :: c
-
86  class(errors), intent(inout), optional, target :: err
-
87 
-
88  ! Local Variables
-
89  character :: t
-
90  integer(int32) :: m, n, flag
-
91  class(errors), pointer :: errmgr
-
92  type(errors), target :: deferr
-
93  character(len = 128) :: errmsg
-
94 
-
95  ! Initialization
-
96  m = size(a, 1)
-
97  n = size(a, 2)
-
98  t = 'N'
-
99  if (trans) t = 'T'
-
100  if (present(err)) then
-
101  errmgr => err
-
102  else
-
103  errmgr => deferr
-
104  end if
-
105 
-
106  ! Input Check
-
107  flag = 0
-
108  if (trans) then
-
109  if (size(b) /= m) then
-
110  flag = 4
-
111  else if (size(c) /= n) then
-
112  flag = 6
-
113  end if
-
114  else
-
115  if (size(b) /= n) then
-
116  flag = 4
-
117  else if (size(c) /= m) then
-
118  flag = 6
-
119  end if
-
120  end if
-
121  if (flag /= 0) then
-
122  ! ERROR: Matrix dimensions mismatch
-
123  write(errmsg, '(AI0A)') &
-
124  "Matrix dimension mismatch. Input number ", flag, &
-
125  " was not sized correctly."
-
126  call errmgr%report_error("mtx_mult_vec", errmsg, &
-
127  la_array_size_error)
-
128  return
-
129  end if
-
130 
-
131  ! Call DGEMV
-
132  call dgemv(t, m, n, alpha, a, m, b, 1, beta, c, 1)
-
133  end subroutine
-
134 
-
135 ! xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx !
-
136 ! COMPLEX VALUED VERSIONS !
-
137 ! xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx !
-
138  module subroutine cmtx_mult_mtx(opa, opb, alpha, a, b, beta, c, err)
-
139  ! Arguments
-
140  integer(int32), intent(in) :: opa, opb
-
141  complex(real64), intent(in) :: alpha, beta
-
142  complex(real64), intent(in), dimension(:,:) :: a, b
-
143  complex(real64), intent(inout), dimension(:,:) :: c
-
144  class(errors), intent(inout), optional, target :: err
-
145 
-
146  ! Parameters
-
147  real(real64), parameter :: zero = 0.0d0
-
148  real(real64), parameter :: one = 1.0d0
-
149 
-
150  ! Local Variables
-
151  character :: ta, tb
-
152  integer(int32) :: m, n, k, lda, ldb, flag
-
153  class(errors), pointer :: errmgr
-
154  type(errors), target :: deferr
-
155  character(len = 128) :: errmsg
-
156 
-
157  ! Initialization
-
158  m = size(c, 1)
-
159  n = size(c, 2)
-
160  if (opa == transpose) then ! K = # of columns in op(A) (# of rows in op(B))
-
161  k = size(a, 1)
-
162  ta = 'T'
-
163  lda = k
-
164  else if (opa == hermitian_transpose) then
-
165  k = size(a, 1)
-
166  ta = 'H'
-
167  lda = k
-
168  else
-
169  k = size(a, 2)
-
170  ta = 'N'
-
171  lda = m
-
172  end if
-
173  if (opb == transpose) then
-
174  tb = 'T'
-
175  ldb = n
-
176  else if (opb == hermitian_transpose) then
-
177  tb = 'H'
-
178  ldb = n
-
179  else
-
180  tb = 'N'
-
181  ldb = k
-
182  end if
-
183  if (present(err)) then
-
184  errmgr => err
-
185  else
-
186  errmgr => deferr
-
187  end if
-
188 
-
189  ! Input Check
-
190  flag = 0
-
191  if (opa == transpose .or. opa == hermitian_transpose) then
-
192  if (size(a, 2) /= m) flag = 4
-
193  else
-
194  if (size(a, 1) /= m) flag = 4
-
195  end if
-
196  if (opb == transpose .or. opb == hermitian_transpose) then
-
197  if (size(b, 2) /= k .or. size(b, 1) /= n) flag = 5
-
198  else
-
199  if (size(b, 1) /= k .or. size(b, 2) /= n) flag = 5
-
200  end if
-
201  if (flag /= 0) then
-
202  ! ERROR: Matrix dimensions mismatch
-
203  write(errmsg, '(AI0A)') &
-
204  "Matrix dimension mismatch. Input number ", flag, &
-
205  " was not sized correctly."
-
206  call errmgr%report_error("cmtx_mult_mtx", errmsg, &
-
207  la_array_size_error)
-
208  return
-
209  end if
-
210 
-
211  ! Call ZGEMM
-
212  call zgemm(ta, tb, m, n, k, alpha, a, lda, b, ldb, beta, c, m)
-
213  end subroutine
-
214 
-
215 ! ------------------------------------------------------------------------------
-
216  module subroutine cmtx_mult_vec(opa, alpha, a, b, beta, c, err)
-
217  ! Arguments
-
218  integer(int32), intent(in) :: opa
-
219  complex(real64), intent(in) :: alpha, beta
-
220  complex(real64), intent(in), dimension(:,:) :: a
-
221  complex(real64), intent(in), dimension(:) :: b
-
222  complex(real64), intent(inout), dimension(:) :: c
-
223  class(errors), intent(inout), optional, target :: err
-
224 
-
225  ! Local Variables
-
226  character :: t
-
227  integer(int32) :: m, n, flag
-
228  class(errors), pointer :: errmgr
-
229  type(errors), target :: deferr
-
230  character(len = 128) :: errmsg
-
231 
-
232  ! Initialization
-
233  m = size(a, 1)
-
234  n = size(a, 2)
-
235  if (opa == transpose) then
-
236  t = 'T'
-
237  else if (opa == hermitian_transpose) then
-
238  t = 'H'
-
239  else
-
240  t = 'N'
-
241  end if
-
242  if (present(err)) then
-
243  errmgr => err
-
244  else
-
245  errmgr => deferr
-
246  end if
-
247 
-
248  ! Input Check
-
249  flag = 0
-
250  if (opa == transpose .or. opa == hermitian_transpose) then
-
251  if (size(b) /= m) then
-
252  flag = 4
-
253  else if (size(c) /= n) then
-
254  flag = 6
-
255  end if
-
256  else
-
257  if (size(b) /= n) then
-
258  flag = 4
-
259  else if (size(c) /= m) then
-
260  flag = 6
-
261  end if
-
262  end if
-
263  if (flag /= 0) then
-
264  ! ERROR: Matrix dimensions mismatch
-
265  write(errmsg, '(AI0A)') &
-
266  "Matrix dimension mismatch. Input number ", flag, &
-
267  " was not sized correctly."
-
268  call errmgr%report_error("cmtx_mult_vec", errmsg, &
-
269  la_array_size_error)
-
270  return
-
271  end if
-
272 
-
273  ! Call ZGEMV
-
274  call zgemv(t, m, n, alpha, a, m, b, 1, beta, c, 1)
-
275  end subroutine
-
276 
-
277 ! ******************************************************************************
-
278 ! RANK 1 UPDATE
-
279 ! ------------------------------------------------------------------------------
-
280  module subroutine rank1_update_dbl(alpha, x, y, a, err)
-
281  ! Arguments
-
282  real(real64), intent(in) :: alpha
-
283  real(real64), intent(in), dimension(:) :: x, y
-
284  real(real64), intent(inout), dimension(:,:) :: a
-
285  class(errors), intent(inout), optional, target :: err
-
286 
-
287  ! Parameters
-
288  real(real64), parameter :: zero = 0.0d0
-
289 
-
290  ! Local Variables
-
291  integer(int32) :: j, m, n
-
292  real(real64) :: temp
-
293  class(errors), pointer :: errmgr
-
294  type(errors), target :: deferr
-
295 
-
296  ! Initialization
-
297  m = size(x)
-
298  n = size(y)
-
299  if (present(err)) then
-
300  errmgr => err
-
301  else
-
302  errmgr => deferr
-
303  end if
-
304 
-
305  ! Input Check
-
306  if (size(a, 1) /= m .or. size(a, 2) /= n) then
-
307  ! ERROR: Matrix dimension array
-
308  call errmgr%report_error("rank1_update_dbl", &
-
309  "Matrix dimension mismatch.", la_array_size_error)
-
310  return
-
311  end if
-
312 
-
313  ! Process
-
314  do j = 1, n
-
315  if (y(j) /= zero) then
-
316  temp = alpha * y(j)
-
317  a(:,j) = a(:,j) + temp * x
-
318  end if
-
319  end do
-
320  end subroutine
-
321 
-
322 ! xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx !
-
323 ! COMPLEX VALUED VERSIONS !
-
324 ! xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx !
-
325  module subroutine rank1_update_cmplx(alpha, x, y, a, err)
-
326  ! Arguments
-
327  complex(real64), intent(in) :: alpha
-
328  complex(real64), intent(in), dimension(:) :: x, y
-
329  complex(real64), intent(inout), dimension(:,:) :: a
-
330  class(errors), intent(inout), optional, target :: err
-
331 
-
332  ! Parameters
-
333  complex(real64), parameter :: zero = (0.0d0, 0.0d0)
-
334 
-
335  ! Local Variables
-
336  integer(int32) :: j, m, n
-
337  complex(real64) :: temp
-
338  class(errors), pointer :: errmgr
-
339  type(errors), target :: deferr
-
340 
-
341  ! Initialization
-
342  m = size(x)
-
343  n = size(y)
-
344  if (present(err)) then
-
345  errmgr => err
-
346  else
-
347  errmgr => deferr
-
348  end if
-
349 
-
350  ! Input Check
-
351  if (size(a, 1) /= m .or. size(a, 2) /= n) then
-
352  ! ERROR: Matrix dimension array
-
353  call errmgr%report_error("rank1_update_cmplx", &
-
354  "Matrix dimension mismatch.", la_array_size_error)
-
355  return
-
356  end if
-
357 
-
358  ! Process
-
359  do j = 1, n
-
360  if (y(j) /= zero) then
-
361  temp = alpha * conjg(y(j))
-
362  a(:,j) = a(:,j) + temp * x
-
363  end if
-
364  end do
-
365  end subroutine
-
366 
-
367 ! ******************************************************************************
-
368 ! DIAGONAL MATRIX MULTIPLICATION ROUTINES
-
369 ! ------------------------------------------------------------------------------
-
370  module subroutine diag_mtx_mult_mtx(lside, trans, alpha, a, b, beta, c, err)
-
371  ! Arguments
-
372  logical, intent(in) :: lside, trans
-
373  real(real64) :: alpha, beta
-
374  real(real64), intent(in), dimension(:) :: a
-
375  real(real64), intent(in), dimension(:,:) :: b
-
376  real(real64), intent(inout), dimension(:,:) :: c
-
377  class(errors), intent(inout), optional, target :: err
-
378 
-
379  ! Parameters
-
380  real(real64), parameter :: zero = 0.0d0
-
381  real(real64), parameter :: one = 1.0d0
-
382 
-
383  ! Local Variables
-
384  integer(int32) :: i, m, n, k, nrowb, ncolb, flag
-
385  real(real64) :: temp
-
386  class(errors), pointer :: errmgr
-
387  type(errors), target :: deferr
-
388  character(len = 128) :: errmsg
-
389 
-
390  ! Initialization
-
391  m = size(c, 1)
-
392  n = size(c, 2)
-
393  k = size(a)
-
394  nrowb = size(b, 1)
-
395  ncolb = size(b, 2)
-
396  if (present(err)) then
-
397  errmgr => err
-
398  else
-
399  errmgr => deferr
-
400  end if
-
401 
-
402  ! Input Check
-
403  flag = 0
-
404  if (lside) then
-
405  if (k > m) then
-
406  flag = 4
-
407  else
-
408  if (trans) then
-
409  ! Compute C = alpha * A * B**T + beta * C
-
410  if (nrowb /= n .or. ncolb < k) flag = 5
-
411  else
-
412  ! Compute C = alpha * A * B + beta * C
-
413  if (nrowb < k .or. ncolb /= n) flag = 5
-
414  end if
-
415  end if
-
416  else
-
417  if (k > n) then
-
418  flag = 4
-
419  else
-
420  if (trans) then
-
421  ! Compute C = alpha * B**T * A + beta * C
-
422  if (ncolb /= m .or. nrowb < k) flag = 5
-
423  else
-
424  ! Compute C = alpha * B * A + beta * C
-
425  if (nrowb /= m .or. ncolb < k) flag = 5
-
426  end if
-
427  end if
-
428  end if
-
429  if (flag /= 0) then
-
430  ! ERROR: One of the input arrays is not sized correctly
-
431  write(errmsg, '(AI0A)') "Input number ", flag, &
-
432  " is not sized correctly."
-
433  call errmgr%report_error("diag_mtx_mult_mtx", trim(errmsg), &
-
434  la_array_size_error)
-
435  return
-
436  end if
-
437 
-
438  ! Deal with ALPHA == 0
-
439  if (alpha == 0) then
-
440  if (beta == zero) then
-
441  c = zero
-
442  else if (beta /= one) then
-
443  c = beta * c
-
444  end if
-
445  return
-
446  end if
-
447 
-
448  ! Process
-
449  if (lside) then
-
450  if (trans) then
-
451  ! Compute C = alpha * A * B**T + beta * C
-
452  do i = 1, k
-
453  if (beta == zero) then
-
454  c(i,:) = zero
-
455  else if (beta /= one) then
-
456  c(i,:) = beta * c(i,:)
-
457  end if
-
458  temp = alpha * a(i)
-
459  if (temp /= one) c(i,:) = c(i,:) + temp * b(:,i)
-
460  end do
-
461  else
-
462  ! Compute C = alpha * A * B + beta * C
-
463  do i = 1, k
-
464  if (beta == zero) then
-
465  c(i,:) = zero
-
466  else if (beta /= one) then
-
467  c(i,:) = beta * c(i,:)
-
468  end if
-
469  temp = alpha * a(i)
-
470  if (temp /= one) c(i,:) = c(i,:) + temp * b(i,:)
-
471  end do
-
472  end if
-
473 
-
474  ! Handle extra rows
-
475  if (m > k) then
-
476  if (beta == zero) then
-
477  c(k+1:m,:) = zero
-
478  else
-
479  c(k+1:m,:) = beta * c(k+1:m,:)
-
480  end if
-
481  end if
-
482  else
-
483  if (trans) then
-
484  ! Compute C = alpha * B**T * A + beta * C
-
485  do i = 1, k
-
486  if (beta == zero) then
-
487  c(:,i) = zero
-
488  else if (beta /= one) then
-
489  c(:,i) = beta * c(:,i)
-
490  end if
-
491  temp = alpha * a(i)
-
492  if (temp /= one) c(:,i) = c(:,i) + temp * b(i,:)
-
493  end do
-
494  else
-
495  ! Compute C = alpha * B * A + beta * C
-
496  do i = 1, k
-
497  if (beta == zero) then
-
498  c(:,i) = zero
-
499  else if (beta /= one) then
-
500  c(:,i) = beta * c(:,i)
-
501  end if
-
502  temp = alpha * a(i)
-
503  if (temp /= one) c(:,i) = c(:,i) + temp * b(:,i)
-
504  end do
-
505  end if
-
506 
-
507  ! Handle extra columns
-
508  if (n > k) then
-
509  if (beta == zero) then
-
510  c(:,k+1:m) = zero
-
511  else if (beta /= one) then
-
512  c(:,k+1:m) = beta * c(:,k+1:m)
-
513  end if
-
514  end if
-
515  end if
-
516  end subroutine
-
517 
-
518 ! ------------------------------------------------------------------------------
-
519  module subroutine diag_mtx_mult_mtx2(lside, alpha, a, b, err)
-
520  ! Arguments
-
521  logical, intent(in) :: lside
-
522  real(real64), intent(in) :: alpha
-
523  real(real64), intent(in), dimension(:) :: a
-
524  real(real64), intent(inout), dimension(:,:) :: b
-
525  class(errors), intent(inout), optional, target :: err
-
526 
-
527  ! Parameters
-
528  real(real64), parameter :: zero = 0.0d0
-
529  real(real64), parameter :: one = 1.0d0
-
530 
-
531  ! Local Variables
-
532  integer(int32) :: i, m, n, k
-
533  real(real64) :: temp
-
534  class(errors), pointer :: errmgr
-
535  type(errors), target :: deferr
-
536 
-
537  ! Initialization
-
538  m = size(b, 1)
-
539  n = size(b, 2)
-
540  k = size(a)
-
541  if (present(err)) then
-
542  errmgr => err
-
543  else
-
544  errmgr => deferr
-
545  end if
-
546 
-
547  ! Input Check
-
548  if ((lside .and. k > m) .or. (.not.lside .and. k > n)) then
-
549  ! ERROR: One of the input arrays is not sized correctly
-
550  call errmgr%report_error("diag_mtx_mult_mtx2", &
-
551  "Input number 3 is not sized correctly.", &
-
552  la_array_size_error)
-
553  return
-
554  end if
-
555 
-
556  ! Process
-
557  if (lside) then
-
558  ! Compute B = alpha * A * B
-
559  do i = 1, k
-
560  temp = alpha * a(i)
-
561  if (temp /= one) b(i,:) = temp * b(i,:)
-
562  end do
-
563  if (m > k) b(k+1:m,:) = zero
-
564  else
-
565  ! Compute B = alpha * B * A
-
566  do i = 1, k
-
567  temp = alpha * a(i)
-
568  if (temp /= one) b(:,i) = temp * b(:,i)
-
569  end do
-
570  if (n > k) b(:,k+1:n) = zero
-
571  end if
-
572  end subroutine
-
573 
-
574 ! ------------------------------------------------------------------------------
-
575  module subroutine diag_mtx_mult_mtx3(lside, trans, alpha, a, b, beta, c, err)
-
576  ! Arguments
-
577  logical, intent(in) :: lside, trans
-
578  real(real64) :: alpha, beta
-
579  complex(real64), intent(in), dimension(:) :: a
-
580  real(real64), intent(in), dimension(:,:) :: b
-
581  complex(real64), intent(inout), dimension(:,:) :: c
-
582  class(errors), intent(inout), optional, target :: err
-
583 
-
584  ! Parameters
-
585  complex(real64), parameter :: zero = (0.0d0, 0.0d0)
-
586  complex(real64), parameter :: one = (1.0d0, 0.0d0)
-
587 
-
588  ! Local Variables
-
589  integer(int32) :: i, m, n, k, nrowb, ncolb, flag
-
590  complex(real64) :: temp
-
591  class(errors), pointer :: errmgr
-
592  type(errors), target :: deferr
-
593  character(len = 128) :: errmsg
-
594 
-
595  ! Initialization
-
596  m = size(c, 1)
-
597  n = size(c, 2)
-
598  k = size(a)
-
599  nrowb = size(b, 1)
-
600  ncolb = size(b, 2)
-
601  if (present(err)) then
-
602  errmgr => err
-
603  else
-
604  errmgr => deferr
-
605  end if
-
606 
-
607  ! Input Check
-
608  flag = 0
-
609  if (lside) then
-
610  if (k > m) then
-
611  flag = 4
-
612  else
-
613  if (trans) then
-
614  ! Compute C = alpha * A * B**T + beta * C
-
615  if (nrowb /= n .or. ncolb < k) flag = 5
-
616  else
-
617  ! Compute C = alpha * A * B + beta * C
-
618  if (nrowb < k .or. ncolb /= n) flag = 5
-
619  end if
-
620  end if
-
621  else
-
622  if (k > n) then
-
623  flag = 4
-
624  else
-
625  if (trans) then
-
626  ! Compute C = alpha * B**T * A + beta * C
-
627  if (ncolb /= m .or. nrowb < k) flag = 5
-
628  else
-
629  ! Compute C = alpha * B * A + beta * C
-
630  if (nrowb /= m .or. ncolb < k) flag = 5
-
631  end if
-
632  end if
-
633  end if
-
634  if (flag /= 0) then
-
635  ! ERROR: One of the input arrays is not sized correctly
-
636  write(errmsg, '(AI0A)') "Input number ", flag, &
-
637  " is not sized correctly."
-
638  call errmgr%report_error("diag_mtx_mult_mtx3", trim(errmsg), &
-
639  la_array_size_error)
-
640  return
-
641  end if
-
642 
-
643  ! Deal with ALPHA == 0
-
644  if (alpha == 0) then
-
645  if (beta == zero) then
-
646  c = zero
-
647  else if (beta /= one) then
-
648  c = beta * c
-
649  end if
-
650  return
-
651  end if
-
652 
-
653  ! Process
-
654  if (lside) then
-
655  if (trans) then
-
656  ! Compute C = alpha * A * B**T + beta * C
-
657  do i = 1, k
-
658  if (beta == zero) then
-
659  c(i,:) = zero
-
660  else if (beta /= one) then
-
661  c(i,:) = beta * c(i,:)
-
662  end if
-
663  temp = alpha * a(i)
-
664  if (temp /= one) c(i,:) = c(i,:) + temp * b(:,i)
-
665  end do
-
666  else
-
667  ! Compute C = alpha * A * B + beta * C
-
668  do i = 1, k
-
669  if (beta == zero) then
-
670  c(i,:) = zero
-
671  else if (beta /= one) then
-
672  c(i,:) = beta * c(i,:)
-
673  end if
-
674  temp = alpha * a(i)
-
675  if (temp /= one) c(i,:) = c(i,:) + temp * b(i,:)
-
676  end do
-
677  end if
-
678 
-
679  ! Handle extra rows
-
680  if (m > k) then
-
681  if (beta == zero) then
-
682  c(k+1:m,:) = zero
-
683  else
-
684  c(k+1:m,:) = beta * c(k+1:m,:)
-
685  end if
-
686  end if
-
687  else
-
688  if (trans) then
-
689  ! Compute C = alpha * B**T * A + beta * C
-
690  do i = 1, k
-
691  if (beta == zero) then
-
692  c(:,i) = zero
-
693  else if (beta /= one) then
-
694  c(:,i) = beta * c(:,i)
-
695  end if
-
696  temp = alpha * a(i)
-
697  if (temp /= one) c(:,i) = c(:,i) + temp * b(i,:)
-
698  end do
-
699  else
-
700  ! Compute C = alpha * B * A + beta * C
-
701  do i = 1, k
-
702  if (beta == zero) then
-
703  c(:,i) = zero
-
704  else if (beta /= one) then
-
705  c(:,i) = beta * c(:,i)
-
706  end if
-
707  temp = alpha * a(i)
-
708  if (temp /= one) c(:,i) = c(:,i) + temp * b(:,i)
-
709  end do
-
710  end if
-
711 
-
712  ! Handle extra columns
-
713  if (n > k) then
-
714  if (beta == zero) then
-
715  c(:,k+1:m) = zero
-
716  else if (beta /= one) then
-
717  c(:,k+1:m) = beta * c(:,k+1:m)
-
718  end if
-
719  end if
-
720  end if
-
721  end subroutine
-
722 
-
723 ! ------------------------------------------------------------------------------
-
724  module subroutine diag_mtx_mult_mtx4(lside, opb, alpha, a, b, beta, c, err)
-
725  ! Arguments
-
726  logical, intent(in) :: lside
-
727  integer(int32), intent(in) :: opb
-
728  real(real64) :: alpha, beta
-
729  complex(real64), intent(in), dimension(:) :: a
-
730  complex(real64), intent(in), dimension(:,:) :: b
-
731  complex(real64), intent(inout), dimension(:,:) :: c
-
732  class(errors), intent(inout), optional, target :: err
-
733 
-
734  ! Parameters
-
735  complex(real64), parameter :: zero = (0.0d0, 0.0d0)
-
736  complex(real64), parameter :: one = (1.0d0, 0.0d0)
-
737 
-
738  ! Local Variables
-
739  integer(int32) :: i, m, n, k, nrowb, ncolb, flag
-
740  complex(real64) :: temp
-
741  class(errors), pointer :: errmgr
-
742  type(errors), target :: deferr
-
743  character(len = 128) :: errmsg
-
744 
-
745  ! Initialization
-
746  m = size(c, 1)
-
747  n = size(c, 2)
-
748  k = size(a)
-
749  nrowb = size(b, 1)
-
750  ncolb = size(b, 2)
-
751  if (present(err)) then
-
752  errmgr => err
-
753  else
-
754  errmgr => deferr
-
755  end if
-
756 
-
757  ! Input Check
-
758  flag = 0
-
759  if (lside) then
-
760  if (k > m) then
-
761  flag = 4
-
762  else
-
763  if (opb == transpose .or. opb == hermitian_transpose) then
-
764  ! Compute C = alpha * A * B**T + beta * C
-
765  if (nrowb /= n .or. ncolb < k) flag = 5
-
766  else
-
767  ! Compute C = alpha * A * B + beta * C
-
768  if (nrowb < k .or. ncolb /= n) flag = 5
-
769  end if
-
770  end if
-
771  else
-
772  if (k > n) then
-
773  flag = 4
-
774  else
-
775  if (opb == transpose .or. opb == hermitian_transpose) then
-
776  ! Compute C = alpha * B**T * A + beta * C
-
777  if (ncolb /= m .or. nrowb < k) flag = 5
-
778  else
-
779  ! Compute C = alpha * B * A + beta * C
-
780  if (nrowb /= m .or. ncolb < k) flag = 5
-
781  end if
-
782  end if
-
783  end if
-
784  if (flag /= 0) then
-
785  ! ERROR: One of the input arrays is not sized correctly
-
786  write(errmsg, '(AI0A)') "Input number ", flag, &
-
787  " is not sized correctly."
-
788  call errmgr%report_error("diag_mtx_mult_mtx4", trim(errmsg), &
-
789  la_array_size_error)
-
790  return
-
791  end if
-
792 
-
793  ! Deal with ALPHA == 0
-
794  if (alpha == 0) then
-
795  if (beta == zero) then
-
796  c = zero
-
797  else if (beta /= one) then
-
798  c = beta * c
-
799  end if
-
800  return
-
801  end if
-
802 
-
803  ! Process
-
804  if (lside) then
-
805  if (opb == transpose) then
-
806  ! Compute C = alpha * A * B**T + beta * C
-
807  do i = 1, k
-
808  if (beta == zero) then
-
809  c(i,:) = zero
-
810  else if (beta /= one) then
-
811  c(i,:) = beta * c(i,:)
-
812  end if
-
813  temp = alpha * a(i)
-
814  if (temp /= one) c(i,:) = c(i,:) + temp * b(:,i)
-
815  end do
-
816  else if (opb == hermitian_transpose) then
-
817  ! Compute C = alpha * A * B**H + beta * C
-
818  do i = 1, k
-
819  if (beta == zero) then
-
820  c(i,:) = zero
-
821  else if (beta /= one) then
-
822  c(i,:) = beta * c(i,:)
-
823  end if
-
824  temp = alpha * a(i)
-
825  if (temp /= one) c(i,:) = c(i,:) + temp * conjg(b(:,i))
-
826  end do
-
827  else
-
828  ! Compute C = alpha * A * B + beta * C
-
829  do i = 1, k
-
830  if (beta == zero) then
-
831  c(i,:) = zero
-
832  else if (beta /= one) then
-
833  c(i,:) = beta * c(i,:)
-
834  end if
-
835  temp = alpha * a(i)
-
836  if (temp /= one) c(i,:) = c(i,:) + temp * b(i,:)
-
837  end do
-
838  end if
-
839 
-
840  ! Handle extra rows
-
841  if (m > k) then
-
842  if (beta == zero) then
-
843  c(k+1:m,:) = zero
-
844  else
-
845  c(k+1:m,:) = beta * c(k+1:m,:)
-
846  end if
-
847  end if
-
848  else
-
849  if (opb == transpose) then
-
850  ! Compute C = alpha * B**T * A + beta * C
-
851  do i = 1, k
-
852  if (beta == zero) then
-
853  c(:,i) = zero
-
854  else if (beta /= one) then
-
855  c(:,i) = beta * c(:,i)
-
856  end if
-
857  temp = alpha * a(i)
-
858  if (temp /= one) c(:,i) = c(:,i) + temp * b(i,:)
-
859  end do
-
860  else if (opb == hermitian_transpose) then
-
861  ! Compute C = alpha * B**H * A + beta * C
-
862  do i = 1, k
-
863  if (beta == zero) then
-
864  c(:,i) = zero
-
865  else if (beta /= one) then
-
866  c(:,i) = beta * c(:,i)
-
867  end if
-
868  temp = alpha * a(i)
-
869  if (temp /= one) c(:,i) = c(:,i) + temp * conjg(b(i,:))
-
870  end do
-
871  else
-
872  ! Compute C = alpha * B * A + beta * C
-
873  do i = 1, k
-
874  if (beta == zero) then
-
875  c(:,i) = zero
-
876  else if (beta /= one) then
-
877  c(:,i) = beta * c(:,i)
-
878  end if
-
879  temp = alpha * a(i)
-
880  if (temp /= one) c(:,i) = c(:,i) + temp * b(:,i)
-
881  end do
-
882  end if
-
883 
-
884  ! Handle extra columns
-
885  if (n > k) then
-
886  if (beta == zero) then
-
887  c(:,k+1:m) = zero
-
888  else if (beta /= one) then
-
889  c(:,k+1:m) = beta * c(:,k+1:m)
-
890  end if
-
891  end if
-
892  end if
-
893  end subroutine
-
894 
-
895 ! ------------------------------------------------------------------------------
-
896  module subroutine diag_mtx_mult_mtx_cmplx(lside, opb, alpha, a, b, beta, c, err)
-
897  ! Arguments
-
898  logical, intent(in) :: lside
-
899  integer(int32), intent(in) :: opb
-
900  complex(real64) :: alpha, beta
-
901  complex(real64), intent(in), dimension(:) :: a
-
902  complex(real64), intent(in), dimension(:,:) :: b
-
903  complex(real64), intent(inout), dimension(:,:) :: c
-
904  class(errors), intent(inout), optional, target :: err
-
905 
-
906  ! Parameters
-
907  complex(real64), parameter :: zero = (0.0d0, 0.0d0)
-
908  complex(real64), parameter :: one = (1.0d0, 0.0d0)
-
909 
-
910  ! Local Variables
-
911  integer(int32) :: i, m, n, k, nrowb, ncolb, flag
-
912  complex(real64) :: temp
-
913  class(errors), pointer :: errmgr
-
914  type(errors), target :: deferr
-
915  character(len = 128) :: errmsg
-
916 
-
917  ! Initialization
-
918  m = size(c, 1)
-
919  n = size(c, 2)
-
920  k = size(a)
-
921  nrowb = size(b, 1)
-
922  ncolb = size(b, 2)
-
923  if (present(err)) then
-
924  errmgr => err
-
925  else
-
926  errmgr => deferr
-
927  end if
-
928 
-
929  ! Input Check
-
930  flag = 0
-
931  if (lside) then
-
932  if (k > m) then
-
933  flag = 4
-
934  else
-
935  if (opb == transpose .or. opb == hermitian_transpose) then
-
936  ! Compute C = alpha * A * B**T + beta * C
-
937  if (nrowb /= n .or. ncolb < k) flag = 5
-
938  else
-
939  ! Compute C = alpha * A * B + beta * C
-
940  if (nrowb < k .or. ncolb /= n) flag = 5
-
941  end if
-
942  end if
-
943  else
-
944  if (k > n) then
-
945  flag = 4
-
946  else
-
947  if (opb == transpose .or. opb == hermitian_transpose) then
-
948  ! Compute C = alpha * B**T * A + beta * C
-
949  if (ncolb /= m .or. nrowb < k) flag = 5
-
950  else
-
951  ! Compute C = alpha * B * A + beta * C
-
952  if (nrowb /= m .or. ncolb < k) flag = 5
-
953  end if
-
954  end if
-
955  end if
-
956  if (flag /= 0) then
-
957  ! ERROR: One of the input arrays is not sized correctly
-
958  write(errmsg, '(AI0A)') "Input number ", flag, &
-
959  " is not sized correctly."
-
960  call errmgr%report_error("diag_mtx_mult_mtx_cmplx", trim(errmsg), &
-
961  la_array_size_error)
-
962  return
-
963  end if
-
964 
-
965  ! Deal with ALPHA == 0
-
966  if (alpha == 0) then
-
967  if (beta == zero) then
-
968  c = zero
-
969  else if (beta /= one) then
-
970  c = beta * c
-
971  end if
-
972  return
-
973  end if
-
974 
-
975  ! Process
-
976  if (lside) then
-
977  if (opb == transpose) then
-
978  ! Compute C = alpha * A * B**T + beta * C
-
979  do i = 1, k
-
980  if (beta == zero) then
-
981  c(i,:) = zero
-
982  else if (beta /= one) then
-
983  c(i,:) = beta * c(i,:)
-
984  end if
-
985  temp = alpha * a(i)
-
986  if (temp /= one) c(i,:) = c(i,:) + temp * b(:,i)
-
987  end do
-
988  else if (opb == hermitian_transpose) then
-
989  ! Compute C = alpha * A * B**H + beta * C
-
990  do i = 1, k
-
991  if (beta == zero) then
-
992  c(i,:) = zero
-
993  else if (beta /= one) then
-
994  c(i,:) = beta * c(i,:)
-
995  end if
-
996  temp = alpha * a(i)
-
997  if (temp /= one) c(i,:) = c(i,:) + temp * conjg(b(:,i))
-
998  end do
-
999  else
-
1000  ! Compute C = alpha * A * B + beta * C
-
1001  do i = 1, k
-
1002  if (beta == zero) then
-
1003  c(i,:) = zero
-
1004  else if (beta /= one) then
-
1005  c(i,:) = beta * c(i,:)
-
1006  end if
-
1007  temp = alpha * a(i)
-
1008  if (temp /= one) c(i,:) = c(i,:) + temp * b(i,:)
-
1009  end do
-
1010  end if
-
1011 
-
1012  ! Handle extra rows
-
1013  if (m > k) then
-
1014  if (beta == zero) then
-
1015  c(k+1:m,:) = zero
-
1016  else
-
1017  c(k+1:m,:) = beta * c(k+1:m,:)
-
1018  end if
-
1019  end if
-
1020  else
-
1021  if (opb == transpose) then
-
1022  ! Compute C = alpha * B**T * A + beta * C
-
1023  do i = 1, k
-
1024  if (beta == zero) then
-
1025  c(:,i) = zero
-
1026  else if (beta /= one) then
-
1027  c(:,i) = beta * c(:,i)
-
1028  end if
-
1029  temp = alpha * a(i)
-
1030  if (temp /= one) c(:,i) = c(:,i) + temp * b(i,:)
-
1031  end do
-
1032  else if (opb == hermitian_transpose) then
-
1033  ! Compute C = alpha * B**H * A + beta * C
-
1034  do i = 1, k
-
1035  if (beta == zero) then
-
1036  c(:,i) = zero
-
1037  else if (beta /= one) then
-
1038  c(:,i) = beta * c(:,i)
-
1039  end if
-
1040  temp = alpha * a(i)
-
1041  if (temp /= one) c(:,i) = c(:,i) + temp * conjg(b(i,:))
-
1042  end do
-
1043  else
-
1044  ! Compute C = alpha * B * A + beta * C
-
1045  do i = 1, k
-
1046  if (beta == zero) then
-
1047  c(:,i) = zero
-
1048  else if (beta /= one) then
-
1049  c(:,i) = beta * c(:,i)
-
1050  end if
-
1051  temp = alpha * a(i)
-
1052  if (temp /= one) c(:,i) = c(:,i) + temp * b(:,i)
-
1053  end do
-
1054  end if
-
1055 
-
1056  ! Handle extra columns
-
1057  if (n > k) then
-
1058  if (beta == zero) then
-
1059  c(:,k+1:m) = zero
-
1060  else if (beta /= one) then
-
1061  c(:,k+1:m) = beta * c(:,k+1:m)
-
1062  end if
-
1063  end if
-
1064  end if
-
1065  end subroutine
-
1066 
-
1067 ! ------------------------------------------------------------------------------
-
1068  module subroutine diag_mtx_mult_mtx2_cmplx(lside, alpha, a, b, err)
-
1069  ! Arguments
-
1070  logical, intent(in) :: lside
-
1071  complex(real64), intent(in) :: alpha
-
1072  complex(real64), intent(in), dimension(:) :: a
-
1073  complex(real64), intent(inout), dimension(:,:) :: b
-
1074  class(errors), intent(inout), optional, target :: err
-
1075 
-
1076  ! Parameters
-
1077  complex(real64), parameter :: zero = (0.0d0, 0.0d0)
-
1078  complex(real64), parameter :: one = (1.0d0, 0.0d0)
-
1079 
-
1080  ! Local Variables
-
1081  integer(int32) :: i, m, n, k
-
1082  complex(real64) :: temp
-
1083  class(errors), pointer :: errmgr
-
1084  type(errors), target :: deferr
-
1085 
-
1086  ! Initialization
-
1087  m = size(b, 1)
-
1088  n = size(b, 2)
-
1089  k = size(a)
-
1090  if (present(err)) then
-
1091  errmgr => err
-
1092  else
-
1093  errmgr => deferr
-
1094  end if
-
1095 
-
1096  ! Input Check
-
1097  if ((lside .and. k > m) .or. (.not.lside .and. k > n)) then
-
1098  ! ERROR: One of the input arrays is not sized correctly
-
1099  call errmgr%report_error("diag_mtx_mult_mtx2_cmplx", &
-
1100  "Input number 3 is not sized correctly.", &
-
1101  la_array_size_error)
-
1102  return
-
1103  end if
-
1104 
-
1105  ! Process
-
1106  if (lside) then
-
1107  ! Compute B = alpha * A * B
-
1108  do i = 1, k
-
1109  temp = alpha * a(i)
-
1110  if (temp /= one) b(i,:) = temp * b(i,:)
-
1111  end do
-
1112  if (m > k) b(k+1:m,:) = zero
-
1113  else
-
1114  ! Compute B = alpha * B * A
-
1115  do i = 1, k
-
1116  temp = alpha * a(i)
-
1117  if (temp /= one) b(:,i) = temp * b(:,i)
-
1118  end do
-
1119  if (n > k) b(:,k+1:n) = zero
-
1120  end if
-
1121  end subroutine
-
1122 
-
1123 ! ******************************************************************************
-
1124 ! BASIC OPERATION ROUTINES
-
1125 ! ------------------------------------------------------------------------------
-
1126  pure module function trace_dbl(x) result(y)
-
1127  ! Arguments
-
1128  real(real64), intent(in), dimension(:,:) :: x
-
1129  real(real64) :: y
-
1130 
-
1131  ! Parameters
-
1132  real(real64), parameter :: zero = 0.0d0
-
1133 
-
1134  ! Local Variables
-
1135  integer(int32) :: i, m, n, mn
-
1136 
-
1137  ! Initialization
-
1138  y = zero
-
1139  m = size(x, 1)
-
1140  n = size(x, 2)
-
1141  mn = min(m, n)
-
1142 
-
1143  ! Process
-
1144  do i = 1, mn
-
1145  y = y + x(i,i)
-
1146  end do
-
1147  end function
-
1148 
-
1149 ! ------------------------------------------------------------------------------
-
1150  pure module function trace_cmplx(x) result(y)
-
1151  ! Arguments
-
1152  complex(real64), intent(in), dimension(:,:) :: x
-
1153  complex(real64) :: y
-
1154 
-
1155  ! Parameters
-
1156  complex(real64), parameter :: zero = (0.0d0, 0.0d0)
-
1157 
-
1158  ! Local Variables
-
1159  integer(int32) :: i, m, n, mn
-
1160 
-
1161  ! Initialization
-
1162  y = zero
-
1163  m = size(x, 1)
-
1164  n = size(x, 2)
-
1165  mn = min(m, n)
-
1166 
-
1167  ! Process
-
1168  do i = 1, mn
-
1169  y = y + x(i,i)
-
1170  end do
-
1171  end function
-
1172 
-
1173 ! ------------------------------------------------------------------------------
-
1174  module function mtx_rank_dbl(a, tol, work, olwork, err) result(rnk)
-
1175  ! Arguments
-
1176  real(real64), intent(inout), dimension(:,:) :: a
-
1177  real(real64), intent(in), optional :: tol
-
1178  real(real64), intent(out), target, optional, dimension(:) :: work
-
1179  integer(int32), intent(out), optional :: olwork
-
1180  class(errors), intent(inout), optional, target :: err
-
1181  integer(int32) :: rnk
-
1182 
-
1183  ! External Function Interfaces
-
1184  interface
-
1185  function dlamch(cmach) result(x)
-
1186  use, intrinsic :: iso_fortran_env, only : real64
-
1187  character, intent(in) :: cmach
-
1188  real(real64) :: x
-
1189  end function
-
1190  end interface
-
1191 
-
1192  ! Local Variables
-
1193  integer(int32) :: i, m, n, mn, istat, lwork, flag
-
1194  real(real64), pointer, dimension(:) :: wptr, s, w
-
1195  real(real64), allocatable, target, dimension(:) :: wrk
-
1196  real(real64) :: t, tref, smlnum
-
1197  real(real64), dimension(1) :: dummy, temp
-
1198  class(errors), pointer :: errmgr
-
1199  type(errors), target :: deferr
-
1200  character(len = 128) :: errmsg
-
1201 
-
1202  ! Initialization
-
1203  m = size(a, 1)
-
1204  n = size(a, 2)
-
1205  mn = min(m, n)
-
1206  smlnum = dlamch('s')
-
1207  rnk = 0
-
1208  if (present(err)) then
-
1209  errmgr => err
-
1210  else
-
1211  errmgr => deferr
-
1212  end if
-
1213 
-
1214  ! Workspace Query
-
1215  !call svd(a, a(1:mn,1), olwork = lwork)
-
1216  call dgesvd('N', 'N', m, n, a, m, dummy, dummy, m, dummy, n, temp, &
-
1217  -1, flag)
-
1218  lwork = int(temp(1), int32) + mn
-
1219  if (present(olwork)) then
-
1220  olwork = lwork
-
1221  return
-
1222  end if
-
1223 
-
1224  ! Local Memory Allocation
-
1225  if (present(work)) then
-
1226  if (size(work) < lwork) then
-
1227  ! ERROR: WORK not sized correctly
-
1228  call errmgr%report_error("mtx_rank", &
-
1229  "Incorrectly sized input array WORK, argument 5.", &
-
1230  la_array_size_error)
-
1231  return
-
1232  end if
-
1233  wptr => work(1:lwork)
-
1234  else
-
1235  allocate(wrk(lwork), stat = istat)
-
1236  if (istat /= 0) then
-
1237  ! ERROR: Out of memory
-
1238  call errmgr%report_error("mtx_rank", &
-
1239  "Insufficient memory available.", &
-
1240  la_out_of_memory_error)
-
1241  return
-
1242  end if
-
1243  wptr => wrk
-
1244  end if
-
1245  s => wptr(1:mn)
-
1246  w => wptr(mn+1:lwork)
-
1247 
-
1248  ! Compute the singular values of A
-
1249  call dgesvd('N', 'N', m, n, a, m, s, dummy, m, dummy, n, w, &
-
1250  lwork - mn, flag)
-
1251  if (flag > 0) then
-
1252  write(errmsg, '(I0A)') flag, " superdiagonals could not " // &
-
1253  "converge to zero as part of the QR iteration process."
-
1254  call errmgr%report_warning("mtx_rank", errmsg, la_convergence_error)
-
1255  end if
-
1256 
-
1257  ! Determine the threshold tolerance for the singular values such that
-
1258  ! singular values less than the threshold result in zero when inverted.
-
1259  tref = max(m, n) * epsilon(t) * s(1)
-
1260  if (present(tol)) then
-
1261  t = tol
-
1262  else
-
1263  t = tref
-
1264  end if
-
1265  if (t < smlnum) then
-
1266  ! ! The supplied tolerance is too small, simply fall back to the
-
1267  ! ! default, but issue a warning to the user
-
1268  ! t = tref
-
1269  ! call report_warning("mtx_rank", "The supplied tolerance was " // &
-
1270  ! "smaller than a value that would result in an overflow " // &
-
1271  ! "condition, or is negative; therefore, the tolerance has " // &
-
1272  ! "been reset to its default value.")
-
1273  end if
-
1274 
-
1275  ! Count the singular values that are larger than the tolerance value
-
1276  do i = 1, mn
-
1277  if (s(i) < t) exit
-
1278  rnk = rnk + 1
-
1279  end do
-
1280  end function
-
1281 
-
1282 ! ------------------------------------------------------------------------------
-
1283  module function mtx_rank_cmplx(a, tol, work, olwork, rwork, err) result(rnk)
-
1284  ! Arguments
-
1285  complex(real64), intent(inout), dimension(:,:) :: a
-
1286  real(real64), intent(in), optional :: tol
-
1287  complex(real64), intent(out), target, optional, dimension(:) :: work
-
1288  integer(int32), intent(out), optional :: olwork
-
1289  real(real64), intent(out), target, optional, dimension(:) :: rwork
-
1290  class(errors), intent(inout), optional, target :: err
-
1291  integer(int32) :: rnk
-
1292 
-
1293  ! External Function Interfaces
-
1294  interface
-
1295  function dlamch(cmach) result(x)
-
1296  use, intrinsic :: iso_fortran_env, only : real64
-
1297  character, intent(in) :: cmach
-
1298  real(real64) :: x
-
1299  end function
-
1300  end interface
-
1301 
-
1302  ! Local Variables
-
1303  integer(int32) :: i, m, n, mn, istat, lwork, flag, lrwork
-
1304  real(real64), pointer, dimension(:) :: s, rwptr, rw
-
1305  real(real64), allocatable, target, dimension(:) :: rwrk
-
1306  complex(real64), allocatable, target, dimension(:) :: wrk
-
1307  complex(real64), pointer, dimension(:) :: wptr
-
1308  real(real64) :: t, tref, smlnum
-
1309  real(real64), dimension(1) :: dummy
-
1310  complex(real64), dimension(1) :: cdummy, temp
-
1311  class(errors), pointer :: errmgr
-
1312  type(errors), target :: deferr
-
1313  character(len = 128) :: errmsg
-
1314 
-
1315  ! Initialization
-
1316  m = size(a, 1)
-
1317  n = size(a, 2)
-
1318  mn = min(m, n)
-
1319  lrwork = 6 * mn
-
1320  smlnum = dlamch('s')
-
1321  rnk = 0
-
1322  if (present(err)) then
-
1323  errmgr => err
-
1324  else
-
1325  errmgr => deferr
-
1326  end if
-
1327 
-
1328  ! Workspace Query
-
1329  call zgesvd('N', 'N', m, n, a, m, dummy, cdummy, m, cdummy, n, temp, &
-
1330  -1, dummy, flag)
-
1331  lwork = int(temp(1), int32)
-
1332  if (present(olwork)) then
-
1333  olwork = lwork
-
1334  return
-
1335  end if
-
1336 
-
1337  ! Local Memory Allocation
-
1338  if (present(work)) then
-
1339  if (size(work) < lwork) then
-
1340  ! ERROR: WORK not sized correctly
-
1341  call errmgr%report_error("mtx_rank_cmplx", &
-
1342  "Incorrectly sized input array WORK, argument 5.", &
-
1343  la_array_size_error)
-
1344  return
-
1345  end if
-
1346  wptr => work(1:lwork)
-
1347  else
-
1348  allocate(wrk(lwork), stat = istat)
-
1349  if (istat /= 0) then
-
1350  ! ERROR: Out of memory
-
1351  call errmgr%report_error("mtx_rank_cmplx", &
-
1352  "Insufficient memory available.", &
-
1353  la_out_of_memory_error)
-
1354  return
-
1355  end if
-
1356  wptr => wrk
-
1357  end if
-
1358 
-
1359  if (present(rwork)) then
-
1360  if (size(rwork) < lrwork) then
-
1361  ! ERROR: RWORK not sized correctly
-
1362  call errmgr%report_error("mtx_rank_cmplx", &
-
1363  "Incorrectly sized input array RWORK.", &
-
1364  la_array_size_error)
-
1365  return
-
1366  end if
-
1367  rwptr => rwork(1:lrwork)
-
1368  else
-
1369  allocate(rwrk(lrwork), stat = istat)
-
1370  if (istat /= 0) then
-
1371  end if
-
1372  rwptr => rwrk
-
1373  end if
-
1374  s => rwptr(1:mn)
-
1375  rw => rwptr(mn+1:lrwork)
-
1376 
-
1377  ! Compute the singular values of A
-
1378  call zgesvd('N', 'N', m, n, a, m, s, cdummy, m, cdummy, n, wptr, &
-
1379  lwork - mn, rw, flag)
-
1380  if (flag > 0) then
-
1381  write(errmsg, '(I0A)') flag, " superdiagonals could not " // &
-
1382  "converge to zero as part of the QR iteration process."
-
1383  call errmgr%report_warning("mtx_rank_cmplx", errmsg, la_convergence_error)
-
1384  end if
-
1385 
-
1386  ! Determine the threshold tolerance for the singular values such that
-
1387  ! singular values less than the threshold result in zero when inverted.
-
1388  tref = max(m, n) * epsilon(t) * s(1)
-
1389  if (present(tol)) then
-
1390  t = tol
-
1391  else
-
1392  t = tref
-
1393  end if
-
1394  if (t < smlnum) then
-
1395  ! ! The supplied tolerance is too small, simply fall back to the
-
1396  ! ! default, but issue a warning to the user
-
1397  ! t = tref
-
1398  ! call report_warning("mtx_rank", "The supplied tolerance was " // &
-
1399  ! "smaller than a value that would result in an overflow " // &
-
1400  ! "condition, or is negative; therefore, the tolerance has " // &
-
1401  ! "been reset to its default value.")
-
1402  end if
-
1403 
-
1404  ! Count the singular values that are larger than the tolerance value
-
1405  do i = 1, mn
-
1406  if (s(i) < t) exit
-
1407  rnk = rnk + 1
-
1408  end do
-
1409  end function
-
1410 
-
1411 ! ------------------------------------------------------------------------------
-
1412  module function det_dbl(a, iwork, err) result(x)
-
1413  ! Arguments
-
1414  real(real64), intent(inout), dimension(:,:) :: a
-
1415  integer(int32), intent(out), target, optional, dimension(:) :: iwork
-
1416  class(errors), intent(inout), optional, target :: err
-
1417  real(real64) :: x
-
1418 
-
1419  ! Parameters
-
1420  real(real64), parameter :: zero = 0.0d0
-
1421  real(real64), parameter :: one = 1.0d0
-
1422  real(real64), parameter :: ten = 1.0d1
-
1423  real(real64), parameter :: p1 = 1.0d-1
-
1424 
-
1425  ! Local Variables
-
1426  integer(int32) :: i, ep, n, istat, flag
-
1427  integer(int32), pointer, dimension(:) :: ipvt
-
1428  integer(int32), allocatable, target, dimension(:) :: iwrk
-
1429  real(real64) :: temp
-
1430  class(errors), pointer :: errmgr
-
1431  type(errors), target :: deferr
-
1432 
-
1433  ! Initialization
-
1434  n = size(a, 1)
-
1435  x = zero
-
1436  if (present(err)) then
-
1437  errmgr => err
-
1438  else
-
1439  errmgr => deferr
-
1440  end if
-
1441 
-
1442  ! Input Check
-
1443  if (size(a, 2) /= n) then
-
1444  call errmgr%report_error("det", &
-
1445  "The supplied matrix must be square.", la_array_size_error)
-
1446  return
-
1447  end if
-
1448 
-
1449  ! Local Memory Allocation
-
1450  if (present(iwork)) then
-
1451  if (size(iwork) < n) then
-
1452  ! ERROR: WORK not sized correctly
-
1453  call errmgr%report_error("det", &
-
1454  "Incorrectly sized input array IWORK, argument 2.", &
-
1455  la_array_size_error)
-
1456  return
-
1457  end if
-
1458  ipvt => iwork(1:n)
-
1459  else
-
1460  allocate(iwrk(n), stat = istat)
-
1461  if (istat /= 0) then
-
1462  ! ERROR: Out of memory
-
1463  call errmgr%report_error("det", &
-
1464  "Insufficient memory available.", &
-
1465  la_out_of_memory_error)
-
1466  return
-
1467  end if
-
1468  ipvt => iwrk
-
1469  end if
-
1470 
-
1471  ! Compute the LU factorization of A
-
1472  call dgetrf(n, n, a, n, ipvt, flag)
-
1473  if (flag > 0) then
-
1474  ! A singular matrix has a determinant of zero
-
1475  x = zero
-
1476  return
-
1477  end if
-
1478 
-
1479  ! Compute the product of the diagonal of A
-
1480  temp = one
-
1481  ep = 0
-
1482  do i = 1, n
-
1483  if (ipvt(i) /= i) temp = -temp
-
1484 
-
1485  temp = a(i,i) * temp
-
1486  if (temp == zero) then
-
1487  x = zero
-
1488  exit
-
1489  end if
-
1490 
-
1491  do while (abs(temp) < one)
-
1492  temp = ten * temp
-
1493  ep = ep - 1
-
1494  end do
-
1495 
-
1496  do while (abs(temp) > ten)
-
1497  temp = p1 * temp
-
1498  ep = ep + 1
-
1499  end do
-
1500  end do
-
1501  x = temp * ten**ep
-
1502  end function
-
1503 
-
1504 ! ------------------------------------------------------------------------------
-
1505  module function det_cmplx(a, iwork, err) result(x)
-
1506  ! Arguments
-
1507  complex(real64), intent(inout), dimension(:,:) :: a
-
1508  integer(int32), intent(out), target, optional, dimension(:) :: iwork
-
1509  class(errors), intent(inout), optional, target :: err
-
1510  complex(real64) :: x
-
1511 
-
1512  ! Parameters
-
1513  complex(real64), parameter :: zero = (0.0d0, 0.0d0)
-
1514  complex(real64), parameter :: one = (1.0d0, 0.0d0)
-
1515  complex(real64), parameter :: ten = (1.0d1, 0.0d0)
-
1516  complex(real64), parameter :: p1 = (1.0d-1, 0.0d0)
-
1517  real(real64), parameter :: real_one = 1.0d0
-
1518  real(real64), parameter :: real_ten = 1.0d1
-
1519 
-
1520  ! Local Variables
-
1521  integer(int32) :: i, ep, n, istat, flag
-
1522  integer(int32), pointer, dimension(:) :: ipvt
-
1523  integer(int32), allocatable, target, dimension(:) :: iwrk
-
1524  complex(real64) :: temp
-
1525  class(errors), pointer :: errmgr
-
1526  type(errors), target :: deferr
-
1527 
-
1528  ! Initialization
-
1529  n = size(a, 1)
-
1530  x = zero
-
1531  if (present(err)) then
-
1532  errmgr => err
-
1533  else
-
1534  errmgr => deferr
-
1535  end if
-
1536 
-
1537  ! Input Check
-
1538  if (size(a, 2) /= n) then
-
1539  call errmgr%report_error("det_cmplx", &
-
1540  "The supplied matrix must be square.", la_array_size_error)
-
1541  return
-
1542  end if
-
1543 
-
1544  ! Local Memory Allocation
-
1545  if (present(iwork)) then
-
1546  if (size(iwork) < n) then
-
1547  ! ERROR: WORK not sized correctly
-
1548  call errmgr%report_error("det_cmplx", &
-
1549  "Incorrectly sized input array IWORK, argument 2.", &
-
1550  la_array_size_error)
-
1551  return
-
1552  end if
-
1553  ipvt => iwork(1:n)
-
1554  else
-
1555  allocate(iwrk(n), stat = istat)
-
1556  if (istat /= 0) then
-
1557  ! ERROR: Out of memory
-
1558  call errmgr%report_error("det_cmplx", &
-
1559  "Insufficient memory available.", &
-
1560  la_out_of_memory_error)
-
1561  return
-
1562  end if
-
1563  ipvt => iwrk
-
1564  end if
-
1565 
-
1566  ! Compute the LU factorization of A
-
1567  call zgetrf(n, n, a, n, ipvt, flag)
-
1568  if (flag > 0) then
-
1569  ! A singular matrix has a determinant of zero
-
1570  x = zero
-
1571  return
-
1572  end if
-
1573 
-
1574  ! Compute the product of the diagonal of A
-
1575  temp = one
-
1576  ep = 0
-
1577  do i = 1, n
-
1578  if (ipvt(i) /= i) temp = -temp
-
1579 
-
1580  temp = a(i,i) * temp
-
1581  if (temp == zero) then
-
1582  x = zero
-
1583  exit
-
1584  end if
-
1585 
-
1586  do while (abs(temp) < real_one)
-
1587  temp = ten * temp
-
1588  ep = ep - 1
-
1589  end do
-
1590 
-
1591  do while (abs(temp) > real_ten)
-
1592  temp = p1 * temp
-
1593  ep = ep + 1
-
1594  end do
-
1595  end do
-
1596  x = temp * ten**ep
-
1597  end function
-
1598 
-
1599 ! ******************************************************************************
-
1600 ! ARRAY SWAPPING ROUTINE
-
1601 ! ------------------------------------------------------------------------------
-
1602  module subroutine swap_dbl(x, y, err)
-
1603  ! Arguments
-
1604  real(real64), intent(inout), dimension(:) :: x, y
-
1605  class(errors), intent(inout), optional, target :: err
-
1606 
-
1607  ! Local Variables
-
1608  integer(int32) :: i, n
-
1609  real(real64) :: temp
-
1610  class(errors), pointer :: errmgr
-
1611  type(errors), target :: deferr
-
1612 
-
1613  ! Initialization
-
1614  n = size(x)
-
1615  if (present(err)) then
-
1616  errmgr => err
-
1617  else
-
1618  errmgr => deferr
-
1619  end if
-
1620 
-
1621  ! Input Check
-
1622  if (size(y) /= n) then
-
1623  call errmgr%report_error("swap", &
-
1624  "The input arrays are not the same size.", &
-
1625  la_array_size_error)
-
1626  return
-
1627  end if
-
1628 
-
1629  ! Process
-
1630  do i = 1, n
-
1631  temp = x(i)
-
1632  x(i) = y(i)
-
1633  y(i) = temp
-
1634  end do
-
1635  end subroutine
-
1636 
-
1637 ! ------------------------------------------------------------------------------
-
1638  module subroutine swap_cmplx(x, y, err)
-
1639  ! Arguments
-
1640  complex(real64), intent(inout), dimension(:) :: x, y
-
1641  class(errors), intent(inout), optional, target :: err
-
1642 
-
1643  ! Local Variables
-
1644  integer(int32) :: i, n
-
1645  complex(real64) :: temp
-
1646  class(errors), pointer :: errmgr
-
1647  type(errors), target :: deferr
-
1648 
-
1649  ! Initialization
-
1650  n = size(x)
-
1651  if (present(err)) then
-
1652  errmgr => err
-
1653  else
-
1654  errmgr => deferr
-
1655  end if
-
1656 
-
1657  ! Input Check
-
1658  if (size(y) /= n) then
-
1659  call errmgr%report_error("swap_cmplx", &
-
1660  "The input arrays are not the same size.", &
-
1661  la_array_size_error)
-
1662  return
-
1663  end if
-
1664 
-
1665  ! Process
-
1666  do i = 1, n
-
1667  temp = x(i)
-
1668  x(i) = y(i)
-
1669  y(i) = temp
-
1670  end do
-
1671  end subroutine
-
1672 
-
1673 ! ******************************************************************************
-
1674 ! ARRAY MULTIPLICIATION ROUTINES
-
1675 ! ------------------------------------------------------------------------------
-
1676  module subroutine recip_mult_array_dbl(a, x)
-
1677  ! Arguments
-
1678  real(real64), intent(in) :: a
-
1679  real(real64), intent(inout), dimension(:) :: x
-
1680 
-
1681  ! External Function Interfaces
-
1682  interface
-
1683  function dlamch(cmach) result(x)
-
1684  use, intrinsic :: iso_fortran_env, only : real64
-
1685  character, intent(in) :: cmach
-
1686  real(real64) :: x
-
1687  end function
-
1688  end interface
-
1689 
-
1690  ! Parameters
-
1691  real(real64), parameter :: zero = 0.0d0
-
1692  real(real64), parameter :: one = 1.0d0
-
1693  real(real64), parameter :: twotho = 2.0d3
-
1694 
-
1695  ! Local Variables
-
1696  logical :: done
-
1697  real(real64) :: bignum, cden, cden1, cnum, cnum1, mul, smlnum
-
1698 
-
1699  ! Initialization
-
1700  smlnum = dlamch('s')
-
1701  bignum = one / smlnum
-
1702  if (log10(bignum) > twotho) then
-
1703  smlnum = sqrt(smlnum)
-
1704  bignum = sqrt(bignum)
-
1705  end if
-
1706 
-
1707  ! Initialize the denominator to A, and the numerator to ONE
-
1708  cden = a
-
1709  cnum = one
-
1710 
-
1711  ! Process
-
1712  do
-
1713  cden1 = cden * smlnum
-
1714  cnum1 = cnum / bignum
-
1715  if (abs(cden1) > abs(cnum) .and. cnum /= zero) then
-
1716  mul = smlnum
-
1717  done = .false.
-
1718  cden = cden1
-
1719  else if (abs(cnum1) > abs(cden)) then
-
1720  mul = bignum
-
1721  done = .false.
-
1722  cnum = cnum1
-
1723  else
-
1724  mul = cnum / cden
-
1725  done = .true.
-
1726  end if
-
1727 
-
1728  ! Scale the vector X by MUL
-
1729  x = mul * x
-
1730 
-
1731  ! Exit if done
-
1732  if (done) exit
-
1733  end do
-
1734  end subroutine
-
1735 
-
1736 ! ******************************************************************************
-
1737 ! TRIANGULAR MATRIX MULTIPLICATION ROUTINES
-
1738 ! ------------------------------------------------------------------------------
-
1739  module subroutine tri_mtx_mult_dbl(upper, alpha, a, beta, b, err)
-
1740  ! Arguments
-
1741  logical, intent(in) :: upper
-
1742  real(real64), intent(in) :: alpha, beta
-
1743  real(real64), intent(in), dimension(:,:) :: a
-
1744  real(real64), intent(inout), dimension(:,:) :: b
-
1745  class(errors), intent(inout), optional, target :: err
-
1746 
-
1747  ! Parameters
-
1748  real(real64), parameter :: zero = 0.0d0
-
1749 
-
1750  ! Local Variables
-
1751  integer(int32) :: i, j, k, n, d1, d2, flag
-
1752  real(real64) :: temp
-
1753  class(errors), pointer :: errmgr
-
1754  type(errors), target :: deferr
-
1755  character(len = 128) :: errmsg
-
1756 
-
1757  ! Initialization
-
1758  n = size(a, 1)
-
1759  d1 = n
-
1760  d2 = n
-
1761  if (present(err)) then
-
1762  errmgr => err
-
1763  else
-
1764  errmgr => deferr
-
1765  end if
-
1766 
-
1767  ! Input Check
-
1768  flag = 0
-
1769  if (size(a, 2) /= n) then
-
1770  flag = 3
-
1771  d2 = size(a, 2)
-
1772  else if (size(b, 1) /= n .or. size(b, 2) /= n) then
-
1773  flag = 5
-
1774  d1 = size(b, 1)
-
1775  d2 = size(b, 2)
-
1776  end if
-
1777  if (flag /= 0) then
-
1778  ! ERROR: Incorrectly sized matrix
-
1779  write(errmsg, '(AI0AI0AI0AI0AI0A)') "The matrix at input ", flag, &
-
1780  " was not sized appropriately. A matrix of ", n, "-by-", n, &
-
1781  "was expected, but a matrix of ", d1, "-by-", d2, " was found."
-
1782  call errmgr%report_error("tri_mtx_mult_dbl", trim(errmsg), &
-
1783  la_array_size_error)
-
1784  return
-
1785  end if
-
1786 
-
1787  ! Process
-
1788  if (upper) then
-
1789  ! Form: B = alpha * A**T * A + beta * B
-
1790  if (beta == zero) then
-
1791  do j = 1, n
-
1792  do i = 1, j
-
1793  temp = zero
-
1794  do k = 1, j
-
1795  temp = temp + a(k,i) * a(k,j)
-
1796  end do
-
1797  temp = alpha * temp
-
1798  b(i,j) = temp
-
1799  if (i /= j) b(j,i) = temp
-
1800  end do
-
1801  end do
-
1802  else
-
1803  do j = 1, n
-
1804  do i = 1, j
-
1805  temp = zero
-
1806  do k = 1, j
-
1807  temp = temp + a(k,i) * a(k,j)
-
1808  end do
-
1809  temp = alpha * temp
-
1810  b(i,j) = temp + beta * b(i,j)
-
1811  if (i /= j) b(j,i) = temp + beta * b(j,i)
-
1812  end do
-
1813  end do
-
1814  end if
-
1815  else
-
1816  ! Form: B = alpha * A * A**T + beta * B
-
1817  if (beta == zero) then
-
1818  do j = 1, n
-
1819  do i = j, n
-
1820  temp = zero
-
1821  do k = 1, j
-
1822  temp = temp + a(i,k) * a(j,k)
-
1823  end do
-
1824  temp = alpha * temp
-
1825  b(i,j) = temp
-
1826  if (i /= j) b(j,i) = temp
-
1827  end do
-
1828  end do
-
1829  else
-
1830  do j = 1, n
-
1831  do i = j, n
-
1832  temp = zero
-
1833  do k = 1, j
-
1834  temp = temp + a(i,k) * a(j,k)
-
1835  end do
-
1836  temp = alpha * temp
-
1837  b(i,j) = temp + beta * b(i,j)
-
1838  if (i /= j) b(j,i) = temp + beta * b(j,i)
-
1839  end do
-
1840  end do
-
1841  end if
-
1842  end if
-
1843  end subroutine
-
1844 
-
1845 ! ------------------------------------------------------------------------------
-
1846  module subroutine tri_mtx_mult_cmplx(upper, alpha, a, beta, b, err)
-
1847  ! Arguments
-
1848  logical, intent(in) :: upper
-
1849  complex(real64), intent(in) :: alpha, beta
-
1850  complex(real64), intent(in), dimension(:,:) :: a
-
1851  complex(real64), intent(inout), dimension(:,:) :: b
-
1852  class(errors), intent(inout), optional, target :: err
-
1853 
-
1854  ! Parameters
-
1855  complex(real64), parameter :: zero = (0.0d0, 0.0d0)
-
1856 
-
1857  ! Local Variables
-
1858  integer(int32) :: i, j, k, n, d1, d2, flag
-
1859  complex(real64) :: temp
-
1860  class(errors), pointer :: errmgr
-
1861  type(errors), target :: deferr
-
1862  character(len = 128) :: errmsg
-
1863 
-
1864  ! Initialization
-
1865  n = size(a, 1)
-
1866  d1 = n
-
1867  d2 = n
-
1868  if (present(err)) then
-
1869  errmgr => err
-
1870  else
-
1871  errmgr => deferr
-
1872  end if
-
1873 
-
1874  ! Input Check
-
1875  flag = 0
-
1876  if (size(a, 2) /= n) then
-
1877  flag = 3
-
1878  d2 = size(a, 2)
-
1879  else if (size(b, 1) /= n .or. size(b, 2) /= n) then
-
1880  flag = 5
-
1881  d1 = size(b, 1)
-
1882  d2 = size(b, 2)
-
1883  end if
-
1884  if (flag /= 0) then
-
1885  ! ERROR: Incorrectly sized matrix
-
1886  write(errmsg, '(AI0AI0AI0AI0AI0A)') "The matrix at input ", flag, &
-
1887  " was not sized appropriately. A matrix of ", n, "-by-", n, &
-
1888  "was expected, but a matrix of ", d1, "-by-", d2, " was found."
-
1889  call errmgr%report_error("tri_mtx_mult_cmplx", trim(errmsg), &
-
1890  la_array_size_error)
-
1891  return
-
1892  end if
-
1893 
-
1894  ! Process
-
1895  if (upper) then
-
1896  ! Form: B = alpha * A**T * A + beta * B
-
1897  if (beta == zero) then
-
1898  do j = 1, n
-
1899  do i = 1, j
-
1900  temp = zero
-
1901  do k = 1, j
-
1902  temp = temp + a(k,i) * a(k,j)
-
1903  end do
-
1904  temp = alpha * temp
-
1905  b(i,j) = temp
-
1906  if (i /= j) b(j,i) = temp
-
1907  end do
-
1908  end do
-
1909  else
-
1910  do j = 1, n
-
1911  do i = 1, j
-
1912  temp = zero
-
1913  do k = 1, j
-
1914  temp = temp + a(k,i) * a(k,j)
-
1915  end do
-
1916  temp = alpha * temp
-
1917  b(i,j) = temp + beta * b(i,j)
-
1918  if (i /= j) b(j,i) = temp + beta * b(j,i)
-
1919  end do
-
1920  end do
-
1921  end if
-
1922  else
-
1923  ! Form: B = alpha * A * A**T + beta * B
-
1924  if (beta == zero) then
-
1925  do j = 1, n
-
1926  do i = j, n
-
1927  temp = zero
-
1928  do k = 1, j
-
1929  temp = temp + a(i,k) * a(j,k)
-
1930  end do
-
1931  temp = alpha * temp
-
1932  b(i,j) = temp
-
1933  if (i /= j) b(j,i) = temp
-
1934  end do
-
1935  end do
-
1936  else
-
1937  do j = 1, n
-
1938  do i = j, n
-
1939  temp = zero
-
1940  do k = 1, j
-
1941  temp = temp + a(i,k) * a(j,k)
-
1942  end do
-
1943  temp = alpha * temp
-
1944  b(i,j) = temp + beta * b(i,j)
-
1945  if (i /= j) b(j,i) = temp + beta * b(j,i)
-
1946  end do
-
1947  end do
-
1948  end if
-
1949  end if
-
1950  end subroutine
-
1951 
-
1952 ! ------------------------------------------------------------------------------
-
1953 end submodule
+
1! linalg_basic.f90
+
2
+
3submodule(linalg_core) linalg_basic
+
4contains
+
5! ******************************************************************************
+
6! MATRIX MULTIPLICATION ROUTINES
+
7! ------------------------------------------------------------------------------
+
8 module subroutine mtx_mult_mtx(transa, transb, alpha, a, b, beta, c, err)
+
9 ! Arguments
+
10 logical, intent(in) :: transa, transb
+
11 real(real64), intent(in) :: alpha, beta
+
12 real(real64), intent(in), dimension(:,:) :: a, b
+
13 real(real64), intent(inout), dimension(:,:) :: c
+
14 class(errors), intent(inout), optional, target :: err
+
15
+
16 ! Parameters
+
17 real(real64), parameter :: zero = 0.0d0
+
18 real(real64), parameter :: one = 1.0d0
+
19
+
20 ! Local Variables
+
21 character :: ta, tb
+
22 integer(int32) :: m, n, k, lda, ldb, flag
+
23 class(errors), pointer :: errmgr
+
24 type(errors), target :: deferr
+
25 character(len = 128) :: errmsg
+
26
+
27 ! Initialization
+
28 m = size(c, 1)
+
29 n = size(c, 2)
+
30 if (transa) then ! K = # of columns in op(A) (# of rows in op(B))
+
31 k = size(a, 1)
+
32 ta = 'T'
+
33 lda = k
+
34 else
+
35 k = size(a, 2)
+
36 ta = 'N'
+
37 lda = m
+
38 end if
+
39 if (transb) then
+
40 tb = 'T'
+
41 ldb = n
+
42 else
+
43 tb = 'N'
+
44 ldb = k
+
45 end if
+
46 if (present(err)) then
+
47 errmgr => err
+
48 else
+
49 errmgr => deferr
+
50 end if
+
51
+
52 ! Input Check
+
53 flag = 0
+
54 if (transa) then
+
55 if (size(a, 2) /= m) flag = 4
+
56 else
+
57 if (size(a, 1) /= m) flag = 4
+
58 end if
+
59 if (transb) then
+
60 if (size(b, 2) /= k .or. size(b, 1) /= n) flag = 5
+
61 else
+
62 if (size(b, 1) /= k .or. size(b, 2) /= n) flag = 5
+
63 end if
+
64 if (flag /= 0) then
+
65 ! ERROR: Matrix dimensions mismatch
+
66 write(errmsg, '(AI0A)') &
+
67 "Matrix dimension mismatch. Input number ", flag, &
+
68 " was not sized correctly."
+
69 call errmgr%report_error("mtx_mult_mtx", errmsg, &
+
70 la_array_size_error)
+
71 return
+
72 end if
+
73
+
74 ! Call DGEMM
+
75 call dgemm(ta, tb, m, n, k, alpha, a, lda, b, ldb, beta, c, m)
+
76 end subroutine
+
77
+
78! ------------------------------------------------------------------------------
+
79 module subroutine mtx_mult_vec(trans, alpha, a, b, beta, c, err)
+
80 ! Arguments
+
81 logical, intent(in) :: trans
+
82 real(real64), intent(in) :: alpha, beta
+
83 real(real64), intent(in), dimension(:,:) :: a
+
84 real(real64), intent(in), dimension(:) :: b
+
85 real(real64), intent(inout), dimension(:) :: c
+
86 class(errors), intent(inout), optional, target :: err
+
87
+
88 ! Local Variables
+
89 character :: t
+
90 integer(int32) :: m, n, flag
+
91 class(errors), pointer :: errmgr
+
92 type(errors), target :: deferr
+
93 character(len = 128) :: errmsg
+
94
+
95 ! Initialization
+
96 m = size(a, 1)
+
97 n = size(a, 2)
+
98 t = 'N'
+
99 if (trans) t = 'T'
+
100 if (present(err)) then
+
101 errmgr => err
+
102 else
+
103 errmgr => deferr
+
104 end if
+
105
+
106 ! Input Check
+
107 flag = 0
+
108 if (trans) then
+
109 if (size(b) /= m) then
+
110 flag = 4
+
111 else if (size(c) /= n) then
+
112 flag = 6
+
113 end if
+
114 else
+
115 if (size(b) /= n) then
+
116 flag = 4
+
117 else if (size(c) /= m) then
+
118 flag = 6
+
119 end if
+
120 end if
+
121 if (flag /= 0) then
+
122 ! ERROR: Matrix dimensions mismatch
+
123 write(errmsg, '(AI0A)') &
+
124 "Matrix dimension mismatch. Input number ", flag, &
+
125 " was not sized correctly."
+
126 call errmgr%report_error("mtx_mult_vec", errmsg, &
+
127 la_array_size_error)
+
128 return
+
129 end if
+
130
+
131 ! Call DGEMV
+
132 call dgemv(t, m, n, alpha, a, m, b, 1, beta, c, 1)
+
133 end subroutine
+
134
+
135! xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx !
+
136! COMPLEX VALUED VERSIONS !
+
137! xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx !
+
138 module subroutine cmtx_mult_mtx(opa, opb, alpha, a, b, beta, c, err)
+
139 ! Arguments
+
140 integer(int32), intent(in) :: opa, opb
+
141 complex(real64), intent(in) :: alpha, beta
+
142 complex(real64), intent(in), dimension(:,:) :: a, b
+
143 complex(real64), intent(inout), dimension(:,:) :: c
+
144 class(errors), intent(inout), optional, target :: err
+
145
+
146 ! Parameters
+
147 real(real64), parameter :: zero = 0.0d0
+
148 real(real64), parameter :: one = 1.0d0
+
149
+
150 ! Local Variables
+
151 character :: ta, tb
+
152 integer(int32) :: m, n, k, lda, ldb, flag
+
153 class(errors), pointer :: errmgr
+
154 type(errors), target :: deferr
+
155 character(len = 128) :: errmsg
+
156
+
157 ! Initialization
+
158 m = size(c, 1)
+
159 n = size(c, 2)
+
160 if (opa == transpose) then ! K = # of columns in op(A) (# of rows in op(B))
+
161 k = size(a, 1)
+
162 ta = 'T'
+
163 lda = k
+
164 else if (opa == hermitian_transpose) then
+
165 k = size(a, 1)
+
166 ta = 'H'
+
167 lda = k
+
168 else
+
169 k = size(a, 2)
+
170 ta = 'N'
+
171 lda = m
+
172 end if
+
173 if (opb == transpose) then
+
174 tb = 'T'
+
175 ldb = n
+
176 else if (opb == hermitian_transpose) then
+
177 tb = 'H'
+
178 ldb = n
+
179 else
+
180 tb = 'N'
+
181 ldb = k
+
182 end if
+
183 if (present(err)) then
+
184 errmgr => err
+
185 else
+
186 errmgr => deferr
+
187 end if
+
188
+
189 ! Input Check
+
190 flag = 0
+
191 if (opa == transpose .or. opa == hermitian_transpose) then
+
192 if (size(a, 2) /= m) flag = 4
+
193 else
+
194 if (size(a, 1) /= m) flag = 4
+
195 end if
+
196 if (opb == transpose .or. opb == hermitian_transpose) then
+
197 if (size(b, 2) /= k .or. size(b, 1) /= n) flag = 5
+
198 else
+
199 if (size(b, 1) /= k .or. size(b, 2) /= n) flag = 5
+
200 end if
+
201 if (flag /= 0) then
+
202 ! ERROR: Matrix dimensions mismatch
+
203 write(errmsg, '(AI0A)') &
+
204 "Matrix dimension mismatch. Input number ", flag, &
+
205 " was not sized correctly."
+
206 call errmgr%report_error("cmtx_mult_mtx", errmsg, &
+
207 la_array_size_error)
+
208 return
+
209 end if
+
210
+
211 ! Call ZGEMM
+
212 call zgemm(ta, tb, m, n, k, alpha, a, lda, b, ldb, beta, c, m)
+
213 end subroutine
+
214
+
215! ------------------------------------------------------------------------------
+
216 module subroutine cmtx_mult_vec(opa, alpha, a, b, beta, c, err)
+
217 ! Arguments
+
218 integer(int32), intent(in) :: opa
+
219 complex(real64), intent(in) :: alpha, beta
+
220 complex(real64), intent(in), dimension(:,:) :: a
+
221 complex(real64), intent(in), dimension(:) :: b
+
222 complex(real64), intent(inout), dimension(:) :: c
+
223 class(errors), intent(inout), optional, target :: err
+
224
+
225 ! Local Variables
+
226 character :: t
+
227 integer(int32) :: m, n, flag
+
228 class(errors), pointer :: errmgr
+
229 type(errors), target :: deferr
+
230 character(len = 128) :: errmsg
+
231
+
232 ! Initialization
+
233 m = size(a, 1)
+
234 n = size(a, 2)
+
235 if (opa == transpose) then
+
236 t = 'T'
+
237 else if (opa == hermitian_transpose) then
+
238 t = 'H'
+
239 else
+
240 t = 'N'
+
241 end if
+
242 if (present(err)) then
+
243 errmgr => err
+
244 else
+
245 errmgr => deferr
+
246 end if
+
247
+
248 ! Input Check
+
249 flag = 0
+
250 if (opa == transpose .or. opa == hermitian_transpose) then
+
251 if (size(b) /= m) then
+
252 flag = 4
+
253 else if (size(c) /= n) then
+
254 flag = 6
+
255 end if
+
256 else
+
257 if (size(b) /= n) then
+
258 flag = 4
+
259 else if (size(c) /= m) then
+
260 flag = 6
+
261 end if
+
262 end if
+
263 if (flag /= 0) then
+
264 ! ERROR: Matrix dimensions mismatch
+
265 write(errmsg, '(AI0A)') &
+
266 "Matrix dimension mismatch. Input number ", flag, &
+
267 " was not sized correctly."
+
268 call errmgr%report_error("cmtx_mult_vec", errmsg, &
+
269 la_array_size_error)
+
270 return
+
271 end if
+
272
+
273 ! Call ZGEMV
+
274 call zgemv(t, m, n, alpha, a, m, b, 1, beta, c, 1)
+
275 end subroutine
+
276
+
277! ******************************************************************************
+
278! RANK 1 UPDATE
+
279! ------------------------------------------------------------------------------
+
280 module subroutine rank1_update_dbl(alpha, x, y, a, err)
+
281 ! Arguments
+
282 real(real64), intent(in) :: alpha
+
283 real(real64), intent(in), dimension(:) :: x, y
+
284 real(real64), intent(inout), dimension(:,:) :: a
+
285 class(errors), intent(inout), optional, target :: err
+
286
+
287 ! Parameters
+
288 real(real64), parameter :: zero = 0.0d0
+
289
+
290 ! Local Variables
+
291 integer(int32) :: j, m, n
+
292 real(real64) :: temp
+
293 class(errors), pointer :: errmgr
+
294 type(errors), target :: deferr
+
295
+
296 ! Initialization
+
297 m = size(x)
+
298 n = size(y)
+
299 if (present(err)) then
+
300 errmgr => err
+
301 else
+
302 errmgr => deferr
+
303 end if
+
304
+
305 ! Input Check
+
306 if (size(a, 1) /= m .or. size(a, 2) /= n) then
+
307 ! ERROR: Matrix dimension array
+
308 call errmgr%report_error("rank1_update_dbl", &
+
309 "Matrix dimension mismatch.", la_array_size_error)
+
310 return
+
311 end if
+
312
+
313 ! Process
+
314 do j = 1, n
+
315 if (y(j) /= zero) then
+
316 temp = alpha * y(j)
+
317 a(:,j) = a(:,j) + temp * x
+
318 end if
+
319 end do
+
320 end subroutine
+
321
+
322! xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx !
+
323! COMPLEX VALUED VERSIONS !
+
324! xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx !
+
325 module subroutine rank1_update_cmplx(alpha, x, y, a, err)
+
326 ! Arguments
+
327 complex(real64), intent(in) :: alpha
+
328 complex(real64), intent(in), dimension(:) :: x, y
+
329 complex(real64), intent(inout), dimension(:,:) :: a
+
330 class(errors), intent(inout), optional, target :: err
+
331
+
332 ! Parameters
+
333 complex(real64), parameter :: zero = (0.0d0, 0.0d0)
+
334
+
335 ! Local Variables
+
336 integer(int32) :: j, m, n
+
337 complex(real64) :: temp
+
338 class(errors), pointer :: errmgr
+
339 type(errors), target :: deferr
+
340
+
341 ! Initialization
+
342 m = size(x)
+
343 n = size(y)
+
344 if (present(err)) then
+
345 errmgr => err
+
346 else
+
347 errmgr => deferr
+
348 end if
+
349
+
350 ! Input Check
+
351 if (size(a, 1) /= m .or. size(a, 2) /= n) then
+
352 ! ERROR: Matrix dimension array
+
353 call errmgr%report_error("rank1_update_cmplx", &
+
354 "Matrix dimension mismatch.", la_array_size_error)
+
355 return
+
356 end if
+
357
+
358 ! Process
+
359 do j = 1, n
+
360 if (y(j) /= zero) then
+
361 temp = alpha * conjg(y(j))
+
362 a(:,j) = a(:,j) + temp * x
+
363 end if
+
364 end do
+
365 end subroutine
+
366
+
367! ******************************************************************************
+
368! DIAGONAL MATRIX MULTIPLICATION ROUTINES
+
369! ------------------------------------------------------------------------------
+
370 module subroutine diag_mtx_mult_mtx(lside, trans, alpha, a, b, beta, c, err)
+
371 ! Arguments
+
372 logical, intent(in) :: lside, trans
+
373 real(real64) :: alpha, beta
+
374 real(real64), intent(in), dimension(:) :: a
+
375 real(real64), intent(in), dimension(:,:) :: b
+
376 real(real64), intent(inout), dimension(:,:) :: c
+
377 class(errors), intent(inout), optional, target :: err
+
378
+
379 ! Parameters
+
380 real(real64), parameter :: zero = 0.0d0
+
381 real(real64), parameter :: one = 1.0d0
+
382
+
383 ! Local Variables
+
384 integer(int32) :: i, m, n, k, nrowb, ncolb, flag
+
385 real(real64) :: temp
+
386 class(errors), pointer :: errmgr
+
387 type(errors), target :: deferr
+
388 character(len = 128) :: errmsg
+
389
+
390 ! Initialization
+
391 m = size(c, 1)
+
392 n = size(c, 2)
+
393 k = size(a)
+
394 nrowb = size(b, 1)
+
395 ncolb = size(b, 2)
+
396 if (present(err)) then
+
397 errmgr => err
+
398 else
+
399 errmgr => deferr
+
400 end if
+
401
+
402 ! Input Check
+
403 flag = 0
+
404 if (lside) then
+
405 if (k > m) then
+
406 flag = 4
+
407 else
+
408 if (trans) then
+
409 ! Compute C = alpha * A * B**T + beta * C
+
410 if (nrowb /= n .or. ncolb < k) flag = 5
+
411 else
+
412 ! Compute C = alpha * A * B + beta * C
+
413 if (nrowb < k .or. ncolb /= n) flag = 5
+
414 end if
+
415 end if
+
416 else
+
417 if (k > n) then
+
418 flag = 4
+
419 else
+
420 if (trans) then
+
421 ! Compute C = alpha * B**T * A + beta * C
+
422 if (ncolb /= m .or. nrowb < k) flag = 5
+
423 else
+
424 ! Compute C = alpha * B * A + beta * C
+
425 if (nrowb /= m .or. ncolb < k) flag = 5
+
426 end if
+
427 end if
+
428 end if
+
429 if (flag /= 0) then
+
430 ! ERROR: One of the input arrays is not sized correctly
+
431 write(errmsg, '(AI0A)') "Input number ", flag, &
+
432 " is not sized correctly."
+
433 call errmgr%report_error("diag_mtx_mult_mtx", trim(errmsg), &
+
434 la_array_size_error)
+
435 return
+
436 end if
+
437
+
438 ! Deal with ALPHA == 0
+
439 if (alpha == 0) then
+
440 if (beta == zero) then
+
441 c = zero
+
442 else if (beta /= one) then
+
443 c = beta * c
+
444 end if
+
445 return
+
446 end if
+
447
+
448 ! Process
+
449 if (lside) then
+
450 if (trans) then
+
451 ! Compute C = alpha * A * B**T + beta * C
+
452 do i = 1, k
+
453 if (beta == zero) then
+
454 c(i,:) = zero
+
455 else if (beta /= one) then
+
456 c(i,:) = beta * c(i,:)
+
457 end if
+
458 temp = alpha * a(i)
+
459 if (temp /= one) c(i,:) = c(i,:) + temp * b(:,i)
+
460 end do
+
461 else
+
462 ! Compute C = alpha * A * B + beta * C
+
463 do i = 1, k
+
464 if (beta == zero) then
+
465 c(i,:) = zero
+
466 else if (beta /= one) then
+
467 c(i,:) = beta * c(i,:)
+
468 end if
+
469 temp = alpha * a(i)
+
470 if (temp /= one) c(i,:) = c(i,:) + temp * b(i,:)
+
471 end do
+
472 end if
+
473
+
474 ! Handle extra rows
+
475 if (m > k) then
+
476 if (beta == zero) then
+
477 c(k+1:m,:) = zero
+
478 else
+
479 c(k+1:m,:) = beta * c(k+1:m,:)
+
480 end if
+
481 end if
+
482 else
+
483 if (trans) then
+
484 ! Compute C = alpha * B**T * A + beta * C
+
485 do i = 1, k
+
486 if (beta == zero) then
+
487 c(:,i) = zero
+
488 else if (beta /= one) then
+
489 c(:,i) = beta * c(:,i)
+
490 end if
+
491 temp = alpha * a(i)
+
492 if (temp /= one) c(:,i) = c(:,i) + temp * b(i,:)
+
493 end do
+
494 else
+
495 ! Compute C = alpha * B * A + beta * C
+
496 do i = 1, k
+
497 if (beta == zero) then
+
498 c(:,i) = zero
+
499 else if (beta /= one) then
+
500 c(:,i) = beta * c(:,i)
+
501 end if
+
502 temp = alpha * a(i)
+
503 if (temp /= one) c(:,i) = c(:,i) + temp * b(:,i)
+
504 end do
+
505 end if
+
506
+
507 ! Handle extra columns
+
508 if (n > k) then
+
509 if (beta == zero) then
+
510 c(:,k+1:m) = zero
+
511 else if (beta /= one) then
+
512 c(:,k+1:m) = beta * c(:,k+1:m)
+
513 end if
+
514 end if
+
515 end if
+
516 end subroutine
+
517
+
518! ------------------------------------------------------------------------------
+
519 module subroutine diag_mtx_mult_mtx2(lside, alpha, a, b, err)
+
520 ! Arguments
+
521 logical, intent(in) :: lside
+
522 real(real64), intent(in) :: alpha
+
523 real(real64), intent(in), dimension(:) :: a
+
524 real(real64), intent(inout), dimension(:,:) :: b
+
525 class(errors), intent(inout), optional, target :: err
+
526
+
527 ! Parameters
+
528 real(real64), parameter :: zero = 0.0d0
+
529 real(real64), parameter :: one = 1.0d0
+
530
+
531 ! Local Variables
+
532 integer(int32) :: i, m, n, k
+
533 real(real64) :: temp
+
534 class(errors), pointer :: errmgr
+
535 type(errors), target :: deferr
+
536
+
537 ! Initialization
+
538 m = size(b, 1)
+
539 n = size(b, 2)
+
540 k = size(a)
+
541 if (present(err)) then
+
542 errmgr => err
+
543 else
+
544 errmgr => deferr
+
545 end if
+
546
+
547 ! Input Check
+
548 if ((lside .and. k > m) .or. (.not.lside .and. k > n)) then
+
549 ! ERROR: One of the input arrays is not sized correctly
+
550 call errmgr%report_error("diag_mtx_mult_mtx2", &
+
551 "Input number 3 is not sized correctly.", &
+
552 la_array_size_error)
+
553 return
+
554 end if
+
555
+
556 ! Process
+
557 if (lside) then
+
558 ! Compute B = alpha * A * B
+
559 do i = 1, k
+
560 temp = alpha * a(i)
+
561 if (temp /= one) b(i,:) = temp * b(i,:)
+
562 end do
+
563 if (m > k) b(k+1:m,:) = zero
+
564 else
+
565 ! Compute B = alpha * B * A
+
566 do i = 1, k
+
567 temp = alpha * a(i)
+
568 if (temp /= one) b(:,i) = temp * b(:,i)
+
569 end do
+
570 if (n > k) b(:,k+1:n) = zero
+
571 end if
+
572 end subroutine
+
573
+
574! ------------------------------------------------------------------------------
+
575 module subroutine diag_mtx_mult_mtx3(lside, trans, alpha, a, b, beta, c, err)
+
576 ! Arguments
+
577 logical, intent(in) :: lside, trans
+
578 real(real64) :: alpha, beta
+
579 complex(real64), intent(in), dimension(:) :: a
+
580 real(real64), intent(in), dimension(:,:) :: b
+
581 complex(real64), intent(inout), dimension(:,:) :: c
+
582 class(errors), intent(inout), optional, target :: err
+
583
+
584 ! Parameters
+
585 complex(real64), parameter :: zero = (0.0d0, 0.0d0)
+
586 complex(real64), parameter :: one = (1.0d0, 0.0d0)
+
587
+
588 ! Local Variables
+
589 integer(int32) :: i, m, n, k, nrowb, ncolb, flag
+
590 complex(real64) :: temp
+
591 class(errors), pointer :: errmgr
+
592 type(errors), target :: deferr
+
593 character(len = 128) :: errmsg
+
594
+
595 ! Initialization
+
596 m = size(c, 1)
+
597 n = size(c, 2)
+
598 k = size(a)
+
599 nrowb = size(b, 1)
+
600 ncolb = size(b, 2)
+
601 if (present(err)) then
+
602 errmgr => err
+
603 else
+
604 errmgr => deferr
+
605 end if
+
606
+
607 ! Input Check
+
608 flag = 0
+
609 if (lside) then
+
610 if (k > m) then
+
611 flag = 4
+
612 else
+
613 if (trans) then
+
614 ! Compute C = alpha * A * B**T + beta * C
+
615 if (nrowb /= n .or. ncolb < k) flag = 5
+
616 else
+
617 ! Compute C = alpha * A * B + beta * C
+
618 if (nrowb < k .or. ncolb /= n) flag = 5
+
619 end if
+
620 end if
+
621 else
+
622 if (k > n) then
+
623 flag = 4
+
624 else
+
625 if (trans) then
+
626 ! Compute C = alpha * B**T * A + beta * C
+
627 if (ncolb /= m .or. nrowb < k) flag = 5
+
628 else
+
629 ! Compute C = alpha * B * A + beta * C
+
630 if (nrowb /= m .or. ncolb < k) flag = 5
+
631 end if
+
632 end if
+
633 end if
+
634 if (flag /= 0) then
+
635 ! ERROR: One of the input arrays is not sized correctly
+
636 write(errmsg, '(AI0A)') "Input number ", flag, &
+
637 " is not sized correctly."
+
638 call errmgr%report_error("diag_mtx_mult_mtx3", trim(errmsg), &
+
639 la_array_size_error)
+
640 return
+
641 end if
+
642
+
643 ! Deal with ALPHA == 0
+
644 if (alpha == 0) then
+
645 if (beta == zero) then
+
646 c = zero
+
647 else if (beta /= one) then
+
648 c = beta * c
+
649 end if
+
650 return
+
651 end if
+
652
+
653 ! Process
+
654 if (lside) then
+
655 if (trans) then
+
656 ! Compute C = alpha * A * B**T + beta * C
+
657 do i = 1, k
+
658 if (beta == zero) then
+
659 c(i,:) = zero
+
660 else if (beta /= one) then
+
661 c(i,:) = beta * c(i,:)
+
662 end if
+
663 temp = alpha * a(i)
+
664 if (temp /= one) c(i,:) = c(i,:) + temp * b(:,i)
+
665 end do
+
666 else
+
667 ! Compute C = alpha * A * B + beta * C
+
668 do i = 1, k
+
669 if (beta == zero) then
+
670 c(i,:) = zero
+
671 else if (beta /= one) then
+
672 c(i,:) = beta * c(i,:)
+
673 end if
+
674 temp = alpha * a(i)
+
675 if (temp /= one) c(i,:) = c(i,:) + temp * b(i,:)
+
676 end do
+
677 end if
+
678
+
679 ! Handle extra rows
+
680 if (m > k) then
+
681 if (beta == zero) then
+
682 c(k+1:m,:) = zero
+
683 else
+
684 c(k+1:m,:) = beta * c(k+1:m,:)
+
685 end if
+
686 end if
+
687 else
+
688 if (trans) then
+
689 ! Compute C = alpha * B**T * A + beta * C
+
690 do i = 1, k
+
691 if (beta == zero) then
+
692 c(:,i) = zero
+
693 else if (beta /= one) then
+
694 c(:,i) = beta * c(:,i)
+
695 end if
+
696 temp = alpha * a(i)
+
697 if (temp /= one) c(:,i) = c(:,i) + temp * b(i,:)
+
698 end do
+
699 else
+
700 ! Compute C = alpha * B * A + beta * C
+
701 do i = 1, k
+
702 if (beta == zero) then
+
703 c(:,i) = zero
+
704 else if (beta /= one) then
+
705 c(:,i) = beta * c(:,i)
+
706 end if
+
707 temp = alpha * a(i)
+
708 if (temp /= one) c(:,i) = c(:,i) + temp * b(:,i)
+
709 end do
+
710 end if
+
711
+
712 ! Handle extra columns
+
713 if (n > k) then
+
714 if (beta == zero) then
+
715 c(:,k+1:m) = zero
+
716 else if (beta /= one) then
+
717 c(:,k+1:m) = beta * c(:,k+1:m)
+
718 end if
+
719 end if
+
720 end if
+
721 end subroutine
+
722
+
723! ------------------------------------------------------------------------------
+
724 module subroutine diag_mtx_mult_mtx4(lside, opb, alpha, a, b, beta, c, err)
+
725 ! Arguments
+
726 logical, intent(in) :: lside
+
727 integer(int32), intent(in) :: opb
+
728 real(real64) :: alpha, beta
+
729 complex(real64), intent(in), dimension(:) :: a
+
730 complex(real64), intent(in), dimension(:,:) :: b
+
731 complex(real64), intent(inout), dimension(:,:) :: c
+
732 class(errors), intent(inout), optional, target :: err
+
733
+
734 ! Parameters
+
735 complex(real64), parameter :: zero = (0.0d0, 0.0d0)
+
736 complex(real64), parameter :: one = (1.0d0, 0.0d0)
+
737
+
738 ! Local Variables
+
739 integer(int32) :: i, m, n, k, nrowb, ncolb, flag
+
740 complex(real64) :: temp
+
741 class(errors), pointer :: errmgr
+
742 type(errors), target :: deferr
+
743 character(len = 128) :: errmsg
+
744
+
745 ! Initialization
+
746 m = size(c, 1)
+
747 n = size(c, 2)
+
748 k = size(a)
+
749 nrowb = size(b, 1)
+
750 ncolb = size(b, 2)
+
751 if (present(err)) then
+
752 errmgr => err
+
753 else
+
754 errmgr => deferr
+
755 end if
+
756
+
757 ! Input Check
+
758 flag = 0
+
759 if (lside) then
+
760 if (k > m) then
+
761 flag = 4
+
762 else
+
763 if (opb == transpose .or. opb == hermitian_transpose) then
+
764 ! Compute C = alpha * A * B**T + beta * C
+
765 if (nrowb /= n .or. ncolb < k) flag = 5
+
766 else
+
767 ! Compute C = alpha * A * B + beta * C
+
768 if (nrowb < k .or. ncolb /= n) flag = 5
+
769 end if
+
770 end if
+
771 else
+
772 if (k > n) then
+
773 flag = 4
+
774 else
+
775 if (opb == transpose .or. opb == hermitian_transpose) then
+
776 ! Compute C = alpha * B**T * A + beta * C
+
777 if (ncolb /= m .or. nrowb < k) flag = 5
+
778 else
+
779 ! Compute C = alpha * B * A + beta * C
+
780 if (nrowb /= m .or. ncolb < k) flag = 5
+
781 end if
+
782 end if
+
783 end if
+
784 if (flag /= 0) then
+
785 ! ERROR: One of the input arrays is not sized correctly
+
786 write(errmsg, '(AI0A)') "Input number ", flag, &
+
787 " is not sized correctly."
+
788 call errmgr%report_error("diag_mtx_mult_mtx4", trim(errmsg), &
+
789 la_array_size_error)
+
790 return
+
791 end if
+
792
+
793 ! Deal with ALPHA == 0
+
794 if (alpha == 0) then
+
795 if (beta == zero) then
+
796 c = zero
+
797 else if (beta /= one) then
+
798 c = beta * c
+
799 end if
+
800 return
+
801 end if
+
802
+
803 ! Process
+
804 if (lside) then
+
805 if (opb == transpose) then
+
806 ! Compute C = alpha * A * B**T + beta * C
+
807 do i = 1, k
+
808 if (beta == zero) then
+
809 c(i,:) = zero
+
810 else if (beta /= one) then
+
811 c(i,:) = beta * c(i,:)
+
812 end if
+
813 temp = alpha * a(i)
+
814 if (temp /= one) c(i,:) = c(i,:) + temp * b(:,i)
+
815 end do
+
816 else if (opb == hermitian_transpose) then
+
817 ! Compute C = alpha * A * B**H + beta * C
+
818 do i = 1, k
+
819 if (beta == zero) then
+
820 c(i,:) = zero
+
821 else if (beta /= one) then
+
822 c(i,:) = beta * c(i,:)
+
823 end if
+
824 temp = alpha * a(i)
+
825 if (temp /= one) c(i,:) = c(i,:) + temp * conjg(b(:,i))
+
826 end do
+
827 else
+
828 ! Compute C = alpha * A * B + beta * C
+
829 do i = 1, k
+
830 if (beta == zero) then
+
831 c(i,:) = zero
+
832 else if (beta /= one) then
+
833 c(i,:) = beta * c(i,:)
+
834 end if
+
835 temp = alpha * a(i)
+
836 if (temp /= one) c(i,:) = c(i,:) + temp * b(i,:)
+
837 end do
+
838 end if
+
839
+
840 ! Handle extra rows
+
841 if (m > k) then
+
842 if (beta == zero) then
+
843 c(k+1:m,:) = zero
+
844 else
+
845 c(k+1:m,:) = beta * c(k+1:m,:)
+
846 end if
+
847 end if
+
848 else
+
849 if (opb == transpose) then
+
850 ! Compute C = alpha * B**T * A + beta * C
+
851 do i = 1, k
+
852 if (beta == zero) then
+
853 c(:,i) = zero
+
854 else if (beta /= one) then
+
855 c(:,i) = beta * c(:,i)
+
856 end if
+
857 temp = alpha * a(i)
+
858 if (temp /= one) c(:,i) = c(:,i) + temp * b(i,:)
+
859 end do
+
860 else if (opb == hermitian_transpose) then
+
861 ! Compute C = alpha * B**H * A + beta * C
+
862 do i = 1, k
+
863 if (beta == zero) then
+
864 c(:,i) = zero
+
865 else if (beta /= one) then
+
866 c(:,i) = beta * c(:,i)
+
867 end if
+
868 temp = alpha * a(i)
+
869 if (temp /= one) c(:,i) = c(:,i) + temp * conjg(b(i,:))
+
870 end do
+
871 else
+
872 ! Compute C = alpha * B * A + beta * C
+
873 do i = 1, k
+
874 if (beta == zero) then
+
875 c(:,i) = zero
+
876 else if (beta /= one) then
+
877 c(:,i) = beta * c(:,i)
+
878 end if
+
879 temp = alpha * a(i)
+
880 if (temp /= one) c(:,i) = c(:,i) + temp * b(:,i)
+
881 end do
+
882 end if
+
883
+
884 ! Handle extra columns
+
885 if (n > k) then
+
886 if (beta == zero) then
+
887 c(:,k+1:m) = zero
+
888 else if (beta /= one) then
+
889 c(:,k+1:m) = beta * c(:,k+1:m)
+
890 end if
+
891 end if
+
892 end if
+
893 end subroutine
+
894
+
895! ------------------------------------------------------------------------------
+
896 module subroutine diag_mtx_mult_mtx_cmplx(lside, opb, alpha, a, b, beta, c, err)
+
897 ! Arguments
+
898 logical, intent(in) :: lside
+
899 integer(int32), intent(in) :: opb
+
900 complex(real64) :: alpha, beta
+
901 complex(real64), intent(in), dimension(:) :: a
+
902 complex(real64), intent(in), dimension(:,:) :: b
+
903 complex(real64), intent(inout), dimension(:,:) :: c
+
904 class(errors), intent(inout), optional, target :: err
+
905
+
906 ! Parameters
+
907 complex(real64), parameter :: zero = (0.0d0, 0.0d0)
+
908 complex(real64), parameter :: one = (1.0d0, 0.0d0)
+
909
+
910 ! Local Variables
+
911 integer(int32) :: i, m, n, k, nrowb, ncolb, flag
+
912 complex(real64) :: temp
+
913 class(errors), pointer :: errmgr
+
914 type(errors), target :: deferr
+
915 character(len = 128) :: errmsg
+
916
+
917 ! Initialization
+
918 m = size(c, 1)
+
919 n = size(c, 2)
+
920 k = size(a)
+
921 nrowb = size(b, 1)
+
922 ncolb = size(b, 2)
+
923 if (present(err)) then
+
924 errmgr => err
+
925 else
+
926 errmgr => deferr
+
927 end if
+
928
+
929 ! Input Check
+
930 flag = 0
+
931 if (lside) then
+
932 if (k > m) then
+
933 flag = 4
+
934 else
+
935 if (opb == transpose .or. opb == hermitian_transpose) then
+
936 ! Compute C = alpha * A * B**T + beta * C
+
937 if (nrowb /= n .or. ncolb < k) flag = 5
+
938 else
+
939 ! Compute C = alpha * A * B + beta * C
+
940 if (nrowb < k .or. ncolb /= n) flag = 5
+
941 end if
+
942 end if
+
943 else
+
944 if (k > n) then
+
945 flag = 4
+
946 else
+
947 if (opb == transpose .or. opb == hermitian_transpose) then
+
948 ! Compute C = alpha * B**T * A + beta * C
+
949 if (ncolb /= m .or. nrowb < k) flag = 5
+
950 else
+
951 ! Compute C = alpha * B * A + beta * C
+
952 if (nrowb /= m .or. ncolb < k) flag = 5
+
953 end if
+
954 end if
+
955 end if
+
956 if (flag /= 0) then
+
957 ! ERROR: One of the input arrays is not sized correctly
+
958 write(errmsg, '(AI0A)') "Input number ", flag, &
+
959 " is not sized correctly."
+
960 call errmgr%report_error("diag_mtx_mult_mtx_cmplx", trim(errmsg), &
+
961 la_array_size_error)
+
962 return
+
963 end if
+
964
+
965 ! Deal with ALPHA == 0
+
966 if (alpha == 0) then
+
967 if (beta == zero) then
+
968 c = zero
+
969 else if (beta /= one) then
+
970 c = beta * c
+
971 end if
+
972 return
+
973 end if
+
974
+
975 ! Process
+
976 if (lside) then
+
977 if (opb == transpose) then
+
978 ! Compute C = alpha * A * B**T + beta * C
+
979 do i = 1, k
+
980 if (beta == zero) then
+
981 c(i,:) = zero
+
982 else if (beta /= one) then
+
983 c(i,:) = beta * c(i,:)
+
984 end if
+
985 temp = alpha * a(i)
+
986 if (temp /= one) c(i,:) = c(i,:) + temp * b(:,i)
+
987 end do
+
988 else if (opb == hermitian_transpose) then
+
989 ! Compute C = alpha * A * B**H + beta * C
+
990 do i = 1, k
+
991 if (beta == zero) then
+
992 c(i,:) = zero
+
993 else if (beta /= one) then
+
994 c(i,:) = beta * c(i,:)
+
995 end if
+
996 temp = alpha * a(i)
+
997 if (temp /= one) c(i,:) = c(i,:) + temp * conjg(b(:,i))
+
998 end do
+
999 else
+
1000 ! Compute C = alpha * A * B + beta * C
+
1001 do i = 1, k
+
1002 if (beta == zero) then
+
1003 c(i,:) = zero
+
1004 else if (beta /= one) then
+
1005 c(i,:) = beta * c(i,:)
+
1006 end if
+
1007 temp = alpha * a(i)
+
1008 if (temp /= one) c(i,:) = c(i,:) + temp * b(i,:)
+
1009 end do
+
1010 end if
+
1011
+
1012 ! Handle extra rows
+
1013 if (m > k) then
+
1014 if (beta == zero) then
+
1015 c(k+1:m,:) = zero
+
1016 else
+
1017 c(k+1:m,:) = beta * c(k+1:m,:)
+
1018 end if
+
1019 end if
+
1020 else
+
1021 if (opb == transpose) then
+
1022 ! Compute C = alpha * B**T * A + beta * C
+
1023 do i = 1, k
+
1024 if (beta == zero) then
+
1025 c(:,i) = zero
+
1026 else if (beta /= one) then
+
1027 c(:,i) = beta * c(:,i)
+
1028 end if
+
1029 temp = alpha * a(i)
+
1030 if (temp /= one) c(:,i) = c(:,i) + temp * b(i,:)
+
1031 end do
+
1032 else if (opb == hermitian_transpose) then
+
1033 ! Compute C = alpha * B**H * A + beta * C
+
1034 do i = 1, k
+
1035 if (beta == zero) then
+
1036 c(:,i) = zero
+
1037 else if (beta /= one) then
+
1038 c(:,i) = beta * c(:,i)
+
1039 end if
+
1040 temp = alpha * a(i)
+
1041 if (temp /= one) c(:,i) = c(:,i) + temp * conjg(b(i,:))
+
1042 end do
+
1043 else
+
1044 ! Compute C = alpha * B * A + beta * C
+
1045 do i = 1, k
+
1046 if (beta == zero) then
+
1047 c(:,i) = zero
+
1048 else if (beta /= one) then
+
1049 c(:,i) = beta * c(:,i)
+
1050 end if
+
1051 temp = alpha * a(i)
+
1052 if (temp /= one) c(:,i) = c(:,i) + temp * b(:,i)
+
1053 end do
+
1054 end if
+
1055
+
1056 ! Handle extra columns
+
1057 if (n > k) then
+
1058 if (beta == zero) then
+
1059 c(:,k+1:m) = zero
+
1060 else if (beta /= one) then
+
1061 c(:,k+1:m) = beta * c(:,k+1:m)
+
1062 end if
+
1063 end if
+
1064 end if
+
1065 end subroutine
+
1066
+
1067! ------------------------------------------------------------------------------
+
1068 module subroutine diag_mtx_mult_mtx2_cmplx(lside, alpha, a, b, err)
+
1069 ! Arguments
+
1070 logical, intent(in) :: lside
+
1071 complex(real64), intent(in) :: alpha
+
1072 complex(real64), intent(in), dimension(:) :: a
+
1073 complex(real64), intent(inout), dimension(:,:) :: b
+
1074 class(errors), intent(inout), optional, target :: err
+
1075
+
1076 ! Parameters
+
1077 complex(real64), parameter :: zero = (0.0d0, 0.0d0)
+
1078 complex(real64), parameter :: one = (1.0d0, 0.0d0)
+
1079
+
1080 ! Local Variables
+
1081 integer(int32) :: i, m, n, k
+
1082 complex(real64) :: temp
+
1083 class(errors), pointer :: errmgr
+
1084 type(errors), target :: deferr
+
1085
+
1086 ! Initialization
+
1087 m = size(b, 1)
+
1088 n = size(b, 2)
+
1089 k = size(a)
+
1090 if (present(err)) then
+
1091 errmgr => err
+
1092 else
+
1093 errmgr => deferr
+
1094 end if
+
1095
+
1096 ! Input Check
+
1097 if ((lside .and. k > m) .or. (.not.lside .and. k > n)) then
+
1098 ! ERROR: One of the input arrays is not sized correctly
+
1099 call errmgr%report_error("diag_mtx_mult_mtx2_cmplx", &
+
1100 "Input number 3 is not sized correctly.", &
+
1101 la_array_size_error)
+
1102 return
+
1103 end if
+
1104
+
1105 ! Process
+
1106 if (lside) then
+
1107 ! Compute B = alpha * A * B
+
1108 do i = 1, k
+
1109 temp = alpha * a(i)
+
1110 if (temp /= one) b(i,:) = temp * b(i,:)
+
1111 end do
+
1112 if (m > k) b(k+1:m,:) = zero
+
1113 else
+
1114 ! Compute B = alpha * B * A
+
1115 do i = 1, k
+
1116 temp = alpha * a(i)
+
1117 if (temp /= one) b(:,i) = temp * b(:,i)
+
1118 end do
+
1119 if (n > k) b(:,k+1:n) = zero
+
1120 end if
+
1121 end subroutine
+
1122
+
1123! ------------------------------------------------------------------------------
+
1124 module subroutine diag_mtx_mult_mtx_mix(lside, opb, alpha, a, b, beta, c, err)
+
1125 ! Arguments
+
1126 logical, intent(in) :: lside
+
1127 integer(int32), intent(in) :: opb
+
1128 complex(real64) :: alpha, beta
+
1129 real(real64), intent(in), dimension(:) :: a
+
1130 complex(real64), intent(in), dimension(:,:) :: b
+
1131 complex(real64), intent(inout), dimension(:,:) :: c
+
1132 class(errors), intent(inout), optional, target :: err
+
1133
+
1134 ! Parameters
+
1135 complex(real64), parameter :: zero = (0.0d0, 0.0d0)
+
1136 complex(real64), parameter :: one = (1.0d0, 0.0d0)
+
1137
+
1138 ! Local Variables
+
1139 integer(int32) :: i, m, n, k, nrowb, ncolb, flag
+
1140 complex(real64) :: temp
+
1141 class(errors), pointer :: errmgr
+
1142 type(errors), target :: deferr
+
1143 character(len = 128) :: errmsg
+
1144
+
1145 ! Initialization
+
1146 m = size(c, 1)
+
1147 n = size(c, 2)
+
1148 k = size(a)
+
1149 nrowb = size(b, 1)
+
1150 ncolb = size(b, 2)
+
1151 if (present(err)) then
+
1152 errmgr => err
+
1153 else
+
1154 errmgr => deferr
+
1155 end if
+
1156
+
1157 ! Input Check
+
1158 flag = 0
+
1159 if (lside) then
+
1160 if (k > m) then
+
1161 flag = 4
+
1162 else
+
1163 if (opb == transpose .or. opb == hermitian_transpose) then
+
1164 ! Compute C = alpha * A * B**T + beta * C
+
1165 if (nrowb /= n .or. ncolb < k) flag = 5
+
1166 else
+
1167 ! Compute C = alpha * A * B + beta * C
+
1168 if (nrowb < k .or. ncolb /= n) flag = 5
+
1169 end if
+
1170 end if
+
1171 else
+
1172 if (k > n) then
+
1173 flag = 4
+
1174 else
+
1175 if (opb == transpose .or. opb == hermitian_transpose) then
+
1176 ! Compute C = alpha * B**T * A + beta * C
+
1177 if (ncolb /= m .or. nrowb < k) flag = 5
+
1178 else
+
1179 ! Compute C = alpha * B * A + beta * C
+
1180 if (nrowb /= m .or. ncolb < k) flag = 5
+
1181 end if
+
1182 end if
+
1183 end if
+
1184 if (flag /= 0) then
+
1185 ! ERROR: One of the input arrays is not sized correctly
+
1186 write(errmsg, '(AI0A)') "Input number ", flag, &
+
1187 " is not sized correctly."
+
1188 call errmgr%report_error("diag_mtx_mult_mtx_mix", trim(errmsg), &
+
1189 la_array_size_error)
+
1190 return
+
1191 end if
+
1192
+
1193 ! Deal with ALPHA == 0
+
1194 if (alpha == 0) then
+
1195 if (beta == zero) then
+
1196 c = zero
+
1197 else if (beta /= one) then
+
1198 c = beta * c
+
1199 end if
+
1200 return
+
1201 end if
+
1202
+
1203 ! Process
+
1204 if (lside) then
+
1205 if (opb == transpose) then
+
1206 ! Compute C = alpha * A * B**T + beta * C
+
1207 do i = 1, k
+
1208 if (beta == zero) then
+
1209 c(i,:) = zero
+
1210 else if (beta /= one) then
+
1211 c(i,:) = beta * c(i,:)
+
1212 end if
+
1213 temp = alpha * a(i)
+
1214 if (temp /= one) c(i,:) = c(i,:) + temp * b(:,i)
+
1215 end do
+
1216 else if (opb == hermitian_transpose) then
+
1217 ! Compute C = alpha * A * B**H + beta * C
+
1218 do i = 1, k
+
1219 if (beta == zero) then
+
1220 c(i,:) = zero
+
1221 else if (beta /= one) then
+
1222 c(i,:) = beta * c(i,:)
+
1223 end if
+
1224 temp = alpha * a(i)
+
1225 if (temp /= one) c(i,:) = c(i,:) + temp * conjg(b(:,i))
+
1226 end do
+
1227 else
+
1228 ! Compute C = alpha * A * B + beta * C
+
1229 do i = 1, k
+
1230 if (beta == zero) then
+
1231 c(i,:) = zero
+
1232 else if (beta /= one) then
+
1233 c(i,:) = beta * c(i,:)
+
1234 end if
+
1235 temp = alpha * a(i)
+
1236 if (temp /= one) c(i,:) = c(i,:) + temp * b(i,:)
+
1237 end do
+
1238 end if
+
1239
+
1240 ! Handle extra rows
+
1241 if (m > k) then
+
1242 if (beta == zero) then
+
1243 c(k+1:m,:) = zero
+
1244 else
+
1245 c(k+1:m,:) = beta * c(k+1:m,:)
+
1246 end if
+
1247 end if
+
1248 else
+
1249 if (opb == transpose) then
+
1250 ! Compute C = alpha * B**T * A + beta * C
+
1251 do i = 1, k
+
1252 if (beta == zero) then
+
1253 c(:,i) = zero
+
1254 else if (beta /= one) then
+
1255 c(:,i) = beta * c(:,i)
+
1256 end if
+
1257 temp = alpha * a(i)
+
1258 if (temp /= one) c(:,i) = c(:,i) + temp * b(i,:)
+
1259 end do
+
1260 else if (opb == hermitian_transpose) then
+
1261 ! Compute C = alpha * B**H * A + beta * C
+
1262 do i = 1, k
+
1263 if (beta == zero) then
+
1264 c(:,i) = zero
+
1265 else if (beta /= one) then
+
1266 c(:,i) = beta * c(:,i)
+
1267 end if
+
1268 temp = alpha * a(i)
+
1269 if (temp /= one) c(:,i) = c(:,i) + temp * conjg(b(i,:))
+
1270 end do
+
1271 else
+
1272 ! Compute C = alpha * B * A + beta * C
+
1273 do i = 1, k
+
1274 if (beta == zero) then
+
1275 c(:,i) = zero
+
1276 else if (beta /= one) then
+
1277 c(:,i) = beta * c(:,i)
+
1278 end if
+
1279 temp = alpha * a(i)
+
1280 if (temp /= one) c(:,i) = c(:,i) + temp * b(:,i)
+
1281 end do
+
1282 end if
+
1283
+
1284 ! Handle extra columns
+
1285 if (n > k) then
+
1286 if (beta == zero) then
+
1287 c(:,k+1:m) = zero
+
1288 else if (beta /= one) then
+
1289 c(:,k+1:m) = beta * c(:,k+1:m)
+
1290 end if
+
1291 end if
+
1292 end if
+
1293 end subroutine
+
1294
+
1295! ------------------------------------------------------------------------------
+
1296 module subroutine diag_mtx_mult_mtx2_mix(lside, alpha, a, b, err)
+
1297 ! Arguments
+
1298 logical, intent(in) :: lside
+
1299 complex(real64), intent(in) :: alpha
+
1300 real(real64), intent(in), dimension(:) :: a
+
1301 complex(real64), intent(inout), dimension(:,:) :: b
+
1302 class(errors), intent(inout), optional, target :: err
+
1303
+
1304 ! Parameters
+
1305 complex(real64), parameter :: zero = (0.0d0, 0.0d0)
+
1306 complex(real64), parameter :: one = (1.0d0, 0.0d0)
+
1307
+
1308 ! Local Variables
+
1309 integer(int32) :: i, m, n, k
+
1310 complex(real64) :: temp
+
1311 class(errors), pointer :: errmgr
+
1312 type(errors), target :: deferr
+
1313
+
1314 ! Initialization
+
1315 m = size(b, 1)
+
1316 n = size(b, 2)
+
1317 k = size(a)
+
1318 if (present(err)) then
+
1319 errmgr => err
+
1320 else
+
1321 errmgr => deferr
+
1322 end if
+
1323
+
1324 ! Input Check
+
1325 if ((lside .and. k > m) .or. (.not.lside .and. k > n)) then
+
1326 ! ERROR: One of the input arrays is not sized correctly
+
1327 call errmgr%report_error("diag_mtx_mult_mtx2_cmplx", &
+
1328 "Input number 3 is not sized correctly.", &
+
1329 la_array_size_error)
+
1330 return
+
1331 end if
+
1332
+
1333 ! Process
+
1334 if (lside) then
+
1335 ! Compute B = alpha * A * B
+
1336 do i = 1, k
+
1337 temp = alpha * a(i)
+
1338 if (temp /= one) b(i,:) = temp * b(i,:)
+
1339 end do
+
1340 if (m > k) b(k+1:m,:) = zero
+
1341 else
+
1342 ! Compute B = alpha * B * A
+
1343 do i = 1, k
+
1344 temp = alpha * a(i)
+
1345 if (temp /= one) b(:,i) = temp * b(:,i)
+
1346 end do
+
1347 if (n > k) b(:,k+1:n) = zero
+
1348 end if
+
1349 end subroutine
+
1350
+
1351! ******************************************************************************
+
1352! BASIC OPERATION ROUTINES
+
1353! ------------------------------------------------------------------------------
+
1354 pure module function trace_dbl(x) result(y)
+
1355 ! Arguments
+
1356 real(real64), intent(in), dimension(:,:) :: x
+
1357 real(real64) :: y
+
1358
+
1359 ! Parameters
+
1360 real(real64), parameter :: zero = 0.0d0
+
1361
+
1362 ! Local Variables
+
1363 integer(int32) :: i, m, n, mn
+
1364
+
1365 ! Initialization
+
1366 y = zero
+
1367 m = size(x, 1)
+
1368 n = size(x, 2)
+
1369 mn = min(m, n)
+
1370
+
1371 ! Process
+
1372 do i = 1, mn
+
1373 y = y + x(i,i)
+
1374 end do
+
1375 end function
+
1376
+
1377! ------------------------------------------------------------------------------
+
1378 pure module function trace_cmplx(x) result(y)
+
1379 ! Arguments
+
1380 complex(real64), intent(in), dimension(:,:) :: x
+
1381 complex(real64) :: y
+
1382
+
1383 ! Parameters
+
1384 complex(real64), parameter :: zero = (0.0d0, 0.0d0)
+
1385
+
1386 ! Local Variables
+
1387 integer(int32) :: i, m, n, mn
+
1388
+
1389 ! Initialization
+
1390 y = zero
+
1391 m = size(x, 1)
+
1392 n = size(x, 2)
+
1393 mn = min(m, n)
+
1394
+
1395 ! Process
+
1396 do i = 1, mn
+
1397 y = y + x(i,i)
+
1398 end do
+
1399 end function
+
1400
+
1401! ------------------------------------------------------------------------------
+
1402 module function mtx_rank_dbl(a, tol, work, olwork, err) result(rnk)
+
1403 ! Arguments
+
1404 real(real64), intent(inout), dimension(:,:) :: a
+
1405 real(real64), intent(in), optional :: tol
+
1406 real(real64), intent(out), target, optional, dimension(:) :: work
+
1407 integer(int32), intent(out), optional :: olwork
+
1408 class(errors), intent(inout), optional, target :: err
+
1409 integer(int32) :: rnk
+
1410
+
1411 ! External Function Interfaces
+
1412 interface
+
1413 function dlamch(cmach) result(x)
+
1414 use, intrinsic :: iso_fortran_env, only : real64
+
1415 character, intent(in) :: cmach
+
1416 real(real64) :: x
+
1417 end function
+
1418 end interface
+
1419
+
1420 ! Local Variables
+
1421 integer(int32) :: i, m, n, mn, istat, lwork, flag
+
1422 real(real64), pointer, dimension(:) :: wptr, s, w
+
1423 real(real64), allocatable, target, dimension(:) :: wrk
+
1424 real(real64) :: t, tref, smlnum
+
1425 real(real64), dimension(1) :: dummy, temp
+
1426 class(errors), pointer :: errmgr
+
1427 type(errors), target :: deferr
+
1428 character(len = 128) :: errmsg
+
1429
+
1430 ! Initialization
+
1431 m = size(a, 1)
+
1432 n = size(a, 2)
+
1433 mn = min(m, n)
+
1434 smlnum = dlamch('s')
+
1435 rnk = 0
+
1436 if (present(err)) then
+
1437 errmgr => err
+
1438 else
+
1439 errmgr => deferr
+
1440 end if
+
1441
+
1442 ! Workspace Query
+
1443 !call svd(a, a(1:mn,1), olwork = lwork)
+
1444 call dgesvd('N', 'N', m, n, a, m, dummy, dummy, m, dummy, n, temp, &
+
1445 -1, flag)
+
1446 lwork = int(temp(1), int32) + mn
+
1447 if (present(olwork)) then
+
1448 olwork = lwork
+
1449 return
+
1450 end if
+
1451
+
1452 ! Local Memory Allocation
+
1453 if (present(work)) then
+
1454 if (size(work) < lwork) then
+
1455 ! ERROR: WORK not sized correctly
+
1456 call errmgr%report_error("mtx_rank", &
+
1457 "Incorrectly sized input array WORK, argument 5.", &
+
1458 la_array_size_error)
+
1459 return
+
1460 end if
+
1461 wptr => work(1:lwork)
+
1462 else
+
1463 allocate(wrk(lwork), stat = istat)
+
1464 if (istat /= 0) then
+
1465 ! ERROR: Out of memory
+
1466 call errmgr%report_error("mtx_rank", &
+
1467 "Insufficient memory available.", &
+
1468 la_out_of_memory_error)
+
1469 return
+
1470 end if
+
1471 wptr => wrk
+
1472 end if
+
1473 s => wptr(1:mn)
+
1474 w => wptr(mn+1:lwork)
+
1475
+
1476 ! Compute the singular values of A
+
1477 call dgesvd('N', 'N', m, n, a, m, s, dummy, m, dummy, n, w, &
+
1478 lwork - mn, flag)
+
1479 if (flag > 0) then
+
1480 write(errmsg, '(I0A)') flag, " superdiagonals could not " // &
+
1481 "converge to zero as part of the QR iteration process."
+
1482 call errmgr%report_warning("mtx_rank", errmsg, la_convergence_error)
+
1483 end if
+
1484
+
1485 ! Determine the threshold tolerance for the singular values such that
+
1486 ! singular values less than the threshold result in zero when inverted.
+
1487 tref = max(m, n) * epsilon(t) * s(1)
+
1488 if (present(tol)) then
+
1489 t = tol
+
1490 else
+
1491 t = tref
+
1492 end if
+
1493 if (t < smlnum) then
+
1494 ! ! The supplied tolerance is too small, simply fall back to the
+
1495 ! ! default, but issue a warning to the user
+
1496 ! t = tref
+
1497 ! call report_warning("mtx_rank", "The supplied tolerance was " // &
+
1498 ! "smaller than a value that would result in an overflow " // &
+
1499 ! "condition, or is negative; therefore, the tolerance has " // &
+
1500 ! "been reset to its default value.")
+
1501 end if
+
1502
+
1503 ! Count the singular values that are larger than the tolerance value
+
1504 do i = 1, mn
+
1505 if (s(i) < t) exit
+
1506 rnk = rnk + 1
+
1507 end do
+
1508 end function
+
1509
+
1510! ------------------------------------------------------------------------------
+
1511 module function mtx_rank_cmplx(a, tol, work, olwork, rwork, err) result(rnk)
+
1512 ! Arguments
+
1513 complex(real64), intent(inout), dimension(:,:) :: a
+
1514 real(real64), intent(in), optional :: tol
+
1515 complex(real64), intent(out), target, optional, dimension(:) :: work
+
1516 integer(int32), intent(out), optional :: olwork
+
1517 real(real64), intent(out), target, optional, dimension(:) :: rwork
+
1518 class(errors), intent(inout), optional, target :: err
+
1519 integer(int32) :: rnk
+
1520
+
1521 ! External Function Interfaces
+
1522 interface
+
1523 function dlamch(cmach) result(x)
+
1524 use, intrinsic :: iso_fortran_env, only : real64
+
1525 character, intent(in) :: cmach
+
1526 real(real64) :: x
+
1527 end function
+
1528 end interface
+
1529
+
1530 ! Local Variables
+
1531 integer(int32) :: i, m, n, mn, istat, lwork, flag, lrwork
+
1532 real(real64), pointer, dimension(:) :: s, rwptr, rw
+
1533 real(real64), allocatable, target, dimension(:) :: rwrk
+
1534 complex(real64), allocatable, target, dimension(:) :: wrk
+
1535 complex(real64), pointer, dimension(:) :: wptr
+
1536 real(real64) :: t, tref, smlnum
+
1537 real(real64), dimension(1) :: dummy
+
1538 complex(real64), dimension(1) :: cdummy, temp
+
1539 class(errors), pointer :: errmgr
+
1540 type(errors), target :: deferr
+
1541 character(len = 128) :: errmsg
+
1542
+
1543 ! Initialization
+
1544 m = size(a, 1)
+
1545 n = size(a, 2)
+
1546 mn = min(m, n)
+
1547 lrwork = 6 * mn
+
1548 smlnum = dlamch('s')
+
1549 rnk = 0
+
1550 if (present(err)) then
+
1551 errmgr => err
+
1552 else
+
1553 errmgr => deferr
+
1554 end if
+
1555
+
1556 ! Workspace Query
+
1557 call zgesvd('N', 'N', m, n, a, m, dummy, cdummy, m, cdummy, n, temp, &
+
1558 -1, dummy, flag)
+
1559 lwork = int(temp(1), int32)
+
1560 if (present(olwork)) then
+
1561 olwork = lwork
+
1562 return
+
1563 end if
+
1564
+
1565 ! Local Memory Allocation
+
1566 if (present(work)) then
+
1567 if (size(work) < lwork) then
+
1568 ! ERROR: WORK not sized correctly
+
1569 call errmgr%report_error("mtx_rank_cmplx", &
+
1570 "Incorrectly sized input array WORK, argument 5.", &
+
1571 la_array_size_error)
+
1572 return
+
1573 end if
+
1574 wptr => work(1:lwork)
+
1575 else
+
1576 allocate(wrk(lwork), stat = istat)
+
1577 if (istat /= 0) then
+
1578 ! ERROR: Out of memory
+
1579 call errmgr%report_error("mtx_rank_cmplx", &
+
1580 "Insufficient memory available.", &
+
1581 la_out_of_memory_error)
+
1582 return
+
1583 end if
+
1584 wptr => wrk
+
1585 end if
+
1586
+
1587 if (present(rwork)) then
+
1588 if (size(rwork) < lrwork) then
+
1589 ! ERROR: RWORK not sized correctly
+
1590 call errmgr%report_error("mtx_rank_cmplx", &
+
1591 "Incorrectly sized input array RWORK.", &
+
1592 la_array_size_error)
+
1593 return
+
1594 end if
+
1595 rwptr => rwork(1:lrwork)
+
1596 else
+
1597 allocate(rwrk(lrwork), stat = istat)
+
1598 if (istat /= 0) then
+
1599 end if
+
1600 rwptr => rwrk
+
1601 end if
+
1602 s => rwptr(1:mn)
+
1603 rw => rwptr(mn+1:lrwork)
+
1604
+
1605 ! Compute the singular values of A
+
1606 call zgesvd('N', 'N', m, n, a, m, s, cdummy, m, cdummy, n, wptr, &
+
1607 lwork - mn, rw, flag)
+
1608 if (flag > 0) then
+
1609 write(errmsg, '(I0A)') flag, " superdiagonals could not " // &
+
1610 "converge to zero as part of the QR iteration process."
+
1611 call errmgr%report_warning("mtx_rank_cmplx", errmsg, la_convergence_error)
+
1612 end if
+
1613
+
1614 ! Determine the threshold tolerance for the singular values such that
+
1615 ! singular values less than the threshold result in zero when inverted.
+
1616 tref = max(m, n) * epsilon(t) * s(1)
+
1617 if (present(tol)) then
+
1618 t = tol
+
1619 else
+
1620 t = tref
+
1621 end if
+
1622 if (t < smlnum) then
+
1623 ! ! The supplied tolerance is too small, simply fall back to the
+
1624 ! ! default, but issue a warning to the user
+
1625 ! t = tref
+
1626 ! call report_warning("mtx_rank", "The supplied tolerance was " // &
+
1627 ! "smaller than a value that would result in an overflow " // &
+
1628 ! "condition, or is negative; therefore, the tolerance has " // &
+
1629 ! "been reset to its default value.")
+
1630 end if
+
1631
+
1632 ! Count the singular values that are larger than the tolerance value
+
1633 do i = 1, mn
+
1634 if (s(i) < t) exit
+
1635 rnk = rnk + 1
+
1636 end do
+
1637 end function
+
1638
+
1639! ------------------------------------------------------------------------------
+
1640 module function det_dbl(a, iwork, err) result(x)
+
1641 ! Arguments
+
1642 real(real64), intent(inout), dimension(:,:) :: a
+
1643 integer(int32), intent(out), target, optional, dimension(:) :: iwork
+
1644 class(errors), intent(inout), optional, target :: err
+
1645 real(real64) :: x
+
1646
+
1647 ! Parameters
+
1648 real(real64), parameter :: zero = 0.0d0
+
1649 real(real64), parameter :: one = 1.0d0
+
1650 real(real64), parameter :: ten = 1.0d1
+
1651 real(real64), parameter :: p1 = 1.0d-1
+
1652
+
1653 ! Local Variables
+
1654 integer(int32) :: i, ep, n, istat, flag
+
1655 integer(int32), pointer, dimension(:) :: ipvt
+
1656 integer(int32), allocatable, target, dimension(:) :: iwrk
+
1657 real(real64) :: temp
+
1658 class(errors), pointer :: errmgr
+
1659 type(errors), target :: deferr
+
1660
+
1661 ! Initialization
+
1662 n = size(a, 1)
+
1663 x = zero
+
1664 if (present(err)) then
+
1665 errmgr => err
+
1666 else
+
1667 errmgr => deferr
+
1668 end if
+
1669
+
1670 ! Input Check
+
1671 if (size(a, 2) /= n) then
+
1672 call errmgr%report_error("det", &
+
1673 "The supplied matrix must be square.", la_array_size_error)
+
1674 return
+
1675 end if
+
1676
+
1677 ! Local Memory Allocation
+
1678 if (present(iwork)) then
+
1679 if (size(iwork) < n) then
+
1680 ! ERROR: WORK not sized correctly
+
1681 call errmgr%report_error("det", &
+
1682 "Incorrectly sized input array IWORK, argument 2.", &
+
1683 la_array_size_error)
+
1684 return
+
1685 end if
+
1686 ipvt => iwork(1:n)
+
1687 else
+
1688 allocate(iwrk(n), stat = istat)
+
1689 if (istat /= 0) then
+
1690 ! ERROR: Out of memory
+
1691 call errmgr%report_error("det", &
+
1692 "Insufficient memory available.", &
+
1693 la_out_of_memory_error)
+
1694 return
+
1695 end if
+
1696 ipvt => iwrk
+
1697 end if
+
1698
+
1699 ! Compute the LU factorization of A
+
1700 call dgetrf(n, n, a, n, ipvt, flag)
+
1701 if (flag > 0) then
+
1702 ! A singular matrix has a determinant of zero
+
1703 x = zero
+
1704 return
+
1705 end if
+
1706
+
1707 ! Compute the product of the diagonal of A
+
1708 temp = one
+
1709 ep = 0
+
1710 do i = 1, n
+
1711 if (ipvt(i) /= i) temp = -temp
+
1712
+
1713 temp = a(i,i) * temp
+
1714 if (temp == zero) then
+
1715 x = zero
+
1716 exit
+
1717 end if
+
1718
+
1719 do while (abs(temp) < one)
+
1720 temp = ten * temp
+
1721 ep = ep - 1
+
1722 end do
+
1723
+
1724 do while (abs(temp) > ten)
+
1725 temp = p1 * temp
+
1726 ep = ep + 1
+
1727 end do
+
1728 end do
+
1729 x = temp * ten**ep
+
1730 end function
+
1731
+
1732! ------------------------------------------------------------------------------
+
1733 module function det_cmplx(a, iwork, err) result(x)
+
1734 ! Arguments
+
1735 complex(real64), intent(inout), dimension(:,:) :: a
+
1736 integer(int32), intent(out), target, optional, dimension(:) :: iwork
+
1737 class(errors), intent(inout), optional, target :: err
+
1738 complex(real64) :: x
+
1739
+
1740 ! Parameters
+
1741 complex(real64), parameter :: zero = (0.0d0, 0.0d0)
+
1742 complex(real64), parameter :: one = (1.0d0, 0.0d0)
+
1743 complex(real64), parameter :: ten = (1.0d1, 0.0d0)
+
1744 complex(real64), parameter :: p1 = (1.0d-1, 0.0d0)
+
1745 real(real64), parameter :: real_one = 1.0d0
+
1746 real(real64), parameter :: real_ten = 1.0d1
+
1747
+
1748 ! Local Variables
+
1749 integer(int32) :: i, ep, n, istat, flag
+
1750 integer(int32), pointer, dimension(:) :: ipvt
+
1751 integer(int32), allocatable, target, dimension(:) :: iwrk
+
1752 complex(real64) :: temp
+
1753 class(errors), pointer :: errmgr
+
1754 type(errors), target :: deferr
+
1755
+
1756 ! Initialization
+
1757 n = size(a, 1)
+
1758 x = zero
+
1759 if (present(err)) then
+
1760 errmgr => err
+
1761 else
+
1762 errmgr => deferr
+
1763 end if
+
1764
+
1765 ! Input Check
+
1766 if (size(a, 2) /= n) then
+
1767 call errmgr%report_error("det_cmplx", &
+
1768 "The supplied matrix must be square.", la_array_size_error)
+
1769 return
+
1770 end if
+
1771
+
1772 ! Local Memory Allocation
+
1773 if (present(iwork)) then
+
1774 if (size(iwork) < n) then
+
1775 ! ERROR: WORK not sized correctly
+
1776 call errmgr%report_error("det_cmplx", &
+
1777 "Incorrectly sized input array IWORK, argument 2.", &
+
1778 la_array_size_error)
+
1779 return
+
1780 end if
+
1781 ipvt => iwork(1:n)
+
1782 else
+
1783 allocate(iwrk(n), stat = istat)
+
1784 if (istat /= 0) then
+
1785 ! ERROR: Out of memory
+
1786 call errmgr%report_error("det_cmplx", &
+
1787 "Insufficient memory available.", &
+
1788 la_out_of_memory_error)
+
1789 return
+
1790 end if
+
1791 ipvt => iwrk
+
1792 end if
+
1793
+
1794 ! Compute the LU factorization of A
+
1795 call zgetrf(n, n, a, n, ipvt, flag)
+
1796 if (flag > 0) then
+
1797 ! A singular matrix has a determinant of zero
+
1798 x = zero
+
1799 return
+
1800 end if
+
1801
+
1802 ! Compute the product of the diagonal of A
+
1803 temp = one
+
1804 ep = 0
+
1805 do i = 1, n
+
1806 if (ipvt(i) /= i) temp = -temp
+
1807
+
1808 temp = a(i,i) * temp
+
1809 if (temp == zero) then
+
1810 x = zero
+
1811 exit
+
1812 end if
+
1813
+
1814 do while (abs(temp) < real_one)
+
1815 temp = ten * temp
+
1816 ep = ep - 1
+
1817 end do
+
1818
+
1819 do while (abs(temp) > real_ten)
+
1820 temp = p1 * temp
+
1821 ep = ep + 1
+
1822 end do
+
1823 end do
+
1824 x = temp * ten**ep
+
1825 end function
+
1826
+
1827! ******************************************************************************
+
1828! ARRAY SWAPPING ROUTINE
+
1829! ------------------------------------------------------------------------------
+
1830 module subroutine swap_dbl(x, y, err)
+
1831 ! Arguments
+
1832 real(real64), intent(inout), dimension(:) :: x, y
+
1833 class(errors), intent(inout), optional, target :: err
+
1834
+
1835 ! Local Variables
+
1836 integer(int32) :: i, n
+
1837 real(real64) :: temp
+
1838 class(errors), pointer :: errmgr
+
1839 type(errors), target :: deferr
+
1840
+
1841 ! Initialization
+
1842 n = size(x)
+
1843 if (present(err)) then
+
1844 errmgr => err
+
1845 else
+
1846 errmgr => deferr
+
1847 end if
+
1848
+
1849 ! Input Check
+
1850 if (size(y) /= n) then
+
1851 call errmgr%report_error("swap", &
+
1852 "The input arrays are not the same size.", &
+
1853 la_array_size_error)
+
1854 return
+
1855 end if
+
1856
+
1857 ! Process
+
1858 do i = 1, n
+
1859 temp = x(i)
+
1860 x(i) = y(i)
+
1861 y(i) = temp
+
1862 end do
+
1863 end subroutine
+
1864
+
1865! ------------------------------------------------------------------------------
+
1866 module subroutine swap_cmplx(x, y, err)
+
1867 ! Arguments
+
1868 complex(real64), intent(inout), dimension(:) :: x, y
+
1869 class(errors), intent(inout), optional, target :: err
+
1870
+
1871 ! Local Variables
+
1872 integer(int32) :: i, n
+
1873 complex(real64) :: temp
+
1874 class(errors), pointer :: errmgr
+
1875 type(errors), target :: deferr
+
1876
+
1877 ! Initialization
+
1878 n = size(x)
+
1879 if (present(err)) then
+
1880 errmgr => err
+
1881 else
+
1882 errmgr => deferr
+
1883 end if
+
1884
+
1885 ! Input Check
+
1886 if (size(y) /= n) then
+
1887 call errmgr%report_error("swap_cmplx", &
+
1888 "The input arrays are not the same size.", &
+
1889 la_array_size_error)
+
1890 return
+
1891 end if
+
1892
+
1893 ! Process
+
1894 do i = 1, n
+
1895 temp = x(i)
+
1896 x(i) = y(i)
+
1897 y(i) = temp
+
1898 end do
+
1899 end subroutine
+
1900
+
1901! ******************************************************************************
+
1902! ARRAY MULTIPLICIATION ROUTINES
+
1903! ------------------------------------------------------------------------------
+
1904 module subroutine recip_mult_array_dbl(a, x)
+
1905 ! Arguments
+
1906 real(real64), intent(in) :: a
+
1907 real(real64), intent(inout), dimension(:) :: x
+
1908
+
1909 ! External Function Interfaces
+
1910 interface
+
1911 function dlamch(cmach) result(x)
+
1912 use, intrinsic :: iso_fortran_env, only : real64
+
1913 character, intent(in) :: cmach
+
1914 real(real64) :: x
+
1915 end function
+
1916 end interface
+
1917
+
1918 ! Parameters
+
1919 real(real64), parameter :: zero = 0.0d0
+
1920 real(real64), parameter :: one = 1.0d0
+
1921 real(real64), parameter :: twotho = 2.0d3
+
1922
+
1923 ! Local Variables
+
1924 logical :: done
+
1925 real(real64) :: bignum, cden, cden1, cnum, cnum1, mul, smlnum
+
1926
+
1927 ! Initialization
+
1928 smlnum = dlamch('s')
+
1929 bignum = one / smlnum
+
1930 if (log10(bignum) > twotho) then
+
1931 smlnum = sqrt(smlnum)
+
1932 bignum = sqrt(bignum)
+
1933 end if
+
1934
+
1935 ! Initialize the denominator to A, and the numerator to ONE
+
1936 cden = a
+
1937 cnum = one
+
1938
+
1939 ! Process
+
1940 do
+
1941 cden1 = cden * smlnum
+
1942 cnum1 = cnum / bignum
+
1943 if (abs(cden1) > abs(cnum) .and. cnum /= zero) then
+
1944 mul = smlnum
+
1945 done = .false.
+
1946 cden = cden1
+
1947 else if (abs(cnum1) > abs(cden)) then
+
1948 mul = bignum
+
1949 done = .false.
+
1950 cnum = cnum1
+
1951 else
+
1952 mul = cnum / cden
+
1953 done = .true.
+
1954 end if
+
1955
+
1956 ! Scale the vector X by MUL
+
1957 x = mul * x
+
1958
+
1959 ! Exit if done
+
1960 if (done) exit
+
1961 end do
+
1962 end subroutine
+
1963
+
1964! ******************************************************************************
+
1965! TRIANGULAR MATRIX MULTIPLICATION ROUTINES
+
1966! ------------------------------------------------------------------------------
+
1967 module subroutine tri_mtx_mult_dbl(upper, alpha, a, beta, b, err)
+
1968 ! Arguments
+
1969 logical, intent(in) :: upper
+
1970 real(real64), intent(in) :: alpha, beta
+
1971 real(real64), intent(in), dimension(:,:) :: a
+
1972 real(real64), intent(inout), dimension(:,:) :: b
+
1973 class(errors), intent(inout), optional, target :: err
+
1974
+
1975 ! Parameters
+
1976 real(real64), parameter :: zero = 0.0d0
+
1977
+
1978 ! Local Variables
+
1979 integer(int32) :: i, j, k, n, d1, d2, flag
+
1980 real(real64) :: temp
+
1981 class(errors), pointer :: errmgr
+
1982 type(errors), target :: deferr
+
1983 character(len = 128) :: errmsg
+
1984
+
1985 ! Initialization
+
1986 n = size(a, 1)
+
1987 d1 = n
+
1988 d2 = n
+
1989 if (present(err)) then
+
1990 errmgr => err
+
1991 else
+
1992 errmgr => deferr
+
1993 end if
+
1994
+
1995 ! Input Check
+
1996 flag = 0
+
1997 if (size(a, 2) /= n) then
+
1998 flag = 3
+
1999 d2 = size(a, 2)
+
2000 else if (size(b, 1) /= n .or. size(b, 2) /= n) then
+
2001 flag = 5
+
2002 d1 = size(b, 1)
+
2003 d2 = size(b, 2)
+
2004 end if
+
2005 if (flag /= 0) then
+
2006 ! ERROR: Incorrectly sized matrix
+
2007 write(errmsg, '(AI0AI0AI0AI0AI0A)') "The matrix at input ", flag, &
+
2008 " was not sized appropriately. A matrix of ", n, "-by-", n, &
+
2009 "was expected, but a matrix of ", d1, "-by-", d2, " was found."
+
2010 call errmgr%report_error("tri_mtx_mult_dbl", trim(errmsg), &
+
2011 la_array_size_error)
+
2012 return
+
2013 end if
+
2014
+
2015 ! Process
+
2016 if (upper) then
+
2017 ! Form: B = alpha * A**T * A + beta * B
+
2018 if (beta == zero) then
+
2019 do j = 1, n
+
2020 do i = 1, j
+
2021 temp = zero
+
2022 do k = 1, j
+
2023 temp = temp + a(k,i) * a(k,j)
+
2024 end do
+
2025 temp = alpha * temp
+
2026 b(i,j) = temp
+
2027 if (i /= j) b(j,i) = temp
+
2028 end do
+
2029 end do
+
2030 else
+
2031 do j = 1, n
+
2032 do i = 1, j
+
2033 temp = zero
+
2034 do k = 1, j
+
2035 temp = temp + a(k,i) * a(k,j)
+
2036 end do
+
2037 temp = alpha * temp
+
2038 b(i,j) = temp + beta * b(i,j)
+
2039 if (i /= j) b(j,i) = temp + beta * b(j,i)
+
2040 end do
+
2041 end do
+
2042 end if
+
2043 else
+
2044 ! Form: B = alpha * A * A**T + beta * B
+
2045 if (beta == zero) then
+
2046 do j = 1, n
+
2047 do i = j, n
+
2048 temp = zero
+
2049 do k = 1, j
+
2050 temp = temp + a(i,k) * a(j,k)
+
2051 end do
+
2052 temp = alpha * temp
+
2053 b(i,j) = temp
+
2054 if (i /= j) b(j,i) = temp
+
2055 end do
+
2056 end do
+
2057 else
+
2058 do j = 1, n
+
2059 do i = j, n
+
2060 temp = zero
+
2061 do k = 1, j
+
2062 temp = temp + a(i,k) * a(j,k)
+
2063 end do
+
2064 temp = alpha * temp
+
2065 b(i,j) = temp + beta * b(i,j)
+
2066 if (i /= j) b(j,i) = temp + beta * b(j,i)
+
2067 end do
+
2068 end do
+
2069 end if
+
2070 end if
+
2071 end subroutine
+
2072
+
2073! ------------------------------------------------------------------------------
+
2074 module subroutine tri_mtx_mult_cmplx(upper, alpha, a, beta, b, err)
+
2075 ! Arguments
+
2076 logical, intent(in) :: upper
+
2077 complex(real64), intent(in) :: alpha, beta
+
2078 complex(real64), intent(in), dimension(:,:) :: a
+
2079 complex(real64), intent(inout), dimension(:,:) :: b
+
2080 class(errors), intent(inout), optional, target :: err
+
2081
+
2082 ! Parameters
+
2083 complex(real64), parameter :: zero = (0.0d0, 0.0d0)
+
2084
+
2085 ! Local Variables
+
2086 integer(int32) :: i, j, k, n, d1, d2, flag
+
2087 complex(real64) :: temp
+
2088 class(errors), pointer :: errmgr
+
2089 type(errors), target :: deferr
+
2090 character(len = 128) :: errmsg
+
2091
+
2092 ! Initialization
+
2093 n = size(a, 1)
+
2094 d1 = n
+
2095 d2 = n
+
2096 if (present(err)) then
+
2097 errmgr => err
+
2098 else
+
2099 errmgr => deferr
+
2100 end if
+
2101
+
2102 ! Input Check
+
2103 flag = 0
+
2104 if (size(a, 2) /= n) then
+
2105 flag = 3
+
2106 d2 = size(a, 2)
+
2107 else if (size(b, 1) /= n .or. size(b, 2) /= n) then
+
2108 flag = 5
+
2109 d1 = size(b, 1)
+
2110 d2 = size(b, 2)
+
2111 end if
+
2112 if (flag /= 0) then
+
2113 ! ERROR: Incorrectly sized matrix
+
2114 write(errmsg, '(AI0AI0AI0AI0AI0A)') "The matrix at input ", flag, &
+
2115 " was not sized appropriately. A matrix of ", n, "-by-", n, &
+
2116 "was expected, but a matrix of ", d1, "-by-", d2, " was found."
+
2117 call errmgr%report_error("tri_mtx_mult_cmplx", trim(errmsg), &
+
2118 la_array_size_error)
+
2119 return
+
2120 end if
+
2121
+
2122 ! Process
+
2123 if (upper) then
+
2124 ! Form: B = alpha * A**T * A + beta * B
+
2125 if (beta == zero) then
+
2126 do j = 1, n
+
2127 do i = 1, j
+
2128 temp = zero
+
2129 do k = 1, j
+
2130 temp = temp + a(k,i) * a(k,j)
+
2131 end do
+
2132 temp = alpha * temp
+
2133 b(i,j) = temp
+
2134 if (i /= j) b(j,i) = temp
+
2135 end do
+
2136 end do
+
2137 else
+
2138 do j = 1, n
+
2139 do i = 1, j
+
2140 temp = zero
+
2141 do k = 1, j
+
2142 temp = temp + a(k,i) * a(k,j)
+
2143 end do
+
2144 temp = alpha * temp
+
2145 b(i,j) = temp + beta * b(i,j)
+
2146 if (i /= j) b(j,i) = temp + beta * b(j,i)
+
2147 end do
+
2148 end do
+
2149 end if
+
2150 else
+
2151 ! Form: B = alpha * A * A**T + beta * B
+
2152 if (beta == zero) then
+
2153 do j = 1, n
+
2154 do i = j, n
+
2155 temp = zero
+
2156 do k = 1, j
+
2157 temp = temp + a(i,k) * a(j,k)
+
2158 end do
+
2159 temp = alpha * temp
+
2160 b(i,j) = temp
+
2161 if (i /= j) b(j,i) = temp
+
2162 end do
+
2163 end do
+
2164 else
+
2165 do j = 1, n
+
2166 do i = j, n
+
2167 temp = zero
+
2168 do k = 1, j
+
2169 temp = temp + a(i,k) * a(j,k)
+
2170 end do
+
2171 temp = alpha * temp
+
2172 b(i,j) = temp + beta * b(i,j)
+
2173 if (i /= j) b(j,i) = temp + beta * b(j,i)
+
2174 end do
+
2175 end do
+
2176 end if
+
2177 end if
+
2178 end subroutine
+
2179
+
2180! ------------------------------------------------------------------------------
+
2181end submodule
+
Provides a set of common linear algebra routines.
Definition: linalg_core.f90:15
-
Provides a set of common linear algebra routines.
Definition: linalg_core.f90:15
diff --git a/doc/html/linalg__c__api_8f90_source.html b/doc/html/linalg__c__api_8f90_source.html index 6aed88d5..c844a85b 100644 --- a/doc/html/linalg__c__api_8f90_source.html +++ b/doc/html/linalg__c__api_8f90_source.html @@ -1,11 +1,11 @@ - + - - + + -linalg: C:/Users/jchri/Documents/github/linalg/src/linalg_c_api.f90 Source File +linalg: D:/Code/linalg/src/linalg_c_api.f90 Source File @@ -13,13 +13,16 @@ - + + @@ -27,10 +30,9 @@
- - + @@ -39,21 +41,22 @@
-
linalg -  1.6.0 +
+
linalg 1.6.1
A linear algebra library that provides a user-friendly interface to several BLAS and LAPACK routines.
- + +/* @license-end */ +
@@ -67,8 +70,8 @@
@@ -81,1919 +84,1979 @@
- +
+
+
+
+
Loading...
+
Searching...
+
No Matches
+
+
+
-
-
linalg_c_api.f90
+
linalg_c_api.f90
-
1 ! linalg_c_api.f90
-
2 
- -
6  use iso_c_binding
-
7  use linalg_core
- -
9  use ferror
-
10  implicit none
-
11 
-
12 contains
-
13 ! ------------------------------------------------------------------------------
-
30  function la_rank1_update(m, n, alpha, x, y, a, lda) &
-
31  bind(C, name = "la_rank1_update") result(flag)
-
32  ! Arguments
-
33  integer(c_int), intent(in), value :: m, n, lda
-
34  real(c_double), intent(in), value :: alpha
-
35  real(c_double), intent(in) :: x(*), y(*)
-
36  real(c_double), intent(inout) :: a(lda,*)
-
37  integer(c_int) :: flag
-
38 
-
39  ! Initialization
-
40  flag = la_no_error
-
41 
-
42  ! Input Checking
-
43  if (lda < m) then
-
44  flag = la_invalid_input_error
-
45  return
-
46  end if
-
47 
-
48  ! Process
-
49  call rank1_update(alpha, x(1:m), y(1:n), a(1:m,1:n))
-
50  end function
-
51 
-
52 ! ------------------------------------------------------------------------------
-
69  function la_rank1_update_cmplx(m, n, alpha, x, y, a, lda) &
-
70  bind(C, name = "la_rank1_update_cmplx") result(flag)
-
71  ! Arguments
-
72  integer(c_int), intent(in), value :: m, n, lda
-
73  complex(c_double), intent(in), value :: alpha
-
74  complex(c_double), intent(in) :: x(*), y(*)
-
75  complex(c_double), intent(inout) :: a(lda,*)
-
76  integer(c_int) :: flag
-
77 
-
78  ! Initialization
-
79  flag = la_no_error
-
80 
-
81  ! Input Checking
-
82  if (lda < m) then
-
83  flag = la_invalid_input_error
-
84  return
-
85  end if
-
86 
-
87  ! Process
-
88  call rank1_update(alpha, x(1:m), y(1:n), a(1:m,1:n))
-
89  end function
-
90 
-
91 ! ------------------------------------------------------------------------------
-
104  function la_trace(m, n, a, lda, rst) bind(C, name = "la_trace") &
-
105  result(flag)
-
106  ! Arguments
-
107  integer(c_int), intent(in), value :: m, n, lda
-
108  real(c_double), intent(in) :: a(lda,*)
-
109  real(c_double), intent(out) :: rst
-
110  integer(c_int) :: flag
-
111 
-
112  ! Initialization
-
113  flag = la_no_error
-
114 
-
115  ! Input Checking
-
116  if (lda < m) then
-
117  flag = la_invalid_input_error
-
118  return
-
119  end if
-
120 
-
121  ! Process
-
122  rst = trace(a(1:m,1:n))
-
123  end function
-
124 
-
125 ! ------------------------------------------------------------------------------
-
138  function la_trace_cmplx(m, n, a, lda, rst) &
-
139  bind(C, name = "la_trace_cmplx") result(flag)
-
140  ! Arguments
-
141  integer(c_int), intent(in), value :: m, n, lda
-
142  complex(c_double), intent(in) :: a(lda,*)
-
143  complex(c_double), intent(out) :: rst
-
144  integer(c_int) :: flag
-
145 
-
146  ! Initialization
-
147  flag = la_no_error
-
148 
-
149  ! Input Checking
-
150  if (lda < m) then
-
151  flag = la_invalid_input_error
-
152  return
-
153  end if
-
154 
-
155  ! Process
-
156  rst = trace(a(1:m,1:n))
-
157  end function
-
158 
-
159 ! ------------------------------------------------------------------------------
-
184  function la_mtx_mult(transa, transb, m, n, k, alpha, a, lda, b, ldb, &
-
185  beta, c, ldc) bind(C, name="la_mtx_mult") result(flag)
-
186  ! Arugments
-
187  logical(c_bool), intent(in), value :: transa, transb
-
188  integer(c_int), intent(in), value :: m, n, k, lda, ldb, ldc
-
189  real(c_double), intent(in), value :: alpha, beta
-
190  real(c_double), intent(in) :: a(lda,*), b(ldb,*)
-
191  real(c_double), intent(inout) :: c(ldc,*)
-
192  integer(c_int) :: flag
-
193 
-
194  ! Local Variables
-
195  character :: ta, tb
-
196  integer(c_int) :: nrowa, nrowb
-
197 
-
198  ! Initialization
-
199  flag = la_no_error
-
200  ta = "N"
-
201  if (transa) ta = "T"
-
202 
-
203  tb = "N"
-
204  if (transb) tb = "T"
-
205 
-
206  if (transa) then
-
207  nrowa = k
-
208  else
-
209  nrowa = m
-
210  end if
-
211 
-
212  if (transb) then
-
213  nrowb = n
-
214  else
-
215  nrowb = k
-
216  end if
-
217 
-
218  ! Input Checking
-
219  if (lda < nrowa .or. ldb < nrowb .or. ldc < m) then
-
220  flag = la_invalid_input_error
-
221  return
-
222  end if
-
223 
-
224  ! Call DGEMM directly
-
225  call dgemm(ta, tb, m, n, k, alpha, a, lda, b, ldb, beta, c, ldc)
-
226  end function
-
227 
-
228 ! ------------------------------------------------------------------------------
-
255  function la_mtx_mult_cmplx(opa, opb, m, n, k, alpha, a, lda, b, ldb, &
-
256  beta, c, ldc) bind(C, name="la_mtx_mult_cmplx") result(flag)
-
257  ! Arguments
-
258  integer(c_int), intent(in), value :: opa, opb, m, n, k, lda, ldb, ldc
-
259  complex(c_double), intent(in), value :: alpha, beta
-
260  complex(c_double), intent(in) :: a(lda,*), b(ldb,*)
-
261  complex(c_double), intent(inout) :: c(ldc,*)
-
262  integer(c_int) :: flag
-
263 
-
264  ! Local Variables
-
265  character :: ta, tb
-
266  integer(c_int) :: nrowa, nrowb
-
267 
-
268  ! Initialization
-
269  flag = la_no_error
-
270  if (opa == transpose) then
-
271  ta = "T"
-
272  else if (opa == hermitian_transpose) then
-
273  ta = "H"
-
274  else
-
275  ta = "N"
-
276  end if
-
277 
-
278  if (opb == transpose) then
-
279  tb = "T"
-
280  else if (opb == hermitian_transpose) then
-
281  tb = "H"
-
282  else
-
283  tb = "N"
-
284  end if
-
285 
-
286  if (opa == transpose .or. opa == hermitian_transpose) then
-
287  nrowa = k
-
288  else
-
289  nrowa = m
-
290  end if
-
291 
-
292  if (opb == transpose .or. opb == hermitian_transpose) then
-
293  nrowb = n
-
294  else
-
295  nrowb = k
-
296  end if
-
297 
-
298  ! Input Checking
-
299  if (lda < nrowa .or. ldb < nrowb .or. ldc < m) then
-
300  flag = la_invalid_input_error
-
301  return
-
302  end if
-
303 
-
304  ! Call ZGEMM directly
-
305  call zgemm(ta, tb, m, n, k, alpha, a, lda, b, ldb, beta, c, ldc)
-
306  end function
-
307 
-
308 ! ------------------------------------------------------------------------------
-
340  function la_diag_mtx_mult(lside, transb, m, n, k, alpha, a, b, ldb, &
-
341  beta, c, ldc) bind(C, name="la_diag_mtx_mult") result(flag)
-
342  ! Arguments
-
343  logical(c_bool), intent(in), value :: lside, transb
-
344  integer(c_int), intent(in), value :: m, n, k, ldb, ldc
-
345  real(c_double), intent(in), value :: alpha, beta
-
346  real(c_double), intent(in) :: a(*), b(ldb,*)
-
347  real(c_double), intent(inout) :: c(ldc,*)
-
348  integer(c_int) :: flag
-
349 
-
350  ! Local Variabes
-
351  integer(c_int) :: nrows, ncols, p
-
352  logical :: ls, tb
-
353  type(errors) :: err
-
354 
-
355  ! Initialization
-
356  call err%set_exit_on_error(.false.)
-
357  flag = la_no_error
-
358  if (lside .and. transb) then
-
359  nrows = n
-
360  ncols = k
-
361  p = min(k, m)
-
362  ls = .true.
-
363  tb = .true.
-
364  else if (lside .and. .not. transb) then
-
365  nrows = k
-
366  ncols = n
-
367  p = min(k, m)
-
368  ls = .true.
-
369  tb = .false.
-
370  else if (.not. lside .and. transb) then
-
371  nrows = k
-
372  ncols = m
-
373  p = min(k, n)
-
374  ls = .false.
-
375  tb = .true.
-
376  else
-
377  nrows = m
-
378  ncols = k
-
379  p = min(k, n)
-
380  ls = .false.
-
381  tb = .false.
-
382  end if
-
383 
-
384  ! Error Checking
-
385  if (ldb < nrows .or. ldc < m) then
-
386  flag = la_invalid_input_error
-
387  return
-
388  end if
-
389 
-
390  ! Process
-
391  call diag_mtx_mult(ls, tb, alpha, a(1:p), b(1:nrows,1:ncols), &
-
392  beta, c(1:m,1:n), err)
-
393  if (err%has_error_occurred()) flag = err%get_error_flag()
-
394  end function
-
395 
-
396 ! ------------------------------------------------------------------------------
-
429  function la_diag_mtx_mult_cmplx(lside, opb, m, n, k, alpha, a, b, &
-
430  ldb, beta, c, ldc) bind(C, name="la_diag_mtx_mult_cmplx") &
-
431  result(flag)
-
432  ! Arguments
-
433  logical(c_bool), intent(in), value :: lside
-
434  integer(c_int), intent(in), value :: opb, m, n, k, ldb, ldc
-
435  complex(c_double), intent(in), value :: alpha, beta
-
436  complex(c_double), intent(in) :: a(*), b(ldb,*)
-
437  complex(c_double), intent(inout) :: c(ldc,*)
-
438  integer(c_int) :: flag
-
439 
-
440  ! Local Variabes
-
441  integer(c_int) :: nrows, ncols, p
-
442  logical :: ls, tb
-
443  type(errors) :: err
-
444 
-
445  ! Initialization
-
446  call err%set_exit_on_error(.false.)
-
447  flag = la_no_error
-
448  tb = .false.
-
449  if (opb == transpose .or. opb == hermitian_transpose) tb = .true.
-
450  if (lside .and. tb) then
-
451  nrows = n
-
452  ncols = k
-
453  p = min(k, m)
-
454  ls = .true.
-
455  else if (lside .and. .not. tb) then
-
456  nrows = k
-
457  ncols = n
-
458  p = min(k, m)
-
459  ls = .true.
-
460  else if (.not. lside .and. tb) then
-
461  nrows = k
-
462  ncols = m
-
463  p = min(k, n)
-
464  ls = .false.
-
465  else
-
466  nrows = m
-
467  ncols = k
-
468  p = min(k, n)
-
469  ls = .false.
-
470  end if
-
471 
-
472  ! Error Checking
-
473  if (ldb < nrows .or. ldc < m) then
-
474  flag = la_invalid_input_error
-
475  return
-
476  end if
-
477 
-
478  ! Process
-
479  call diag_mtx_mult(ls, opb, alpha, a(1:p), b(1:nrows,1:ncols), &
-
480  beta, c(1:m,1:n))
-
481  if (err%has_error_occurred()) flag = err%get_error_flag()
-
482  end function
-
483 
-
484 ! ------------------------------------------------------------------------------
-
501  function la_rank(m, n, a, lda, rnk) bind(C, name="la_rank") result(flag)
-
502  ! Arguments
-
503  integer(c_int), intent(in), value :: m, n, lda
-
504  real(c_double), intent(inout) :: a(lda,*)
-
505  integer(c_int), intent(out) :: rnk
-
506  integer(c_int) :: flag
-
507 
-
508  ! Local Variables
-
509  type(errors) :: err
-
510 
-
511  ! Input Check
-
512  call err%set_exit_on_error(.false.)
-
513  flag = la_no_error
-
514  if (lda < m) then
-
515  flag = la_invalid_input_error
-
516  return
-
517  end if
-
518 
-
519  ! Process
-
520  rnk = mtx_rank(a(1:m,1:n), err =err)
-
521  if (err%has_error_occurred()) flag = err%get_error_flag()
-
522  end function
-
523 
-
524 ! ------------------------------------------------------------------------------
-
541  function la_rank_cmplx(m, n, a, lda, rnk) bind(C, name="la_rank_cmplx") &
-
542  result(flag)
-
543  ! Arguments
-
544  integer(c_int), intent(in), value :: m, n, lda
-
545  complex(c_double), intent(inout) :: a(lda,*)
-
546  integer(c_int), intent(out) :: rnk
-
547  integer(c_int) :: flag
-
548 
-
549  ! Local Variables
-
550  type(errors) :: err
-
551 
-
552  ! Input Check
-
553  call err%set_exit_on_error(.false.)
-
554  flag = la_no_error
-
555  if (lda < m) then
-
556  flag = la_invalid_input_error
-
557  return
-
558  end if
-
559 
-
560  ! Process
-
561  rnk = mtx_rank(a(1:m,1:n), err = err)
-
562  if (err%has_error_occurred()) flag = err%get_error_flag()
-
563  end function
-
564 
-
565 ! ------------------------------------------------------------------------------
-
579  function la_det(n, a, lda, d) bind(C, name="la_det") result(flag)
-
580  ! Arguments
-
581  integer(c_int), intent(in), value :: n, lda
-
582  real(c_double), intent(inout) :: a(lda,*)
-
583  real(c_double), intent(out) :: d
-
584  integer(c_int) :: flag
-
585 
-
586  ! Local Variables
-
587  type(errors) :: err
-
588 
-
589  ! Error Checking
-
590  call err%set_exit_on_error(.false.)
-
591  flag = la_no_error
-
592  if (lda < n) then
-
593  flag = la_invalid_input_error
-
594  return
-
595  end if
-
596 
-
597  ! Process
-
598  d = det(a(1:n,1:n), err = err)
-
599  if (err%has_error_occurred()) flag = err%get_error_flag()
-
600  end function
-
601 
-
602 ! ------------------------------------------------------------------------------
-
616  function la_det_cmplx(n, a, lda, d) bind(C, name="la_det_cmplx") result(flag)
-
617  ! Arguments
-
618  integer(c_int), intent(in), value :: n, lda
-
619  complex(c_double), intent(inout) :: a(lda,*)
-
620  complex(c_double), intent(out) :: d
-
621  integer(c_int) :: flag
-
622 
-
623  ! Local Variables
-
624  type(errors) :: err
-
625 
-
626  ! Error Checking
-
627  call err%set_exit_on_error(.false.)
-
628  flag = la_no_error
-
629  if (lda < n) then
-
630  flag = la_invalid_input_error
-
631  return
-
632  end if
-
633 
-
634  ! Process
-
635  d = det(a(1:n,1:n), err = err)
-
636  if (err%has_error_occurred()) flag = err%get_error_flag()
-
637  end function
-
638 
-
639 ! ------------------------------------------------------------------------------
-
663  function la_tri_mtx_mult(upper, alpha, n, a, lda, beta, b, ldb) &
-
664  bind(C, name = "la_tri_mtx_mult") result(flag)
-
665  ! Arguments
-
666  logical(c_bool), intent(in), value :: upper
-
667  integer(c_int), intent(in), value :: n, lda, ldb
-
668  real(c_double), intent(in), value :: alpha, beta
-
669  real(c_double), intent(in) :: a(lda,*)
-
670  real(c_double), intent(inout) :: b(ldb,*)
-
671  integer(c_int) :: flag
-
672 
-
673  ! Error Checking
-
674  flag = la_no_error
-
675  if (lda < n .or. ldb < n) then
-
676  flag = la_invalid_input_error
-
677  return
-
678  end if
-
679 
-
680  ! Process
-
681  call tri_mtx_mult(logical(upper), alpha, a(1:n,1:n), beta, b(1:n,1:n))
-
682  end function
-
683 
-
684 ! ------------------------------------------------------------------------------
-
708  function la_tri_mtx_mult_cmplx(upper, alpha, n, a, lda, beta, b, ldb) &
-
709  bind(C, name = "la_tri_mtx_mult_cmplx") result(flag)
-
710  ! Arguments
-
711  logical(c_bool), intent(in), value :: upper
-
712  integer(c_int), intent(in), value :: n, lda, ldb
-
713  complex(c_double), intent(in), value :: alpha, beta
-
714  complex(c_double), intent(in) :: a(lda,*)
-
715  complex(c_double), intent(inout) :: b(ldb,*)
-
716  integer(c_int) :: flag
-
717 
-
718  ! Error Checking
-
719  flag = la_no_error
-
720  if (lda < n .or. ldb < n) then
-
721  flag = la_invalid_input_error
-
722  return
-
723  end if
-
724 
-
725  ! Process
-
726  call tri_mtx_mult(logical(upper), alpha, a(1:n,1:n), beta, b(1:n,1:n))
-
727  end function
-
728 
-
729 ! ------------------------------------------------------------------------------
-
747  function la_lu_factor(m, n, a, lda, ipvt) bind(C, name = "la_lu_factor") &
-
748  result(flag)
-
749  ! Arguments
-
750  integer(c_int), intent(in), value :: m, n, lda
-
751  real(c_double), intent(inout) :: a(lda,*)
-
752  integer(c_int), intent(out) :: ipvt(*)
-
753  integer(c_int) :: flag
-
754 
-
755  ! Local Variables
-
756  type(errors) :: err
-
757  integer(c_int) :: mn
-
758 
-
759  ! Error Checking
-
760  call err%set_exit_on_error(.false.)
-
761  flag = la_no_error
-
762  if (lda < m) then
-
763  flag = la_invalid_input_error
-
764  return
-
765  end if
-
766 
-
767  ! Process
-
768  mn = min(m, n)
-
769  call lu_factor(a(1:m,1:n), ipvt(1:mn), err)
-
770  if (err%has_error_occurred()) then
-
771  flag = err%get_error_flag()
-
772  return
-
773  end if
-
774  end function
-
775 
-
776 ! ------------------------------------------------------------------------------
-
794  function la_lu_factor_cmplx(m, n, a, lda, ipvt) &
-
795  bind(C, name = "la_lu_factor_cmplx") result(flag)
-
796  ! Arguments
-
797  integer(c_int), intent(in), value :: m, n, lda
-
798  complex(c_double), intent(inout) :: a(lda,*)
-
799  integer(c_int), intent(out) :: ipvt(*)
-
800  integer(c_int) :: flag
-
801 
-
802  ! Local Variables
-
803  type(errors) :: err
-
804  integer(c_int) :: mn
-
805 
-
806  ! Error Checking
-
807  call err%set_exit_on_error(.false.)
-
808  flag = la_no_error
-
809  if (lda < m) then
-
810  flag = la_invalid_input_error
-
811  return
-
812  end if
-
813 
-
814  ! Process
-
815  mn = min(m, n)
-
816  call lu_factor(a(1:m,1:n), ipvt(1:mn), err)
-
817  if (err%has_error_occurred()) then
-
818  flag = err%get_error_flag()
-
819  return
-
820  end if
-
821  end function
-
822 
-
823 ! ------------------------------------------------------------------------------
-
843  function la_form_lu(n, a, lda, ipvt, u, ldu, p, ldp) &
-
844  bind(C, name = "la_form_lu") result(flag)
-
845  ! Arguments
-
846  integer(c_int), intent(in), value :: n, lda, ldu, ldp
-
847  real(c_double), intent(inout) :: a(lda,*)
-
848  real(c_double), intent(out) :: u(ldu,*), p(ldp,*)
-
849  integer(c_int), intent(in) :: ipvt(*)
-
850  integer(c_int) :: flag
-
851 
-
852  ! Input Checking
-
853  flag = la_no_error
-
854  if (lda < n .or. ldu < n .or. ldp < n) then
-
855  flag = la_invalid_input_error
-
856  return
-
857  end if
-
858 
-
859  ! Process
-
860  call form_lu(a(1:n,1:n), ipvt(1:n), u(1:n,1:n), p(1:n,1:n))
-
861  end function
-
862 
-
863 ! ------------------------------------------------------------------------------
-
883  function la_form_lu_cmplx(n, a, lda, ipvt, u, ldu, p, ldp) &
-
884  bind(C, name = "la_form_lu_cmplx") result(flag)
-
885  ! Arguments
-
886  integer(c_int), intent(in), value :: n, lda, ldu, ldp
-
887  complex(c_double), intent(inout) :: a(lda,*)
-
888  complex(c_double), intent(out) :: u(ldu,*)
-
889  real(c_double), intent(out) :: p(ldp,*)
-
890  integer(c_int), intent(in) :: ipvt(*)
-
891  integer(c_int) :: flag
-
892 
-
893  ! Input Checking
-
894  flag = la_no_error
-
895  if (lda < n .or. ldu < n .or. ldp < n) then
-
896  flag = la_invalid_input_error
-
897  return
-
898  end if
-
899 
-
900  ! Process
-
901  call form_lu(a(1:n,1:n), ipvt(1:n), u(1:n,1:n), p(1:n,1:n))
-
902  end function
-
903 
-
904 ! ------------------------------------------------------------------------------
-
924  function la_qr_factor(m, n, a, lda, tau) bind(C, name = "la_qr_factor") &
-
925  result(flag)
-
926  ! Arguments
-
927  integer(c_int), intent(in), value :: m, n, lda
-
928  real(c_double), intent(inout) :: a(lda,*)
-
929  real(c_double), intent(out) :: tau(*)
-
930  integer(c_int) :: flag
-
931 
-
932  ! Local Variables
-
933  type(errors) :: err
-
934  integer(c_int) :: mn
-
935 
-
936  ! Error Checking
-
937  call err%set_exit_on_error(.false.)
-
938  flag = la_no_error
-
939  if (lda < m) then
-
940  flag = la_invalid_input_error
-
941  return
-
942  end if
-
943 
-
944  ! Process
-
945  mn = min(m, n)
-
946  call qr_factor(a(1:m,1:n), tau(1:mn), err = err)
-
947  if (err%has_error_occurred()) then
-
948  flag = err%get_error_flag()
-
949  return
-
950  end if
-
951  end function
-
952 
-
953 ! ------------------------------------------------------------------------------
-
973  function la_qr_factor_cmplx(m, n, a, lda, tau) &
-
974  bind(C, name = "la_qr_factor_cmplx") result(flag)
-
975  ! Arguments
-
976  integer(c_int), intent(in), value :: m, n, lda
-
977  complex(c_double), intent(inout) :: a(lda,*)
-
978  complex(c_double), intent(out) :: tau(*)
-
979  integer(c_int) :: flag
-
980 
-
981  ! Local Variables
-
982  type(errors) :: err
-
983  integer(c_int) :: mn
-
984 
-
985  ! Error Checking
-
986  call err%set_exit_on_error(.false.)
-
987  flag = la_no_error
-
988  if (lda < m) then
-
989  flag = la_invalid_input_error
-
990  return
-
991  end if
-
992 
-
993  ! Process
-
994  mn = min(m, n)
-
995  call qr_factor(a(1:m,1:n), tau(1:mn), err = err)
-
996  if (err%has_error_occurred()) then
-
997  flag = err%get_error_flag()
-
998  return
-
999  end if
-
1000  end function
-
1001 
-
1002 ! ------------------------------------------------------------------------------
-
1026  function la_qr_factor_pvt(m, n, a, lda, tau, jpvt) &
-
1027  bind(C, name = "la_qr_factor_pvt") result(flag)
-
1028  ! Arguments
-
1029  integer(c_int), intent(in), value :: m, n, lda
-
1030  real(c_double), intent(inout) :: a(lda,*)
-
1031  real(c_double), intent(out) :: tau(*)
-
1032  integer(c_int), intent(inout) :: jpvt(*)
-
1033  integer(c_int) :: flag
-
1034 
-
1035  ! Local Variables
-
1036  type(errors) :: err
-
1037  integer(c_int) :: mn
-
1038 
-
1039  ! Error Checking
-
1040  call err%set_exit_on_error(.false.)
-
1041  flag = la_no_error
-
1042  if (lda < m) then
-
1043  flag = la_invalid_input_error
-
1044  return
-
1045  end if
-
1046 
-
1047  ! Process
-
1048  mn = min(m, n)
-
1049  call qr_factor(a(1:m,1:n), tau(1:mn), jpvt(1:n), err = err)
-
1050  if (err%has_error_occurred()) then
-
1051  flag = err%get_error_flag()
-
1052  return
-
1053  end if
-
1054  end function
-
1055 
-
1056 ! ------------------------------------------------------------------------------
-
1080  function la_qr_factor_cmplx_pvt(m, n, a, lda, tau, jpvt) &
-
1081  bind(C, name = "la_qr_factor_cmplx_pvt") result(flag)
-
1082  ! Arguments
-
1083  integer(c_int), intent(in), value :: m, n, lda
-
1084  complex(c_double), intent(inout) :: a(lda,*)
-
1085  complex(c_double), intent(out) :: tau(*)
-
1086  integer(c_int), intent(inout) :: jpvt(*)
-
1087  integer(c_int) :: flag
-
1088 
-
1089  ! Local Variables
-
1090  type(errors) :: err
-
1091  integer(c_int) :: mn
-
1092 
-
1093  ! Error Checking
-
1094  call err%set_exit_on_error(.false.)
-
1095  flag = la_no_error
-
1096  if (lda < m) then
-
1097  flag = la_invalid_input_error
-
1098  return
-
1099  end if
-
1100 
-
1101  ! Process
-
1102  mn = min(m, n)
-
1103  call qr_factor(a(1:m,1:n), tau(1:mn), jpvt(1:n), err = err)
-
1104  if (err%has_error_occurred()) then
-
1105  flag = err%get_error_flag()
-
1106  return
-
1107  end if
-
1108  end function
-
1109 
-
1110 ! ------------------------------------------------------------------------------
-
1135  function la_form_qr(fullq, m, n, r, ldr, tau, q, ldq) &
-
1136  bind(C, name = "la_form_qr") result(flag)
-
1137  ! Arguments
-
1138  logical(c_bool), intent(in), value :: fullq
-
1139  integer(c_int), intent(in), value :: m, n, ldr, ldq
-
1140  real(c_double), intent(inout) :: r(ldr,*)
-
1141  real(c_double), intent(in) :: tau(*)
-
1142  real(c_double), intent(out) :: q(ldq,*)
-
1143  integer(c_int) :: flag
-
1144 
-
1145  ! Local Variables
-
1146  type(errors) :: err
-
1147  integer(c_int) :: mn, nq
-
1148 
-
1149  ! Error Checking
-
1150  call err%set_exit_on_error(.false.)
-
1151  flag = la_no_error
-
1152  if (ldr < m .or. ldq < m) then
-
1153  flag = la_invalid_input_error
-
1154  return
-
1155  end if
-
1156 
-
1157  ! Process
-
1158  mn = min(m, n)
-
1159  nq = m
-
1160  if (.not.fullq) nq = n
-
1161  call form_qr(r(1:m,1:n), tau(1:mn), q(1:m,1:nq), err = err)
-
1162  if (err%has_error_occurred()) then
-
1163  flag = err%get_error_flag()
-
1164  return
-
1165  end if
-
1166  end function
-
1167 
-
1168 ! ------------------------------------------------------------------------------
-
1193  function la_form_qr_cmplx(fullq, m, n, r, ldr, tau, q, ldq) &
-
1194  bind(C, name = "la_form_qr_cmplx") result(flag)
-
1195  ! Arguments
-
1196  logical(c_bool), intent(in), value :: fullq
-
1197  integer(c_int), intent(in), value :: m, n, ldr, ldq
-
1198  complex(c_double), intent(inout) :: r(ldr,*)
-
1199  complex(c_double), intent(in) :: tau(*)
-
1200  complex(c_double), intent(out) :: q(ldq,*)
-
1201  integer(c_int) :: flag
-
1202 
-
1203  ! Local Variables
-
1204  type(errors) :: err
-
1205  integer(c_int) :: mn, nq
-
1206 
-
1207  ! Error Checking
-
1208  call err%set_exit_on_error(.false.)
-
1209  flag = la_no_error
-
1210  if (ldr < m .or. ldq < m) then
-
1211  flag = la_invalid_input_error
-
1212  return
-
1213  end if
-
1214 
-
1215  ! Process
-
1216  mn = min(m, n)
-
1217  nq = m
-
1218  if (.not.fullq) nq = n
-
1219  call form_qr(r(1:m,1:n), tau(1:mn), q(1:m,1:nq), err = err)
-
1220  if (err%has_error_occurred()) then
-
1221  flag = err%get_error_flag()
-
1222  return
-
1223  end if
-
1224  end function
-
1225 
-
1226 ! ------------------------------------------------------------------------------
-
1257  function la_form_qr_pvt(fullq, m, n, r, ldr, tau, pvt, q, ldq, p, ldp) &
-
1258  bind(C, name = "la_form_qr_pvt") result(flag)
-
1259  ! Arguments
-
1260  logical(c_bool), intent(in), value :: fullq
-
1261  integer(c_int), intent(in), value :: m, n, ldr, ldq, ldp
-
1262  real(c_double), intent(inout) :: r(ldr,*)
-
1263  real(c_double), intent(in) :: tau(*)
-
1264  integer(c_int), intent(in) :: pvt(*)
-
1265  real(c_double), intent(out) :: q(ldq,*), p(ldp,*)
-
1266  integer(c_int) :: flag
-
1267 
-
1268  ! Local Variables
-
1269  type(errors) :: err
-
1270  integer(c_int) :: mn, nq
-
1271 
-
1272  ! Error Checking
-
1273  call err%set_exit_on_error(.false.)
-
1274  flag = la_no_error
-
1275  if (ldr < m .or. ldq < m .or. ldp < n) then
-
1276  flag = la_invalid_input_error
-
1277  return
-
1278  end if
-
1279 
-
1280  ! Process
-
1281  mn = min(m, n)
-
1282  nq = m
-
1283  if (.not.fullq) nq = n
-
1284  call form_qr(r(1:m,1:n), tau(1:mn), pvt(1:n), q(1:m,1:nq), p(1:n,1:n), &
-
1285  err = err)
-
1286  if (err%has_error_occurred()) then
-
1287  flag = err%get_error_flag()
-
1288  return
-
1289  end if
-
1290  end function
-
1291 
-
1292 ! ------------------------------------------------------------------------------
-
1323  function la_form_qr_cmplx_pvt(fullq, m, n, r, ldr, tau, pvt, q, ldq, p, &
-
1324  ldp) bind(C, name = "la_form_qr_cmplx_pvt") result(flag)
-
1325  ! Arguments
-
1326  logical(c_bool), intent(in), value :: fullq
-
1327  integer(c_int), intent(in), value :: m, n, ldr, ldq, ldp
-
1328  complex(c_double), intent(inout) :: r(ldr,*)
-
1329  complex(c_double), intent(in) :: tau(*)
-
1330  integer(c_int), intent(in) :: pvt(*)
-
1331  complex(c_double), intent(out) :: q(ldq,*), p(ldp,*)
-
1332  integer(c_int) :: flag
-
1333 
-
1334  ! Local Variables
-
1335  type(errors) :: err
-
1336  integer(c_int) :: mn, nq
-
1337 
-
1338  ! Error Checking
-
1339  call err%set_exit_on_error(.false.)
-
1340  flag = la_no_error
-
1341  if (ldr < m .or. ldq < m .or. ldp < n) then
-
1342  flag = la_invalid_input_error
-
1343  return
-
1344  end if
-
1345 
-
1346  ! Process
-
1347  mn = min(m, n)
-
1348  nq = m
-
1349  if (.not.fullq) nq = n
-
1350  call form_qr(r(1:m,1:n), tau(1:mn), pvt(1:n), q(1:m,1:nq), p(1:n,1:n), &
-
1351  err = err)
-
1352  if (err%has_error_occurred()) then
-
1353  flag = err%get_error_flag()
-
1354  return
-
1355  end if
-
1356  end function
-
1357 
-
1358 ! ------------------------------------------------------------------------------
-
1386  function la_mult_qr(lside, trans, m, n, k, a, lda, tau, c, ldc) &
-
1387  bind(C, name = "la_mult_qr") result(flag)
-
1388  ! Local Variables
-
1389  logical(c_bool), intent(in), value :: lside, trans
-
1390  integer(c_int), intent(in), value :: m, n, k, lda, ldc
-
1391  real(c_double), intent(inout) :: a(lda,*), c(ldc,*)
-
1392  real(c_double), intent(in) :: tau(*)
-
1393  integer(c_int) :: flag
-
1394 
-
1395  ! Local Variables
-
1396  type(errors) :: err
-
1397  integer(c_int) :: ma, na
-
1398 
-
1399  ! Initialization
-
1400  if (lside) then
-
1401  ma = m
-
1402  na = m
-
1403  else
-
1404  ma = n
-
1405  na = n
-
1406  end if
-
1407 
-
1408  ! Error Checking
-
1409  call err%set_exit_on_error(.false.)
-
1410  flag = la_no_error
-
1411  if (lda < ma .or. ldc < m) then
-
1412  flag = la_invalid_input_error
-
1413  return
-
1414  end if
-
1415  if (k > na .or. k < 0) then
-
1416  flag = la_invalid_input_error
-
1417  return
-
1418  end if
-
1419 
-
1420  ! Process
-
1421  call mult_qr(logical(lside), logical(trans), a(1:ma,1:k), tau(1:k), &
-
1422  c(1:m,1:n), err = err)
-
1423  if (err%has_error_occurred()) then
-
1424  flag = err%get_error_flag()
-
1425  return
-
1426  end if
-
1427  end function
-
1428 
-
1429 ! ------------------------------------------------------------------------------
-
1457  function la_mult_qr_cmplx(lside, trans, m, n, k, a, lda, tau, c, ldc) &
-
1458  bind(C, name = "la_mult_qr_cmplx") result(flag)
-
1459  ! Local Variables
-
1460  logical(c_bool), intent(in), value :: lside, trans
-
1461  integer(c_int), intent(in), value :: m, n, k, lda, ldc
-
1462  complex(c_double), intent(inout) :: a(lda,*), c(ldc,*)
-
1463  complex(c_double), intent(in) :: tau(*)
-
1464  integer(c_int) :: flag
-
1465 
-
1466  ! Local Variables
-
1467  type(errors) :: err
-
1468  integer(c_int) :: ma, na
-
1469 
-
1470  ! Initialization
-
1471  if (lside) then
-
1472  ma = m
-
1473  na = m
-
1474  else
-
1475  ma = n
-
1476  na = n
-
1477  end if
-
1478 
-
1479  ! Error Checking
-
1480  call err%set_exit_on_error(.false.)
-
1481  flag = la_no_error
-
1482  if (lda < ma .or. ldc < m) then
-
1483  flag = la_invalid_input_error
-
1484  return
-
1485  end if
-
1486  if (k > na .or. k < 0) then
-
1487  flag = la_invalid_input_error
-
1488  return
-
1489  end if
-
1490 
-
1491  ! Process
-
1492  call mult_qr(logical(lside), logical(trans), a(1:ma,1:k), tau(1:k), &
-
1493  c(1:m,1:n), err = err)
-
1494  if (err%has_error_occurred()) then
-
1495  flag = err%get_error_flag()
-
1496  return
-
1497  end if
-
1498  end function
-
1499 
-
1500 ! ------------------------------------------------------------------------------
-
1522  function la_qr_rank1_update(m, n, q, ldq, r, ldr, u, v) &
-
1523  bind(C, name = "la_qr_rank1_update") result(flag)
-
1524  ! Arguments
-
1525  integer(c_int), intent(in), value :: m, n, ldq, ldr
-
1526  real(c_double), intent(inout) :: q(ldq,*), r(ldr,*), u(*), v(*)
-
1527  integer(c_int) :: flag
-
1528 
-
1529  ! Local Variables
-
1530  type(errors) :: err
-
1531  integer(c_int) :: mn
-
1532 
-
1533  ! Error Checking
-
1534  call err%set_exit_on_error(.false.)
-
1535  flag = la_no_error
-
1536  if (ldq < m .or. ldr < m) then
-
1537  flag = la_invalid_input_error
-
1538  return
-
1539  end if
-
1540 
-
1541  ! Process
-
1542  mn = min(m, n)
-
1543  call qr_rank1_update(q(1:m,1:mn), r(1:m,1:n), u(1:m), v(1:n), err = err)
-
1544  if (err%has_error_occurred()) then
-
1545  flag = err%get_error_flag()
-
1546  return
-
1547  end if
-
1548  end function
-
1549 
-
1550 ! ------------------------------------------------------------------------------
-
1572  function la_qr_rank1_update_cmplx(m, n, q, ldq, r, ldr, u, v) &
-
1573  bind(C, name = "la_qr_rank1_update_cmplx") result(flag)
-
1574  ! Arguments
-
1575  integer(c_int), intent(in), value :: m, n, ldq, ldr
-
1576  complex(c_double), intent(inout) :: q(ldq,*), r(ldr,*), u(*), v(*)
-
1577  integer(c_int) :: flag
-
1578 
-
1579  ! Local Variables
-
1580  type(errors) :: err
-
1581  integer(c_int) :: mn
-
1582 
-
1583  ! Error Checking
-
1584  call err%set_exit_on_error(.false.)
-
1585  flag = la_no_error
-
1586  if (ldq < m .or. ldr < m) then
-
1587  flag = la_invalid_input_error
-
1588  return
-
1589  end if
-
1590 
-
1591  ! Process
-
1592  mn = min(m, n)
-
1593  call qr_rank1_update(q(1:m,1:mn), r(1:m,1:n), u(1:m), v(1:n), err = err)
-
1594  if (err%has_error_occurred()) then
-
1595  flag = err%get_error_flag()
-
1596  return
-
1597  end if
-
1598  end function
-
1599 
-
1600 ! ------------------------------------------------------------------------------
-
1617  function la_cholesky_factor(upper, n, a, lda) &
-
1618  bind(C, name = "la_cholesky_factor") result(flag)
-
1619  ! Arguments
-
1620  logical(c_bool), intent(in), value :: upper
-
1621  integer(c_int), intent(in), value :: n, lda
-
1622  real(c_double), intent(inout) :: a(lda,*)
-
1623  integer(c_int) :: flag
-
1624 
-
1625  ! Local Variables
-
1626  type(errors) :: err
-
1627 
-
1628  ! Error Checking
-
1629  call err%set_exit_on_error(.false.)
-
1630  flag = la_no_error
-
1631  if (lda < n) then
-
1632  flag = la_invalid_input_error
-
1633  return
-
1634  end if
-
1635 
-
1636  ! Process
-
1637  call cholesky_factor(a(1:n,1:n), logical(upper), err = err)
-
1638  if (err%has_error_occurred()) then
-
1639  flag = err%get_error_flag()
-
1640  return
-
1641  end if
-
1642  end function
-
1643 
-
1644 ! ------------------------------------------------------------------------------
-
1661  function la_cholesky_factor_cmplx(upper, n, a, lda) &
-
1662  bind(C, name = "la_cholesky_factor_cmplx") result(flag)
-
1663  ! Arguments
-
1664  logical(c_bool), intent(in), value :: upper
-
1665  integer(c_int), intent(in), value :: n, lda
-
1666  complex(c_double), intent(inout) :: a(lda,*)
-
1667  integer(c_int) :: flag
-
1668 
-
1669  ! Local Variables
-
1670  type(errors) :: err
-
1671 
-
1672  ! Error Checking
-
1673  call err%set_exit_on_error(.false.)
-
1674  flag = la_no_error
-
1675  if (lda < n) then
-
1676  flag = la_invalid_input_error
-
1677  return
-
1678  end if
-
1679 
-
1680  ! Process
-
1681  call cholesky_factor(a(1:n,1:n), logical(upper), err = err)
-
1682  if (err%has_error_occurred()) then
-
1683  flag = err%get_error_flag()
-
1684  return
-
1685  end if
-
1686  end function
-
1687 
-
1688 ! ------------------------------------------------------------------------------
-
1704  function la_cholesky_rank1_update(n, r, ldr, u) &
-
1705  bind(C, name = "la_cholesky_rank1_update") result(flag)
-
1706  ! Arguments
-
1707  integer(c_int), intent(in), value :: n, ldr
-
1708  real(c_double), intent(inout) :: r(ldr,*), u(*)
-
1709  integer(c_int) :: flag
-
1710 
-
1711  ! Local Variables
-
1712  type(errors) :: err
-
1713 
-
1714  ! Error Checking
-
1715  call err%set_exit_on_error(.false.)
-
1716  flag = la_no_error
-
1717  if (ldr < n) then
-
1718  flag = la_invalid_input_error
-
1719  return
-
1720  end if
-
1721 
-
1722  ! Process
-
1723  call cholesky_rank1_update(r(1:n,1:n), u(1:n), err = err)
-
1724  if (err%has_error_occurred()) then
-
1725  flag = err%get_error_flag()
-
1726  return
-
1727  end if
-
1728  end function
-
1729 
-
1730 ! ------------------------------------------------------------------------------
-
1746  function la_cholesky_rank1_update_cmplx(n, r, ldr, u) &
-
1747  bind(C, name = "la_cholesky_rank1_update_cmplx") result(flag)
-
1748  ! Arguments
-
1749  integer(c_int), intent(in), value :: n, ldr
-
1750  complex(c_double), intent(inout) :: r(ldr,*), u(*)
-
1751  integer(c_int) :: flag
-
1752 
-
1753  ! Local Variables
-
1754  type(errors) :: err
-
1755 
-
1756  ! Error Checking
-
1757  call err%set_exit_on_error(.false.)
-
1758  flag = la_no_error
-
1759  if (ldr < n) then
-
1760  flag = la_invalid_input_error
-
1761  return
-
1762  end if
-
1763 
-
1764  ! Process
-
1765  call cholesky_rank1_update(r(1:n,1:n), u(1:n), err = err)
-
1766  if (err%has_error_occurred()) then
-
1767  flag = err%get_error_flag()
-
1768  return
-
1769  end if
-
1770  end function
-
1771 
-
1772 ! ------------------------------------------------------------------------------
-
1790  function la_cholesky_rank1_downdate(n, r, ldr, u) &
-
1791  bind(C, name = "la_cholesky_rank1_downdate") result(flag)
-
1792  ! Arguments
-
1793  integer(c_int), intent(in), value :: n, ldr
-
1794  real(c_double), intent(inout) :: r(ldr,*), u(*)
-
1795  integer(c_int) :: flag
-
1796 
-
1797  ! Local Variables
-
1798  type(errors) :: err
-
1799 
-
1800  ! Error Checking
-
1801  call err%set_exit_on_error(.false.)
-
1802  flag = la_no_error
-
1803  if (ldr < n) then
-
1804  flag = la_invalid_input_error
-
1805  return
-
1806  end if
-
1807 
-
1808  ! Process
-
1809  call cholesky_rank1_downdate(r(1:n,1:n), u(1:n), err = err)
-
1810  if (err%has_error_occurred()) then
-
1811  flag = err%get_error_flag()
-
1812  return
-
1813  end if
-
1814  end function
-
1815 
-
1816 ! ------------------------------------------------------------------------------
-
1834  function la_cholesky_rank1_downdate_cmplx(n, r, ldr, u) &
-
1835  bind(C, name = "la_cholesky_rank1_downdate_cmplx") result(flag)
-
1836  ! Arguments
-
1837  integer(c_int), intent(in), value :: n, ldr
-
1838  complex(c_double), intent(inout) :: r(ldr,*), u(*)
-
1839  integer(c_int) :: flag
-
1840 
-
1841  ! Local Variables
-
1842  type(errors) :: err
-
1843 
-
1844  ! Error Checking
-
1845  call err%set_exit_on_error(.false.)
-
1846  flag = la_no_error
-
1847  if (ldr < n) then
-
1848  flag = la_invalid_input_error
-
1849  return
-
1850  end if
-
1851 
-
1852  ! Process
-
1853  call cholesky_rank1_downdate(r(1:n,1:n), u(1:n), err = err)
-
1854  if (err%has_error_occurred()) then
-
1855  flag = err%get_error_flag()
-
1856  return
-
1857  end if
-
1858  end function
-
1859 
-
1860 ! ------------------------------------------------------------------------------
-
1888  function la_svd(m, n, a, lda, s, u, ldu, vt, ldv) &
-
1889  bind(C, name = "la_svd") result(flag)
-
1890  ! Arguments
-
1891  integer(c_int), intent(in), value :: m, n, lda, ldu, ldv
-
1892  real(c_double), intent(inout) :: a(lda,*)
-
1893  real(c_double), intent(out) :: s(*), u(ldu,*), vt(ldv,*)
-
1894  integer(c_int) :: flag
-
1895 
-
1896  ! Local Variables
-
1897  type(errors) :: err
-
1898  integer(c_int) :: mn
-
1899 
-
1900  ! Error Checking
-
1901  call err%set_exit_on_error(.false.)
-
1902  flag = la_no_error
-
1903  if (lda < m .or. ldu < m .or. ldv < n) then
-
1904  flag = la_invalid_input_error
-
1905  return
-
1906  end if
-
1907 
-
1908  ! Process
-
1909  mn = min(m, n)
-
1910  call svd(a(1:m,1:n), s(1:mn), u(1:m,1:m), vt(1:n,1:n), err = err)
-
1911  if (err%has_error_occurred()) then
-
1912  flag = err%get_error_flag()
-
1913  return
-
1914  end if
-
1915  end function
-
1916 
-
1917 ! ------------------------------------------------------------------------------
-
1945  function la_svd_cmplx(m, n, a, lda, s, u, ldu, vt, ldv) &
-
1946  bind(C, name = "la_svd_cmplx") result(flag)
-
1947  ! Arguments
-
1948  integer(c_int), intent(in), value :: m, n, lda, ldu, ldv
-
1949  complex(c_double), intent(inout) :: a(lda,*)
-
1950  real(c_double), intent(out) :: s(*)
-
1951  complex(c_double), intent(out) :: u(ldu,*), vt(ldv,*)
-
1952  integer(c_int) :: flag
-
1953 
-
1954  ! Local Variables
-
1955  type(errors) :: err
-
1956  integer(c_int) :: mn
-
1957 
-
1958  ! Error Checking
-
1959  call err%set_exit_on_error(.false.)
-
1960  flag = la_no_error
-
1961  if (lda < m .or. ldu < m .or. ldv < n) then
-
1962  flag = la_invalid_input_error
-
1963  return
-
1964  end if
-
1965 
-
1966  ! Process
-
1967  mn = min(m, n)
-
1968  call svd(a(1:m,1:n), s(1:mn), u(1:m,1:m), vt(1:n,1:n), err = err)
-
1969  if (err%has_error_occurred()) then
-
1970  flag = err%get_error_flag()
-
1971  return
-
1972  end if
-
1973  end function
-
1974 
-
1975 ! ------------------------------------------------------------------------------
-
2002  function la_solve_tri_mtx(lside, upper, trans, nounit, m, n, alpha, a, &
-
2003  lda, b, ldb) bind(C, name = "la_solve_tri_mtx") result(flag)
-
2004  ! Arguments
-
2005  logical(c_bool), intent(in), value :: lside, upper, trans, nounit
-
2006  integer(c_int), intent(in), value :: m, n, lda, ldb
-
2007  real(c_double), intent(in), value :: alpha
-
2008  real(c_double), intent(in) :: a(lda,*)
-
2009  real(c_double), intent(inout) :: b(ldb,*)
-
2010  integer(c_int) :: flag
-
2011 
-
2012  ! Local Variables
-
2013  type(errors) :: err
-
2014  integer(c_int) :: ma
-
2015 
-
2016  ! Initialization
-
2017  if (lside) then
-
2018  ma = m
-
2019  else
-
2020  ma = n
-
2021  end if
-
2022 
-
2023  ! Error Checking
-
2024  call err%set_exit_on_error(.false.)
-
2025  flag = la_no_error
-
2026  if (lda < ma .or. ldb < m) then
-
2027  flag = la_invalid_input_error
-
2028  return
-
2029  end if
-
2030 
-
2031  ! Process
-
2032  call solve_triangular_system(logical(lside), logical(upper), &
-
2033  logical(trans), logical(nounit), alpha, a(1:ma,1:ma), b(1:m,1:n))
-
2034  end function
-
2035 
-
2036 ! ------------------------------------------------------------------------------
-
2063  function la_solve_tri_mtx_cmplx(lside, upper, trans, nounit, m, n, &
-
2064  alpha, a, lda, b, ldb) &
-
2065  bind(C, name = "la_solve_tri_mtx_cmplx") result(flag)
-
2066  ! Arguments
-
2067  logical(c_bool), intent(in), value :: lside, upper, trans, nounit
-
2068  integer(c_int), intent(in), value :: m, n, lda, ldb
-
2069  complex(c_double), intent(in), value :: alpha
-
2070  complex(c_double), intent(in) :: a(lda,*)
-
2071  complex(c_double), intent(inout) :: b(ldb,*)
-
2072  integer(c_int) :: flag
-
2073 
-
2074  ! Local Variables
-
2075  type(errors) :: err
-
2076  integer(c_int) :: ma
-
2077 
-
2078  ! Initialization
-
2079  if (lside) then
-
2080  ma = m
-
2081  else
-
2082  ma = n
-
2083  end if
-
2084 
-
2085  ! Error Checking
-
2086  call err%set_exit_on_error(.false.)
-
2087  flag = la_no_error
-
2088  if (lda < ma .or. ldb < m) then
-
2089  flag = la_invalid_input_error
-
2090  return
-
2091  end if
-
2092 
-
2093  ! Process
-
2094  call solve_triangular_system(logical(lside), logical(upper), &
-
2095  logical(trans), logical(nounit), alpha, a(1:ma,1:ma), b(1:m,1:n))
-
2096  end function
-
2097 
-
2098 ! ------------------------------------------------------------------------------
-
2113  function la_solve_lu(m, n, a, lda, ipvt, b, ldb) &
-
2114  bind(C, name = "la_solve_lu") result(flag)
-
2115  ! Arguments
-
2116  integer(c_int), intent(in), value :: m, n, lda, ldb
-
2117  real(c_double), intent(in) :: a(lda,*)
-
2118  integer(c_int), intent(in) :: ipvt(*)
-
2119  real(c_double), intent(inout) :: b(ldb,*)
-
2120  integer(c_int) :: flag
-
2121 
-
2122  ! Local Variables
-
2123  type(errors) :: err
-
2124 
-
2125  ! Error Checking
-
2126  call err%set_exit_on_error(.false.)
-
2127  flag = la_no_error
-
2128  if (lda < m .or. ldb < m) then
-
2129  flag = la_invalid_input_error
-
2130  return
-
2131  end if
-
2132 
-
2133  ! Process
-
2134  call solve_lu(a(1:m,1:m), ipvt(1:m), b(1:m,1:n))
-
2135  end function
-
2136 
-
2137 ! ------------------------------------------------------------------------------
-
2152  function la_solve_lu_cmplx(m, n, a, lda, ipvt, b, ldb) &
-
2153  bind(C, name = "la_solve_lu_cmplx") result(flag)
-
2154  ! Arguments
-
2155  integer(c_int), intent(in), value :: m, n, lda, ldb
-
2156  complex(c_double), intent(in) :: a(lda,*)
-
2157  integer(c_int), intent(in) :: ipvt(*)
-
2158  complex(c_double), intent(inout) :: b(ldb,*)
-
2159  integer(c_int) :: flag
-
2160 
-
2161  ! Local Variables
-
2162  type(errors) :: err
-
2163 
-
2164  ! Error Checking
-
2165  call err%set_exit_on_error(.false.)
-
2166  flag = la_no_error
-
2167  if (lda < m .or. ldb < m) then
-
2168  flag = la_invalid_input_error
-
2169  return
-
2170  end if
-
2171 
-
2172  ! Process
-
2173  call solve_lu(a(1:m,1:m), ipvt(1:m), b(1:m,1:n))
-
2174  end function
-
2175 
-
2176 ! ------------------------------------------------------------------------------
-
2198  function la_solve_qr(m, n, k, a, lda, tau, b, ldb) &
-
2199  bind(C, name = "la_solve_qr") result(flag)
-
2200  ! Arguments
-
2201  integer(c_int), intent(in), value :: m, n, k, lda, ldb
-
2202  real(c_double), intent(inout) :: a(lda,*), b(ldb,*)
-
2203  real(c_double), intent(in) :: tau(*)
-
2204  integer(c_int) :: flag
-
2205 
-
2206  ! Local Variables
-
2207  type(errors) :: err
-
2208  integer(c_int) :: minmn
-
2209 
-
2210  ! Error Checking
-
2211  call err%set_exit_on_error(.false.)
-
2212  flag = la_no_error
-
2213  if (lda < m .or. ldb < m .or. m < n) then
-
2214  flag = la_invalid_input_error
-
2215  return
-
2216  end if
-
2217 
-
2218  ! Process
-
2219  minmn = min(m, n)
-
2220  call solve_qr(a(1:m,1:n), tau(1:minmn), b(1:m,1:k), err = err)
-
2221  if (err%has_error_occurred()) then
-
2222  flag = err%get_error_flag()
-
2223  return
-
2224  end if
-
2225  end function
-
2226 
-
2227 ! ------------------------------------------------------------------------------
-
2249  function la_solve_qr_cmplx(m, n, k, a, lda, tau, b, ldb) &
-
2250  bind(C, name = "la_solve_qr_cmplx") result(flag)
-
2251  ! Arguments
-
2252  integer(c_int), intent(in), value :: m, n, k, lda, ldb
-
2253  complex(c_double), intent(inout) :: a(lda,*), b(ldb,*)
-
2254  complex(c_double), intent(in) :: tau(*)
-
2255  integer(c_int) :: flag
-
2256 
-
2257  ! Local Variables
-
2258  type(errors) :: err
-
2259  integer(c_int) :: minmn
-
2260 
-
2261  ! Error Checking
-
2262  call err%set_exit_on_error(.false.)
-
2263  flag = la_no_error
-
2264  if (lda < m .or. ldb < m .or. m < n) then
-
2265  flag = la_invalid_input_error
-
2266  return
-
2267  end if
-
2268 
-
2269  ! Process
-
2270  minmn = min(m, n)
-
2271  call solve_qr(a(1:m,1:n), tau(1:minmn), b(1:m,1:k), err = err)
-
2272  if (err%has_error_occurred()) then
-
2273  flag = err%get_error_flag()
-
2274  return
-
2275  end if
-
2276  end function
-
2277 
-
2278 ! ------------------------------------------------------------------------------
-
2300  function la_solve_qr_pvt(m, n, k, a, lda, tau, jpvt, b, ldb) &
-
2301  bind(C, name = "la_solve_qr_pvt") result(flag)
-
2302  ! Arguments
-
2303  integer(c_int), intent(in), value :: m, n, k, lda, ldb
-
2304  real(c_double), intent(inout) :: a(lda,*), b(ldb,*)
-
2305  real(c_double), intent(in) :: tau(*)
-
2306  integer(c_int), intent(in) :: jpvt(*)
-
2307  integer(c_int) :: flag
-
2308 
-
2309  ! Local Variables
-
2310  type(errors) :: err
-
2311  integer(c_int) :: minmn, maxmn
-
2312 
-
2313  ! Error Checking
-
2314  minmn = min(m, n)
-
2315  maxmn = max(m, n)
-
2316  call err%set_exit_on_error(.false.)
-
2317  flag = la_no_error
-
2318  if (lda < m .or. ldb < maxmn) then
-
2319  flag = la_invalid_input_error
-
2320  return
-
2321  end if
-
2322 
-
2323  ! Process
-
2324  call solve_qr(a(1:m,1:n), tau(1:minmn), jpvt(1:n), b(1:maxmn,1:k), &
-
2325  err = err)
-
2326  if (err%has_error_occurred()) then
-
2327  flag = err%get_error_flag()
-
2328  return
-
2329  end if
-
2330  end function
-
2331 
-
2332 ! ------------------------------------------------------------------------------
-
2354  function la_solve_qr_cmplx_pvt(m, n, k, a, lda, tau, jpvt, b, ldb) &
-
2355  bind(C, name = "la_solve_qr_cmplx_pvt") result(flag)
-
2356  ! Arguments
-
2357  integer(c_int), intent(in), value :: m, n, k, lda, ldb
-
2358  complex(c_double), intent(inout) :: a(lda,*), b(ldb,*)
-
2359  complex(c_double), intent(in) :: tau(*)
-
2360  integer(c_int), intent(in) :: jpvt(*)
-
2361  integer(c_int) :: flag
-
2362 
-
2363  ! Local Variables
-
2364  type(errors) :: err
-
2365  integer(c_int) :: minmn, maxmn
-
2366 
-
2367  ! Error Checking
-
2368  minmn = min(m, n)
-
2369  maxmn = max(m, n)
-
2370  call err%set_exit_on_error(.false.)
-
2371  flag = la_no_error
-
2372  if (lda < m .or. ldb < maxmn) then
-
2373  flag = la_invalid_input_error
-
2374  return
-
2375  end if
-
2376 
-
2377  ! Process
-
2378  call solve_qr(a(1:m,1:n), tau(1:minmn), jpvt(1:n), b(1:maxmn,1:k), &
-
2379  err = err)
-
2380  if (err%has_error_occurred()) then
-
2381  flag = err%get_error_flag()
-
2382  return
-
2383  end if
-
2384  end function
-
2385 
-
2386 ! ------------------------------------------------------------------------------
-
2403  function la_solve_cholesky(upper, m, n, a, lda, b, ldb) &
-
2404  bind(C, name = "la_solve_cholesky") result(flag)
-
2405  ! Arguments
-
2406  logical(c_bool), intent(in), value :: upper
-
2407  integer(c_int), intent(in), value :: m, n, lda, ldb
-
2408  real(c_double), intent(in) :: a(lda,*)
-
2409  real(c_double), intent(inout) :: b(ldb,*)
-
2410  integer(c_int) :: flag
-
2411 
-
2412  ! Local Variables
-
2413  type(errors) :: err
-
2414 
-
2415  ! Error Checking
-
2416  call err%set_exit_on_error(.false.)
-
2417  flag = la_no_error
-
2418  if (lda < m .or. ldb < m) then
-
2419  flag = la_invalid_input_error
-
2420  return
-
2421  end if
-
2422 
-
2423  ! Process
-
2424  call solve_cholesky(logical(upper), a(1:m,1:m), b(1:m,1:n))
-
2425  end function
-
2426 
-
2427 ! ------------------------------------------------------------------------------
-
2444  function la_solve_cholesky_cmplx(upper, m, n, a, lda, b, ldb) &
-
2445  bind(C, name = "la_solve_cholesky_cmplx") result(flag)
-
2446  ! Arguments
-
2447  logical(c_bool), intent(in), value :: upper
-
2448  integer(c_int), intent(in), value :: m, n, lda, ldb
-
2449  complex(c_double), intent(in) :: a(lda,*)
-
2450  complex(c_double), intent(inout) :: b(ldb,*)
-
2451  integer(c_int) :: flag
-
2452 
-
2453  ! Local Variables
-
2454  type(errors) :: err
-
2455 
-
2456  ! Error Checking
-
2457  call err%set_exit_on_error(.false.)
-
2458  flag = la_no_error
-
2459  if (lda < m .or. ldb < m) then
-
2460  flag = la_invalid_input_error
-
2461  return
-
2462  end if
-
2463 
-
2464  ! Process
-
2465  call solve_cholesky(logical(upper), a(1:m,1:m), b(1:m,1:n))
-
2466  end function
-
2467 
-
2468 ! ------------------------------------------------------------------------------
-
2492  function la_solve_least_squares(m, n, k, a, lda, b, ldb) &
-
2493  bind(C, name = "la_solve_least_squares") result(flag)
-
2494  ! Arguments
-
2495  integer(c_int), intent(in), value :: m, n, k, lda, ldb
-
2496  real(c_double), intent(inout) :: a(lda,*), b(ldb,*)
-
2497  integer(c_int) :: flag
-
2498 
-
2499  ! Local Variables
-
2500  type(errors) :: err
-
2501  integer(c_int) :: maxmn
-
2502 
-
2503  ! Error Checking
-
2504  maxmn = max(m, n)
-
2505  call err%set_exit_on_error(.false.)
-
2506  flag = la_no_error
-
2507  if (lda < m .or. ldb < maxmn) then
-
2508  flag = la_invalid_input_error
-
2509  return
-
2510  end if
-
2511 
-
2512  ! Process
-
2513  call solve_least_squares(a(1:m,1:n), b(1:maxmn,1:k), err = err)
-
2514  if (err%has_error_occurred()) then
-
2515  flag = err%get_error_flag()
-
2516  return
-
2517  end if
-
2518  end function
-
2519 
-
2520 ! ------------------------------------------------------------------------------
-
2544  function la_solve_least_squares_cmplx(m, n, k, a, lda, b, ldb) &
-
2545  bind(C, name = "la_solve_least_squares_cmplx") result(flag)
-
2546  ! Arguments
-
2547  integer(c_int), intent(in), value :: m, n, k, lda, ldb
-
2548  complex(c_double), intent(inout) :: a(lda,*), b(ldb,*)
-
2549  integer(c_int) :: flag
-
2550 
-
2551  ! Local Variables
-
2552  type(errors) :: err
-
2553  integer(c_int) :: maxmn
-
2554 
-
2555  ! Error Checking
-
2556  maxmn = max(m, n)
-
2557  call err%set_exit_on_error(.false.)
-
2558  flag = la_no_error
-
2559  if (lda < m .or. ldb < maxmn) then
-
2560  flag = la_invalid_input_error
-
2561  return
-
2562  end if
-
2563 
-
2564  ! Process
-
2565  call solve_least_squares(a(1:m,1:n), b(1:maxmn,1:k), err = err)
-
2566  if (err%has_error_occurred()) then
-
2567  flag = err%get_error_flag()
-
2568  return
-
2569  end if
-
2570  end function
-
2571 
-
2572 ! ------------------------------------------------------------------------------
-
2584  function la_inverse(n, a, lda) bind(C, name = "la_inverse") result(flag)
-
2585  ! Arguments
-
2586  integer(c_int), intent(in), value :: n, lda
-
2587  real(c_double), intent(inout) :: a(lda,*)
-
2588  integer(c_int) :: flag
-
2589 
-
2590  ! Local Variables
-
2591  type(errors) :: err
-
2592 
-
2593  ! Error Checking
-
2594  call err%set_exit_on_error(.false.)
-
2595  flag = la_no_error
-
2596  if (lda < n) then
-
2597  flag = la_invalid_input_error
-
2598  return
-
2599  end if
-
2600 
-
2601  ! Process
-
2602  call mtx_inverse(a(1:n,1:n), err = err)
-
2603  if (err%has_error_occurred()) then
-
2604  flag = err%get_error_flag()
-
2605  return
-
2606  end if
-
2607  end function
-
2608 
-
2609 ! ------------------------------------------------------------------------------
-
2621  function la_inverse_cmplx(n, a, lda) bind(C, name = "la_inverse_cmplx") &
-
2622  result(flag)
-
2623  ! Arguments
-
2624  integer(c_int), intent(in), value :: n, lda
-
2625  complex(c_double), intent(inout) :: a(lda,*)
-
2626  integer(c_int) :: flag
-
2627 
-
2628  ! Local Variables
-
2629  type(errors) :: err
-
2630 
-
2631  ! Error Checking
-
2632  call err%set_exit_on_error(.false.)
-
2633  flag = la_no_error
-
2634  if (lda < n) then
-
2635  flag = la_invalid_input_error
-
2636  return
-
2637  end if
-
2638 
-
2639  ! Process
-
2640  call mtx_inverse(a(1:n,1:n), err = err)
-
2641  if (err%has_error_occurred()) then
-
2642  flag = err%get_error_flag()
-
2643  return
-
2644  end if
-
2645  end function
-
2646 
-
2647 ! ------------------------------------------------------------------------------
-
2663  function la_pinverse(m, n, a, lda, ainv, ldai) &
-
2664  bind(C, name = "la_pinverse") result(flag)
-
2665  ! Arguments
-
2666  integer(c_int), intent(in), value :: m, n, lda, ldai
-
2667  real(c_double), intent(inout) :: a(lda,*)
-
2668  real(c_double), intent(out) :: ainv(ldai,*)
-
2669  integer(c_int) :: flag
-
2670 
-
2671  ! Local Variables
-
2672  type(errors) :: err
-
2673 
-
2674  ! Error Checking
-
2675  call err%set_exit_on_error(.false.)
-
2676  flag = la_no_error
-
2677  if (lda < m .or. ldai < n) then
-
2678  flag = la_invalid_input_error
-
2679  return
-
2680  end if
-
2681 
-
2682  ! Process
-
2683  call mtx_pinverse(a(1:m,1:n), ainv(1:n,1:m), err = err)
-
2684  if (err%has_error_occurred()) then
-
2685  flag = err%get_error_flag()
-
2686  return
-
2687  end if
-
2688  end function
-
2689 
-
2690 ! ------------------------------------------------------------------------------
-
2706  function la_pinverse_cmplx(m, n, a, lda, ainv, ldai) &
-
2707  bind(C, name = "la_pinverse_cmplx") result(flag)
-
2708  ! Arguments
-
2709  integer(c_int), intent(in), value :: m, n, lda, ldai
-
2710  complex(c_double), intent(inout) :: a(lda,*)
-
2711  complex(c_double), intent(out) :: ainv(ldai,*)
-
2712  integer(c_int) :: flag
-
2713 
-
2714  ! Local Variables
-
2715  type(errors) :: err
-
2716 
-
2717  ! Error Checking
-
2718  call err%set_exit_on_error(.false.)
-
2719  flag = la_no_error
-
2720  if (lda < m .or. ldai < n) then
-
2721  flag = la_invalid_input_error
-
2722  return
-
2723  end if
-
2724 
-
2725  ! Process
-
2726  call mtx_pinverse(a(1:m,1:n), ainv(1:n,1:m), err = err)
-
2727  if (err%has_error_occurred()) then
-
2728  flag = err%get_error_flag()
-
2729  return
-
2730  end if
-
2731  end function
-
2732 
-
2733 ! ------------------------------------------------------------------------------
-
2755  function la_eigen_symm(vecs, n, a, lda, vals) &
-
2756  bind(C, name = "la_eigen_symm") result(flag)
-
2757  ! Arguments
-
2758  logical(c_bool), intent(in), value :: vecs
-
2759  integer(c_int), intent(in), value :: n, lda
-
2760  real(c_double), intent(inout) :: a(lda,*)
-
2761  real(c_double), intent(out) :: vals(*)
-
2762  integer(c_int) :: flag
-
2763 
-
2764  ! Local Variables
-
2765  type(errors) :: err
-
2766 
-
2767  ! Error Checking
-
2768  call err%set_exit_on_error(.false.)
-
2769  flag = la_no_error
-
2770  if (lda < n) then
-
2771  flag = la_invalid_input_error
-
2772  return
-
2773  end if
-
2774 
-
2775  ! Process
-
2776  call eigen(logical(vecs), a(1:n,1:n), vals(1:n), err = err)
-
2777  if (err%has_error_occurred()) then
-
2778  flag = err%get_error_flag()
-
2779  return
-
2780  end if
-
2781  end function
-
2782 
-
2783 ! ------------------------------------------------------------------------------
-
2804  function la_eigen_asymm(vecs, n, a, lda, vals, v, ldv) &
-
2805  bind(C, name = "la_eigen_asymm") result(flag)
-
2806  ! Arguments
-
2807  logical(c_bool), intent(in), value :: vecs
-
2808  integer(c_int), intent(in), value :: n, lda, ldv
-
2809  real(c_double), intent(inout) :: a(lda,*)
-
2810  complex(c_double), intent(out) :: vals(*), v(ldv,*)
-
2811  integer(c_int) :: flag
-
2812 
-
2813  ! Local Variables
-
2814  type(errors) :: err
-
2815 
-
2816  ! Error Checking
-
2817  call err%set_exit_on_error(.false.)
-
2818  flag = la_no_error
-
2819  if (vecs) then
-
2820  if (lda < n .or. ldv < n) then
-
2821  flag = la_invalid_input_error
-
2822  return
-
2823  end if
-
2824  else
-
2825  if (lda < n) then
-
2826  flag = la_invalid_input_error
-
2827  return
-
2828  end if
-
2829  end if
-
2830 
-
2831  ! Process
-
2832  if (vecs) then
-
2833  call eigen(a(1:n,1:n), vals(1:n), v(1:n,1:n), err = err)
-
2834  else
-
2835  call eigen(a(1:n,1:n), vals(1:n))
-
2836  end if
-
2837  if (err%has_error_occurred()) then
-
2838  flag = err%get_error_flag()
-
2839  return
-
2840  end if
-
2841  end function
-
2842 
-
2843 ! ------------------------------------------------------------------------------
-
2877  function la_eigen_gen(vecs, n, a, lda, b, ldb, alpha, beta, v, ldv) &
-
2878  bind(C, name = "la_eigen_gen") result(flag)
-
2879  ! Arguments
-
2880  logical(c_bool), intent(in), value :: vecs
-
2881  integer(c_int), intent(in), value :: n, lda, ldb, ldv
-
2882  real(c_double), intent(inout) :: a(lda,*), b(ldb,*)
-
2883  real(c_double), intent(out) :: beta(*)
-
2884  complex(c_double), intent(out) :: alpha(*), v(ldv,*)
-
2885  integer(c_int) :: flag
-
2886 
-
2887  ! Local Variables
-
2888  type(errors) :: err
-
2889 
-
2890  ! Error Checking
-
2891  call err%set_exit_on_error(.false.)
-
2892  flag = la_no_error
-
2893  if (vecs) then
-
2894  if (lda < n .or. ldb < n .or. ldv < n) then
-
2895  flag = la_invalid_input_error
-
2896  return
-
2897  end if
-
2898  else
-
2899  if (lda < n .or. ldb < n) then
-
2900  flag = la_invalid_input_error
-
2901  return
-
2902  end if
-
2903  end if
-
2904 
-
2905  ! Process
-
2906  if (vecs) then
-
2907  call eigen(a(1:n,1:n), b(1:n,1:n), alpha(1:n), beta(1:n), &
-
2908  v(1:n,1:n), err = err)
-
2909  else
-
2910  call eigen(a(1:n,1:n), b(1:n,1:n), alpha(1:n), beta(1:n), err = err)
-
2911  end if
-
2912  if (err%has_error_occurred()) then
-
2913  flag = err%get_error_flag()
-
2914  return
-
2915  end if
-
2916  end function
-
2917 
-
2918 ! ------------------------------------------------------------------------------
-
2939  function la_eigen_cmplx(vecs, n, a, lda, vals, v, ldv) &
-
2940  bind(C, name = "la_eigen_cmplx") result(flag)
-
2941  ! Arguments
-
2942  logical(c_bool), intent(in), value :: vecs
-
2943  integer(c_int), intent(in), value :: n, lda, ldv
-
2944  complex(c_double), intent(inout) :: a(lda,*)
-
2945  complex(c_double), intent(out) :: vals(*), v(ldv,*)
-
2946  integer(c_int) :: flag
-
2947 
-
2948  ! Local Variables
-
2949  type(errors) :: err
-
2950 
-
2951  ! Error Checking
-
2952  call err%set_exit_on_error(.false.)
-
2953  flag = la_no_error
-
2954  if (vecs) then
-
2955  if (lda < n .or. ldv < n) then
-
2956  flag = la_invalid_input_error
-
2957  return
-
2958  end if
-
2959  else
-
2960  if (lda < n) then
-
2961  flag = la_invalid_input_error
-
2962  return
-
2963  end if
-
2964  end if
-
2965 
-
2966  ! Process
-
2967  if (vecs) then
-
2968  call eigen(a(1:n,1:n), vals(1:n), v(1:n,1:n), err = err)
-
2969  else
-
2970  call eigen(a(1:n,1:n), vals(1:n))
-
2971  end if
-
2972  if (err%has_error_occurred()) then
-
2973  flag = err%get_error_flag()
-
2974  return
-
2975  end if
-
2976  end function
-
2977 
-
2978 ! ------------------------------------------------------------------------------
-
2996  function la_sort_eigen(ascend, n, vals, vecs, ldv) &
-
2997  bind(C, name = "la_sort_eigen") result(flag)
-
2998  ! Arguments
-
2999  logical(c_bool), intent(in), value :: ascend
-
3000  integer(c_int), intent(in), value :: n, ldv
-
3001  real(c_double), intent(inout) :: vals(*), vecs(ldv,*)
-
3002  integer(c_int) :: flag
-
3003 
-
3004  ! Local Variables
-
3005  type(errors) :: err
-
3006 
-
3007  ! Error Checking
-
3008  call err%set_exit_on_error(.false.)
-
3009  flag = la_no_error
-
3010  if (ldv < n) then
-
3011  flag = la_invalid_input_error
-
3012  return
-
3013  end if
-
3014 
-
3015  ! Process
-
3016  call sort(vals(1:n), vecs(1:n,1:n), logical(ascend), err = err)
-
3017  if (err%has_error_occurred()) then
-
3018  flag = err%get_error_flag()
-
3019  return
-
3020  end if
-
3021  end function
-
3022 
-
3023 ! ------------------------------------------------------------------------------
-
3041  function la_sort_eigen_cmplx(ascend, n, vals, vecs, ldv) &
-
3042  bind(C, name = "la_sort_eigen_cmplx") result(flag)
-
3043  ! Arguments
-
3044  logical(c_bool), intent(in), value :: ascend
-
3045  integer(c_int), intent(in), value :: n, ldv
-
3046  complex(c_double), intent(inout) :: vals(*), vecs(ldv,*)
-
3047  integer(c_int) :: flag
-
3048 
-
3049  ! Local Variables
-
3050  type(errors) :: err
-
3051 
-
3052  ! Error Checking
-
3053  call err%set_exit_on_error(.false.)
-
3054  flag = la_no_error
-
3055  if (ldv < n) then
-
3056  flag = la_invalid_input_error
-
3057  return
-
3058  end if
-
3059 
-
3060  ! Process
-
3061  call sort(vals(1:n), vecs(1:n,1:n), logical(ascend), err = err)
-
3062  if (err%has_error_occurred()) then
-
3063  flag = err%get_error_flag()
-
3064  return
-
3065  end if
-
3066  end function
-
3067 
-
3068 ! ------------------------------------------------------------------------------
-
3069 
-
3070 ! ------------------------------------------------------------------------------
-
3071 
-
3072 ! ------------------------------------------------------------------------------
-
3073 end module
+
1! linalg_c_api.f90
+
2
+ +
6 use iso_c_binding
+ + +
9 use ferror
+
10 implicit none
+
11
+
12contains
+
13! ------------------------------------------------------------------------------
+
30 function la_rank1_update(m, n, alpha, x, y, a, lda) &
+
31 bind(C, name = "la_rank1_update") result(flag)
+
32 ! Arguments
+
33 integer(c_int), intent(in), value :: m, n, lda
+
34 real(c_double), intent(in), value :: alpha
+
35 real(c_double), intent(in) :: x(*), y(*)
+
36 real(c_double), intent(inout) :: a(lda,*)
+
37 integer(c_int) :: flag
+
38
+
39 ! Initialization
+
40 flag = la_no_error
+
41
+
42 ! Input Checking
+
43 if (lda < m) then
+
44 flag = la_invalid_input_error
+
45 return
+
46 end if
+
47
+
48 ! Process
+
49 call rank1_update(alpha, x(1:m), y(1:n), a(1:m,1:n))
+
50 end function
+
51
+
52! ------------------------------------------------------------------------------
+
69 function la_rank1_update_cmplx(m, n, alpha, x, y, a, lda) &
+
70 bind(C, name = "la_rank1_update_cmplx") result(flag)
+
71 ! Arguments
+
72 integer(c_int), intent(in), value :: m, n, lda
+
73 complex(c_double), intent(in), value :: alpha
+
74 complex(c_double), intent(in) :: x(*), y(*)
+
75 complex(c_double), intent(inout) :: a(lda,*)
+
76 integer(c_int) :: flag
+
77
+
78 ! Initialization
+
79 flag = la_no_error
+
80
+
81 ! Input Checking
+
82 if (lda < m) then
+
83 flag = la_invalid_input_error
+
84 return
+
85 end if
+
86
+
87 ! Process
+
88 call rank1_update(alpha, x(1:m), y(1:n), a(1:m,1:n))
+
89 end function
+
90
+
91! ------------------------------------------------------------------------------
+
104 function la_trace(m, n, a, lda, rst) bind(C, name = "la_trace") &
+
105 result(flag)
+
106 ! Arguments
+
107 integer(c_int), intent(in), value :: m, n, lda
+
108 real(c_double), intent(in) :: a(lda,*)
+
109 real(c_double), intent(out) :: rst
+
110 integer(c_int) :: flag
+
111
+
112 ! Initialization
+
113 flag = la_no_error
+
114
+
115 ! Input Checking
+
116 if (lda < m) then
+
117 flag = la_invalid_input_error
+
118 return
+
119 end if
+
120
+
121 ! Process
+
122 rst = trace(a(1:m,1:n))
+
123 end function
+
124
+
125! ------------------------------------------------------------------------------
+
138 function la_trace_cmplx(m, n, a, lda, rst) &
+
139 bind(C, name = "la_trace_cmplx") result(flag)
+
140 ! Arguments
+
141 integer(c_int), intent(in), value :: m, n, lda
+
142 complex(c_double), intent(in) :: a(lda,*)
+
143 complex(c_double), intent(out) :: rst
+
144 integer(c_int) :: flag
+
145
+
146 ! Initialization
+
147 flag = la_no_error
+
148
+
149 ! Input Checking
+
150 if (lda < m) then
+
151 flag = la_invalid_input_error
+
152 return
+
153 end if
+
154
+
155 ! Process
+
156 rst = trace(a(1:m,1:n))
+
157 end function
+
158
+
159! ------------------------------------------------------------------------------
+
184 function la_mtx_mult(transa, transb, m, n, k, alpha, a, lda, b, ldb, &
+
185 beta, c, ldc) bind(C, name="la_mtx_mult") result(flag)
+
186 ! Arugments
+
187 logical(c_bool), intent(in), value :: transa, transb
+
188 integer(c_int), intent(in), value :: m, n, k, lda, ldb, ldc
+
189 real(c_double), intent(in), value :: alpha, beta
+
190 real(c_double), intent(in) :: a(lda,*), b(ldb,*)
+
191 real(c_double), intent(inout) :: c(ldc,*)
+
192 integer(c_int) :: flag
+
193
+
194 ! Local Variables
+
195 character :: ta, tb
+
196 integer(c_int) :: nrowa, nrowb
+
197
+
198 ! Initialization
+
199 flag = la_no_error
+
200 ta = "N"
+
201 if (transa) ta = "T"
+
202
+
203 tb = "N"
+
204 if (transb) tb = "T"
+
205
+
206 if (transa) then
+
207 nrowa = k
+
208 else
+
209 nrowa = m
+
210 end if
+
211
+
212 if (transb) then
+
213 nrowb = n
+
214 else
+
215 nrowb = k
+
216 end if
+
217
+
218 ! Input Checking
+
219 if (lda < nrowa .or. ldb < nrowb .or. ldc < m) then
+
220 flag = la_invalid_input_error
+
221 return
+
222 end if
+
223
+
224 ! Call DGEMM directly
+
225 call dgemm(ta, tb, m, n, k, alpha, a, lda, b, ldb, beta, c, ldc)
+
226 end function
+
227
+
228! ------------------------------------------------------------------------------
+
255 function la_mtx_mult_cmplx(opa, opb, m, n, k, alpha, a, lda, b, ldb, &
+
256 beta, c, ldc) bind(C, name="la_mtx_mult_cmplx") result(flag)
+
257 ! Arguments
+
258 integer(c_int), intent(in), value :: opa, opb, m, n, k, lda, ldb, ldc
+
259 complex(c_double), intent(in), value :: alpha, beta
+
260 complex(c_double), intent(in) :: a(lda,*), b(ldb,*)
+
261 complex(c_double), intent(inout) :: c(ldc,*)
+
262 integer(c_int) :: flag
+
263
+
264 ! Local Variables
+
265 character :: ta, tb
+
266 integer(c_int) :: nrowa, nrowb
+
267
+
268 ! Initialization
+
269 flag = la_no_error
+
270 if (opa == transpose) then
+
271 ta = "T"
+
272 else if (opa == hermitian_transpose) then
+
273 ta = "H"
+
274 else
+
275 ta = "N"
+
276 end if
+
277
+
278 if (opb == transpose) then
+
279 tb = "T"
+
280 else if (opb == hermitian_transpose) then
+
281 tb = "H"
+
282 else
+
283 tb = "N"
+
284 end if
+
285
+
286 if (opa == transpose .or. opa == hermitian_transpose) then
+
287 nrowa = k
+
288 else
+
289 nrowa = m
+
290 end if
+
291
+
292 if (opb == transpose .or. opb == hermitian_transpose) then
+
293 nrowb = n
+
294 else
+
295 nrowb = k
+
296 end if
+
297
+
298 ! Input Checking
+
299 if (lda < nrowa .or. ldb < nrowb .or. ldc < m) then
+
300 flag = la_invalid_input_error
+
301 return
+
302 end if
+
303
+
304 ! Call ZGEMM directly
+
305 call zgemm(ta, tb, m, n, k, alpha, a, lda, b, ldb, beta, c, ldc)
+
306 end function
+
307
+
308! ------------------------------------------------------------------------------
+
340 function la_diag_mtx_mult(lside, transb, m, n, k, alpha, a, b, ldb, &
+
341 beta, c, ldc) bind(C, name="la_diag_mtx_mult") result(flag)
+
342 ! Arguments
+
343 logical(c_bool), intent(in), value :: lside, transb
+
344 integer(c_int), intent(in), value :: m, n, k, ldb, ldc
+
345 real(c_double), intent(in), value :: alpha, beta
+
346 real(c_double), intent(in) :: a(*), b(ldb,*)
+
347 real(c_double), intent(inout) :: c(ldc,*)
+
348 integer(c_int) :: flag
+
349
+
350 ! Local Variabes
+
351 integer(c_int) :: nrows, ncols, p
+
352 logical :: ls, tb
+
353 type(errors) :: err
+
354
+
355 ! Initialization
+
356 call err%set_exit_on_error(.false.)
+
357 flag = la_no_error
+
358 if (lside .and. transb) then
+
359 nrows = n
+
360 ncols = k
+
361 p = min(k, m)
+
362 ls = .true.
+
363 tb = .true.
+
364 else if (lside .and. .not. transb) then
+
365 nrows = k
+
366 ncols = n
+
367 p = min(k, m)
+
368 ls = .true.
+
369 tb = .false.
+
370 else if (.not. lside .and. transb) then
+
371 nrows = k
+
372 ncols = m
+
373 p = min(k, n)
+
374 ls = .false.
+
375 tb = .true.
+
376 else
+
377 nrows = m
+
378 ncols = k
+
379 p = min(k, n)
+
380 ls = .false.
+
381 tb = .false.
+
382 end if
+
383
+
384 ! Error Checking
+
385 if (ldb < nrows .or. ldc < m) then
+
386 flag = la_invalid_input_error
+
387 return
+
388 end if
+
389
+
390 ! Process
+
391 call diag_mtx_mult(ls, tb, alpha, a(1:p), b(1:nrows,1:ncols), &
+
392 beta, c(1:m,1:n), err)
+
393 if (err%has_error_occurred()) flag = err%get_error_flag()
+
394 end function
+
395
+
396! ------------------------------------------------------------------------------
+
429 function la_diag_mtx_mult_mixed(lside, opb, m, n, k, alpha, a, b, ldb, &
+
430 beta, c, ldc) bind(C, name = "la_diag_mtx_mult_mixed") result(flag)
+
431 ! Arguments
+
432 logical(c_bool), intent(in), value :: lside
+
433 integer(c_int), intent(in), value :: opb, m, n, k, ldb, ldc
+
434 complex(c_double), intent(in), value :: alpha, beta
+
435 real(c_double), intent(in) :: a(*)
+
436 complex(c_double), intent(in) :: b(ldb,*)
+
437 complex(c_double), intent(inout) :: c(ldc,*)
+
438 integer(c_int) :: flag
+
439
+
440 ! Local Variabes
+
441 integer(c_int) :: nrows, ncols, p
+
442 logical :: ls, tb
+
443 type(errors) :: err
+
444
+
445 ! Initialization
+
446 call err%set_exit_on_error(.false.)
+
447 flag = la_no_error
+
448 tb = .false.
+
449 if (opb == transpose .or. opb == hermitian_transpose) tb = .true.
+
450 if (lside .and. tb) then
+
451 nrows = n
+
452 ncols = k
+
453 p = min(k, m)
+
454 ls = .true.
+
455 else if (lside .and. .not. tb) then
+
456 nrows = k
+
457 ncols = n
+
458 p = min(k, m)
+
459 ls = .true.
+
460 else if (.not. lside .and. tb) then
+
461 nrows = k
+
462 ncols = m
+
463 p = min(k, n)
+
464 ls = .false.
+
465 else
+
466 nrows = m
+
467 ncols = k
+
468 p = min(k, n)
+
469 ls = .false.
+
470 end if
+
471
+
472 ! Error Checking
+
473 if (ldb < nrows .or. ldc < m) then
+
474 flag = la_invalid_input_error
+
475 return
+
476 end if
+
477
+
478 ! Process
+
479 call diag_mtx_mult(ls, opb, alpha, a(1:p), b(1:nrows,1:ncols), &
+
480 beta, c(1:m,1:n))
+
481 if (err%has_error_occurred()) flag = err%get_error_flag()
+
482 end function
+
483
+
484! ------------------------------------------------------------------------------
+
517 function la_diag_mtx_mult_cmplx(lside, opb, m, n, k, alpha, a, b, &
+
518 ldb, beta, c, ldc) bind(C, name="la_diag_mtx_mult_cmplx") &
+
519 result(flag)
+
520 ! Arguments
+
521 logical(c_bool), intent(in), value :: lside
+
522 integer(c_int), intent(in), value :: opb, m, n, k, ldb, ldc
+
523 complex(c_double), intent(in), value :: alpha, beta
+
524 complex(c_double), intent(in) :: a(*), b(ldb,*)
+
525 complex(c_double), intent(inout) :: c(ldc,*)
+
526 integer(c_int) :: flag
+
527
+
528 ! Local Variabes
+
529 integer(c_int) :: nrows, ncols, p
+
530 logical :: ls, tb
+
531 type(errors) :: err
+
532
+
533 ! Initialization
+
534 call err%set_exit_on_error(.false.)
+
535 flag = la_no_error
+
536 tb = .false.
+
537 if (opb == transpose .or. opb == hermitian_transpose) tb = .true.
+
538 if (lside .and. tb) then
+
539 nrows = n
+
540 ncols = k
+
541 p = min(k, m)
+
542 ls = .true.
+
543 else if (lside .and. .not. tb) then
+
544 nrows = k
+
545 ncols = n
+
546 p = min(k, m)
+
547 ls = .true.
+
548 else if (.not. lside .and. tb) then
+
549 nrows = k
+
550 ncols = m
+
551 p = min(k, n)
+
552 ls = .false.
+
553 else
+
554 nrows = m
+
555 ncols = k
+
556 p = min(k, n)
+
557 ls = .false.
+
558 end if
+
559
+
560 ! Error Checking
+
561 if (ldb < nrows .or. ldc < m) then
+
562 flag = la_invalid_input_error
+
563 return
+
564 end if
+
565
+
566 ! Process
+
567 call diag_mtx_mult(ls, opb, alpha, a(1:p), b(1:nrows,1:ncols), &
+
568 beta, c(1:m,1:n))
+
569 if (err%has_error_occurred()) flag = err%get_error_flag()
+
570 end function
+
571
+
572! ------------------------------------------------------------------------------
+
589 function la_rank(m, n, a, lda, rnk) bind(C, name="la_rank") result(flag)
+
590 ! Arguments
+
591 integer(c_int), intent(in), value :: m, n, lda
+
592 real(c_double), intent(inout) :: a(lda,*)
+
593 integer(c_int), intent(out) :: rnk
+
594 integer(c_int) :: flag
+
595
+
596 ! Local Variables
+
597 type(errors) :: err
+
598
+
599 ! Input Check
+
600 call err%set_exit_on_error(.false.)
+
601 flag = la_no_error
+
602 if (lda < m) then
+
603 flag = la_invalid_input_error
+
604 return
+
605 end if
+
606
+
607 ! Process
+
608 rnk = mtx_rank(a(1:m,1:n), err =err)
+
609 if (err%has_error_occurred()) flag = err%get_error_flag()
+
610 end function
+
611
+
612! ------------------------------------------------------------------------------
+
629 function la_rank_cmplx(m, n, a, lda, rnk) bind(C, name="la_rank_cmplx") &
+
630 result(flag)
+
631 ! Arguments
+
632 integer(c_int), intent(in), value :: m, n, lda
+
633 complex(c_double), intent(inout) :: a(lda,*)
+
634 integer(c_int), intent(out) :: rnk
+
635 integer(c_int) :: flag
+
636
+
637 ! Local Variables
+
638 type(errors) :: err
+
639
+
640 ! Input Check
+
641 call err%set_exit_on_error(.false.)
+
642 flag = la_no_error
+
643 if (lda < m) then
+
644 flag = la_invalid_input_error
+
645 return
+
646 end if
+
647
+
648 ! Process
+
649 rnk = mtx_rank(a(1:m,1:n), err = err)
+
650 if (err%has_error_occurred()) flag = err%get_error_flag()
+
651 end function
+
652
+
653! ------------------------------------------------------------------------------
+
667 function la_det(n, a, lda, d) bind(C, name="la_det") result(flag)
+
668 ! Arguments
+
669 integer(c_int), intent(in), value :: n, lda
+
670 real(c_double), intent(inout) :: a(lda,*)
+
671 real(c_double), intent(out) :: d
+
672 integer(c_int) :: flag
+
673
+
674 ! Local Variables
+
675 type(errors) :: err
+
676
+
677 ! Error Checking
+
678 call err%set_exit_on_error(.false.)
+
679 flag = la_no_error
+
680 if (lda < n) then
+
681 flag = la_invalid_input_error
+
682 return
+
683 end if
+
684
+
685 ! Process
+
686 d = det(a(1:n,1:n), err = err)
+
687 if (err%has_error_occurred()) flag = err%get_error_flag()
+
688 end function
+
689
+
690! ------------------------------------------------------------------------------
+
704 function la_det_cmplx(n, a, lda, d) bind(C, name="la_det_cmplx") result(flag)
+
705 ! Arguments
+
706 integer(c_int), intent(in), value :: n, lda
+
707 complex(c_double), intent(inout) :: a(lda,*)
+
708 complex(c_double), intent(out) :: d
+
709 integer(c_int) :: flag
+
710
+
711 ! Local Variables
+
712 type(errors) :: err
+
713
+
714 ! Error Checking
+
715 call err%set_exit_on_error(.false.)
+
716 flag = la_no_error
+
717 if (lda < n) then
+
718 flag = la_invalid_input_error
+
719 return
+
720 end if
+
721
+
722 ! Process
+
723 d = det(a(1:n,1:n), err = err)
+
724 if (err%has_error_occurred()) flag = err%get_error_flag()
+
725 end function
+
726
+
727! ------------------------------------------------------------------------------
+
751 function la_tri_mtx_mult(upper, alpha, n, a, lda, beta, b, ldb) &
+
752 bind(C, name = "la_tri_mtx_mult") result(flag)
+
753 ! Arguments
+
754 logical(c_bool), intent(in), value :: upper
+
755 integer(c_int), intent(in), value :: n, lda, ldb
+
756 real(c_double), intent(in), value :: alpha, beta
+
757 real(c_double), intent(in) :: a(lda,*)
+
758 real(c_double), intent(inout) :: b(ldb,*)
+
759 integer(c_int) :: flag
+
760
+
761 ! Error Checking
+
762 flag = la_no_error
+
763 if (lda < n .or. ldb < n) then
+
764 flag = la_invalid_input_error
+
765 return
+
766 end if
+
767
+
768 ! Process
+
769 call tri_mtx_mult(logical(upper), alpha, a(1:n,1:n), beta, b(1:n,1:n))
+
770 end function
+
771
+
772! ------------------------------------------------------------------------------
+
796 function la_tri_mtx_mult_cmplx(upper, alpha, n, a, lda, beta, b, ldb) &
+
797 bind(C, name = "la_tri_mtx_mult_cmplx") result(flag)
+
798 ! Arguments
+
799 logical(c_bool), intent(in), value :: upper
+
800 integer(c_int), intent(in), value :: n, lda, ldb
+
801 complex(c_double), intent(in), value :: alpha, beta
+
802 complex(c_double), intent(in) :: a(lda,*)
+
803 complex(c_double), intent(inout) :: b(ldb,*)
+
804 integer(c_int) :: flag
+
805
+
806 ! Error Checking
+
807 flag = la_no_error
+
808 if (lda < n .or. ldb < n) then
+
809 flag = la_invalid_input_error
+
810 return
+
811 end if
+
812
+
813 ! Process
+
814 call tri_mtx_mult(logical(upper), alpha, a(1:n,1:n), beta, b(1:n,1:n))
+
815 end function
+
816
+
817! ------------------------------------------------------------------------------
+
835 function la_lu_factor(m, n, a, lda, ipvt) bind(C, name = "la_lu_factor") &
+
836 result(flag)
+
837 ! Arguments
+
838 integer(c_int), intent(in), value :: m, n, lda
+
839 real(c_double), intent(inout) :: a(lda,*)
+
840 integer(c_int), intent(out) :: ipvt(*)
+
841 integer(c_int) :: flag
+
842
+
843 ! Local Variables
+
844 type(errors) :: err
+
845 integer(c_int) :: mn
+
846
+
847 ! Error Checking
+
848 call err%set_exit_on_error(.false.)
+
849 flag = la_no_error
+
850 if (lda < m) then
+
851 flag = la_invalid_input_error
+
852 return
+
853 end if
+
854
+
855 ! Process
+
856 mn = min(m, n)
+
857 call lu_factor(a(1:m,1:n), ipvt(1:mn), err)
+
858 if (err%has_error_occurred()) then
+
859 flag = err%get_error_flag()
+
860 return
+
861 end if
+
862 end function
+
863
+
864! ------------------------------------------------------------------------------
+
882 function la_lu_factor_cmplx(m, n, a, lda, ipvt) &
+
883 bind(C, name = "la_lu_factor_cmplx") result(flag)
+
884 ! Arguments
+
885 integer(c_int), intent(in), value :: m, n, lda
+
886 complex(c_double), intent(inout) :: a(lda,*)
+
887 integer(c_int), intent(out) :: ipvt(*)
+
888 integer(c_int) :: flag
+
889
+
890 ! Local Variables
+
891 type(errors) :: err
+
892 integer(c_int) :: mn
+
893
+
894 ! Error Checking
+
895 call err%set_exit_on_error(.false.)
+
896 flag = la_no_error
+
897 if (lda < m) then
+
898 flag = la_invalid_input_error
+
899 return
+
900 end if
+
901
+
902 ! Process
+
903 mn = min(m, n)
+
904 call lu_factor(a(1:m,1:n), ipvt(1:mn), err)
+
905 if (err%has_error_occurred()) then
+
906 flag = err%get_error_flag()
+
907 return
+
908 end if
+
909 end function
+
910
+
911! ------------------------------------------------------------------------------
+
931 function la_form_lu(n, a, lda, ipvt, u, ldu, p, ldp) &
+
932 bind(C, name = "la_form_lu") result(flag)
+
933 ! Arguments
+
934 integer(c_int), intent(in), value :: n, lda, ldu, ldp
+
935 real(c_double), intent(inout) :: a(lda,*)
+
936 real(c_double), intent(out) :: u(ldu,*), p(ldp,*)
+
937 integer(c_int), intent(in) :: ipvt(*)
+
938 integer(c_int) :: flag
+
939
+
940 ! Input Checking
+
941 flag = la_no_error
+
942 if (lda < n .or. ldu < n .or. ldp < n) then
+
943 flag = la_invalid_input_error
+
944 return
+
945 end if
+
946
+
947 ! Process
+
948 call form_lu(a(1:n,1:n), ipvt(1:n), u(1:n,1:n), p(1:n,1:n))
+
949 end function
+
950
+
951! ------------------------------------------------------------------------------
+
971 function la_form_lu_cmplx(n, a, lda, ipvt, u, ldu, p, ldp) &
+
972 bind(C, name = "la_form_lu_cmplx") result(flag)
+
973 ! Arguments
+
974 integer(c_int), intent(in), value :: n, lda, ldu, ldp
+
975 complex(c_double), intent(inout) :: a(lda,*)
+
976 complex(c_double), intent(out) :: u(ldu,*)
+
977 real(c_double), intent(out) :: p(ldp,*)
+
978 integer(c_int), intent(in) :: ipvt(*)
+
979 integer(c_int) :: flag
+
980
+
981 ! Input Checking
+
982 flag = la_no_error
+
983 if (lda < n .or. ldu < n .or. ldp < n) then
+
984 flag = la_invalid_input_error
+
985 return
+
986 end if
+
987
+
988 ! Process
+
989 call form_lu(a(1:n,1:n), ipvt(1:n), u(1:n,1:n), p(1:n,1:n))
+
990 end function
+
991
+
992! ------------------------------------------------------------------------------
+
1012 function la_qr_factor(m, n, a, lda, tau) bind(C, name = "la_qr_factor") &
+
1013 result(flag)
+
1014 ! Arguments
+
1015 integer(c_int), intent(in), value :: m, n, lda
+
1016 real(c_double), intent(inout) :: a(lda,*)
+
1017 real(c_double), intent(out) :: tau(*)
+
1018 integer(c_int) :: flag
+
1019
+
1020 ! Local Variables
+
1021 type(errors) :: err
+
1022 integer(c_int) :: mn
+
1023
+
1024 ! Error Checking
+
1025 call err%set_exit_on_error(.false.)
+
1026 flag = la_no_error
+
1027 if (lda < m) then
+
1028 flag = la_invalid_input_error
+
1029 return
+
1030 end if
+
1031
+
1032 ! Process
+
1033 mn = min(m, n)
+
1034 call qr_factor(a(1:m,1:n), tau(1:mn), err = err)
+
1035 if (err%has_error_occurred()) then
+
1036 flag = err%get_error_flag()
+
1037 return
+
1038 end if
+
1039 end function
+
1040
+
1041! ------------------------------------------------------------------------------
+
1061 function la_qr_factor_cmplx(m, n, a, lda, tau) &
+
1062 bind(C, name = "la_qr_factor_cmplx") result(flag)
+
1063 ! Arguments
+
1064 integer(c_int), intent(in), value :: m, n, lda
+
1065 complex(c_double), intent(inout) :: a(lda,*)
+
1066 complex(c_double), intent(out) :: tau(*)
+
1067 integer(c_int) :: flag
+
1068
+
1069 ! Local Variables
+
1070 type(errors) :: err
+
1071 integer(c_int) :: mn
+
1072
+
1073 ! Error Checking
+
1074 call err%set_exit_on_error(.false.)
+
1075 flag = la_no_error
+
1076 if (lda < m) then
+
1077 flag = la_invalid_input_error
+
1078 return
+
1079 end if
+
1080
+
1081 ! Process
+
1082 mn = min(m, n)
+
1083 call qr_factor(a(1:m,1:n), tau(1:mn), err = err)
+
1084 if (err%has_error_occurred()) then
+
1085 flag = err%get_error_flag()
+
1086 return
+
1087 end if
+
1088 end function
+
1089
+
1090! ------------------------------------------------------------------------------
+
1114 function la_qr_factor_pvt(m, n, a, lda, tau, jpvt) &
+
1115 bind(C, name = "la_qr_factor_pvt") result(flag)
+
1116 ! Arguments
+
1117 integer(c_int), intent(in), value :: m, n, lda
+
1118 real(c_double), intent(inout) :: a(lda,*)
+
1119 real(c_double), intent(out) :: tau(*)
+
1120 integer(c_int), intent(inout) :: jpvt(*)
+
1121 integer(c_int) :: flag
+
1122
+
1123 ! Local Variables
+
1124 type(errors) :: err
+
1125 integer(c_int) :: mn
+
1126
+
1127 ! Error Checking
+
1128 call err%set_exit_on_error(.false.)
+
1129 flag = la_no_error
+
1130 if (lda < m) then
+
1131 flag = la_invalid_input_error
+
1132 return
+
1133 end if
+
1134
+
1135 ! Process
+
1136 mn = min(m, n)
+
1137 call qr_factor(a(1:m,1:n), tau(1:mn), jpvt(1:n), err = err)
+
1138 if (err%has_error_occurred()) then
+
1139 flag = err%get_error_flag()
+
1140 return
+
1141 end if
+
1142 end function
+
1143
+
1144! ------------------------------------------------------------------------------
+
1168 function la_qr_factor_cmplx_pvt(m, n, a, lda, tau, jpvt) &
+
1169 bind(C, name = "la_qr_factor_cmplx_pvt") result(flag)
+
1170 ! Arguments
+
1171 integer(c_int), intent(in), value :: m, n, lda
+
1172 complex(c_double), intent(inout) :: a(lda,*)
+
1173 complex(c_double), intent(out) :: tau(*)
+
1174 integer(c_int), intent(inout) :: jpvt(*)
+
1175 integer(c_int) :: flag
+
1176
+
1177 ! Local Variables
+
1178 type(errors) :: err
+
1179 integer(c_int) :: mn
+
1180
+
1181 ! Error Checking
+
1182 call err%set_exit_on_error(.false.)
+
1183 flag = la_no_error
+
1184 if (lda < m) then
+
1185 flag = la_invalid_input_error
+
1186 return
+
1187 end if
+
1188
+
1189 ! Process
+
1190 mn = min(m, n)
+
1191 call qr_factor(a(1:m,1:n), tau(1:mn), jpvt(1:n), err = err)
+
1192 if (err%has_error_occurred()) then
+
1193 flag = err%get_error_flag()
+
1194 return
+
1195 end if
+
1196 end function
+
1197
+
1198! ------------------------------------------------------------------------------
+
1223 function la_form_qr(fullq, m, n, r, ldr, tau, q, ldq) &
+
1224 bind(C, name = "la_form_qr") result(flag)
+
1225 ! Arguments
+
1226 logical(c_bool), intent(in), value :: fullq
+
1227 integer(c_int), intent(in), value :: m, n, ldr, ldq
+
1228 real(c_double), intent(inout) :: r(ldr,*)
+
1229 real(c_double), intent(in) :: tau(*)
+
1230 real(c_double), intent(out) :: q(ldq,*)
+
1231 integer(c_int) :: flag
+
1232
+
1233 ! Local Variables
+
1234 type(errors) :: err
+
1235 integer(c_int) :: mn, nq
+
1236
+
1237 ! Error Checking
+
1238 call err%set_exit_on_error(.false.)
+
1239 flag = la_no_error
+
1240 if (ldr < m .or. ldq < m) then
+
1241 flag = la_invalid_input_error
+
1242 return
+
1243 end if
+
1244
+
1245 ! Process
+
1246 mn = min(m, n)
+
1247 nq = m
+
1248 if (.not.fullq) nq = n
+
1249 call form_qr(r(1:m,1:n), tau(1:mn), q(1:m,1:nq), err = err)
+
1250 if (err%has_error_occurred()) then
+
1251 flag = err%get_error_flag()
+
1252 return
+
1253 end if
+
1254 end function
+
1255
+
1256! ------------------------------------------------------------------------------
+
1281 function la_form_qr_cmplx(fullq, m, n, r, ldr, tau, q, ldq) &
+
1282 bind(C, name = "la_form_qr_cmplx") result(flag)
+
1283 ! Arguments
+
1284 logical(c_bool), intent(in), value :: fullq
+
1285 integer(c_int), intent(in), value :: m, n, ldr, ldq
+
1286 complex(c_double), intent(inout) :: r(ldr,*)
+
1287 complex(c_double), intent(in) :: tau(*)
+
1288 complex(c_double), intent(out) :: q(ldq,*)
+
1289 integer(c_int) :: flag
+
1290
+
1291 ! Local Variables
+
1292 type(errors) :: err
+
1293 integer(c_int) :: mn, nq
+
1294
+
1295 ! Error Checking
+
1296 call err%set_exit_on_error(.false.)
+
1297 flag = la_no_error
+
1298 if (ldr < m .or. ldq < m) then
+
1299 flag = la_invalid_input_error
+
1300 return
+
1301 end if
+
1302
+
1303 ! Process
+
1304 mn = min(m, n)
+
1305 nq = m
+
1306 if (.not.fullq) nq = n
+
1307 call form_qr(r(1:m,1:n), tau(1:mn), q(1:m,1:nq), err = err)
+
1308 if (err%has_error_occurred()) then
+
1309 flag = err%get_error_flag()
+
1310 return
+
1311 end if
+
1312 end function
+
1313
+
1314! ------------------------------------------------------------------------------
+
1345 function la_form_qr_pvt(fullq, m, n, r, ldr, tau, pvt, q, ldq, p, ldp) &
+
1346 bind(C, name = "la_form_qr_pvt") result(flag)
+
1347 ! Arguments
+
1348 logical(c_bool), intent(in), value :: fullq
+
1349 integer(c_int), intent(in), value :: m, n, ldr, ldq, ldp
+
1350 real(c_double), intent(inout) :: r(ldr,*)
+
1351 real(c_double), intent(in) :: tau(*)
+
1352 integer(c_int), intent(in) :: pvt(*)
+
1353 real(c_double), intent(out) :: q(ldq,*), p(ldp,*)
+
1354 integer(c_int) :: flag
+
1355
+
1356 ! Local Variables
+
1357 type(errors) :: err
+
1358 integer(c_int) :: mn, nq
+
1359
+
1360 ! Error Checking
+
1361 call err%set_exit_on_error(.false.)
+
1362 flag = la_no_error
+
1363 if (ldr < m .or. ldq < m .or. ldp < n) then
+
1364 flag = la_invalid_input_error
+
1365 return
+
1366 end if
+
1367
+
1368 ! Process
+
1369 mn = min(m, n)
+
1370 nq = m
+
1371 if (.not.fullq) nq = n
+
1372 call form_qr(r(1:m,1:n), tau(1:mn), pvt(1:n), q(1:m,1:nq), p(1:n,1:n), &
+
1373 err = err)
+
1374 if (err%has_error_occurred()) then
+
1375 flag = err%get_error_flag()
+
1376 return
+
1377 end if
+
1378 end function
+
1379
+
1380! ------------------------------------------------------------------------------
+
1411 function la_form_qr_cmplx_pvt(fullq, m, n, r, ldr, tau, pvt, q, ldq, p, &
+
1412 ldp) bind(C, name = "la_form_qr_cmplx_pvt") result(flag)
+
1413 ! Arguments
+
1414 logical(c_bool), intent(in), value :: fullq
+
1415 integer(c_int), intent(in), value :: m, n, ldr, ldq, ldp
+
1416 complex(c_double), intent(inout) :: r(ldr,*)
+
1417 complex(c_double), intent(in) :: tau(*)
+
1418 integer(c_int), intent(in) :: pvt(*)
+
1419 complex(c_double), intent(out) :: q(ldq,*), p(ldp,*)
+
1420 integer(c_int) :: flag
+
1421
+
1422 ! Local Variables
+
1423 type(errors) :: err
+
1424 integer(c_int) :: mn, nq
+
1425
+
1426 ! Error Checking
+
1427 call err%set_exit_on_error(.false.)
+
1428 flag = la_no_error
+
1429 if (ldr < m .or. ldq < m .or. ldp < n) then
+
1430 flag = la_invalid_input_error
+
1431 return
+
1432 end if
+
1433
+
1434 ! Process
+
1435 mn = min(m, n)
+
1436 nq = m
+
1437 if (.not.fullq) nq = n
+
1438 call form_qr(r(1:m,1:n), tau(1:mn), pvt(1:n), q(1:m,1:nq), p(1:n,1:n), &
+
1439 err = err)
+
1440 if (err%has_error_occurred()) then
+
1441 flag = err%get_error_flag()
+
1442 return
+
1443 end if
+
1444 end function
+
1445
+
1446! ------------------------------------------------------------------------------
+
1474 function la_mult_qr(lside, trans, m, n, k, a, lda, tau, c, ldc) &
+
1475 bind(C, name = "la_mult_qr") result(flag)
+
1476 ! Local Variables
+
1477 logical(c_bool), intent(in), value :: lside, trans
+
1478 integer(c_int), intent(in), value :: m, n, k, lda, ldc
+
1479 real(c_double), intent(inout) :: a(lda,*), c(ldc,*)
+
1480 real(c_double), intent(in) :: tau(*)
+
1481 integer(c_int) :: flag
+
1482
+
1483 ! Local Variables
+
1484 type(errors) :: err
+
1485 integer(c_int) :: ma, na
+
1486
+
1487 ! Initialization
+
1488 if (lside) then
+
1489 ma = m
+
1490 na = m
+
1491 else
+
1492 ma = n
+
1493 na = n
+
1494 end if
+
1495
+
1496 ! Error Checking
+
1497 call err%set_exit_on_error(.false.)
+
1498 flag = la_no_error
+
1499 if (lda < ma .or. ldc < m) then
+
1500 flag = la_invalid_input_error
+
1501 return
+
1502 end if
+
1503 if (k > na .or. k < 0) then
+
1504 flag = la_invalid_input_error
+
1505 return
+
1506 end if
+
1507
+
1508 ! Process
+
1509 call mult_qr(logical(lside), logical(trans), a(1:ma,1:k), tau(1:k), &
+
1510 c(1:m,1:n), err = err)
+
1511 if (err%has_error_occurred()) then
+
1512 flag = err%get_error_flag()
+
1513 return
+
1514 end if
+
1515 end function
+
1516
+
1517! ------------------------------------------------------------------------------
+
1545 function la_mult_qr_cmplx(lside, trans, m, n, k, a, lda, tau, c, ldc) &
+
1546 bind(C, name = "la_mult_qr_cmplx") result(flag)
+
1547 ! Local Variables
+
1548 logical(c_bool), intent(in), value :: lside, trans
+
1549 integer(c_int), intent(in), value :: m, n, k, lda, ldc
+
1550 complex(c_double), intent(inout) :: a(lda,*), c(ldc,*)
+
1551 complex(c_double), intent(in) :: tau(*)
+
1552 integer(c_int) :: flag
+
1553
+
1554 ! Local Variables
+
1555 type(errors) :: err
+
1556 integer(c_int) :: ma, na
+
1557
+
1558 ! Initialization
+
1559 if (lside) then
+
1560 ma = m
+
1561 na = m
+
1562 else
+
1563 ma = n
+
1564 na = n
+
1565 end if
+
1566
+
1567 ! Error Checking
+
1568 call err%set_exit_on_error(.false.)
+
1569 flag = la_no_error
+
1570 if (lda < ma .or. ldc < m) then
+
1571 flag = la_invalid_input_error
+
1572 return
+
1573 end if
+
1574 if (k > na .or. k < 0) then
+
1575 flag = la_invalid_input_error
+
1576 return
+
1577 end if
+
1578
+
1579 ! Process
+
1580 call mult_qr(logical(lside), logical(trans), a(1:ma,1:k), tau(1:k), &
+
1581 c(1:m,1:n), err = err)
+
1582 if (err%has_error_occurred()) then
+
1583 flag = err%get_error_flag()
+
1584 return
+
1585 end if
+
1586 end function
+
1587
+
1588! ------------------------------------------------------------------------------
+
1610 function la_qr_rank1_update(m, n, q, ldq, r, ldr, u, v) &
+
1611 bind(C, name = "la_qr_rank1_update") result(flag)
+
1612 ! Arguments
+
1613 integer(c_int), intent(in), value :: m, n, ldq, ldr
+
1614 real(c_double), intent(inout) :: q(ldq,*), r(ldr,*), u(*), v(*)
+
1615 integer(c_int) :: flag
+
1616
+
1617 ! Local Variables
+
1618 type(errors) :: err
+
1619 integer(c_int) :: mn
+
1620
+
1621 ! Error Checking
+
1622 call err%set_exit_on_error(.false.)
+
1623 flag = la_no_error
+
1624 if (ldq < m .or. ldr < m) then
+
1625 flag = la_invalid_input_error
+
1626 return
+
1627 end if
+
1628
+
1629 ! Process
+
1630 mn = min(m, n)
+
1631 call qr_rank1_update(q(1:m,1:mn), r(1:m,1:n), u(1:m), v(1:n), err = err)
+
1632 if (err%has_error_occurred()) then
+
1633 flag = err%get_error_flag()
+
1634 return
+
1635 end if
+
1636 end function
+
1637
+
1638! ------------------------------------------------------------------------------
+
1660 function la_qr_rank1_update_cmplx(m, n, q, ldq, r, ldr, u, v) &
+
1661 bind(C, name = "la_qr_rank1_update_cmplx") result(flag)
+
1662 ! Arguments
+
1663 integer(c_int), intent(in), value :: m, n, ldq, ldr
+
1664 complex(c_double), intent(inout) :: q(ldq,*), r(ldr,*), u(*), v(*)
+
1665 integer(c_int) :: flag
+
1666
+
1667 ! Local Variables
+
1668 type(errors) :: err
+
1669 integer(c_int) :: mn
+
1670
+
1671 ! Error Checking
+
1672 call err%set_exit_on_error(.false.)
+
1673 flag = la_no_error
+
1674 if (ldq < m .or. ldr < m) then
+
1675 flag = la_invalid_input_error
+
1676 return
+
1677 end if
+
1678
+
1679 ! Process
+
1680 mn = min(m, n)
+
1681 call qr_rank1_update(q(1:m,1:mn), r(1:m,1:n), u(1:m), v(1:n), err = err)
+
1682 if (err%has_error_occurred()) then
+
1683 flag = err%get_error_flag()
+
1684 return
+
1685 end if
+
1686 end function
+
1687
+
1688! ------------------------------------------------------------------------------
+
1705 function la_cholesky_factor(upper, n, a, lda) &
+
1706 bind(C, name = "la_cholesky_factor") result(flag)
+
1707 ! Arguments
+
1708 logical(c_bool), intent(in), value :: upper
+
1709 integer(c_int), intent(in), value :: n, lda
+
1710 real(c_double), intent(inout) :: a(lda,*)
+
1711 integer(c_int) :: flag
+
1712
+
1713 ! Local Variables
+
1714 type(errors) :: err
+
1715
+
1716 ! Error Checking
+
1717 call err%set_exit_on_error(.false.)
+
1718 flag = la_no_error
+
1719 if (lda < n) then
+
1720 flag = la_invalid_input_error
+
1721 return
+
1722 end if
+
1723
+
1724 ! Process
+
1725 call cholesky_factor(a(1:n,1:n), logical(upper), err = err)
+
1726 if (err%has_error_occurred()) then
+
1727 flag = err%get_error_flag()
+
1728 return
+
1729 end if
+
1730 end function
+
1731
+
1732! ------------------------------------------------------------------------------
+
1749 function la_cholesky_factor_cmplx(upper, n, a, lda) &
+
1750 bind(C, name = "la_cholesky_factor_cmplx") result(flag)
+
1751 ! Arguments
+
1752 logical(c_bool), intent(in), value :: upper
+
1753 integer(c_int), intent(in), value :: n, lda
+
1754 complex(c_double), intent(inout) :: a(lda,*)
+
1755 integer(c_int) :: flag
+
1756
+
1757 ! Local Variables
+
1758 type(errors) :: err
+
1759
+
1760 ! Error Checking
+
1761 call err%set_exit_on_error(.false.)
+
1762 flag = la_no_error
+
1763 if (lda < n) then
+
1764 flag = la_invalid_input_error
+
1765 return
+
1766 end if
+
1767
+
1768 ! Process
+
1769 call cholesky_factor(a(1:n,1:n), logical(upper), err = err)
+
1770 if (err%has_error_occurred()) then
+
1771 flag = err%get_error_flag()
+
1772 return
+
1773 end if
+
1774 end function
+
1775
+
1776! ------------------------------------------------------------------------------
+
1792 function la_cholesky_rank1_update(n, r, ldr, u) &
+
1793 bind(C, name = "la_cholesky_rank1_update") result(flag)
+
1794 ! Arguments
+
1795 integer(c_int), intent(in), value :: n, ldr
+
1796 real(c_double), intent(inout) :: r(ldr,*), u(*)
+
1797 integer(c_int) :: flag
+
1798
+
1799 ! Local Variables
+
1800 type(errors) :: err
+
1801
+
1802 ! Error Checking
+
1803 call err%set_exit_on_error(.false.)
+
1804 flag = la_no_error
+
1805 if (ldr < n) then
+
1806 flag = la_invalid_input_error
+
1807 return
+
1808 end if
+
1809
+
1810 ! Process
+
1811 call cholesky_rank1_update(r(1:n,1:n), u(1:n), err = err)
+
1812 if (err%has_error_occurred()) then
+
1813 flag = err%get_error_flag()
+
1814 return
+
1815 end if
+
1816 end function
+
1817
+
1818! ------------------------------------------------------------------------------
+
1834 function la_cholesky_rank1_update_cmplx(n, r, ldr, u) &
+
1835 bind(C, name = "la_cholesky_rank1_update_cmplx") result(flag)
+
1836 ! Arguments
+
1837 integer(c_int), intent(in), value :: n, ldr
+
1838 complex(c_double), intent(inout) :: r(ldr,*), u(*)
+
1839 integer(c_int) :: flag
+
1840
+
1841 ! Local Variables
+
1842 type(errors) :: err
+
1843
+
1844 ! Error Checking
+
1845 call err%set_exit_on_error(.false.)
+
1846 flag = la_no_error
+
1847 if (ldr < n) then
+
1848 flag = la_invalid_input_error
+
1849 return
+
1850 end if
+
1851
+
1852 ! Process
+
1853 call cholesky_rank1_update(r(1:n,1:n), u(1:n), err = err)
+
1854 if (err%has_error_occurred()) then
+
1855 flag = err%get_error_flag()
+
1856 return
+
1857 end if
+
1858 end function
+
1859
+
1860! ------------------------------------------------------------------------------
+
1878 function la_cholesky_rank1_downdate(n, r, ldr, u) &
+
1879 bind(C, name = "la_cholesky_rank1_downdate") result(flag)
+
1880 ! Arguments
+
1881 integer(c_int), intent(in), value :: n, ldr
+
1882 real(c_double), intent(inout) :: r(ldr,*), u(*)
+
1883 integer(c_int) :: flag
+
1884
+
1885 ! Local Variables
+
1886 type(errors) :: err
+
1887
+
1888 ! Error Checking
+
1889 call err%set_exit_on_error(.false.)
+
1890 flag = la_no_error
+
1891 if (ldr < n) then
+
1892 flag = la_invalid_input_error
+
1893 return
+
1894 end if
+
1895
+
1896 ! Process
+
1897 call cholesky_rank1_downdate(r(1:n,1:n), u(1:n), err = err)
+
1898 if (err%has_error_occurred()) then
+
1899 flag = err%get_error_flag()
+
1900 return
+
1901 end if
+
1902 end function
+
1903
+
1904! ------------------------------------------------------------------------------
+
1922 function la_cholesky_rank1_downdate_cmplx(n, r, ldr, u) &
+
1923 bind(C, name = "la_cholesky_rank1_downdate_cmplx") result(flag)
+
1924 ! Arguments
+
1925 integer(c_int), intent(in), value :: n, ldr
+
1926 complex(c_double), intent(inout) :: r(ldr,*), u(*)
+
1927 integer(c_int) :: flag
+
1928
+
1929 ! Local Variables
+
1930 type(errors) :: err
+
1931
+
1932 ! Error Checking
+
1933 call err%set_exit_on_error(.false.)
+
1934 flag = la_no_error
+
1935 if (ldr < n) then
+
1936 flag = la_invalid_input_error
+
1937 return
+
1938 end if
+
1939
+
1940 ! Process
+
1941 call cholesky_rank1_downdate(r(1:n,1:n), u(1:n), err = err)
+
1942 if (err%has_error_occurred()) then
+
1943 flag = err%get_error_flag()
+
1944 return
+
1945 end if
+
1946 end function
+
1947
+
1948! ------------------------------------------------------------------------------
+
1976 function la_svd(m, n, a, lda, s, u, ldu, vt, ldv) &
+
1977 bind(C, name = "la_svd") result(flag)
+
1978 ! Arguments
+
1979 integer(c_int), intent(in), value :: m, n, lda, ldu, ldv
+
1980 real(c_double), intent(inout) :: a(lda,*)
+
1981 real(c_double), intent(out) :: s(*), u(ldu,*), vt(ldv,*)
+
1982 integer(c_int) :: flag
+
1983
+
1984 ! Local Variables
+
1985 type(errors) :: err
+
1986 integer(c_int) :: mn
+
1987
+
1988 ! Error Checking
+
1989 call err%set_exit_on_error(.false.)
+
1990 flag = la_no_error
+
1991 if (lda < m .or. ldu < m .or. ldv < n) then
+
1992 flag = la_invalid_input_error
+
1993 return
+
1994 end if
+
1995
+
1996 ! Process
+
1997 mn = min(m, n)
+
1998 call svd(a(1:m,1:n), s(1:mn), u(1:m,1:m), vt(1:n,1:n), err = err)
+
1999 if (err%has_error_occurred()) then
+
2000 flag = err%get_error_flag()
+
2001 return
+
2002 end if
+
2003 end function
+
2004
+
2005! ------------------------------------------------------------------------------
+
2033 function la_svd_cmplx(m, n, a, lda, s, u, ldu, vt, ldv) &
+
2034 bind(C, name = "la_svd_cmplx") result(flag)
+
2035 ! Arguments
+
2036 integer(c_int), intent(in), value :: m, n, lda, ldu, ldv
+
2037 complex(c_double), intent(inout) :: a(lda,*)
+
2038 real(c_double), intent(out) :: s(*)
+
2039 complex(c_double), intent(out) :: u(ldu,*), vt(ldv,*)
+
2040 integer(c_int) :: flag
+
2041
+
2042 ! Local Variables
+
2043 type(errors) :: err
+
2044 integer(c_int) :: mn
+
2045
+
2046 ! Error Checking
+
2047 call err%set_exit_on_error(.false.)
+
2048 flag = la_no_error
+
2049 if (lda < m .or. ldu < m .or. ldv < n) then
+
2050 flag = la_invalid_input_error
+
2051 return
+
2052 end if
+
2053
+
2054 ! Process
+
2055 mn = min(m, n)
+
2056 call svd(a(1:m,1:n), s(1:mn), u(1:m,1:m), vt(1:n,1:n), err = err)
+
2057 if (err%has_error_occurred()) then
+
2058 flag = err%get_error_flag()
+
2059 return
+
2060 end if
+
2061 end function
+
2062
+
2063! ------------------------------------------------------------------------------
+
2090 function la_solve_tri_mtx(lside, upper, trans, nounit, m, n, alpha, a, &
+
2091 lda, b, ldb) bind(C, name = "la_solve_tri_mtx") result(flag)
+
2092 ! Arguments
+
2093 logical(c_bool), intent(in), value :: lside, upper, trans, nounit
+
2094 integer(c_int), intent(in), value :: m, n, lda, ldb
+
2095 real(c_double), intent(in), value :: alpha
+
2096 real(c_double), intent(in) :: a(lda,*)
+
2097 real(c_double), intent(inout) :: b(ldb,*)
+
2098 integer(c_int) :: flag
+
2099
+
2100 ! Local Variables
+
2101 type(errors) :: err
+
2102 integer(c_int) :: ma
+
2103
+
2104 ! Initialization
+
2105 if (lside) then
+
2106 ma = m
+
2107 else
+
2108 ma = n
+
2109 end if
+
2110
+
2111 ! Error Checking
+
2112 call err%set_exit_on_error(.false.)
+
2113 flag = la_no_error
+
2114 if (lda < ma .or. ldb < m) then
+
2115 flag = la_invalid_input_error
+
2116 return
+
2117 end if
+
2118
+
2119 ! Process
+
2120 call solve_triangular_system(logical(lside), logical(upper), &
+
2121 logical(trans), logical(nounit), alpha, a(1:ma,1:ma), b(1:m,1:n))
+
2122 end function
+
2123
+
2124! ------------------------------------------------------------------------------
+
2151 function la_solve_tri_mtx_cmplx(lside, upper, trans, nounit, m, n, &
+
2152 alpha, a, lda, b, ldb) &
+
2153 bind(C, name = "la_solve_tri_mtx_cmplx") result(flag)
+
2154 ! Arguments
+
2155 logical(c_bool), intent(in), value :: lside, upper, trans, nounit
+
2156 integer(c_int), intent(in), value :: m, n, lda, ldb
+
2157 complex(c_double), intent(in), value :: alpha
+
2158 complex(c_double), intent(in) :: a(lda,*)
+
2159 complex(c_double), intent(inout) :: b(ldb,*)
+
2160 integer(c_int) :: flag
+
2161
+
2162 ! Local Variables
+
2163 type(errors) :: err
+
2164 integer(c_int) :: ma
+
2165
+
2166 ! Initialization
+
2167 if (lside) then
+
2168 ma = m
+
2169 else
+
2170 ma = n
+
2171 end if
+
2172
+
2173 ! Error Checking
+
2174 call err%set_exit_on_error(.false.)
+
2175 flag = la_no_error
+
2176 if (lda < ma .or. ldb < m) then
+
2177 flag = la_invalid_input_error
+
2178 return
+
2179 end if
+
2180
+
2181 ! Process
+
2182 call solve_triangular_system(logical(lside), logical(upper), &
+
2183 logical(trans), logical(nounit), alpha, a(1:ma,1:ma), b(1:m,1:n))
+
2184 end function
+
2185
+
2186! ------------------------------------------------------------------------------
+
2201 function la_solve_lu(m, n, a, lda, ipvt, b, ldb) &
+
2202 bind(C, name = "la_solve_lu") result(flag)
+
2203 ! Arguments
+
2204 integer(c_int), intent(in), value :: m, n, lda, ldb
+
2205 real(c_double), intent(in) :: a(lda,*)
+
2206 integer(c_int), intent(in) :: ipvt(*)
+
2207 real(c_double), intent(inout) :: b(ldb,*)
+
2208 integer(c_int) :: flag
+
2209
+
2210 ! Local Variables
+
2211 type(errors) :: err
+
2212
+
2213 ! Error Checking
+
2214 call err%set_exit_on_error(.false.)
+
2215 flag = la_no_error
+
2216 if (lda < m .or. ldb < m) then
+
2217 flag = la_invalid_input_error
+
2218 return
+
2219 end if
+
2220
+
2221 ! Process
+
2222 call solve_lu(a(1:m,1:m), ipvt(1:m), b(1:m,1:n))
+
2223 end function
+
2224
+
2225! ------------------------------------------------------------------------------
+
2240 function la_solve_lu_cmplx(m, n, a, lda, ipvt, b, ldb) &
+
2241 bind(C, name = "la_solve_lu_cmplx") result(flag)
+
2242 ! Arguments
+
2243 integer(c_int), intent(in), value :: m, n, lda, ldb
+
2244 complex(c_double), intent(in) :: a(lda,*)
+
2245 integer(c_int), intent(in) :: ipvt(*)
+
2246 complex(c_double), intent(inout) :: b(ldb,*)
+
2247 integer(c_int) :: flag
+
2248
+
2249 ! Local Variables
+
2250 type(errors) :: err
+
2251
+
2252 ! Error Checking
+
2253 call err%set_exit_on_error(.false.)
+
2254 flag = la_no_error
+
2255 if (lda < m .or. ldb < m) then
+
2256 flag = la_invalid_input_error
+
2257 return
+
2258 end if
+
2259
+
2260 ! Process
+
2261 call solve_lu(a(1:m,1:m), ipvt(1:m), b(1:m,1:n))
+
2262 end function
+
2263
+
2264! ------------------------------------------------------------------------------
+
2286 function la_solve_qr(m, n, k, a, lda, tau, b, ldb) &
+
2287 bind(C, name = "la_solve_qr") result(flag)
+
2288 ! Arguments
+
2289 integer(c_int), intent(in), value :: m, n, k, lda, ldb
+
2290 real(c_double), intent(inout) :: a(lda,*), b(ldb,*)
+
2291 real(c_double), intent(in) :: tau(*)
+
2292 integer(c_int) :: flag
+
2293
+
2294 ! Local Variables
+
2295 type(errors) :: err
+
2296 integer(c_int) :: minmn
+
2297
+
2298 ! Error Checking
+
2299 call err%set_exit_on_error(.false.)
+
2300 flag = la_no_error
+
2301 if (lda < m .or. ldb < m .or. m < n) then
+
2302 flag = la_invalid_input_error
+
2303 return
+
2304 end if
+
2305
+
2306 ! Process
+
2307 minmn = min(m, n)
+
2308 call solve_qr(a(1:m,1:n), tau(1:minmn), b(1:m,1:k), err = err)
+
2309 if (err%has_error_occurred()) then
+
2310 flag = err%get_error_flag()
+
2311 return
+
2312 end if
+
2313 end function
+
2314
+
2315! ------------------------------------------------------------------------------
+
2337 function la_solve_qr_cmplx(m, n, k, a, lda, tau, b, ldb) &
+
2338 bind(C, name = "la_solve_qr_cmplx") result(flag)
+
2339 ! Arguments
+
2340 integer(c_int), intent(in), value :: m, n, k, lda, ldb
+
2341 complex(c_double), intent(inout) :: a(lda,*), b(ldb,*)
+
2342 complex(c_double), intent(in) :: tau(*)
+
2343 integer(c_int) :: flag
+
2344
+
2345 ! Local Variables
+
2346 type(errors) :: err
+
2347 integer(c_int) :: minmn
+
2348
+
2349 ! Error Checking
+
2350 call err%set_exit_on_error(.false.)
+
2351 flag = la_no_error
+
2352 if (lda < m .or. ldb < m .or. m < n) then
+
2353 flag = la_invalid_input_error
+
2354 return
+
2355 end if
+
2356
+
2357 ! Process
+
2358 minmn = min(m, n)
+
2359 call solve_qr(a(1:m,1:n), tau(1:minmn), b(1:m,1:k), err = err)
+
2360 if (err%has_error_occurred()) then
+
2361 flag = err%get_error_flag()
+
2362 return
+
2363 end if
+
2364 end function
+
2365
+
2366! ------------------------------------------------------------------------------
+
2388 function la_solve_qr_pvt(m, n, k, a, lda, tau, jpvt, b, ldb) &
+
2389 bind(C, name = "la_solve_qr_pvt") result(flag)
+
2390 ! Arguments
+
2391 integer(c_int), intent(in), value :: m, n, k, lda, ldb
+
2392 real(c_double), intent(inout) :: a(lda,*), b(ldb,*)
+
2393 real(c_double), intent(in) :: tau(*)
+
2394 integer(c_int), intent(in) :: jpvt(*)
+
2395 integer(c_int) :: flag
+
2396
+
2397 ! Local Variables
+
2398 type(errors) :: err
+
2399 integer(c_int) :: minmn, maxmn
+
2400
+
2401 ! Error Checking
+
2402 minmn = min(m, n)
+
2403 maxmn = max(m, n)
+
2404 call err%set_exit_on_error(.false.)
+
2405 flag = la_no_error
+
2406 if (lda < m .or. ldb < maxmn) then
+
2407 flag = la_invalid_input_error
+
2408 return
+
2409 end if
+
2410
+
2411 ! Process
+
2412 call solve_qr(a(1:m,1:n), tau(1:minmn), jpvt(1:n), b(1:maxmn,1:k), &
+
2413 err = err)
+
2414 if (err%has_error_occurred()) then
+
2415 flag = err%get_error_flag()
+
2416 return
+
2417 end if
+
2418 end function
+
2419
+
2420! ------------------------------------------------------------------------------
+
2442 function la_solve_qr_cmplx_pvt(m, n, k, a, lda, tau, jpvt, b, ldb) &
+
2443 bind(C, name = "la_solve_qr_cmplx_pvt") result(flag)
+
2444 ! Arguments
+
2445 integer(c_int), intent(in), value :: m, n, k, lda, ldb
+
2446 complex(c_double), intent(inout) :: a(lda,*), b(ldb,*)
+
2447 complex(c_double), intent(in) :: tau(*)
+
2448 integer(c_int), intent(in) :: jpvt(*)
+
2449 integer(c_int) :: flag
+
2450
+
2451 ! Local Variables
+
2452 type(errors) :: err
+
2453 integer(c_int) :: minmn, maxmn
+
2454
+
2455 ! Error Checking
+
2456 minmn = min(m, n)
+
2457 maxmn = max(m, n)
+
2458 call err%set_exit_on_error(.false.)
+
2459 flag = la_no_error
+
2460 if (lda < m .or. ldb < maxmn) then
+
2461 flag = la_invalid_input_error
+
2462 return
+
2463 end if
+
2464
+
2465 ! Process
+
2466 call solve_qr(a(1:m,1:n), tau(1:minmn), jpvt(1:n), b(1:maxmn,1:k), &
+
2467 err = err)
+
2468 if (err%has_error_occurred()) then
+
2469 flag = err%get_error_flag()
+
2470 return
+
2471 end if
+
2472 end function
+
2473
+
2474! ------------------------------------------------------------------------------
+
2491 function la_solve_cholesky(upper, m, n, a, lda, b, ldb) &
+
2492 bind(C, name = "la_solve_cholesky") result(flag)
+
2493 ! Arguments
+
2494 logical(c_bool), intent(in), value :: upper
+
2495 integer(c_int), intent(in), value :: m, n, lda, ldb
+
2496 real(c_double), intent(in) :: a(lda,*)
+
2497 real(c_double), intent(inout) :: b(ldb,*)
+
2498 integer(c_int) :: flag
+
2499
+
2500 ! Local Variables
+
2501 type(errors) :: err
+
2502
+
2503 ! Error Checking
+
2504 call err%set_exit_on_error(.false.)
+
2505 flag = la_no_error
+
2506 if (lda < m .or. ldb < m) then
+
2507 flag = la_invalid_input_error
+
2508 return
+
2509 end if
+
2510
+
2511 ! Process
+
2512 call solve_cholesky(logical(upper), a(1:m,1:m), b(1:m,1:n))
+
2513 end function
+
2514
+
2515! ------------------------------------------------------------------------------
+
2532 function la_solve_cholesky_cmplx(upper, m, n, a, lda, b, ldb) &
+
2533 bind(C, name = "la_solve_cholesky_cmplx") result(flag)
+
2534 ! Arguments
+
2535 logical(c_bool), intent(in), value :: upper
+
2536 integer(c_int), intent(in), value :: m, n, lda, ldb
+
2537 complex(c_double), intent(in) :: a(lda,*)
+
2538 complex(c_double), intent(inout) :: b(ldb,*)
+
2539 integer(c_int) :: flag
+
2540
+
2541 ! Local Variables
+
2542 type(errors) :: err
+
2543
+
2544 ! Error Checking
+
2545 call err%set_exit_on_error(.false.)
+
2546 flag = la_no_error
+
2547 if (lda < m .or. ldb < m) then
+
2548 flag = la_invalid_input_error
+
2549 return
+
2550 end if
+
2551
+
2552 ! Process
+
2553 call solve_cholesky(logical(upper), a(1:m,1:m), b(1:m,1:n))
+
2554 end function
+
2555
+
2556! ------------------------------------------------------------------------------
+
2580 function la_solve_least_squares(m, n, k, a, lda, b, ldb) &
+
2581 bind(C, name = "la_solve_least_squares") result(flag)
+
2582 ! Arguments
+
2583 integer(c_int), intent(in), value :: m, n, k, lda, ldb
+
2584 real(c_double), intent(inout) :: a(lda,*), b(ldb,*)
+
2585 integer(c_int) :: flag
+
2586
+
2587 ! Local Variables
+
2588 type(errors) :: err
+
2589 integer(c_int) :: maxmn
+
2590
+
2591 ! Error Checking
+
2592 maxmn = max(m, n)
+
2593 call err%set_exit_on_error(.false.)
+
2594 flag = la_no_error
+
2595 if (lda < m .or. ldb < maxmn) then
+
2596 flag = la_invalid_input_error
+
2597 return
+
2598 end if
+
2599
+
2600 ! Process
+
2601 call solve_least_squares(a(1:m,1:n), b(1:maxmn,1:k), err = err)
+
2602 if (err%has_error_occurred()) then
+
2603 flag = err%get_error_flag()
+
2604 return
+
2605 end if
+
2606 end function
+
2607
+
2608! ------------------------------------------------------------------------------
+
2632 function la_solve_least_squares_cmplx(m, n, k, a, lda, b, ldb) &
+
2633 bind(C, name = "la_solve_least_squares_cmplx") result(flag)
+
2634 ! Arguments
+
2635 integer(c_int), intent(in), value :: m, n, k, lda, ldb
+
2636 complex(c_double), intent(inout) :: a(lda,*), b(ldb,*)
+
2637 integer(c_int) :: flag
+
2638
+
2639 ! Local Variables
+
2640 type(errors) :: err
+
2641 integer(c_int) :: maxmn
+
2642
+
2643 ! Error Checking
+
2644 maxmn = max(m, n)
+
2645 call err%set_exit_on_error(.false.)
+
2646 flag = la_no_error
+
2647 if (lda < m .or. ldb < maxmn) then
+
2648 flag = la_invalid_input_error
+
2649 return
+
2650 end if
+
2651
+
2652 ! Process
+
2653 call solve_least_squares(a(1:m,1:n), b(1:maxmn,1:k), err = err)
+
2654 if (err%has_error_occurred()) then
+
2655 flag = err%get_error_flag()
+
2656 return
+
2657 end if
+
2658 end function
+
2659
+
2660! ------------------------------------------------------------------------------
+
2672 function la_inverse(n, a, lda) bind(C, name = "la_inverse") result(flag)
+
2673 ! Arguments
+
2674 integer(c_int), intent(in), value :: n, lda
+
2675 real(c_double), intent(inout) :: a(lda,*)
+
2676 integer(c_int) :: flag
+
2677
+
2678 ! Local Variables
+
2679 type(errors) :: err
+
2680
+
2681 ! Error Checking
+
2682 call err%set_exit_on_error(.false.)
+
2683 flag = la_no_error
+
2684 if (lda < n) then
+
2685 flag = la_invalid_input_error
+
2686 return
+
2687 end if
+
2688
+
2689 ! Process
+
2690 call mtx_inverse(a(1:n,1:n), err = err)
+
2691 if (err%has_error_occurred()) then
+
2692 flag = err%get_error_flag()
+
2693 return
+
2694 end if
+
2695 end function
+
2696
+
2697! ------------------------------------------------------------------------------
+
2709 function la_inverse_cmplx(n, a, lda) bind(C, name = "la_inverse_cmplx") &
+
2710 result(flag)
+
2711 ! Arguments
+
2712 integer(c_int), intent(in), value :: n, lda
+
2713 complex(c_double), intent(inout) :: a(lda,*)
+
2714 integer(c_int) :: flag
+
2715
+
2716 ! Local Variables
+
2717 type(errors) :: err
+
2718
+
2719 ! Error Checking
+
2720 call err%set_exit_on_error(.false.)
+
2721 flag = la_no_error
+
2722 if (lda < n) then
+
2723 flag = la_invalid_input_error
+
2724 return
+
2725 end if
+
2726
+
2727 ! Process
+
2728 call mtx_inverse(a(1:n,1:n), err = err)
+
2729 if (err%has_error_occurred()) then
+
2730 flag = err%get_error_flag()
+
2731 return
+
2732 end if
+
2733 end function
+
2734
+
2735! ------------------------------------------------------------------------------
+
2751 function la_pinverse(m, n, a, lda, ainv, ldai) &
+
2752 bind(C, name = "la_pinverse") result(flag)
+
2753 ! Arguments
+
2754 integer(c_int), intent(in), value :: m, n, lda, ldai
+
2755 real(c_double), intent(inout) :: a(lda,*)
+
2756 real(c_double), intent(out) :: ainv(ldai,*)
+
2757 integer(c_int) :: flag
+
2758
+
2759 ! Local Variables
+
2760 type(errors) :: err
+
2761
+
2762 ! Error Checking
+
2763 call err%set_exit_on_error(.false.)
+
2764 flag = la_no_error
+
2765 if (lda < m .or. ldai < n) then
+
2766 flag = la_invalid_input_error
+
2767 return
+
2768 end if
+
2769
+
2770 ! Process
+
2771 call mtx_pinverse(a(1:m,1:n), ainv(1:n,1:m), err = err)
+
2772 if (err%has_error_occurred()) then
+
2773 flag = err%get_error_flag()
+
2774 return
+
2775 end if
+
2776 end function
+
2777
+
2778! ------------------------------------------------------------------------------
+
2794 function la_pinverse_cmplx(m, n, a, lda, ainv, ldai) &
+
2795 bind(C, name = "la_pinverse_cmplx") result(flag)
+
2796 ! Arguments
+
2797 integer(c_int), intent(in), value :: m, n, lda, ldai
+
2798 complex(c_double), intent(inout) :: a(lda,*)
+
2799 complex(c_double), intent(out) :: ainv(ldai,*)
+
2800 integer(c_int) :: flag
+
2801
+
2802 ! Local Variables
+
2803 type(errors) :: err
+
2804
+
2805 ! Error Checking
+
2806 call err%set_exit_on_error(.false.)
+
2807 flag = la_no_error
+
2808 if (lda < m .or. ldai < n) then
+
2809 flag = la_invalid_input_error
+
2810 return
+
2811 end if
+
2812
+
2813 ! Process
+
2814 call mtx_pinverse(a(1:m,1:n), ainv(1:n,1:m), err = err)
+
2815 if (err%has_error_occurred()) then
+
2816 flag = err%get_error_flag()
+
2817 return
+
2818 end if
+
2819 end function
+
2820
+
2821! ------------------------------------------------------------------------------
+
2843 function la_eigen_symm(vecs, n, a, lda, vals) &
+
2844 bind(C, name = "la_eigen_symm") result(flag)
+
2845 ! Arguments
+
2846 logical(c_bool), intent(in), value :: vecs
+
2847 integer(c_int), intent(in), value :: n, lda
+
2848 real(c_double), intent(inout) :: a(lda,*)
+
2849 real(c_double), intent(out) :: vals(*)
+
2850 integer(c_int) :: flag
+
2851
+
2852 ! Local Variables
+
2853 type(errors) :: err
+
2854
+
2855 ! Error Checking
+
2856 call err%set_exit_on_error(.false.)
+
2857 flag = la_no_error
+
2858 if (lda < n) then
+
2859 flag = la_invalid_input_error
+
2860 return
+
2861 end if
+
2862
+
2863 ! Process
+
2864 call eigen(logical(vecs), a(1:n,1:n), vals(1:n), err = err)
+
2865 if (err%has_error_occurred()) then
+
2866 flag = err%get_error_flag()
+
2867 return
+
2868 end if
+
2869 end function
+
2870
+
2871! ------------------------------------------------------------------------------
+
2892 function la_eigen_asymm(vecs, n, a, lda, vals, v, ldv) &
+
2893 bind(C, name = "la_eigen_asymm") result(flag)
+
2894 ! Arguments
+
2895 logical(c_bool), intent(in), value :: vecs
+
2896 integer(c_int), intent(in), value :: n, lda, ldv
+
2897 real(c_double), intent(inout) :: a(lda,*)
+
2898 complex(c_double), intent(out) :: vals(*), v(ldv,*)
+
2899 integer(c_int) :: flag
+
2900
+
2901 ! Local Variables
+
2902 type(errors) :: err
+
2903
+
2904 ! Error Checking
+
2905 call err%set_exit_on_error(.false.)
+
2906 flag = la_no_error
+
2907 if (vecs) then
+
2908 if (lda < n .or. ldv < n) then
+
2909 flag = la_invalid_input_error
+
2910 return
+
2911 end if
+
2912 else
+
2913 if (lda < n) then
+
2914 flag = la_invalid_input_error
+
2915 return
+
2916 end if
+
2917 end if
+
2918
+
2919 ! Process
+
2920 if (vecs) then
+
2921 call eigen(a(1:n,1:n), vals(1:n), v(1:n,1:n), err = err)
+
2922 else
+
2923 call eigen(a(1:n,1:n), vals(1:n))
+
2924 end if
+
2925 if (err%has_error_occurred()) then
+
2926 flag = err%get_error_flag()
+
2927 return
+
2928 end if
+
2929 end function
+
2930
+
2931! ------------------------------------------------------------------------------
+
2965 function la_eigen_gen(vecs, n, a, lda, b, ldb, alpha, beta, v, ldv) &
+
2966 bind(C, name = "la_eigen_gen") result(flag)
+
2967 ! Arguments
+
2968 logical(c_bool), intent(in), value :: vecs
+
2969 integer(c_int), intent(in), value :: n, lda, ldb, ldv
+
2970 real(c_double), intent(inout) :: a(lda,*), b(ldb,*)
+
2971 real(c_double), intent(out) :: beta(*)
+
2972 complex(c_double), intent(out) :: alpha(*), v(ldv,*)
+
2973 integer(c_int) :: flag
+
2974
+
2975 ! Local Variables
+
2976 type(errors) :: err
+
2977
+
2978 ! Error Checking
+
2979 call err%set_exit_on_error(.false.)
+
2980 flag = la_no_error
+
2981 if (vecs) then
+
2982 if (lda < n .or. ldb < n .or. ldv < n) then
+
2983 flag = la_invalid_input_error
+
2984 return
+
2985 end if
+
2986 else
+
2987 if (lda < n .or. ldb < n) then
+
2988 flag = la_invalid_input_error
+
2989 return
+
2990 end if
+
2991 end if
+
2992
+
2993 ! Process
+
2994 if (vecs) then
+
2995 call eigen(a(1:n,1:n), b(1:n,1:n), alpha(1:n), beta(1:n), &
+
2996 v(1:n,1:n), err = err)
+
2997 else
+
2998 call eigen(a(1:n,1:n), b(1:n,1:n), alpha(1:n), beta(1:n), err = err)
+
2999 end if
+
3000 if (err%has_error_occurred()) then
+
3001 flag = err%get_error_flag()
+
3002 return
+
3003 end if
+
3004 end function
+
3005
+
3006! ------------------------------------------------------------------------------
+
3027 function la_eigen_cmplx(vecs, n, a, lda, vals, v, ldv) &
+
3028 bind(C, name = "la_eigen_cmplx") result(flag)
+
3029 ! Arguments
+
3030 logical(c_bool), intent(in), value :: vecs
+
3031 integer(c_int), intent(in), value :: n, lda, ldv
+
3032 complex(c_double), intent(inout) :: a(lda,*)
+
3033 complex(c_double), intent(out) :: vals(*), v(ldv,*)
+
3034 integer(c_int) :: flag
+
3035
+
3036 ! Local Variables
+
3037 type(errors) :: err
+
3038
+
3039 ! Error Checking
+
3040 call err%set_exit_on_error(.false.)
+
3041 flag = la_no_error
+
3042 if (vecs) then
+
3043 if (lda < n .or. ldv < n) then
+
3044 flag = la_invalid_input_error
+
3045 return
+
3046 end if
+
3047 else
+
3048 if (lda < n) then
+
3049 flag = la_invalid_input_error
+
3050 return
+
3051 end if
+
3052 end if
+
3053
+
3054 ! Process
+
3055 if (vecs) then
+
3056 call eigen(a(1:n,1:n), vals(1:n), v(1:n,1:n), err = err)
+
3057 else
+
3058 call eigen(a(1:n,1:n), vals(1:n))
+
3059 end if
+
3060 if (err%has_error_occurred()) then
+
3061 flag = err%get_error_flag()
+
3062 return
+
3063 end if
+
3064 end function
+
3065
+
3066! ------------------------------------------------------------------------------
+
3084 function la_sort_eigen(ascend, n, vals, vecs, ldv) &
+
3085 bind(C, name = "la_sort_eigen") result(flag)
+
3086 ! Arguments
+
3087 logical(c_bool), intent(in), value :: ascend
+
3088 integer(c_int), intent(in), value :: n, ldv
+
3089 real(c_double), intent(inout) :: vals(*), vecs(ldv,*)
+
3090 integer(c_int) :: flag
+
3091
+
3092 ! Local Variables
+
3093 type(errors) :: err
+
3094
+
3095 ! Error Checking
+
3096 call err%set_exit_on_error(.false.)
+
3097 flag = la_no_error
+
3098 if (ldv < n) then
+
3099 flag = la_invalid_input_error
+
3100 return
+
3101 end if
+
3102
+
3103 ! Process
+
3104 call sort(vals(1:n), vecs(1:n,1:n), logical(ascend), err = err)
+
3105 if (err%has_error_occurred()) then
+
3106 flag = err%get_error_flag()
+
3107 return
+
3108 end if
+
3109 end function
+
3110
+
3111! ------------------------------------------------------------------------------
+
3129 function la_sort_eigen_cmplx(ascend, n, vals, vecs, ldv) &
+
3130 bind(C, name = "la_sort_eigen_cmplx") result(flag)
+
3131 ! Arguments
+
3132 logical(c_bool), intent(in), value :: ascend
+
3133 integer(c_int), intent(in), value :: n, ldv
+
3134 complex(c_double), intent(inout) :: vals(*), vecs(ldv,*)
+
3135 integer(c_int) :: flag
+
3136
+
3137 ! Local Variables
+
3138 type(errors) :: err
+
3139
+
3140 ! Error Checking
+
3141 call err%set_exit_on_error(.false.)
+
3142 flag = la_no_error
+
3143 if (ldv < n) then
+
3144 flag = la_invalid_input_error
+
3145 return
+
3146 end if
+
3147
+
3148 ! Process
+
3149 call sort(vals(1:n), vecs(1:n,1:n), logical(ascend), err = err)
+
3150 if (err%has_error_occurred()) then
+
3151 flag = err%get_error_flag()
+
3152 return
+
3153 end if
+
3154 end function
+
3155
+
3156! ------------------------------------------------------------------------------
+
3157
+
3158! ------------------------------------------------------------------------------
+
3159
+
3160! ------------------------------------------------------------------------------
+
3161end module
+
Computes the Cholesky factorization of a symmetric, positive definite matrix.
+
Computes the rank 1 downdate to a Cholesky factored matrix (upper triangular).
+
Computes the rank 1 update to a Cholesky factored matrix (upper triangular).
+
Computes the determinant of a square matrix.
+
Multiplies a diagonal matrix with another matrix or array.
+
Computes the eigenvalues, and optionally the eigenvectors, of a matrix.
+
Extracts the L and U matrices from the condensed [L\U] storage format used by the lu_factor.
+
Forms the full M-by-M orthogonal matrix Q from the elementary reflectors returned by the base QR fact...
+
Computes the LU factorization of an M-by-N matrix.
+
Computes the inverse of a square matrix.
+
Computes the Moore-Penrose pseudo-inverse of a M-by-N matrix using the singular value decomposition o...
+
Computes the rank of a matrix.
+
Multiplies a general matrix by the orthogonal matrix Q from a QR factorization.
+
Computes the QR factorization of an M-by-N matrix.
+
Computes the rank 1 update to an M-by-N QR factored matrix A (M >= N) where A = Q * R,...
+
Performs the rank-1 update to matrix A such that: , where is an M-by-N matrix, is a scalar,...
+
Solves a system of Cholesky factored equations.
+
Solves the overdetermined or underdetermined system (A*X = B) of M equations of N unknowns.
+
Solves a system of LU-factored equations.
+
Solves a system of M QR-factored equations of N unknowns.
+
Solves a triangular system of equations.
+
Sorts an array.
+
Computes the singular value decomposition of a matrix A. The SVD is defined as: A = U * S * V**T,...
+
Computes the trace of a matrix (the sum of the main diagonal elements).
+
Computes the triangular matrix operation: B = alpha * A**T * A + beta * B, or B = alpha * A * A**T + ...
+
Provides a C-friendly API to the LINALG library. Notice, all C-API LINALG routines begin with the pre...
Definition: linalg_c_api.f90:5
+
Provides a set of constants and error flags for the library.
+
Provides a set of common linear algebra routines.
Definition: linalg_core.f90:15
-
Provides a set of common linear algebra routines.
Definition: linalg_core.f90:15
-
Computes the triangular matrix operation: B = alpha * A**T * A + beta * B, or B = alpha * A * A**T + ...
-
Computes the singular value decomposition of a matrix A. The SVD is defined as: A = U * S * V**T,...
-
Multiplies a diagonal matrix with another matrix or array.
-
Computes the Cholesky factorization of a symmetric, positive definite matrix.
-
Computes the Moore-Penrose pseudo-inverse of a M-by-N matrix using the singular value decomposition o...
-
Solves the overdetermined or underdetermined system (A*X = B) of M equations of N unknowns.
-
Provides a set of constants and error flags for the library.
-
Computes the determinant of a square matrix.
-
Solves a system of Cholesky factored equations.
-
Sorts an array.
-
Computes the rank 1 downdate to a Cholesky factored matrix (upper triangular).
-
Solves a system of M QR-factored equations of N unknowns.
-
Computes the eigenvalues, and optionally the eigenvectors, of a matrix.
-
Computes the LU factorization of an M-by-N matrix.
-
Solves a system of LU-factored equations.
-
Provides a C-friendly API to the LINALG library. Notice, all C-API LINALG routines begin with the pre...
Definition: linalg_c_api.f90:5
-
Performs the rank-1 update to matrix A such that: A = alpha * X * Y**T + A, where A is an M-by-N matr...
Definition: linalg_core.f90:72
-
Forms the full M-by-M orthogonal matrix Q from the elementary reflectors returned by the base QR fact...
-
Computes the rank 1 update to a Cholesky factored matrix (upper triangular).
-
Computes the rank 1 update to an M-by-N QR factored matrix A (M >= N) where A = Q * R,...
-
Extracts the L and U matrices from the condensed [L\U] storage format used by the lu_factor.
-
Computes the rank of a matrix.
-
Solves a triangular system of equations.
-
Computes the trace of a matrix (the sum of the main diagonal elements).
-
Computes the inverse of a square matrix.
-
Computes the QR factorization of an M-by-N matrix.
-
Multiplies a general matrix by the orthogonal matrix Q from a QR factorization.
diff --git a/doc/html/linalg__constants_8f90_source.html b/doc/html/linalg__constants_8f90_source.html index f5071bda..1a405ab0 100644 --- a/doc/html/linalg__constants_8f90_source.html +++ b/doc/html/linalg__constants_8f90_source.html @@ -1,11 +1,11 @@ - + - - + + -linalg: C:/Users/jchri/Documents/github/linalg/src/linalg_constants.f90 Source File +linalg: D:/Code/linalg/src/linalg_constants.f90 Source File @@ -13,13 +13,16 @@ - + + @@ -27,10 +30,9 @@
- - + @@ -39,21 +41,22 @@
-
linalg -  1.6.0 +
+
linalg 1.6.1
A linear algebra library that provides a user-friendly interface to several BLAS and LAPACK routines.
- + +/* @license-end */ +
@@ -67,8 +70,8 @@
@@ -81,51 +84,55 @@
- +
+
+
+
+
Loading...
+
Searching...
+
No Matches
+
+
+
-
-
linalg_constants.f90
+
linalg_constants.f90
-
1 ! linalg_constants.f90
-
2 
- -
5  use, intrinsic :: iso_fortran_env, only : int32
-
6  implicit none
-
7 
-
8 ! ******************************************************************************
-
9 ! CONSTANTS
-
10 ! ------------------------------------------------------------------------------
-
12  integer(int32), parameter :: no_operation = 0
-
14  integer(int32), parameter :: transpose = 1
-
16  integer(int32), parameter :: hermitian_transpose = 2
-
17 
-
18 ! ******************************************************************************
-
19 ! ERROR FLAGS
-
20 ! ------------------------------------------------------------------------------
-
22  integer(int32), parameter :: la_no_error = 0
-
24  integer(int32), parameter :: la_invalid_input_error = 101
-
26  integer(int32), parameter :: la_array_size_error = 102
-
28  integer(int32), parameter :: la_singular_matrix_error = 103
-
30  integer(int32), parameter :: la_matrix_format_error = 104
-
32  integer(int32), parameter :: la_out_of_memory_error = 105
-
34  integer(int32), parameter :: la_convergence_error = 106
-
36  integer(int32), parameter :: la_invalid_operation_error = 107
-
37 end module
+
1! linalg_constants.f90
+
2
+ +
5 use, intrinsic :: iso_fortran_env, only : int32
+
6 implicit none
+
7
+
8! ******************************************************************************
+
9! CONSTANTS
+
10! ------------------------------------------------------------------------------
+
12 integer(int32), parameter :: no_operation = 0
+
14 integer(int32), parameter :: transpose = 1
+
16 integer(int32), parameter :: hermitian_transpose = 2
+
17
+
18! ******************************************************************************
+
19! ERROR FLAGS
+
20! ------------------------------------------------------------------------------
+
22 integer(int32), parameter :: la_no_error = 0
+
24 integer(int32), parameter :: la_invalid_input_error = 101
+
26 integer(int32), parameter :: la_array_size_error = 102
+
28 integer(int32), parameter :: la_singular_matrix_error = 103
+
30 integer(int32), parameter :: la_matrix_format_error = 104
+
32 integer(int32), parameter :: la_out_of_memory_error = 105
+
34 integer(int32), parameter :: la_convergence_error = 106
+
36 integer(int32), parameter :: la_invalid_operation_error = 107
+
37end module
+
Provides a set of constants and error flags for the library.
-
Provides a set of constants and error flags for the library.
diff --git a/doc/html/linalg__core_8f90_source.html b/doc/html/linalg__core_8f90_source.html index 69c5f4f2..7c438db1 100644 --- a/doc/html/linalg__core_8f90_source.html +++ b/doc/html/linalg__core_8f90_source.html @@ -1,11 +1,11 @@ - + - - + + -linalg: C:/Users/jchri/Documents/github/linalg/src/linalg_core.f90 Source File +linalg: D:/Code/linalg/src/linalg_core.f90 Source File @@ -13,13 +13,16 @@ - + + @@ -27,10 +30,9 @@
- - + @@ -39,21 +41,22 @@
-
linalg -  1.6.0 +
+
linalg 1.6.1
A linear algebra library that provides a user-friendly interface to several BLAS and LAPACK routines.
- + +/* @license-end */ +
@@ -67,8 +70,8 @@
@@ -81,1209 +84,1233 @@
- +
+
+
+
+
Loading...
+
Searching...
+
No Matches
+
+
+
-
-
linalg_core.f90
+
linalg_core.f90
-
1 ! linalg_core.f90
-
2 
-
3 
-
12 
-
13 
- -
16  use, intrinsic :: iso_fortran_env, only : int32, real64
-
17  use ferror, only : errors
- -
19  implicit none
-
20 
-
21  private
-
22  public :: mtx_mult
-
23  public :: rank1_update
-
24  public :: diag_mtx_mult
-
25  public :: trace
-
26  public :: mtx_rank
-
27  public :: det
-
28  public :: swap
-
29  public :: recip_mult_array
-
30  public :: tri_mtx_mult
-
31  public :: lu_factor
-
32  public :: form_lu
-
33  public :: qr_factor
-
34  public :: form_qr
-
35  public :: mult_qr
-
36  public :: qr_rank1_update
-
37  public :: cholesky_factor
-
38  public :: cholesky_rank1_update
-
39  public :: cholesky_rank1_downdate
-
40  public :: rz_factor
-
41  public :: mult_rz
-
42  public :: svd
-
43  public :: solve_triangular_system
-
44  public :: solve_lu
-
45  public :: solve_qr
-
46  public :: solve_cholesky
-
47  public :: mtx_inverse
-
48  public :: mtx_pinverse
-
49  public :: solve_least_squares
-
50  public :: solve_least_squares_full
-
51  public :: solve_least_squares_svd
-
52  public :: eigen
-
53  public :: sort
-
54 
-
55 ! ******************************************************************************
-
56 ! INTERFACES
-
57 ! ------------------------------------------------------------------------------
-
60 interface mtx_mult
-
61  module procedure :: mtx_mult_mtx
-
62  module procedure :: mtx_mult_vec
-
63  module procedure :: cmtx_mult_mtx
-
64  module procedure :: cmtx_mult_vec
-
65 end interface
-
66 
-
67 ! ------------------------------------------------------------------------------
-
72 interface rank1_update
-
73  module procedure :: rank1_update_dbl
-
74  module procedure :: rank1_update_cmplx
-
75 end interface
-
76 
-
77 ! ------------------------------------------------------------------------------
-
144 interface diag_mtx_mult
-
145  module procedure :: diag_mtx_mult_mtx
-
146  module procedure :: diag_mtx_mult_mtx2
-
147  module procedure :: diag_mtx_mult_mtx3
-
148  module procedure :: diag_mtx_mult_mtx4
-
149  module procedure :: diag_mtx_mult_mtx_cmplx
-
150  module procedure :: diag_mtx_mult_mtx2_cmplx
-
151 end interface
-
152 
-
153 ! ------------------------------------------------------------------------------
-
156 interface trace
-
157  module procedure :: trace_dbl
-
158  module procedure :: trace_cmplx
-
159 end interface
-
160 
-
161 ! ------------------------------------------------------------------------------
-
163 interface mtx_rank
-
164  module procedure :: mtx_rank_dbl
-
165  module procedure :: mtx_rank_cmplx
-
166 end interface
-
167 
-
168 ! ------------------------------------------------------------------------------
-
170 interface det
-
171  module procedure :: det_dbl
-
172  module procedure :: det_cmplx
-
173 end interface
-
174 
-
175 ! ------------------------------------------------------------------------------
-
177 interface swap
-
178  module procedure :: swap_dbl
-
179  module procedure :: swap_cmplx
-
180 end interface
-
181 
-
182 ! ------------------------------------------------------------------------------
- -
185  module procedure :: recip_mult_array_dbl
-
186 end interface
-
187 
-
188 ! ------------------------------------------------------------------------------
-
192 interface tri_mtx_mult
-
193  module procedure :: tri_mtx_mult_dbl
-
194  module procedure :: tri_mtx_mult_cmplx
-
195 end interface
-
196 
-
197 ! ------------------------------------------------------------------------------
-
250 interface lu_factor
-
251  module procedure :: lu_factor_dbl
-
252  module procedure :: lu_factor_cmplx
-
253 end interface
-
254 
-
319 interface form_lu
-
320  module procedure :: form_lu_all
-
321  module procedure :: form_lu_all_cmplx
-
322  module procedure :: form_lu_only
-
323  module procedure :: form_lu_only_cmplx
-
324 end interface
-
325 
-
326 ! ------------------------------------------------------------------------------
-
389 interface qr_factor
-
390  module procedure :: qr_factor_no_pivot
-
391  module procedure :: qr_factor_no_pivot_cmplx
-
392  module procedure :: qr_factor_pivot
-
393  module procedure :: qr_factor_pivot_cmplx
-
394 end interface
-
395 
-
396 ! ------------------------------------------------------------------------------
-
472 interface form_qr
-
473  module procedure :: form_qr_no_pivot
-
474  module procedure :: form_qr_no_pivot_cmplx
-
475  module procedure :: form_qr_pivot
-
476  module procedure :: form_qr_pivot_cmplx
-
477 end interface
-
478 
-
479 ! ------------------------------------------------------------------------------
-
549 interface mult_qr
-
550  module procedure :: mult_qr_mtx
-
551  module procedure :: mult_qr_mtx_cmplx
-
552  module procedure :: mult_qr_vec
-
553  module procedure :: mult_qr_vec_cmplx
-
554 end interface
-
555 
-
556 ! ------------------------------------------------------------------------------
- -
652  module procedure :: qr_rank1_update_dbl
-
653  module procedure :: qr_rank1_update_cmplx
-
654 end interface
-
655 
-
656 ! ------------------------------------------------------------------------------
- -
727  module procedure :: cholesky_factor_dbl
-
728  module procedure :: cholesky_factor_cmplx
-
729 end interface
-
730 
-
731 ! ------------------------------------------------------------------------------
- -
795  module procedure :: cholesky_rank1_update_dbl
-
796  module procedure :: cholesky_rank1_update_cmplx
-
797 end interface
-
798 
-
799 ! ------------------------------------------------------------------------------
- -
868  module procedure :: cholesky_rank1_downdate_dbl
-
869  module procedure :: cholesky_rank1_downdate_cmplx
-
870 end interface
-
871 
-
872 ! ------------------------------------------------------------------------------
-
877 interface rz_factor
-
878  module procedure :: rz_factor_dbl
-
879  module procedure :: rz_factor_cmplx
-
880 end interface
-
881 
-
882 ! ------------------------------------------------------------------------------
-
885 interface mult_rz
-
886  module procedure :: mult_rz_mtx
-
887  module procedure :: mult_rz_mtx_cmplx
-
888  module procedure :: mult_rz_vec
-
889  module procedure :: mult_rz_vec_cmplx
-
890 end interface
-
891 
-
892 ! ------------------------------------------------------------------------------
-
961 interface svd
-
962  module procedure :: svd_dbl
-
963  module procedure :: svd_cmplx
-
964 end interface
-
965 
-
966 ! ------------------------------------------------------------------------------
- -
1031  module procedure :: solve_tri_mtx
-
1032  module procedure :: solve_tri_mtx_cmplx
-
1033  module procedure :: solve_tri_vec
-
1034  module procedure :: solve_tri_vec_cmplx
-
1035 end interface
-
1036 
-
1037 ! ------------------------------------------------------------------------------
-
1094 interface solve_lu
-
1095  module procedure :: solve_lu_mtx
-
1096  module procedure :: solve_lu_mtx_cmplx
-
1097  module procedure :: solve_lu_vec
-
1098  module procedure :: solve_lu_vec_cmplx
-
1099 end interface
-
1100 
-
1101 ! ------------------------------------------------------------------------------
-
1163 interface solve_qr
-
1164  module procedure :: solve_qr_no_pivot_mtx
-
1165  module procedure :: solve_qr_no_pivot_mtx_cmplx
-
1166  module procedure :: solve_qr_no_pivot_vec
-
1167  module procedure :: solve_qr_no_pivot_vec_cmplx
-
1168  module procedure :: solve_qr_pivot_mtx
-
1169  module procedure :: solve_qr_pivot_mtx_cmplx
-
1170  module procedure :: solve_qr_pivot_vec
-
1171  module procedure :: solve_qr_pivot_vec_cmplx
-
1172 end interface
-
1173 
-
1174 ! ------------------------------------------------------------------------------
- -
1244  module procedure :: solve_cholesky_mtx
-
1245  module procedure :: solve_cholesky_mtx_cmplx
-
1246  module procedure :: solve_cholesky_vec
-
1247  module procedure :: solve_cholesky_vec_cmplx
-
1248 end interface
-
1249 
-
1250 ! ------------------------------------------------------------------------------
- -
1298  module procedure :: solve_least_squares_mtx
-
1299  module procedure :: solve_least_squares_mtx_cmplx
-
1300  module procedure :: solve_least_squares_vec
-
1301  module procedure :: solve_least_squares_vec_cmplx
-
1302 end interface
-
1303 
-
1304 ! ------------------------------------------------------------------------------
- -
1353  module procedure :: solve_least_squares_mtx_pvt
-
1354  module procedure :: solve_least_squares_mtx_pvt_cmplx
-
1355  module procedure :: solve_least_squares_vec_pvt
-
1356  module procedure :: solve_least_squares_vec_pvt_cmplx
-
1357 end interface
-
1358 
-
1359 ! ------------------------------------------------------------------------------
- -
1408  module procedure :: solve_least_squares_mtx_svd
-
1409  module procedure :: solve_least_squares_vec_svd
-
1410 end interface
-
1411 
-
1412 ! ------------------------------------------------------------------------------
-
1466 interface mtx_inverse
-
1467  module procedure :: mtx_inverse_dbl
-
1468  module procedure :: mtx_inverse_cmplx
-
1469 end interface
-
1470 
-
1471 ! ------------------------------------------------------------------------------
-
1527 interface mtx_pinverse
-
1528  module procedure :: mtx_pinverse_dbl
-
1529  module procedure :: mtx_pinverse_cmplx
-
1530 end interface
-
1531 
-
1532 ! ------------------------------------------------------------------------------
-
1621 interface eigen
-
1622  module procedure :: eigen_symm
-
1623  module procedure :: eigen_asymm
-
1624  module procedure :: eigen_gen
-
1625  module procedure :: eigen_cmplx
-
1626 end interface
-
1627 
-
1628 ! ------------------------------------------------------------------------------
-
1630 interface sort
-
1631  module procedure :: sort_dbl_array
-
1632  module procedure :: sort_dbl_array_ind
-
1633  module procedure :: sort_cmplx_array
-
1634  module procedure :: sort_cmplx_array_ind
-
1635  module procedure :: sort_eigen_cmplx
-
1636  module procedure :: sort_eigen_dbl
-
1637 end interface
-
1638 
-
1639 
-
1640 ! ******************************************************************************
-
1641 ! LINALG_BASIC.F90
-
1642 ! ------------------------------------------------------------------------------
-
1643 interface
-
1644 
-
1669  module subroutine mtx_mult_mtx(transa, transb, alpha, a, b, beta, c, err)
-
1670  logical, intent(in) :: transa, transb
-
1671  real(real64), intent(in) :: alpha, beta
-
1672  real(real64), intent(in), dimension(:,:) :: a, b
-
1673  real(real64), intent(inout), dimension(:,:) :: c
-
1674  class(errors), intent(inout), optional, target :: err
-
1675  end subroutine
-
1676 
-
1700  module subroutine mtx_mult_vec(trans, alpha, a, b, beta, c, err)
-
1701  logical, intent(in) :: trans
-
1702  real(real64), intent(in) :: alpha, beta
-
1703  real(real64), intent(in), dimension(:,:) :: a
-
1704  real(real64), intent(in), dimension(:) :: b
-
1705  real(real64), intent(inout), dimension(:) :: c
-
1706  class(errors), intent(inout), optional, target :: err
-
1707  end subroutine
-
1708 
-
1736  module subroutine cmtx_mult_mtx(opa, opb, alpha, a, b, beta, c, err)
-
1737  integer(int32), intent(in) :: opa, opb
-
1738  complex(real64), intent(in) :: alpha, beta
-
1739  complex(real64), intent(in), dimension(:,:) :: a, b
-
1740  complex(real64), intent(inout), dimension(:,:) :: c
-
1741  class(errors), intent(inout), optional, target :: err
-
1742  end subroutine
-
1743 
-
1768  module subroutine cmtx_mult_vec(opa, alpha, a, b, beta, c, err)
-
1769  integer(int32), intent(in) :: opa
-
1770  complex(real64), intent(in) :: alpha, beta
-
1771  complex(real64), intent(in), dimension(:,:) :: a
-
1772  complex(real64), intent(in), dimension(:) :: b
-
1773  complex(real64), intent(inout), dimension(:) :: c
-
1774  class(errors), intent(inout), optional, target :: err
-
1775  end subroutine
-
1776 
-
1796  module subroutine rank1_update_dbl(alpha, x, y, a, err)
-
1797  real(real64), intent(in) :: alpha
-
1798  real(real64), intent(in), dimension(:) :: x, y
-
1799  real(real64), intent(inout), dimension(:,:) :: a
-
1800  class(errors), intent(inout), optional, target :: err
-
1801  end subroutine
-
1802 
-
1822  module subroutine rank1_update_cmplx(alpha, x, y, a, err)
-
1823  complex(real64), intent(in) :: alpha
-
1824  complex(real64), intent(in), dimension(:) :: x, y
-
1825  complex(real64), intent(inout), dimension(:,:) :: a
-
1826  class(errors), intent(inout), optional, target :: err
-
1827  end subroutine
-
1828 
-
1856  module subroutine diag_mtx_mult_mtx(lside, trans, alpha, a, b, beta, c, err)
-
1857  logical, intent(in) :: lside, trans
-
1858  real(real64) :: alpha, beta
-
1859  real(real64), intent(in), dimension(:) :: a
-
1860  real(real64), intent(in), dimension(:,:) :: b
-
1861  real(real64), intent(inout), dimension(:,:) :: c
-
1862  class(errors), intent(inout), optional, target :: err
-
1863  end subroutine
-
1864 
-
1883  module subroutine diag_mtx_mult_mtx2(lside, alpha, a, b, err)
-
1884  logical, intent(in) :: lside
-
1885  real(real64), intent(in) :: alpha
-
1886  real(real64), intent(in), dimension(:) :: a
-
1887  real(real64), intent(inout), dimension(:,:) :: b
-
1888  class(errors), intent(inout), optional, target :: err
-
1889  end subroutine
-
1890 
-
1918  module subroutine diag_mtx_mult_mtx3(lside, trans, alpha, a, b, beta, c, err)
-
1919  logical, intent(in) :: lside, trans
-
1920  real(real64) :: alpha, beta
-
1921  complex(real64), intent(in), dimension(:) :: a
-
1922  real(real64), intent(in), dimension(:,:) :: b
-
1923  complex(real64), intent(inout), dimension(:,:) :: c
-
1924  class(errors), intent(inout), optional, target :: err
-
1925  end subroutine
-
1926 
-
1955  module subroutine diag_mtx_mult_mtx4(lside, opb, alpha, a, b, beta, c, err)
-
1956  logical, intent(in) :: lside
-
1957  integer(int32), intent(in) :: opb
-
1958  real(real64) :: alpha, beta
-
1959  complex(real64), intent(in), dimension(:) :: a
-
1960  complex(real64), intent(in), dimension(:,:) :: b
-
1961  complex(real64), intent(inout), dimension(:,:) :: c
-
1962  class(errors), intent(inout), optional, target :: err
-
1963  end subroutine
-
1964 
-
1993  module subroutine diag_mtx_mult_mtx_cmplx(lside, opb, alpha, a, b, beta, c, err)
-
1994  logical, intent(in) :: lside
-
1995  integer(int32), intent(in) :: opb
-
1996  complex(real64) :: alpha, beta
-
1997  complex(real64), intent(in), dimension(:) :: a
-
1998  complex(real64), intent(in), dimension(:,:) :: b
-
1999  complex(real64), intent(inout), dimension(:,:) :: c
-
2000  class(errors), intent(inout), optional, target :: err
-
2001  end subroutine
-
2002 
-
2021  module subroutine diag_mtx_mult_mtx2_cmplx(lside, alpha, a, b, err)
-
2022  logical, intent(in) :: lside
-
2023  complex(real64), intent(in) :: alpha
-
2024  complex(real64), intent(in), dimension(:) :: a
-
2025  complex(real64), intent(inout), dimension(:,:) :: b
-
2026  class(errors), intent(inout), optional, target :: err
-
2027  end subroutine
-
2028 
-
2035  pure module function trace_dbl(x) result(y)
-
2036  real(real64), intent(in), dimension(:,:) :: x
-
2037  real(real64) :: y
-
2038  end function
-
2039 
-
2046  pure module function trace_cmplx(x) result(y)
-
2047  complex(real64), intent(in), dimension(:,:) :: x
-
2048  complex(real64) :: y
-
2049  end function
-
2050 
-
2083  module function mtx_rank_dbl(a, tol, work, olwork, err) result(rnk)
-
2084  real(real64), intent(inout), dimension(:,:) :: a
-
2085  real(real64), intent(in), optional :: tol
-
2086  real(real64), intent(out), target, optional, dimension(:) :: work
-
2087  integer(int32), intent(out), optional :: olwork
-
2088  class(errors), intent(inout), optional, target :: err
-
2089  integer(int32) :: rnk
-
2090  end function
-
2091 
-
2128  module function mtx_rank_cmplx(a, tol, work, olwork, rwork, err) result(rnk)
-
2129  complex(real64), intent(inout), dimension(:,:) :: a
-
2130  real(real64), intent(in), optional :: tol
-
2131  complex(real64), intent(out), target, optional, dimension(:) :: work
-
2132  integer(int32), intent(out), optional :: olwork
-
2133  real(real64), intent(out), target, optional, dimension(:) :: rwork
-
2134  class(errors), intent(inout), optional, target :: err
-
2135  integer(int32) :: rnk
-
2136  end function
-
2137 
-
2158  module function det_dbl(a, iwork, err) result(x)
-
2159  real(real64), intent(inout), dimension(:,:) :: a
-
2160  integer(int32), intent(out), target, optional, dimension(:) :: iwork
-
2161  class(errors), intent(inout), optional, target :: err
-
2162  real(real64) :: x
-
2163  end function
-
2164 
-
2185  module function det_cmplx(a, iwork, err) result(x)
-
2186  complex(real64), intent(inout), dimension(:,:) :: a
-
2187  integer(int32), intent(out), target, optional, dimension(:) :: iwork
-
2188  class(errors), intent(inout), optional, target :: err
-
2189  complex(real64) :: x
-
2190  end function
-
2191 
-
2202  module subroutine swap_dbl(x, y, err)
-
2203  real(real64), intent(inout), dimension(:) :: x, y
-
2204  class(errors), intent(inout), optional, target :: err
-
2205  end subroutine
-
2206 
-
2217  module subroutine swap_cmplx(x, y, err)
-
2218  complex(real64), intent(inout), dimension(:) :: x, y
-
2219  class(errors), intent(inout), optional, target :: err
-
2220  end subroutine
-
2221 
-
2230  module subroutine recip_mult_array_dbl(a, x)
-
2231  real(real64), intent(in) :: a
-
2232  real(real64), intent(inout), dimension(:) :: x
-
2233  end subroutine
-
2234 
-
2258  module subroutine tri_mtx_mult_dbl(upper, alpha, a, beta, b, err)
-
2259  logical, intent(in) :: upper
-
2260  real(real64), intent(in) :: alpha, beta
-
2261  real(real64), intent(in), dimension(:,:) :: a
-
2262  real(real64), intent(inout), dimension(:,:) :: b
-
2263  class(errors), intent(inout), optional, target :: err
-
2264  end subroutine
-
2265 
-
2289  module subroutine tri_mtx_mult_cmplx(upper, alpha, a, beta, b, err)
-
2290  logical, intent(in) :: upper
-
2291  complex(real64), intent(in) :: alpha, beta
-
2292  complex(real64), intent(in), dimension(:,:) :: a
-
2293  complex(real64), intent(inout), dimension(:,:) :: b
-
2294  class(errors), intent(inout), optional, target :: err
-
2295  end subroutine
-
2296 
-
2297 end interface
-
2298 
-
2299 ! ******************************************************************************
-
2300 ! LINALG_FACTOR.F90
-
2301 ! ------------------------------------------------------------------------------
-
2302 interface
-
2303 
-
2326  module subroutine lu_factor_dbl(a, ipvt, err)
-
2327  real(real64), intent(inout), dimension(:,:) :: a
-
2328  integer(int32), intent(out), dimension(:) :: ipvt
-
2329  class(errors), intent(inout), optional, target :: err
-
2330  end subroutine
-
2331 
-
2355  module subroutine lu_factor_cmplx(a, ipvt, err)
-
2356  complex(real64), intent(inout), dimension(:,:) :: a
-
2357  integer(int32), intent(out), dimension(:) :: ipvt
-
2358  class(errors), intent(inout), optional, target :: err
-
2359  end subroutine
-
2360 
-
2393  module subroutine form_lu_all(lu, ipvt, u, p, err)
-
2394  real(real64), intent(inout), dimension(:,:) :: lu
-
2395  integer(int32), intent(in), dimension(:) :: ipvt
-
2396  real(real64), intent(out), dimension(:,:) :: u, p
-
2397  class(errors), intent(inout), optional, target :: err
-
2398  end subroutine
-
2399 
-
2432  module subroutine form_lu_all_cmplx(lu, ipvt, u, p, err)
-
2433  complex(real64), intent(inout), dimension(:,:) :: lu
-
2434  integer(int32), intent(in), dimension(:) :: ipvt
-
2435  complex(real64), intent(out), dimension(:,:) :: u
-
2436  real(real64), intent(out), dimension(:,:) :: p
-
2437  class(errors), intent(inout), optional, target :: err
-
2438  end subroutine
-
2439 
-
2453  module subroutine form_lu_only(lu, u, err)
-
2454  real(real64), intent(inout), dimension(:,:) :: lu
-
2455  real(real64), intent(out), dimension(:,:) :: u
-
2456  class(errors), intent(inout), optional, target :: err
-
2457  end subroutine
-
2458 
-
2472  module subroutine form_lu_only_cmplx(lu, u, err)
-
2473  complex(real64), intent(inout), dimension(:,:) :: lu
-
2474  complex(real64), intent(out), dimension(:,:) :: u
-
2475  class(errors), intent(inout), optional, target :: err
-
2476  end subroutine
-
2477 
-
2513  module subroutine qr_factor_no_pivot(a, tau, work, olwork, err)
-
2514  real(real64), intent(inout), dimension(:,:) :: a
-
2515  real(real64), intent(out), dimension(:) :: tau
-
2516  real(real64), intent(out), target, dimension(:), optional :: work
-
2517  integer(int32), intent(out), optional :: olwork
-
2518  class(errors), intent(inout), optional, target :: err
-
2519  end subroutine
-
2520 
-
2556  module subroutine qr_factor_no_pivot_cmplx(a, tau, work, olwork, err)
-
2557  complex(real64), intent(inout), dimension(:,:) :: a
-
2558  complex(real64), intent(out), dimension(:) :: tau
-
2559  complex(real64), intent(out), target, dimension(:), optional :: work
-
2560  integer(int32), intent(out), optional :: olwork
-
2561  class(errors), intent(inout), optional, target :: err
-
2562  end subroutine
-
2563 
-
2597  module subroutine qr_factor_pivot(a, tau, jpvt, work, olwork, err)
-
2598  real(real64), intent(inout), dimension(:,:) :: a
-
2599  real(real64), intent(out), dimension(:) :: tau
-
2600  integer(int32), intent(inout), dimension(:) :: jpvt
-
2601  real(real64), intent(out), target, dimension(:), optional :: work
-
2602  integer(int32), intent(out), optional :: olwork
-
2603  class(errors), intent(inout), optional, target :: err
-
2604  end subroutine
-
2605 
-
2643  module subroutine qr_factor_pivot_cmplx(a, tau, jpvt, work, olwork, rwork, &
-
2644  err)
-
2645  complex(real64), intent(inout), dimension(:,:) :: a
-
2646  complex(real64), intent(out), dimension(:) :: tau
-
2647  integer(int32), intent(inout), dimension(:) :: jpvt
-
2648  complex(real64), intent(out), target, dimension(:), optional :: work
-
2649  integer(int32), intent(out), optional :: olwork
-
2650  real(real64), intent(out), target, dimension(:), optional :: rwork
-
2651  class(errors), intent(inout), optional, target :: err
-
2652  end subroutine
-
2653 
-
2687  module subroutine form_qr_no_pivot(r, tau, q, work, olwork, err)
-
2688  real(real64), intent(inout), dimension(:,:) :: r
-
2689  real(real64), intent(in), dimension(:) :: tau
-
2690  real(real64), intent(out), dimension(:,:) :: q
-
2691  real(real64), intent(out), target, dimension(:), optional :: work
-
2692  integer(int32), intent(out), optional :: olwork
-
2693  class(errors), intent(inout), optional, target :: err
-
2694  end subroutine
-
2695 
-
2729  module subroutine form_qr_no_pivot_cmplx(r, tau, q, work, olwork, err)
-
2730  complex(real64), intent(inout), dimension(:,:) :: r
-
2731  complex(real64), intent(in), dimension(:) :: tau
-
2732  complex(real64), intent(out), dimension(:,:) :: q
-
2733  complex(real64), intent(out), target, dimension(:), optional :: work
-
2734  integer(int32), intent(out), optional :: olwork
-
2735  class(errors), intent(inout), optional, target :: err
-
2736  end subroutine
-
2737 
-
2774  module subroutine form_qr_pivot(r, tau, pvt, q, p, work, olwork, err)
-
2775  real(real64), intent(inout), dimension(:,:) :: r
-
2776  real(real64), intent(in), dimension(:) :: tau
-
2777  integer(int32), intent(in), dimension(:) :: pvt
-
2778  real(real64), intent(out), dimension(:,:) :: q, p
-
2779  real(real64), intent(out), target, dimension(:), optional :: work
-
2780  integer(int32), intent(out), optional :: olwork
-
2781  class(errors), intent(inout), optional, target :: err
-
2782  end subroutine
-
2783 
-
2820  module subroutine form_qr_pivot_cmplx(r, tau, pvt, q, p, work, olwork, err)
-
2821  complex(real64), intent(inout), dimension(:,:) :: r
-
2822  complex(real64), intent(in), dimension(:) :: tau
-
2823  integer(int32), intent(in), dimension(:) :: pvt
-
2824  complex(real64), intent(out), dimension(:,:) :: q, p
-
2825  complex(real64), intent(out), target, dimension(:), optional :: work
-
2826  integer(int32), intent(out), optional :: olwork
-
2827  class(errors), intent(inout), optional, target :: err
-
2828  end subroutine
-
2829 
-
2864  module subroutine mult_qr_mtx(lside, trans, a, tau, c, work, olwork, err)
-
2865  logical, intent(in) :: lside, trans
-
2866  real(real64), intent(in), dimension(:) :: tau
-
2867  real(real64), intent(inout), dimension(:,:) :: a, c
-
2868  real(real64), intent(out), target, dimension(:), optional :: work
-
2869  integer(int32), intent(out), optional :: olwork
-
2870  class(errors), intent(inout), optional, target :: err
-
2871  end subroutine
-
2872 
-
2907  module subroutine mult_qr_mtx_cmplx(lside, trans, a, tau, c, work, olwork, err)
-
2908  logical, intent(in) :: lside, trans
-
2909  complex(real64), intent(in), dimension(:) :: tau
-
2910  complex(real64), intent(inout), dimension(:,:) :: a, c
-
2911  complex(real64), intent(out), target, dimension(:), optional :: work
-
2912  integer(int32), intent(out), optional :: olwork
-
2913  class(errors), intent(inout), optional, target :: err
-
2914  end subroutine
-
2915 
-
2946  module subroutine mult_qr_vec(trans, a, tau, c, work, olwork, err)
-
2947  logical, intent(in) :: trans
-
2948  real(real64), intent(inout), dimension(:,:) :: a
-
2949  real(real64), intent(in), dimension(:) :: tau
-
2950  real(real64), intent(inout), dimension(:) :: c
-
2951  real(real64), intent(out), target, dimension(:), optional :: work
-
2952  integer(int32), intent(out), optional :: olwork
-
2953  class(errors), intent(inout), optional, target :: err
-
2954  end subroutine
-
2955 
-
2986  module subroutine mult_qr_vec_cmplx(trans, a, tau, c, work, olwork, err)
-
2987  logical, intent(in) :: trans
-
2988  complex(real64), intent(inout), dimension(:,:) :: a
-
2989  complex(real64), intent(in), dimension(:) :: tau
-
2990  complex(real64), intent(inout), dimension(:) :: c
-
2991  complex(real64), intent(out), target, dimension(:), optional :: work
-
2992  integer(int32), intent(out), optional :: olwork
-
2993  class(errors), intent(inout), optional, target :: err
-
2994  end subroutine
-
2995 
-
3036  module subroutine qr_rank1_update_dbl(q, r, u, v, work, err)
-
3037  real(real64), intent(inout), dimension(:,:) :: q, r
-
3038  real(real64), intent(inout), dimension(:) :: u, v
-
3039  real(real64), intent(out), target, optional, dimension(:) :: work
-
3040  class(errors), intent(inout), optional, target :: err
-
3041  end subroutine
-
3042 
-
3086  module subroutine qr_rank1_update_cmplx(q, r, u, v, work, rwork, err)
-
3087  complex(real64), intent(inout), dimension(:,:) :: q, r
-
3088  complex(real64), intent(inout), dimension(:) :: u, v
-
3089  complex(real64), intent(out), target, optional, dimension(:) :: work
-
3090  real(real64), intent(out), target, optional, dimension(:) :: rwork
-
3091  class(errors), intent(inout), optional, target :: err
-
3092  end subroutine
-
3093 
-
3114  module subroutine cholesky_factor_dbl(a, upper, err)
-
3115  real(real64), intent(inout), dimension(:,:) :: a
-
3116  logical, intent(in), optional :: upper
-
3117  class(errors), intent(inout), optional, target :: err
-
3118  end subroutine
-
3119 
-
3140  module subroutine cholesky_factor_cmplx(a, upper, err)
-
3141  complex(real64), intent(inout), dimension(:,:) :: a
-
3142  logical, intent(in), optional :: upper
-
3143  class(errors), intent(inout), optional, target :: err
-
3144  end subroutine
-
3145 
-
3172  module subroutine cholesky_rank1_update_dbl(r, u, work, err)
-
3173  real(real64), intent(inout), dimension(:,:) :: r
-
3174  real(real64), intent(inout), dimension(:) :: u
-
3175  real(real64), intent(out), target, optional, dimension(:) :: work
-
3176  class(errors), intent(inout), optional, target :: err
-
3177  end subroutine
-
3178 
-
3205  module subroutine cholesky_rank1_update_cmplx(r, u, work, err)
-
3206  complex(real64), intent(inout), dimension(:,:) :: r
-
3207  complex(real64), intent(inout), dimension(:) :: u
-
3208  real(real64), intent(out), target, optional, dimension(:) :: work
-
3209  class(errors), intent(inout), optional, target :: err
-
3210  end subroutine
-
3211 
-
3241  module subroutine cholesky_rank1_downdate_dbl(r, u, work, err)
-
3242  real(real64), intent(inout), dimension(:,:) :: r
-
3243  real(real64), intent(inout), dimension(:) :: u
-
3244  real(real64), intent(out), target, optional, dimension(:) :: work
-
3245  class(errors), intent(inout), optional, target :: err
-
3246  end subroutine
-
3247 
-
3277  module subroutine cholesky_rank1_downdate_cmplx(r, u, work, err)
-
3278  complex(real64), intent(inout), dimension(:,:) :: r
-
3279  complex(real64), intent(inout), dimension(:) :: u
-
3280  real(real64), intent(out), target, optional, dimension(:) :: work
-
3281  class(errors), intent(inout), optional, target :: err
-
3282  end subroutine
-
3283 
-
3346  module subroutine rz_factor_dbl(a, tau, work, olwork, err)
-
3347  real(real64), intent(inout), dimension(:,:) :: a
-
3348  real(real64), intent(out), dimension(:) :: tau
-
3349  real(real64), intent(out), target, optional, dimension(:) :: work
-
3350  integer(int32), intent(out), optional :: olwork
-
3351  class(errors), intent(inout), optional, target :: err
-
3352  end subroutine
-
3353 
-
3416  module subroutine rz_factor_cmplx(a, tau, work, olwork, err)
-
3417  complex(real64), intent(inout), dimension(:,:) :: a
-
3418  complex(real64), intent(out), dimension(:) :: tau
-
3419  complex(real64), intent(out), target, optional, dimension(:) :: work
-
3420  integer(int32), intent(out), optional :: olwork
-
3421  class(errors), intent(inout), optional, target :: err
-
3422  end subroutine
-
3423 
-
3461  module subroutine mult_rz_mtx(lside, trans, l, a, tau, c, work, olwork, err)
-
3462  logical, intent(in) :: lside, trans
-
3463  integer(int32), intent(in) :: l
-
3464  real(real64), intent(inout), dimension(:,:) :: a, c
-
3465  real(real64), intent(in), dimension(:) :: tau
-
3466  real(real64), intent(out), target, optional, dimension(:) :: work
-
3467  integer(int32), intent(out), optional :: olwork
-
3468  class(errors), intent(inout), optional, target :: err
-
3469  end subroutine
-
3470 
-
3508  module subroutine mult_rz_mtx_cmplx(lside, trans, l, a, tau, c, work, olwork, err)
-
3509  logical, intent(in) :: lside, trans
-
3510  integer(int32), intent(in) :: l
-
3511  complex(real64), intent(inout), dimension(:,:) :: a, c
-
3512  complex(real64), intent(in), dimension(:) :: tau
-
3513  complex(real64), intent(out), target, optional, dimension(:) :: work
-
3514  integer(int32), intent(out), optional :: olwork
-
3515  class(errors), intent(inout), optional, target :: err
-
3516  end subroutine
-
3517 
-
3553  module subroutine mult_rz_vec(trans, l, a, tau, c, work, olwork, err)
-
3554  logical, intent(in) :: trans
-
3555  integer(int32), intent(in) :: l
-
3556  real(real64), intent(inout), dimension(:,:) :: a
-
3557  real(real64), intent(in), dimension(:) :: tau
-
3558  real(real64), intent(inout), dimension(:) :: c
-
3559  real(real64), intent(out), target, optional, dimension(:) :: work
-
3560  integer(int32), intent(out), optional :: olwork
-
3561  class(errors), intent(inout), optional, target :: err
-
3562  end subroutine
-
3563 
-
3599  module subroutine mult_rz_vec_cmplx(trans, l, a, tau, c, work, olwork, err)
-
3600  logical, intent(in) :: trans
-
3601  integer(int32), intent(in) :: l
-
3602  complex(real64), intent(inout), dimension(:,:) :: a
-
3603  complex(real64), intent(in), dimension(:) :: tau
-
3604  complex(real64), intent(inout), dimension(:) :: c
-
3605  complex(real64), intent(out), target, optional, dimension(:) :: work
-
3606  integer(int32), intent(out), optional :: olwork
-
3607  class(errors), intent(inout), optional, target :: err
-
3608  end subroutine
-
3609 
-
3652  module subroutine svd_dbl(a, s, u, vt, work, olwork, err)
-
3653  real(real64), intent(inout), dimension(:,:) :: a
-
3654  real(real64), intent(out), dimension(:) :: s
-
3655  real(real64), intent(out), optional, dimension(:,:) :: u, vt
-
3656  real(real64), intent(out), target, optional, dimension(:) :: work
-
3657  integer(int32), intent(out), optional :: olwork
-
3658  class(errors), intent(inout), optional, target :: err
-
3659  end subroutine
-
3660 
-
3707  module subroutine svd_cmplx(a, s, u, vt, work, olwork, rwork, err)
-
3708  complex(real64), intent(inout), dimension(:,:) :: a
-
3709  real(real64), intent(out), dimension(:) :: s
-
3710  complex(real64), intent(out), optional, dimension(:,:) :: u, vt
-
3711  complex(real64), intent(out), target, optional, dimension(:) :: work
-
3712  integer(int32), intent(out), optional :: olwork
-
3713  real(real64), intent(out), target, optional, dimension(:) :: rwork
-
3714  class(errors), intent(inout), optional, target :: err
-
3715  end subroutine
-
3716 end interface
-
3717 
-
3718 ! ******************************************************************************
-
3719 ! LINALG_SOLVE.F90
-
3720 ! ------------------------------------------------------------------------------
-
3721 interface
-
3722 
-
3750  module subroutine solve_tri_mtx(lside, upper, trans, nounit, alpha, a, b, err)
-
3751  logical, intent(in) :: lside, upper, trans, nounit
-
3752  real(real64), intent(in) :: alpha
-
3753  real(real64), intent(in), dimension(:,:) :: a
-
3754  real(real64), intent(inout), dimension(:,:) :: b
-
3755  class(errors), intent(inout), optional, target :: err
-
3756  end subroutine
-
3757 
-
3786  module subroutine solve_tri_mtx_cmplx(lside, upper, trans, nounit, alpha, a, b, err)
-
3787  logical, intent(in) :: lside, upper, trans, nounit
-
3788  complex(real64), intent(in) :: alpha
-
3789  complex(real64), intent(in), dimension(:,:) :: a
-
3790  complex(real64), intent(inout), dimension(:,:) :: b
-
3791  class(errors), intent(inout), optional, target :: err
-
3792  end subroutine
-
3793 
-
3838  module subroutine solve_tri_vec(upper, trans, nounit, a, x, err)
-
3839  logical, intent(in) :: upper, trans, nounit
-
3840  real(real64), intent(in), dimension(:,:) :: a
-
3841  real(real64), intent(inout), dimension(:) :: x
-
3842  class(errors), intent(inout), optional, target :: err
-
3843  end subroutine
-
3844 
-
3889  module subroutine solve_tri_vec_cmplx(upper, trans, nounit, a, x, err)
-
3890  logical, intent(in) :: upper, trans, nounit
-
3891  complex(real64), intent(in), dimension(:,:) :: a
-
3892  complex(real64), intent(inout), dimension(:) :: x
-
3893  class(errors), intent(inout), optional, target :: err
-
3894  end subroutine
-
3895 
-
3912  module subroutine solve_lu_mtx(a, ipvt, b, err)
-
3913  real(real64), intent(in), dimension(:,:) :: a
-
3914  integer(int32), intent(in), dimension(:) :: ipvt
-
3915  real(real64), intent(inout), dimension(:,:) :: b
-
3916  class(errors), intent(inout), optional, target :: err
-
3917  end subroutine
-
3918 
-
3935  module subroutine solve_lu_mtx_cmplx(a, ipvt, b, err)
-
3936  complex(real64), intent(in), dimension(:,:) :: a
-
3937  integer(int32), intent(in), dimension(:) :: ipvt
-
3938  complex(real64), intent(inout), dimension(:,:) :: b
-
3939  class(errors), intent(inout), optional, target :: err
-
3940  end subroutine
-
3941 
-
3958  module subroutine solve_lu_vec(a, ipvt, b, err)
-
3959  real(real64), intent(in), dimension(:,:) :: a
-
3960  integer(int32), intent(in), dimension(:) :: ipvt
-
3961  real(real64), intent(inout), dimension(:) :: b
-
3962  class(errors), intent(inout), optional, target :: err
-
3963  end subroutine
-
3964 
-
3981  module subroutine solve_lu_vec_cmplx(a, ipvt, b, err)
-
3982  complex(real64), intent(in), dimension(:,:) :: a
-
3983  integer(int32), intent(in), dimension(:) :: ipvt
-
3984  complex(real64), intent(inout), dimension(:) :: b
-
3985  class(errors), intent(inout), optional, target :: err
-
3986  end subroutine
-
3987 
-
4017  module subroutine solve_qr_no_pivot_mtx(a, tau, b, work, olwork, err)
-
4018  real(real64), intent(inout), dimension(:,:) :: a, b
-
4019  real(real64), intent(in), dimension(:) :: tau
-
4020  real(real64), intent(out), target, optional, dimension(:) :: work
-
4021  integer(int32), intent(out), optional :: olwork
-
4022  class(errors), intent(inout), optional, target :: err
-
4023  end subroutine
-
4024 
-
4054  module subroutine solve_qr_no_pivot_mtx_cmplx(a, tau, b, work, olwork, err)
-
4055  complex(real64), intent(inout), dimension(:,:) :: a, b
-
4056  complex(real64), intent(in), dimension(:) :: tau
-
4057  complex(real64), intent(out), target, optional, dimension(:) :: work
-
4058  integer(int32), intent(out), optional :: olwork
-
4059  class(errors), intent(inout), optional, target :: err
-
4060  end subroutine
-
4061 
-
4091  module subroutine solve_qr_no_pivot_vec(a, tau, b, work, olwork, err)
-
4092  real(real64), intent(inout), dimension(:,:) :: a
-
4093  real(real64), intent(in), dimension(:) :: tau
-
4094  real(real64), intent(inout), dimension(:) :: b
-
4095  real(real64), intent(out), target, optional, dimension(:) :: work
-
4096  integer(int32), intent(out), optional :: olwork
-
4097  class(errors), intent(inout), optional, target :: err
-
4098  end subroutine
-
4099 
-
4129  module subroutine solve_qr_no_pivot_vec_cmplx(a, tau, b, work, olwork, err)
-
4130  complex(real64), intent(inout), dimension(:,:) :: a
-
4131  complex(real64), intent(in), dimension(:) :: tau
-
4132  complex(real64), intent(inout), dimension(:) :: b
-
4133  complex(real64), intent(out), target, optional, dimension(:) :: work
-
4134  integer(int32), intent(out), optional :: olwork
-
4135  class(errors), intent(inout), optional, target :: err
-
4136  end subroutine
-
4137 
-
4169  module subroutine solve_qr_pivot_mtx(a, tau, jpvt, b, work, olwork, err)
-
4170  real(real64), intent(inout), dimension(:,:) :: a
-
4171  real(real64), intent(in), dimension(:) :: tau
-
4172  integer(int32), intent(in), dimension(:) :: jpvt
-
4173  real(real64), intent(inout), dimension(:,:) :: b
-
4174  real(real64), intent(out), target, optional, dimension(:) :: work
-
4175  integer(int32), intent(out), optional :: olwork
-
4176  class(errors), intent(inout), optional, target :: err
-
4177  end subroutine
-
4178 
-
4210  module subroutine solve_qr_pivot_mtx_cmplx(a, tau, jpvt, b, work, olwork, err)
-
4211  complex(real64), intent(inout), dimension(:,:) :: a
-
4212  complex(real64), intent(in), dimension(:) :: tau
-
4213  integer(int32), intent(in), dimension(:) :: jpvt
-
4214  complex(real64), intent(inout), dimension(:,:) :: b
-
4215  complex(real64), intent(out), target, optional, dimension(:) :: work
-
4216  integer(int32), intent(out), optional :: olwork
-
4217  class(errors), intent(inout), optional, target :: err
-
4218  end subroutine
-
4219 
-
4251  module subroutine solve_qr_pivot_vec(a, tau, jpvt, b, work, olwork, err)
-
4252  real(real64), intent(inout), dimension(:,:) :: a
-
4253  real(real64), intent(in), dimension(:) :: tau
-
4254  integer(int32), intent(in), dimension(:) :: jpvt
-
4255  real(real64), intent(inout), dimension(:) :: b
-
4256  real(real64), intent(out), target, optional, dimension(:) :: work
-
4257  integer(int32), intent(out), optional :: olwork
-
4258  class(errors), intent(inout), optional, target :: err
-
4259  end subroutine
-
4260 
-
4292  module subroutine solve_qr_pivot_vec_cmplx(a, tau, jpvt, b, work, olwork, err)
-
4293  complex(real64), intent(inout), dimension(:,:) :: a
-
4294  complex(real64), intent(in), dimension(:) :: tau
-
4295  integer(int32), intent(in), dimension(:) :: jpvt
-
4296  complex(real64), intent(inout), dimension(:) :: b
-
4297  complex(real64), intent(out), target, optional, dimension(:) :: work
-
4298  integer(int32), intent(out), optional :: olwork
-
4299  class(errors), intent(inout), optional, target :: err
-
4300  end subroutine
-
4301 
-
4320  module subroutine solve_cholesky_mtx(upper, a, b, err)
-
4321  logical, intent(in) :: upper
-
4322  real(real64), intent(in), dimension(:,:) :: a
-
4323  real(real64), intent(inout), dimension(:,:) :: b
-
4324  class(errors), intent(inout), optional, target :: err
-
4325  end subroutine
-
4326 
-
4345  module subroutine solve_cholesky_mtx_cmplx(upper, a, b, err)
-
4346  logical, intent(in) :: upper
-
4347  complex(real64), intent(in), dimension(:,:) :: a
-
4348  complex(real64), intent(inout), dimension(:,:) :: b
-
4349  class(errors), intent(inout), optional, target :: err
-
4350  end subroutine
-
4351 
-
4370  module subroutine solve_cholesky_vec(upper, a, b, err)
-
4371  logical, intent(in) :: upper
-
4372  real(real64), intent(in), dimension(:,:) :: a
-
4373  real(real64), intent(inout), dimension(:) :: b
-
4374  class(errors), intent(inout), optional, target :: err
-
4375  end subroutine
-
4376 
-
4395  module subroutine solve_cholesky_vec_cmplx(upper, a, b, err)
-
4396  logical, intent(in) :: upper
-
4397  complex(real64), intent(in), dimension(:,:) :: a
-
4398  complex(real64), intent(inout), dimension(:) :: b
-
4399  class(errors), intent(inout), optional, target :: err
-
4400  end subroutine
-
4401 
-
4433  module subroutine solve_least_squares_mtx(a, b, work, olwork, err)
-
4434  real(real64), intent(inout), dimension(:,:) :: a, b
-
4435  real(real64), intent(out), target, optional, dimension(:) :: work
-
4436  integer(int32), intent(out), optional :: olwork
-
4437  class(errors), intent(inout), optional, target :: err
-
4438  end subroutine
-
4439 
-
4471  module subroutine solve_least_squares_mtx_cmplx(a, b, work, olwork, err)
-
4472  complex(real64), intent(inout), dimension(:,:) :: a, b
-
4473  complex(real64), intent(out), target, optional, dimension(:) :: work
-
4474  integer(int32), intent(out), optional :: olwork
-
4475  class(errors), intent(inout), optional, target :: err
-
4476  end subroutine
-
4477 
-
4509  module subroutine solve_least_squares_vec(a, b, work, olwork, err)
-
4510  real(real64), intent(inout), dimension(:,:) :: a
-
4511  real(real64), intent(inout), dimension(:) :: b
-
4512  real(real64), intent(out), target, optional, dimension(:) :: work
-
4513  integer(int32), intent(out), optional :: olwork
-
4514  class(errors), intent(inout), optional, target :: err
-
4515  end subroutine
-
4516 
-
4548  module subroutine solve_least_squares_vec_cmplx(a, b, work, olwork, err)
-
4549  complex(real64), intent(inout), dimension(:,:) :: a
-
4550  complex(real64), intent(inout), dimension(:) :: b
-
4551  complex(real64), intent(out), target, optional, dimension(:) :: work
-
4552  integer(int32), intent(out), optional :: olwork
-
4553  class(errors), intent(inout), optional, target :: err
-
4554  end subroutine
-
4555 
-
4593  module subroutine solve_least_squares_mtx_pvt(a, b, ipvt, arnk, work, olwork, err)
-
4594  real(real64), intent(inout), dimension(:,:) :: a, b
-
4595  integer(int32), intent(inout), target, optional, dimension(:) :: ipvt
-
4596  integer(int32), intent(out), optional :: arnk
-
4597  real(real64), intent(out), target, optional, dimension(:) :: work
-
4598  integer(int32), intent(out), optional :: olwork
-
4599  class(errors), intent(inout), optional, target :: err
-
4600  end subroutine
-
4601 
-
4643  module subroutine solve_least_squares_mtx_pvt_cmplx(a, b, ipvt, arnk, &
-
4644  work, olwork, rwork, err)
-
4645  complex(real64), intent(inout), dimension(:,:) :: a, b
-
4646  integer(int32), intent(inout), target, optional, dimension(:) :: ipvt
-
4647  integer(int32), intent(out), optional :: arnk
-
4648  complex(real64), intent(out), target, optional, dimension(:) :: work
-
4649  integer(int32), intent(out), optional :: olwork
-
4650  real(real64), intent(out), target, optional, dimension(:) :: rwork
-
4651  class(errors), intent(inout), optional, target :: err
-
4652  end subroutine
-
4653 
-
4691  module subroutine solve_least_squares_vec_pvt(a, b, ipvt, arnk, work, olwork, err)
-
4692  real(real64), intent(inout), dimension(:,:) :: a
-
4693  real(real64), intent(inout), dimension(:) :: b
-
4694  integer(int32), intent(inout), target, optional, dimension(:) :: ipvt
-
4695  integer(int32), intent(out), optional :: arnk
-
4696  real(real64), intent(out), target, optional, dimension(:) :: work
-
4697  integer(int32), intent(out), optional :: olwork
-
4698  class(errors), intent(inout), optional, target :: err
-
4699  end subroutine
-
4700 
-
4742  module subroutine solve_least_squares_vec_pvt_cmplx(a, b, ipvt, arnk, &
-
4743  work, olwork, rwork, err)
-
4744  complex(real64), intent(inout), dimension(:,:) :: a
-
4745  complex(real64), intent(inout), dimension(:) :: b
-
4746  integer(int32), intent(inout), target, optional, dimension(:) :: ipvt
-
4747  integer(int32), intent(out), optional :: arnk
-
4748  complex(real64), intent(out), target, optional, dimension(:) :: work
-
4749  integer(int32), intent(out), optional :: olwork
-
4750  real(real64), intent(out), target, optional, dimension(:) :: rwork
-
4751  class(errors), intent(inout), optional, target :: err
-
4752  end subroutine
-
4753 
-
4792  module subroutine solve_least_squares_mtx_svd(a, b, s, arnk, work, olwork, err)
-
4793  real(real64), intent(inout), dimension(:,:) :: a, b
-
4794  integer(int32), intent(out), optional :: arnk
-
4795  real(real64), intent(out), target, optional, dimension(:) :: work, s
-
4796  integer(int32), intent(out), optional :: olwork
-
4797  class(errors), intent(inout), optional, target :: err
-
4798  end subroutine
-
4799 
-
4842  module subroutine solve_least_squares_mtx_svd_cmplx(a, b, s, arnk, work, &
-
4843  olwork, rwork, err)
-
4844  complex(real64), intent(inout), dimension(:,:) :: a, b
-
4845  integer(int32), intent(out), optional :: arnk
-
4846  complex(real64), intent(out), target, optional, dimension(:) :: work
-
4847  real(real64), intent(out), target, optional, dimension(:) :: rwork, s
-
4848  integer(int32), intent(out), optional :: olwork
-
4849  class(errors), intent(inout), optional, target :: err
-
4850  end subroutine
-
4851 
-
4888  module subroutine solve_least_squares_vec_svd(a, b, s, arnk, work, olwork, err)
-
4889  real(real64), intent(inout), dimension(:,:) :: a
-
4890  real(real64), intent(inout), dimension(:) :: b
-
4891  integer(int32), intent(out), optional :: arnk
-
4892  real(real64), intent(out), target, optional, dimension(:) :: work, s
-
4893  integer(int32), intent(out), optional :: olwork
-
4894  class(errors), intent(inout), optional, target :: err
-
4895  end subroutine
-
4896 
-
4937  module subroutine solve_least_squares_vec_svd_cmplx(a, b, s, arnk, work, &
-
4938  olwork, rwork, err)
-
4939  complex(real64), intent(inout), dimension(:,:) :: a
-
4940  complex(real64), intent(inout), dimension(:) :: b
-
4941  integer(int32), intent(out), optional :: arnk
-
4942  complex(real64), intent(out), target, optional, dimension(:) :: work
-
4943  real(real64), intent(out), target, optional, dimension(:) :: rwork, s
-
4944  integer(int32), intent(out), optional :: olwork
-
4945  class(errors), intent(inout), optional, target :: err
-
4946  end subroutine
-
4947 
-
4979  module subroutine mtx_inverse_dbl(a, iwork, work, olwork, err)
-
4980  real(real64), intent(inout), dimension(:,:) :: a
-
4981  integer(int32), intent(out), target, optional, dimension(:) :: iwork
-
4982  real(real64), intent(out), target, optional, dimension(:) :: work
-
4983  integer(int32), intent(out), optional :: olwork
-
4984  class(errors), intent(inout), optional, target :: err
-
4985  end subroutine
-
4986 
-
5018  module subroutine mtx_inverse_cmplx(a, iwork, work, olwork, err)
-
5019  complex(real64), intent(inout), dimension(:,:) :: a
-
5020  integer(int32), intent(out), target, optional, dimension(:) :: iwork
-
5021  complex(real64), intent(out), target, optional, dimension(:) :: work
-
5022  integer(int32), intent(out), optional :: olwork
-
5023  class(errors), intent(inout), optional, target :: err
-
5024  end subroutine
-
5025 
-
5063  module subroutine mtx_pinverse_dbl(a, ainv, tol, work, olwork, err)
-
5064  real(real64), intent(inout), dimension(:,:) :: a
-
5065  real(real64), intent(out), dimension(:,:) :: ainv
-
5066  real(real64), intent(in), optional :: tol
-
5067  real(real64), intent(out), target, dimension(:), optional :: work
-
5068  integer(int32), intent(out), optional :: olwork
-
5069  class(errors), intent(inout), optional, target :: err
-
5070  end subroutine
-
5071 
-
5113  module subroutine mtx_pinverse_cmplx(a, ainv, tol, work, olwork, rwork, err)
-
5114  complex(real64), intent(inout), dimension(:,:) :: a
-
5115  complex(real64), intent(out), dimension(:,:) :: ainv
-
5116  real(real64), intent(in), optional :: tol
-
5117  complex(real64), intent(out), target, dimension(:), optional :: work
-
5118  integer(int32), intent(out), optional :: olwork
-
5119  real(real64), intent(out), target, dimension(:), optional :: rwork
-
5120  class(errors), intent(inout), optional, target :: err
-
5121  end subroutine
-
5122 
-
5123 end interface
-
5124 
-
5125 ! ******************************************************************************
-
5126 ! LINALG_EIGEN.F90
-
5127 ! ------------------------------------------------------------------------------
-
5128 interface
-
5129 
-
5161  module subroutine eigen_symm(vecs, a, vals, work, olwork, err)
-
5162  logical, intent(in) :: vecs
-
5163  real(real64), intent(inout), dimension(:,:) :: a
-
5164  real(real64), intent(out), dimension(:) :: vals
-
5165  real(real64), intent(out), pointer, optional, dimension(:) :: work
-
5166  integer(int32), intent(out), optional :: olwork
-
5167  class(errors), intent(inout), optional, target :: err
-
5168  end subroutine
-
5169 
-
5200  module subroutine eigen_asymm(a, vals, vecs, work, olwork, err)
-
5201  real(real64), intent(inout), dimension(:,:) :: a
-
5202  complex(real64), intent(out), dimension(:) :: vals
-
5203  complex(real64), intent(out), optional, dimension(:,:) :: vecs
-
5204  real(real64), intent(out), pointer, optional, dimension(:) :: work
-
5205  integer(int32), intent(out), optional :: olwork
-
5206  class(errors), intent(inout), optional, target :: err
-
5207  end subroutine
-
5208 
-
5251  module subroutine eigen_gen(a, b, alpha, beta, vecs, work, olwork, err)
-
5252  real(real64), intent(inout), dimension(:,:) :: a, b
-
5253  complex(real64), intent(out), dimension(:) :: alpha
-
5254  real(real64), intent(out), optional, dimension(:) :: beta
-
5255  complex(real64), intent(out), optional, dimension(:,:) :: vecs
-
5256  real(real64), intent(out), optional, pointer, dimension(:) :: work
-
5257  integer(int32), intent(out), optional :: olwork
-
5258  class(errors), intent(inout), optional, target :: err
-
5259  end subroutine
-
5260 
-
5291  module subroutine eigen_cmplx(a, vals, vecs, work, olwork, rwork, err)
-
5292  complex(real64), intent(inout), dimension(:,:) :: a
-
5293  complex(real64), intent(out), dimension(:) :: vals
-
5294  complex(real64), intent(out), optional, dimension(:,:) :: vecs
-
5295  complex(real64), intent(out), target, optional, dimension(:) :: work
-
5296  real(real64), intent(out), target, optional, dimension(:) :: rwork
-
5297  integer(int32), intent(out), optional :: olwork
-
5298  class(errors), intent(inout), optional, target :: err
-
5299  end subroutine
-
5300 end interface
-
5301 
-
5302 ! ******************************************************************************
-
5303 ! LINALG_SORTING.F90
-
5304 ! ------------------------------------------------------------------------------
-
5305 interface
-
5306 
-
5321  module subroutine sort_dbl_array(x, ascend)
-
5322  real(real64), intent(inout), dimension(:) :: x
-
5323  logical, intent(in), optional :: ascend
-
5324  end subroutine
-
5325 
-
5350  module subroutine sort_dbl_array_ind(x, ind, ascend, err)
-
5351  real(real64), intent(inout), dimension(:) :: x
-
5352  integer(int32), intent(inout), dimension(:) :: ind
-
5353  logical, intent(in), optional :: ascend
-
5354  class(errors), intent(inout), optional, target :: err
-
5355  end subroutine
-
5356 
-
5373  module subroutine sort_cmplx_array(x, ascend)
-
5374  complex(real64), intent(inout), dimension(:) :: x
-
5375  logical, intent(in), optional :: ascend
-
5376  end subroutine
-
5377 
-
5407  module subroutine sort_cmplx_array_ind(x, ind, ascend, err)
-
5408  complex(real64), intent(inout), dimension(:) :: x
-
5409  integer(int32), intent(inout), dimension(:) :: ind
-
5410  logical, intent(in), optional :: ascend
-
5411  class(errors), intent(inout), optional, target :: err
-
5412  end subroutine
-
5413 
-
5433  module subroutine sort_eigen_cmplx(vals, vecs, ascend, err)
-
5434  complex(real64), intent(inout), dimension(:) :: vals
-
5435  complex(real64), intent(inout), dimension(:,:) :: vecs
-
5436  logical, intent(in), optional :: ascend
-
5437  class(errors), intent(inout), optional, target :: err
-
5438  end subroutine
-
5439 
-
5459  module subroutine sort_eigen_dbl(vals, vecs, ascend, err)
-
5460  real(real64), intent(inout), dimension(:) :: vals
-
5461  real(real64), intent(inout), dimension(:,:) :: vecs
-
5462  logical, intent(in), optional :: ascend
-
5463  class(errors), intent(inout), optional, target :: err
-
5464  end subroutine
-
5465 
-
5466 end interface
-
5467 
-
5468 end module
+
1! linalg_core.f90
+
2
+
3
+
12
+
13
+ +
16 use, intrinsic :: iso_fortran_env, only : int32, real64
+
17 use ferror, only : errors
+ +
19 implicit none
+
20
+
21 private
+
22 public :: mtx_mult
+
23 public :: rank1_update
+
24 public :: diag_mtx_mult
+
25 public :: trace
+
26 public :: mtx_rank
+
27 public :: det
+
28 public :: swap
+
29 public :: recip_mult_array
+
30 public :: tri_mtx_mult
+
31 public :: lu_factor
+
32 public :: form_lu
+
33 public :: qr_factor
+
34 public :: form_qr
+
35 public :: mult_qr
+
36 public :: qr_rank1_update
+
37 public :: cholesky_factor
+
38 public :: cholesky_rank1_update
+ +
40 public :: rz_factor
+
41 public :: mult_rz
+
42 public :: svd
+ +
44 public :: solve_lu
+
45 public :: solve_qr
+
46 public :: solve_cholesky
+
47 public :: mtx_inverse
+
48 public :: mtx_pinverse
+
49 public :: solve_least_squares
+ + +
52 public :: eigen
+
53 public :: sort
+
54
+
55! ******************************************************************************
+
56! INTERFACES
+
57! ------------------------------------------------------------------------------
+
119interface mtx_mult
+
120 module procedure :: mtx_mult_mtx
+
121 module procedure :: mtx_mult_vec
+
122 module procedure :: cmtx_mult_mtx
+
123 module procedure :: cmtx_mult_vec
+
124end interface
+
125
+
126! ------------------------------------------------------------------------------
+ +
155 module procedure :: rank1_update_dbl
+
156 module procedure :: rank1_update_cmplx
+
157end interface
+
158
+
159! ------------------------------------------------------------------------------
+ +
274 module procedure :: diag_mtx_mult_mtx
+
275 module procedure :: diag_mtx_mult_mtx2
+
276 module procedure :: diag_mtx_mult_mtx3
+
277 module procedure :: diag_mtx_mult_mtx4
+
278 module procedure :: diag_mtx_mult_mtx_cmplx
+
279 module procedure :: diag_mtx_mult_mtx2_cmplx
+
280 module procedure :: diag_mtx_mult_mtx_mix
+
281 module procedure :: diag_mtx_mult_mtx2_mix
+
282end interface
+
283
+
284! ------------------------------------------------------------------------------
+
287interface trace
+
288 module procedure :: trace_dbl
+
289 module procedure :: trace_cmplx
+
290end interface
+
291
+
292! ------------------------------------------------------------------------------
+
294interface mtx_rank
+
295 module procedure :: mtx_rank_dbl
+
296 module procedure :: mtx_rank_cmplx
+
297end interface
+
298
+
299! ------------------------------------------------------------------------------
+
301interface det
+
302 module procedure :: det_dbl
+
303 module procedure :: det_cmplx
+
304end interface
+
305
+
306! ------------------------------------------------------------------------------
+
308interface swap
+
309 module procedure :: swap_dbl
+
310 module procedure :: swap_cmplx
+
311end interface
+
312
+
313! ------------------------------------------------------------------------------
+ +
316 module procedure :: recip_mult_array_dbl
+
317end interface
+
318
+
319! ------------------------------------------------------------------------------
+ +
324 module procedure :: tri_mtx_mult_dbl
+
325 module procedure :: tri_mtx_mult_cmplx
+
326end interface
+
327
+
328! ------------------------------------------------------------------------------
+
381interface lu_factor
+
382 module procedure :: lu_factor_dbl
+
383 module procedure :: lu_factor_cmplx
+
384end interface
+
385
+
450interface form_lu
+
451 module procedure :: form_lu_all
+
452 module procedure :: form_lu_all_cmplx
+
453 module procedure :: form_lu_only
+
454 module procedure :: form_lu_only_cmplx
+
455end interface
+
456
+
457! ------------------------------------------------------------------------------
+
520interface qr_factor
+
521 module procedure :: qr_factor_no_pivot
+
522 module procedure :: qr_factor_no_pivot_cmplx
+
523 module procedure :: qr_factor_pivot
+
524 module procedure :: qr_factor_pivot_cmplx
+
525end interface
+
526
+
527! ------------------------------------------------------------------------------
+
603interface form_qr
+
604 module procedure :: form_qr_no_pivot
+
605 module procedure :: form_qr_no_pivot_cmplx
+
606 module procedure :: form_qr_pivot
+
607 module procedure :: form_qr_pivot_cmplx
+
608end interface
+
609
+
610! ------------------------------------------------------------------------------
+
680interface mult_qr
+
681 module procedure :: mult_qr_mtx
+
682 module procedure :: mult_qr_mtx_cmplx
+
683 module procedure :: mult_qr_vec
+
684 module procedure :: mult_qr_vec_cmplx
+
685end interface
+
686
+
687! ------------------------------------------------------------------------------
+ +
783 module procedure :: qr_rank1_update_dbl
+
784 module procedure :: qr_rank1_update_cmplx
+
785end interface
+
786
+
787! ------------------------------------------------------------------------------
+ +
858 module procedure :: cholesky_factor_dbl
+
859 module procedure :: cholesky_factor_cmplx
+
860end interface
+
861
+
862! ------------------------------------------------------------------------------
+ +
926 module procedure :: cholesky_rank1_update_dbl
+
927 module procedure :: cholesky_rank1_update_cmplx
+
928end interface
+
929
+
930! ------------------------------------------------------------------------------
+ +
999 module procedure :: cholesky_rank1_downdate_dbl
+
1000 module procedure :: cholesky_rank1_downdate_cmplx
+
1001end interface
+
1002
+
1003! ------------------------------------------------------------------------------
+
1008interface rz_factor
+
1009 module procedure :: rz_factor_dbl
+
1010 module procedure :: rz_factor_cmplx
+
1011end interface
+
1012
+
1013! ------------------------------------------------------------------------------
+
1016interface mult_rz
+
1017 module procedure :: mult_rz_mtx
+
1018 module procedure :: mult_rz_mtx_cmplx
+
1019 module procedure :: mult_rz_vec
+
1020 module procedure :: mult_rz_vec_cmplx
+
1021end interface
+
1022
+
1023! ------------------------------------------------------------------------------
+
1092interface svd
+
1093 module procedure :: svd_dbl
+
1094 module procedure :: svd_cmplx
+
1095end interface
+
1096
+
1097! ------------------------------------------------------------------------------
+ +
1162 module procedure :: solve_tri_mtx
+
1163 module procedure :: solve_tri_mtx_cmplx
+
1164 module procedure :: solve_tri_vec
+
1165 module procedure :: solve_tri_vec_cmplx
+
1166end interface
+
1167
+
1168! ------------------------------------------------------------------------------
+
1225interface solve_lu
+
1226 module procedure :: solve_lu_mtx
+
1227 module procedure :: solve_lu_mtx_cmplx
+
1228 module procedure :: solve_lu_vec
+
1229 module procedure :: solve_lu_vec_cmplx
+
1230end interface
+
1231
+
1232! ------------------------------------------------------------------------------
+
1294interface solve_qr
+
1295 module procedure :: solve_qr_no_pivot_mtx
+
1296 module procedure :: solve_qr_no_pivot_mtx_cmplx
+
1297 module procedure :: solve_qr_no_pivot_vec
+
1298 module procedure :: solve_qr_no_pivot_vec_cmplx
+
1299 module procedure :: solve_qr_pivot_mtx
+
1300 module procedure :: solve_qr_pivot_mtx_cmplx
+
1301 module procedure :: solve_qr_pivot_vec
+
1302 module procedure :: solve_qr_pivot_vec_cmplx
+
1303end interface
+
1304
+
1305! ------------------------------------------------------------------------------
+ +
1375 module procedure :: solve_cholesky_mtx
+
1376 module procedure :: solve_cholesky_mtx_cmplx
+
1377 module procedure :: solve_cholesky_vec
+
1378 module procedure :: solve_cholesky_vec_cmplx
+
1379end interface
+
1380
+
1381! ------------------------------------------------------------------------------
+ +
1429 module procedure :: solve_least_squares_mtx
+
1430 module procedure :: solve_least_squares_mtx_cmplx
+
1431 module procedure :: solve_least_squares_vec
+
1432 module procedure :: solve_least_squares_vec_cmplx
+
1433end interface
+
1434
+
1435! ------------------------------------------------------------------------------
+ +
1484 module procedure :: solve_least_squares_mtx_pvt
+
1485 module procedure :: solve_least_squares_mtx_pvt_cmplx
+
1486 module procedure :: solve_least_squares_vec_pvt
+
1487 module procedure :: solve_least_squares_vec_pvt_cmplx
+
1488end interface
+
1489
+
1490! ------------------------------------------------------------------------------
+ +
1539 module procedure :: solve_least_squares_mtx_svd
+
1540 module procedure :: solve_least_squares_vec_svd
+
1541end interface
+
1542
+
1543! ------------------------------------------------------------------------------
+ +
1598 module procedure :: mtx_inverse_dbl
+
1599 module procedure :: mtx_inverse_cmplx
+
1600end interface
+
1601
+
1602! ------------------------------------------------------------------------------
+ +
1659 module procedure :: mtx_pinverse_dbl
+
1660 module procedure :: mtx_pinverse_cmplx
+
1661end interface
+
1662
+
1663! ------------------------------------------------------------------------------
+
1752interface eigen
+
1753 module procedure :: eigen_symm
+
1754 module procedure :: eigen_asymm
+
1755 module procedure :: eigen_gen
+
1756 module procedure :: eigen_cmplx
+
1757end interface
+
1758
+
1759! ------------------------------------------------------------------------------
+
1761interface sort
+
1762 module procedure :: sort_dbl_array
+
1763 module procedure :: sort_dbl_array_ind
+
1764 module procedure :: sort_cmplx_array
+
1765 module procedure :: sort_cmplx_array_ind
+
1766 module procedure :: sort_eigen_cmplx
+
1767 module procedure :: sort_eigen_dbl
+
1768end interface
+
1769
+
1770
+
1771! ******************************************************************************
+
1772! LINALG_BASIC.F90
+
1773! ------------------------------------------------------------------------------
+
1774interface
+
1775 module subroutine mtx_mult_mtx(transa, transb, alpha, a, b, beta, c, err)
+
1776 logical, intent(in) :: transa, transb
+
1777 real(real64), intent(in) :: alpha, beta
+
1778 real(real64), intent(in), dimension(:,:) :: a, b
+
1779 real(real64), intent(inout), dimension(:,:) :: c
+
1780 class(errors), intent(inout), optional, target :: err
+
1781 end subroutine
+
1782
+
1783 module subroutine mtx_mult_vec(trans, alpha, a, b, beta, c, err)
+
1784 logical, intent(in) :: trans
+
1785 real(real64), intent(in) :: alpha, beta
+
1786 real(real64), intent(in), dimension(:,:) :: a
+
1787 real(real64), intent(in), dimension(:) :: b
+
1788 real(real64), intent(inout), dimension(:) :: c
+
1789 class(errors), intent(inout), optional, target :: err
+
1790 end subroutine
+
1791
+
1792 module subroutine cmtx_mult_mtx(opa, opb, alpha, a, b, beta, c, err)
+
1793 integer(int32), intent(in) :: opa, opb
+
1794 complex(real64), intent(in) :: alpha, beta
+
1795 complex(real64), intent(in), dimension(:,:) :: a, b
+
1796 complex(real64), intent(inout), dimension(:,:) :: c
+
1797 class(errors), intent(inout), optional, target :: err
+
1798 end subroutine
+
1799
+
1800 module subroutine cmtx_mult_vec(opa, alpha, a, b, beta, c, err)
+
1801 integer(int32), intent(in) :: opa
+
1802 complex(real64), intent(in) :: alpha, beta
+
1803 complex(real64), intent(in), dimension(:,:) :: a
+
1804 complex(real64), intent(in), dimension(:) :: b
+
1805 complex(real64), intent(inout), dimension(:) :: c
+
1806 class(errors), intent(inout), optional, target :: err
+
1807 end subroutine
+
1808
+
1809 module subroutine rank1_update_dbl(alpha, x, y, a, err)
+
1810 real(real64), intent(in) :: alpha
+
1811 real(real64), intent(in), dimension(:) :: x, y
+
1812 real(real64), intent(inout), dimension(:,:) :: a
+
1813 class(errors), intent(inout), optional, target :: err
+
1814 end subroutine
+
1815
+
1816 module subroutine rank1_update_cmplx(alpha, x, y, a, err)
+
1817 complex(real64), intent(in) :: alpha
+
1818 complex(real64), intent(in), dimension(:) :: x, y
+
1819 complex(real64), intent(inout), dimension(:,:) :: a
+
1820 class(errors), intent(inout), optional, target :: err
+
1821 end subroutine
+
1822
+
1850 module subroutine diag_mtx_mult_mtx(lside, trans, alpha, a, b, beta, c, err)
+
1851 logical, intent(in) :: lside, trans
+
1852 real(real64) :: alpha, beta
+
1853 real(real64), intent(in), dimension(:) :: a
+
1854 real(real64), intent(in), dimension(:,:) :: b
+
1855 real(real64), intent(inout), dimension(:,:) :: c
+
1856 class(errors), intent(inout), optional, target :: err
+
1857 end subroutine
+
1858
+
1877 module subroutine diag_mtx_mult_mtx2(lside, alpha, a, b, err)
+
1878 logical, intent(in) :: lside
+
1879 real(real64), intent(in) :: alpha
+
1880 real(real64), intent(in), dimension(:) :: a
+
1881 real(real64), intent(inout), dimension(:,:) :: b
+
1882 class(errors), intent(inout), optional, target :: err
+
1883 end subroutine
+
1884
+
1912 module subroutine diag_mtx_mult_mtx3(lside, trans, alpha, a, b, beta, c, err)
+
1913 logical, intent(in) :: lside, trans
+
1914 real(real64) :: alpha, beta
+
1915 complex(real64), intent(in), dimension(:) :: a
+
1916 real(real64), intent(in), dimension(:,:) :: b
+
1917 complex(real64), intent(inout), dimension(:,:) :: c
+
1918 class(errors), intent(inout), optional, target :: err
+
1919 end subroutine
+
1920
+
1949 module subroutine diag_mtx_mult_mtx4(lside, opb, alpha, a, b, beta, c, err)
+
1950 logical, intent(in) :: lside
+
1951 integer(int32), intent(in) :: opb
+
1952 real(real64) :: alpha, beta
+
1953 complex(real64), intent(in), dimension(:) :: a
+
1954 complex(real64), intent(in), dimension(:,:) :: b
+
1955 complex(real64), intent(inout), dimension(:,:) :: c
+
1956 class(errors), intent(inout), optional, target :: err
+
1957 end subroutine
+
1958
+
1987 module subroutine diag_mtx_mult_mtx_cmplx(lside, opb, alpha, a, b, beta, c, err)
+
1988 logical, intent(in) :: lside
+
1989 integer(int32), intent(in) :: opb
+
1990 complex(real64) :: alpha, beta
+
1991 complex(real64), intent(in), dimension(:) :: a
+
1992 complex(real64), intent(in), dimension(:,:) :: b
+
1993 complex(real64), intent(inout), dimension(:,:) :: c
+
1994 class(errors), intent(inout), optional, target :: err
+
1995 end subroutine
+
1996
+
2015 module subroutine diag_mtx_mult_mtx2_cmplx(lside, alpha, a, b, err)
+
2016 logical, intent(in) :: lside
+
2017 complex(real64), intent(in) :: alpha
+
2018 complex(real64), intent(in), dimension(:) :: a
+
2019 complex(real64), intent(inout), dimension(:,:) :: b
+
2020 class(errors), intent(inout), optional, target :: err
+
2021 end subroutine
+
2022
+
2051 module subroutine diag_mtx_mult_mtx_mix(lside, opb, alpha, a, b, beta, c, err)
+
2052 logical, intent(in) :: lside
+
2053 integer(int32), intent(in) :: opb
+
2054 complex(real64) :: alpha, beta
+
2055 real(real64), intent(in), dimension(:) :: a
+
2056 complex(real64), intent(in), dimension(:,:) :: b
+
2057 complex(real64), intent(inout), dimension(:,:) :: c
+
2058 class(errors), intent(inout), optional, target :: err
+
2059 end subroutine
+
2060
+
2079 module subroutine diag_mtx_mult_mtx2_mix(lside, alpha, a, b, err)
+
2080 logical, intent(in) :: lside
+
2081 complex(real64), intent(in) :: alpha
+
2082 real(real64), intent(in), dimension(:) :: a
+
2083 complex(real64), intent(inout), dimension(:,:) :: b
+
2084 class(errors), intent(inout), optional, target :: err
+
2085 end subroutine
+
2086
+
2087
+
2094 pure module function trace_dbl(x) result(y)
+
2095 real(real64), intent(in), dimension(:,:) :: x
+
2096 real(real64) :: y
+
2097 end function
+
2098
+
2105 pure module function trace_cmplx(x) result(y)
+
2106 complex(real64), intent(in), dimension(:,:) :: x
+
2107 complex(real64) :: y
+
2108 end function
+
2109
+
2142 module function mtx_rank_dbl(a, tol, work, olwork, err) result(rnk)
+
2143 real(real64), intent(inout), dimension(:,:) :: a
+
2144 real(real64), intent(in), optional :: tol
+
2145 real(real64), intent(out), target, optional, dimension(:) :: work
+
2146 integer(int32), intent(out), optional :: olwork
+
2147 class(errors), intent(inout), optional, target :: err
+
2148 integer(int32) :: rnk
+
2149 end function
+
2150
+
2187 module function mtx_rank_cmplx(a, tol, work, olwork, rwork, err) result(rnk)
+
2188 complex(real64), intent(inout), dimension(:,:) :: a
+
2189 real(real64), intent(in), optional :: tol
+
2190 complex(real64), intent(out), target, optional, dimension(:) :: work
+
2191 integer(int32), intent(out), optional :: olwork
+
2192 real(real64), intent(out), target, optional, dimension(:) :: rwork
+
2193 class(errors), intent(inout), optional, target :: err
+
2194 integer(int32) :: rnk
+
2195 end function
+
2196
+
2217 module function det_dbl(a, iwork, err) result(x)
+
2218 real(real64), intent(inout), dimension(:,:) :: a
+
2219 integer(int32), intent(out), target, optional, dimension(:) :: iwork
+
2220 class(errors), intent(inout), optional, target :: err
+
2221 real(real64) :: x
+
2222 end function
+
2223
+
2244 module function det_cmplx(a, iwork, err) result(x)
+
2245 complex(real64), intent(inout), dimension(:,:) :: a
+
2246 integer(int32), intent(out), target, optional, dimension(:) :: iwork
+
2247 class(errors), intent(inout), optional, target :: err
+
2248 complex(real64) :: x
+
2249 end function
+
2250
+
2261 module subroutine swap_dbl(x, y, err)
+
2262 real(real64), intent(inout), dimension(:) :: x, y
+
2263 class(errors), intent(inout), optional, target :: err
+
2264 end subroutine
+
2265
+
2276 module subroutine swap_cmplx(x, y, err)
+
2277 complex(real64), intent(inout), dimension(:) :: x, y
+
2278 class(errors), intent(inout), optional, target :: err
+
2279 end subroutine
+
2280
+
2289 module subroutine recip_mult_array_dbl(a, x)
+
2290 real(real64), intent(in) :: a
+
2291 real(real64), intent(inout), dimension(:) :: x
+
2292 end subroutine
+
2293
+
2317 module subroutine tri_mtx_mult_dbl(upper, alpha, a, beta, b, err)
+
2318 logical, intent(in) :: upper
+
2319 real(real64), intent(in) :: alpha, beta
+
2320 real(real64), intent(in), dimension(:,:) :: a
+
2321 real(real64), intent(inout), dimension(:,:) :: b
+
2322 class(errors), intent(inout), optional, target :: err
+
2323 end subroutine
+
2324
+
2348 module subroutine tri_mtx_mult_cmplx(upper, alpha, a, beta, b, err)
+
2349 logical, intent(in) :: upper
+
2350 complex(real64), intent(in) :: alpha, beta
+
2351 complex(real64), intent(in), dimension(:,:) :: a
+
2352 complex(real64), intent(inout), dimension(:,:) :: b
+
2353 class(errors), intent(inout), optional, target :: err
+
2354 end subroutine
+
2355
+
2356end interface
+
2357
+
2358! ******************************************************************************
+
2359! LINALG_FACTOR.F90
+
2360! ------------------------------------------------------------------------------
+
2361interface
+
2362
+
2385 module subroutine lu_factor_dbl(a, ipvt, err)
+
2386 real(real64), intent(inout), dimension(:,:) :: a
+
2387 integer(int32), intent(out), dimension(:) :: ipvt
+
2388 class(errors), intent(inout), optional, target :: err
+
2389 end subroutine
+
2390
+
2414 module subroutine lu_factor_cmplx(a, ipvt, err)
+
2415 complex(real64), intent(inout), dimension(:,:) :: a
+
2416 integer(int32), intent(out), dimension(:) :: ipvt
+
2417 class(errors), intent(inout), optional, target :: err
+
2418 end subroutine
+
2419
+
2452 module subroutine form_lu_all(lu, ipvt, u, p, err)
+
2453 real(real64), intent(inout), dimension(:,:) :: lu
+
2454 integer(int32), intent(in), dimension(:) :: ipvt
+
2455 real(real64), intent(out), dimension(:,:) :: u, p
+
2456 class(errors), intent(inout), optional, target :: err
+
2457 end subroutine
+
2458
+
2491 module subroutine form_lu_all_cmplx(lu, ipvt, u, p, err)
+
2492 complex(real64), intent(inout), dimension(:,:) :: lu
+
2493 integer(int32), intent(in), dimension(:) :: ipvt
+
2494 complex(real64), intent(out), dimension(:,:) :: u
+
2495 real(real64), intent(out), dimension(:,:) :: p
+
2496 class(errors), intent(inout), optional, target :: err
+
2497 end subroutine
+
2498
+
2512 module subroutine form_lu_only(lu, u, err)
+
2513 real(real64), intent(inout), dimension(:,:) :: lu
+
2514 real(real64), intent(out), dimension(:,:) :: u
+
2515 class(errors), intent(inout), optional, target :: err
+
2516 end subroutine
+
2517
+
2531 module subroutine form_lu_only_cmplx(lu, u, err)
+
2532 complex(real64), intent(inout), dimension(:,:) :: lu
+
2533 complex(real64), intent(out), dimension(:,:) :: u
+
2534 class(errors), intent(inout), optional, target :: err
+
2535 end subroutine
+
2536
+
2572 module subroutine qr_factor_no_pivot(a, tau, work, olwork, err)
+
2573 real(real64), intent(inout), dimension(:,:) :: a
+
2574 real(real64), intent(out), dimension(:) :: tau
+
2575 real(real64), intent(out), target, dimension(:), optional :: work
+
2576 integer(int32), intent(out), optional :: olwork
+
2577 class(errors), intent(inout), optional, target :: err
+
2578 end subroutine
+
2579
+
2615 module subroutine qr_factor_no_pivot_cmplx(a, tau, work, olwork, err)
+
2616 complex(real64), intent(inout), dimension(:,:) :: a
+
2617 complex(real64), intent(out), dimension(:) :: tau
+
2618 complex(real64), intent(out), target, dimension(:), optional :: work
+
2619 integer(int32), intent(out), optional :: olwork
+
2620 class(errors), intent(inout), optional, target :: err
+
2621 end subroutine
+
2622
+
2656 module subroutine qr_factor_pivot(a, tau, jpvt, work, olwork, err)
+
2657 real(real64), intent(inout), dimension(:,:) :: a
+
2658 real(real64), intent(out), dimension(:) :: tau
+
2659 integer(int32), intent(inout), dimension(:) :: jpvt
+
2660 real(real64), intent(out), target, dimension(:), optional :: work
+
2661 integer(int32), intent(out), optional :: olwork
+
2662 class(errors), intent(inout), optional, target :: err
+
2663 end subroutine
+
2664
+
2702 module subroutine qr_factor_pivot_cmplx(a, tau, jpvt, work, olwork, rwork, &
+
2703 err)
+
2704 complex(real64), intent(inout), dimension(:,:) :: a
+
2705 complex(real64), intent(out), dimension(:) :: tau
+
2706 integer(int32), intent(inout), dimension(:) :: jpvt
+
2707 complex(real64), intent(out), target, dimension(:), optional :: work
+
2708 integer(int32), intent(out), optional :: olwork
+
2709 real(real64), intent(out), target, dimension(:), optional :: rwork
+
2710 class(errors), intent(inout), optional, target :: err
+
2711 end subroutine
+
2712
+
2746 module subroutine form_qr_no_pivot(r, tau, q, work, olwork, err)
+
2747 real(real64), intent(inout), dimension(:,:) :: r
+
2748 real(real64), intent(in), dimension(:) :: tau
+
2749 real(real64), intent(out), dimension(:,:) :: q
+
2750 real(real64), intent(out), target, dimension(:), optional :: work
+
2751 integer(int32), intent(out), optional :: olwork
+
2752 class(errors), intent(inout), optional, target :: err
+
2753 end subroutine
+
2754
+
2788 module subroutine form_qr_no_pivot_cmplx(r, tau, q, work, olwork, err)
+
2789 complex(real64), intent(inout), dimension(:,:) :: r
+
2790 complex(real64), intent(in), dimension(:) :: tau
+
2791 complex(real64), intent(out), dimension(:,:) :: q
+
2792 complex(real64), intent(out), target, dimension(:), optional :: work
+
2793 integer(int32), intent(out), optional :: olwork
+
2794 class(errors), intent(inout), optional, target :: err
+
2795 end subroutine
+
2796
+
2833 module subroutine form_qr_pivot(r, tau, pvt, q, p, work, olwork, err)
+
2834 real(real64), intent(inout), dimension(:,:) :: r
+
2835 real(real64), intent(in), dimension(:) :: tau
+
2836 integer(int32), intent(in), dimension(:) :: pvt
+
2837 real(real64), intent(out), dimension(:,:) :: q, p
+
2838 real(real64), intent(out), target, dimension(:), optional :: work
+
2839 integer(int32), intent(out), optional :: olwork
+
2840 class(errors), intent(inout), optional, target :: err
+
2841 end subroutine
+
2842
+
2879 module subroutine form_qr_pivot_cmplx(r, tau, pvt, q, p, work, olwork, err)
+
2880 complex(real64), intent(inout), dimension(:,:) :: r
+
2881 complex(real64), intent(in), dimension(:) :: tau
+
2882 integer(int32), intent(in), dimension(:) :: pvt
+
2883 complex(real64), intent(out), dimension(:,:) :: q, p
+
2884 complex(real64), intent(out), target, dimension(:), optional :: work
+
2885 integer(int32), intent(out), optional :: olwork
+
2886 class(errors), intent(inout), optional, target :: err
+
2887 end subroutine
+
2888
+
2923 module subroutine mult_qr_mtx(lside, trans, a, tau, c, work, olwork, err)
+
2924 logical, intent(in) :: lside, trans
+
2925 real(real64), intent(in), dimension(:) :: tau
+
2926 real(real64), intent(inout), dimension(:,:) :: a, c
+
2927 real(real64), intent(out), target, dimension(:), optional :: work
+
2928 integer(int32), intent(out), optional :: olwork
+
2929 class(errors), intent(inout), optional, target :: err
+
2930 end subroutine
+
2931
+
2966 module subroutine mult_qr_mtx_cmplx(lside, trans, a, tau, c, work, olwork, err)
+
2967 logical, intent(in) :: lside, trans
+
2968 complex(real64), intent(in), dimension(:) :: tau
+
2969 complex(real64), intent(inout), dimension(:,:) :: a, c
+
2970 complex(real64), intent(out), target, dimension(:), optional :: work
+
2971 integer(int32), intent(out), optional :: olwork
+
2972 class(errors), intent(inout), optional, target :: err
+
2973 end subroutine
+
2974
+
3005 module subroutine mult_qr_vec(trans, a, tau, c, work, olwork, err)
+
3006 logical, intent(in) :: trans
+
3007 real(real64), intent(inout), dimension(:,:) :: a
+
3008 real(real64), intent(in), dimension(:) :: tau
+
3009 real(real64), intent(inout), dimension(:) :: c
+
3010 real(real64), intent(out), target, dimension(:), optional :: work
+
3011 integer(int32), intent(out), optional :: olwork
+
3012 class(errors), intent(inout), optional, target :: err
+
3013 end subroutine
+
3014
+
3045 module subroutine mult_qr_vec_cmplx(trans, a, tau, c, work, olwork, err)
+
3046 logical, intent(in) :: trans
+
3047 complex(real64), intent(inout), dimension(:,:) :: a
+
3048 complex(real64), intent(in), dimension(:) :: tau
+
3049 complex(real64), intent(inout), dimension(:) :: c
+
3050 complex(real64), intent(out), target, dimension(:), optional :: work
+
3051 integer(int32), intent(out), optional :: olwork
+
3052 class(errors), intent(inout), optional, target :: err
+
3053 end subroutine
+
3054
+
3095 module subroutine qr_rank1_update_dbl(q, r, u, v, work, err)
+
3096 real(real64), intent(inout), dimension(:,:) :: q, r
+
3097 real(real64), intent(inout), dimension(:) :: u, v
+
3098 real(real64), intent(out), target, optional, dimension(:) :: work
+
3099 class(errors), intent(inout), optional, target :: err
+
3100 end subroutine
+
3101
+
3145 module subroutine qr_rank1_update_cmplx(q, r, u, v, work, rwork, err)
+
3146 complex(real64), intent(inout), dimension(:,:) :: q, r
+
3147 complex(real64), intent(inout), dimension(:) :: u, v
+
3148 complex(real64), intent(out), target, optional, dimension(:) :: work
+
3149 real(real64), intent(out), target, optional, dimension(:) :: rwork
+
3150 class(errors), intent(inout), optional, target :: err
+
3151 end subroutine
+
3152
+
3173 module subroutine cholesky_factor_dbl(a, upper, err)
+
3174 real(real64), intent(inout), dimension(:,:) :: a
+
3175 logical, intent(in), optional :: upper
+
3176 class(errors), intent(inout), optional, target :: err
+
3177 end subroutine
+
3178
+
3199 module subroutine cholesky_factor_cmplx(a, upper, err)
+
3200 complex(real64), intent(inout), dimension(:,:) :: a
+
3201 logical, intent(in), optional :: upper
+
3202 class(errors), intent(inout), optional, target :: err
+
3203 end subroutine
+
3204
+
3231 module subroutine cholesky_rank1_update_dbl(r, u, work, err)
+
3232 real(real64), intent(inout), dimension(:,:) :: r
+
3233 real(real64), intent(inout), dimension(:) :: u
+
3234 real(real64), intent(out), target, optional, dimension(:) :: work
+
3235 class(errors), intent(inout), optional, target :: err
+
3236 end subroutine
+
3237
+
3264 module subroutine cholesky_rank1_update_cmplx(r, u, work, err)
+
3265 complex(real64), intent(inout), dimension(:,:) :: r
+
3266 complex(real64), intent(inout), dimension(:) :: u
+
3267 real(real64), intent(out), target, optional, dimension(:) :: work
+
3268 class(errors), intent(inout), optional, target :: err
+
3269 end subroutine
+
3270
+
3300 module subroutine cholesky_rank1_downdate_dbl(r, u, work, err)
+
3301 real(real64), intent(inout), dimension(:,:) :: r
+
3302 real(real64), intent(inout), dimension(:) :: u
+
3303 real(real64), intent(out), target, optional, dimension(:) :: work
+
3304 class(errors), intent(inout), optional, target :: err
+
3305 end subroutine
+
3306
+
3336 module subroutine cholesky_rank1_downdate_cmplx(r, u, work, err)
+
3337 complex(real64), intent(inout), dimension(:,:) :: r
+
3338 complex(real64), intent(inout), dimension(:) :: u
+
3339 real(real64), intent(out), target, optional, dimension(:) :: work
+
3340 class(errors), intent(inout), optional, target :: err
+
3341 end subroutine
+
3342
+
3405 module subroutine rz_factor_dbl(a, tau, work, olwork, err)
+
3406 real(real64), intent(inout), dimension(:,:) :: a
+
3407 real(real64), intent(out), dimension(:) :: tau
+
3408 real(real64), intent(out), target, optional, dimension(:) :: work
+
3409 integer(int32), intent(out), optional :: olwork
+
3410 class(errors), intent(inout), optional, target :: err
+
3411 end subroutine
+
3412
+
3475 module subroutine rz_factor_cmplx(a, tau, work, olwork, err)
+
3476 complex(real64), intent(inout), dimension(:,:) :: a
+
3477 complex(real64), intent(out), dimension(:) :: tau
+
3478 complex(real64), intent(out), target, optional, dimension(:) :: work
+
3479 integer(int32), intent(out), optional :: olwork
+
3480 class(errors), intent(inout), optional, target :: err
+
3481 end subroutine
+
3482
+
3520 module subroutine mult_rz_mtx(lside, trans, l, a, tau, c, work, olwork, err)
+
3521 logical, intent(in) :: lside, trans
+
3522 integer(int32), intent(in) :: l
+
3523 real(real64), intent(inout), dimension(:,:) :: a, c
+
3524 real(real64), intent(in), dimension(:) :: tau
+
3525 real(real64), intent(out), target, optional, dimension(:) :: work
+
3526 integer(int32), intent(out), optional :: olwork
+
3527 class(errors), intent(inout), optional, target :: err
+
3528 end subroutine
+
3529
+
3567 module subroutine mult_rz_mtx_cmplx(lside, trans, l, a, tau, c, work, olwork, err)
+
3568 logical, intent(in) :: lside, trans
+
3569 integer(int32), intent(in) :: l
+
3570 complex(real64), intent(inout), dimension(:,:) :: a, c
+
3571 complex(real64), intent(in), dimension(:) :: tau
+
3572 complex(real64), intent(out), target, optional, dimension(:) :: work
+
3573 integer(int32), intent(out), optional :: olwork
+
3574 class(errors), intent(inout), optional, target :: err
+
3575 end subroutine
+
3576
+
3612 module subroutine mult_rz_vec(trans, l, a, tau, c, work, olwork, err)
+
3613 logical, intent(in) :: trans
+
3614 integer(int32), intent(in) :: l
+
3615 real(real64), intent(inout), dimension(:,:) :: a
+
3616 real(real64), intent(in), dimension(:) :: tau
+
3617 real(real64), intent(inout), dimension(:) :: c
+
3618 real(real64), intent(out), target, optional, dimension(:) :: work
+
3619 integer(int32), intent(out), optional :: olwork
+
3620 class(errors), intent(inout), optional, target :: err
+
3621 end subroutine
+
3622
+
3658 module subroutine mult_rz_vec_cmplx(trans, l, a, tau, c, work, olwork, err)
+
3659 logical, intent(in) :: trans
+
3660 integer(int32), intent(in) :: l
+
3661 complex(real64), intent(inout), dimension(:,:) :: a
+
3662 complex(real64), intent(in), dimension(:) :: tau
+
3663 complex(real64), intent(inout), dimension(:) :: c
+
3664 complex(real64), intent(out), target, optional, dimension(:) :: work
+
3665 integer(int32), intent(out), optional :: olwork
+
3666 class(errors), intent(inout), optional, target :: err
+
3667 end subroutine
+
3668
+
3711 module subroutine svd_dbl(a, s, u, vt, work, olwork, err)
+
3712 real(real64), intent(inout), dimension(:,:) :: a
+
3713 real(real64), intent(out), dimension(:) :: s
+
3714 real(real64), intent(out), optional, dimension(:,:) :: u, vt
+
3715 real(real64), intent(out), target, optional, dimension(:) :: work
+
3716 integer(int32), intent(out), optional :: olwork
+
3717 class(errors), intent(inout), optional, target :: err
+
3718 end subroutine
+
3719
+
3766 module subroutine svd_cmplx(a, s, u, vt, work, olwork, rwork, err)
+
3767 complex(real64), intent(inout), dimension(:,:) :: a
+
3768 real(real64), intent(out), dimension(:) :: s
+
3769 complex(real64), intent(out), optional, dimension(:,:) :: u, vt
+
3770 complex(real64), intent(out), target, optional, dimension(:) :: work
+
3771 integer(int32), intent(out), optional :: olwork
+
3772 real(real64), intent(out), target, optional, dimension(:) :: rwork
+
3773 class(errors), intent(inout), optional, target :: err
+
3774 end subroutine
+
3775end interface
+
3776
+
3777! ******************************************************************************
+
3778! LINALG_SOLVE.F90
+
3779! ------------------------------------------------------------------------------
+
3780interface
+
3781
+
3809 module subroutine solve_tri_mtx(lside, upper, trans, nounit, alpha, a, b, err)
+
3810 logical, intent(in) :: lside, upper, trans, nounit
+
3811 real(real64), intent(in) :: alpha
+
3812 real(real64), intent(in), dimension(:,:) :: a
+
3813 real(real64), intent(inout), dimension(:,:) :: b
+
3814 class(errors), intent(inout), optional, target :: err
+
3815 end subroutine
+
3816
+
3845 module subroutine solve_tri_mtx_cmplx(lside, upper, trans, nounit, alpha, a, b, err)
+
3846 logical, intent(in) :: lside, upper, trans, nounit
+
3847 complex(real64), intent(in) :: alpha
+
3848 complex(real64), intent(in), dimension(:,:) :: a
+
3849 complex(real64), intent(inout), dimension(:,:) :: b
+
3850 class(errors), intent(inout), optional, target :: err
+
3851 end subroutine
+
3852
+
3897 module subroutine solve_tri_vec(upper, trans, nounit, a, x, err)
+
3898 logical, intent(in) :: upper, trans, nounit
+
3899 real(real64), intent(in), dimension(:,:) :: a
+
3900 real(real64), intent(inout), dimension(:) :: x
+
3901 class(errors), intent(inout), optional, target :: err
+
3902 end subroutine
+
3903
+
3948 module subroutine solve_tri_vec_cmplx(upper, trans, nounit, a, x, err)
+
3949 logical, intent(in) :: upper, trans, nounit
+
3950 complex(real64), intent(in), dimension(:,:) :: a
+
3951 complex(real64), intent(inout), dimension(:) :: x
+
3952 class(errors), intent(inout), optional, target :: err
+
3953 end subroutine
+
3954
+
3971 module subroutine solve_lu_mtx(a, ipvt, b, err)
+
3972 real(real64), intent(in), dimension(:,:) :: a
+
3973 integer(int32), intent(in), dimension(:) :: ipvt
+
3974 real(real64), intent(inout), dimension(:,:) :: b
+
3975 class(errors), intent(inout), optional, target :: err
+
3976 end subroutine
+
3977
+
3994 module subroutine solve_lu_mtx_cmplx(a, ipvt, b, err)
+
3995 complex(real64), intent(in), dimension(:,:) :: a
+
3996 integer(int32), intent(in), dimension(:) :: ipvt
+
3997 complex(real64), intent(inout), dimension(:,:) :: b
+
3998 class(errors), intent(inout), optional, target :: err
+
3999 end subroutine
+
4000
+
4017 module subroutine solve_lu_vec(a, ipvt, b, err)
+
4018 real(real64), intent(in), dimension(:,:) :: a
+
4019 integer(int32), intent(in), dimension(:) :: ipvt
+
4020 real(real64), intent(inout), dimension(:) :: b
+
4021 class(errors), intent(inout), optional, target :: err
+
4022 end subroutine
+
4023
+
4040 module subroutine solve_lu_vec_cmplx(a, ipvt, b, err)
+
4041 complex(real64), intent(in), dimension(:,:) :: a
+
4042 integer(int32), intent(in), dimension(:) :: ipvt
+
4043 complex(real64), intent(inout), dimension(:) :: b
+
4044 class(errors), intent(inout), optional, target :: err
+
4045 end subroutine
+
4046
+
4076 module subroutine solve_qr_no_pivot_mtx(a, tau, b, work, olwork, err)
+
4077 real(real64), intent(inout), dimension(:,:) :: a, b
+
4078 real(real64), intent(in), dimension(:) :: tau
+
4079 real(real64), intent(out), target, optional, dimension(:) :: work
+
4080 integer(int32), intent(out), optional :: olwork
+
4081 class(errors), intent(inout), optional, target :: err
+
4082 end subroutine
+
4083
+
4113 module subroutine solve_qr_no_pivot_mtx_cmplx(a, tau, b, work, olwork, err)
+
4114 complex(real64), intent(inout), dimension(:,:) :: a, b
+
4115 complex(real64), intent(in), dimension(:) :: tau
+
4116 complex(real64), intent(out), target, optional, dimension(:) :: work
+
4117 integer(int32), intent(out), optional :: olwork
+
4118 class(errors), intent(inout), optional, target :: err
+
4119 end subroutine
+
4120
+
4150 module subroutine solve_qr_no_pivot_vec(a, tau, b, work, olwork, err)
+
4151 real(real64), intent(inout), dimension(:,:) :: a
+
4152 real(real64), intent(in), dimension(:) :: tau
+
4153 real(real64), intent(inout), dimension(:) :: b
+
4154 real(real64), intent(out), target, optional, dimension(:) :: work
+
4155 integer(int32), intent(out), optional :: olwork
+
4156 class(errors), intent(inout), optional, target :: err
+
4157 end subroutine
+
4158
+
4188 module subroutine solve_qr_no_pivot_vec_cmplx(a, tau, b, work, olwork, err)
+
4189 complex(real64), intent(inout), dimension(:,:) :: a
+
4190 complex(real64), intent(in), dimension(:) :: tau
+
4191 complex(real64), intent(inout), dimension(:) :: b
+
4192 complex(real64), intent(out), target, optional, dimension(:) :: work
+
4193 integer(int32), intent(out), optional :: olwork
+
4194 class(errors), intent(inout), optional, target :: err
+
4195 end subroutine
+
4196
+
4228 module subroutine solve_qr_pivot_mtx(a, tau, jpvt, b, work, olwork, err)
+
4229 real(real64), intent(inout), dimension(:,:) :: a
+
4230 real(real64), intent(in), dimension(:) :: tau
+
4231 integer(int32), intent(in), dimension(:) :: jpvt
+
4232 real(real64), intent(inout), dimension(:,:) :: b
+
4233 real(real64), intent(out), target, optional, dimension(:) :: work
+
4234 integer(int32), intent(out), optional :: olwork
+
4235 class(errors), intent(inout), optional, target :: err
+
4236 end subroutine
+
4237
+
4269 module subroutine solve_qr_pivot_mtx_cmplx(a, tau, jpvt, b, work, olwork, err)
+
4270 complex(real64), intent(inout), dimension(:,:) :: a
+
4271 complex(real64), intent(in), dimension(:) :: tau
+
4272 integer(int32), intent(in), dimension(:) :: jpvt
+
4273 complex(real64), intent(inout), dimension(:,:) :: b
+
4274 complex(real64), intent(out), target, optional, dimension(:) :: work
+
4275 integer(int32), intent(out), optional :: olwork
+
4276 class(errors), intent(inout), optional, target :: err
+
4277 end subroutine
+
4278
+
4310 module subroutine solve_qr_pivot_vec(a, tau, jpvt, b, work, olwork, err)
+
4311 real(real64), intent(inout), dimension(:,:) :: a
+
4312 real(real64), intent(in), dimension(:) :: tau
+
4313 integer(int32), intent(in), dimension(:) :: jpvt
+
4314 real(real64), intent(inout), dimension(:) :: b
+
4315 real(real64), intent(out), target, optional, dimension(:) :: work
+
4316 integer(int32), intent(out), optional :: olwork
+
4317 class(errors), intent(inout), optional, target :: err
+
4318 end subroutine
+
4319
+
4351 module subroutine solve_qr_pivot_vec_cmplx(a, tau, jpvt, b, work, olwork, err)
+
4352 complex(real64), intent(inout), dimension(:,:) :: a
+
4353 complex(real64), intent(in), dimension(:) :: tau
+
4354 integer(int32), intent(in), dimension(:) :: jpvt
+
4355 complex(real64), intent(inout), dimension(:) :: b
+
4356 complex(real64), intent(out), target, optional, dimension(:) :: work
+
4357 integer(int32), intent(out), optional :: olwork
+
4358 class(errors), intent(inout), optional, target :: err
+
4359 end subroutine
+
4360
+
4379 module subroutine solve_cholesky_mtx(upper, a, b, err)
+
4380 logical, intent(in) :: upper
+
4381 real(real64), intent(in), dimension(:,:) :: a
+
4382 real(real64), intent(inout), dimension(:,:) :: b
+
4383 class(errors), intent(inout), optional, target :: err
+
4384 end subroutine
+
4385
+
4404 module subroutine solve_cholesky_mtx_cmplx(upper, a, b, err)
+
4405 logical, intent(in) :: upper
+
4406 complex(real64), intent(in), dimension(:,:) :: a
+
4407 complex(real64), intent(inout), dimension(:,:) :: b
+
4408 class(errors), intent(inout), optional, target :: err
+
4409 end subroutine
+
4410
+
4429 module subroutine solve_cholesky_vec(upper, a, b, err)
+
4430 logical, intent(in) :: upper
+
4431 real(real64), intent(in), dimension(:,:) :: a
+
4432 real(real64), intent(inout), dimension(:) :: b
+
4433 class(errors), intent(inout), optional, target :: err
+
4434 end subroutine
+
4435
+
4454 module subroutine solve_cholesky_vec_cmplx(upper, a, b, err)
+
4455 logical, intent(in) :: upper
+
4456 complex(real64), intent(in), dimension(:,:) :: a
+
4457 complex(real64), intent(inout), dimension(:) :: b
+
4458 class(errors), intent(inout), optional, target :: err
+
4459 end subroutine
+
4460
+
4492 module subroutine solve_least_squares_mtx(a, b, work, olwork, err)
+
4493 real(real64), intent(inout), dimension(:,:) :: a, b
+
4494 real(real64), intent(out), target, optional, dimension(:) :: work
+
4495 integer(int32), intent(out), optional :: olwork
+
4496 class(errors), intent(inout), optional, target :: err
+
4497 end subroutine
+
4498
+
4530 module subroutine solve_least_squares_mtx_cmplx(a, b, work, olwork, err)
+
4531 complex(real64), intent(inout), dimension(:,:) :: a, b
+
4532 complex(real64), intent(out), target, optional, dimension(:) :: work
+
4533 integer(int32), intent(out), optional :: olwork
+
4534 class(errors), intent(inout), optional, target :: err
+
4535 end subroutine
+
4536
+
4568 module subroutine solve_least_squares_vec(a, b, work, olwork, err)
+
4569 real(real64), intent(inout), dimension(:,:) :: a
+
4570 real(real64), intent(inout), dimension(:) :: b
+
4571 real(real64), intent(out), target, optional, dimension(:) :: work
+
4572 integer(int32), intent(out), optional :: olwork
+
4573 class(errors), intent(inout), optional, target :: err
+
4574 end subroutine
+
4575
+
4607 module subroutine solve_least_squares_vec_cmplx(a, b, work, olwork, err)
+
4608 complex(real64), intent(inout), dimension(:,:) :: a
+
4609 complex(real64), intent(inout), dimension(:) :: b
+
4610 complex(real64), intent(out), target, optional, dimension(:) :: work
+
4611 integer(int32), intent(out), optional :: olwork
+
4612 class(errors), intent(inout), optional, target :: err
+
4613 end subroutine
+
4614
+
4652 module subroutine solve_least_squares_mtx_pvt(a, b, ipvt, arnk, work, olwork, err)
+
4653 real(real64), intent(inout), dimension(:,:) :: a, b
+
4654 integer(int32), intent(inout), target, optional, dimension(:) :: ipvt
+
4655 integer(int32), intent(out), optional :: arnk
+
4656 real(real64), intent(out), target, optional, dimension(:) :: work
+
4657 integer(int32), intent(out), optional :: olwork
+
4658 class(errors), intent(inout), optional, target :: err
+
4659 end subroutine
+
4660
+
4702 module subroutine solve_least_squares_mtx_pvt_cmplx(a, b, ipvt, arnk, &
+
4703 work, olwork, rwork, err)
+
4704 complex(real64), intent(inout), dimension(:,:) :: a, b
+
4705 integer(int32), intent(inout), target, optional, dimension(:) :: ipvt
+
4706 integer(int32), intent(out), optional :: arnk
+
4707 complex(real64), intent(out), target, optional, dimension(:) :: work
+
4708 integer(int32), intent(out), optional :: olwork
+
4709 real(real64), intent(out), target, optional, dimension(:) :: rwork
+
4710 class(errors), intent(inout), optional, target :: err
+
4711 end subroutine
+
4712
+
4750 module subroutine solve_least_squares_vec_pvt(a, b, ipvt, arnk, work, olwork, err)
+
4751 real(real64), intent(inout), dimension(:,:) :: a
+
4752 real(real64), intent(inout), dimension(:) :: b
+
4753 integer(int32), intent(inout), target, optional, dimension(:) :: ipvt
+
4754 integer(int32), intent(out), optional :: arnk
+
4755 real(real64), intent(out), target, optional, dimension(:) :: work
+
4756 integer(int32), intent(out), optional :: olwork
+
4757 class(errors), intent(inout), optional, target :: err
+
4758 end subroutine
+
4759
+
4801 module subroutine solve_least_squares_vec_pvt_cmplx(a, b, ipvt, arnk, &
+
4802 work, olwork, rwork, err)
+
4803 complex(real64), intent(inout), dimension(:,:) :: a
+
4804 complex(real64), intent(inout), dimension(:) :: b
+
4805 integer(int32), intent(inout), target, optional, dimension(:) :: ipvt
+
4806 integer(int32), intent(out), optional :: arnk
+
4807 complex(real64), intent(out), target, optional, dimension(:) :: work
+
4808 integer(int32), intent(out), optional :: olwork
+
4809 real(real64), intent(out), target, optional, dimension(:) :: rwork
+
4810 class(errors), intent(inout), optional, target :: err
+
4811 end subroutine
+
4812
+
4851 module subroutine solve_least_squares_mtx_svd(a, b, s, arnk, work, olwork, err)
+
4852 real(real64), intent(inout), dimension(:,:) :: a, b
+
4853 integer(int32), intent(out), optional :: arnk
+
4854 real(real64), intent(out), target, optional, dimension(:) :: work, s
+
4855 integer(int32), intent(out), optional :: olwork
+
4856 class(errors), intent(inout), optional, target :: err
+
4857 end subroutine
+
4858
+
4901 module subroutine solve_least_squares_mtx_svd_cmplx(a, b, s, arnk, work, &
+
4902 olwork, rwork, err)
+
4903 complex(real64), intent(inout), dimension(:,:) :: a, b
+
4904 integer(int32), intent(out), optional :: arnk
+
4905 complex(real64), intent(out), target, optional, dimension(:) :: work
+
4906 real(real64), intent(out), target, optional, dimension(:) :: rwork, s
+
4907 integer(int32), intent(out), optional :: olwork
+
4908 class(errors), intent(inout), optional, target :: err
+
4909 end subroutine
+
4910
+
4947 module subroutine solve_least_squares_vec_svd(a, b, s, arnk, work, olwork, err)
+
4948 real(real64), intent(inout), dimension(:,:) :: a
+
4949 real(real64), intent(inout), dimension(:) :: b
+
4950 integer(int32), intent(out), optional :: arnk
+
4951 real(real64), intent(out), target, optional, dimension(:) :: work, s
+
4952 integer(int32), intent(out), optional :: olwork
+
4953 class(errors), intent(inout), optional, target :: err
+
4954 end subroutine
+
4955
+
4996 module subroutine solve_least_squares_vec_svd_cmplx(a, b, s, arnk, work, &
+
4997 olwork, rwork, err)
+
4998 complex(real64), intent(inout), dimension(:,:) :: a
+
4999 complex(real64), intent(inout), dimension(:) :: b
+
5000 integer(int32), intent(out), optional :: arnk
+
5001 complex(real64), intent(out), target, optional, dimension(:) :: work
+
5002 real(real64), intent(out), target, optional, dimension(:) :: rwork, s
+
5003 integer(int32), intent(out), optional :: olwork
+
5004 class(errors), intent(inout), optional, target :: err
+
5005 end subroutine
+
5006
+
5038 module subroutine mtx_inverse_dbl(a, iwork, work, olwork, err)
+
5039 real(real64), intent(inout), dimension(:,:) :: a
+
5040 integer(int32), intent(out), target, optional, dimension(:) :: iwork
+
5041 real(real64), intent(out), target, optional, dimension(:) :: work
+
5042 integer(int32), intent(out), optional :: olwork
+
5043 class(errors), intent(inout), optional, target :: err
+
5044 end subroutine
+
5045
+
5077 module subroutine mtx_inverse_cmplx(a, iwork, work, olwork, err)
+
5078 complex(real64), intent(inout), dimension(:,:) :: a
+
5079 integer(int32), intent(out), target, optional, dimension(:) :: iwork
+
5080 complex(real64), intent(out), target, optional, dimension(:) :: work
+
5081 integer(int32), intent(out), optional :: olwork
+
5082 class(errors), intent(inout), optional, target :: err
+
5083 end subroutine
+
5084
+
5122 module subroutine mtx_pinverse_dbl(a, ainv, tol, work, olwork, err)
+
5123 real(real64), intent(inout), dimension(:,:) :: a
+
5124 real(real64), intent(out), dimension(:,:) :: ainv
+
5125 real(real64), intent(in), optional :: tol
+
5126 real(real64), intent(out), target, dimension(:), optional :: work
+
5127 integer(int32), intent(out), optional :: olwork
+
5128 class(errors), intent(inout), optional, target :: err
+
5129 end subroutine
+
5130
+
5172 module subroutine mtx_pinverse_cmplx(a, ainv, tol, work, olwork, rwork, err)
+
5173 complex(real64), intent(inout), dimension(:,:) :: a
+
5174 complex(real64), intent(out), dimension(:,:) :: ainv
+
5175 real(real64), intent(in), optional :: tol
+
5176 complex(real64), intent(out), target, dimension(:), optional :: work
+
5177 integer(int32), intent(out), optional :: olwork
+
5178 real(real64), intent(out), target, dimension(:), optional :: rwork
+
5179 class(errors), intent(inout), optional, target :: err
+
5180 end subroutine
+
5181
+
5182end interface
+
5183
+
5184! ******************************************************************************
+
5185! LINALG_EIGEN.F90
+
5186! ------------------------------------------------------------------------------
+
5187interface
+
5188
+
5220 module subroutine eigen_symm(vecs, a, vals, work, olwork, err)
+
5221 logical, intent(in) :: vecs
+
5222 real(real64), intent(inout), dimension(:,:) :: a
+
5223 real(real64), intent(out), dimension(:) :: vals
+
5224 real(real64), intent(out), pointer, optional, dimension(:) :: work
+
5225 integer(int32), intent(out), optional :: olwork
+
5226 class(errors), intent(inout), optional, target :: err
+
5227 end subroutine
+
5228
+
5259 module subroutine eigen_asymm(a, vals, vecs, work, olwork, err)
+
5260 real(real64), intent(inout), dimension(:,:) :: a
+
5261 complex(real64), intent(out), dimension(:) :: vals
+
5262 complex(real64), intent(out), optional, dimension(:,:) :: vecs
+
5263 real(real64), intent(out), pointer, optional, dimension(:) :: work
+
5264 integer(int32), intent(out), optional :: olwork
+
5265 class(errors), intent(inout), optional, target :: err
+
5266 end subroutine
+
5267
+
5310 module subroutine eigen_gen(a, b, alpha, beta, vecs, work, olwork, err)
+
5311 real(real64), intent(inout), dimension(:,:) :: a, b
+
5312 complex(real64), intent(out), dimension(:) :: alpha
+
5313 real(real64), intent(out), optional, dimension(:) :: beta
+
5314 complex(real64), intent(out), optional, dimension(:,:) :: vecs
+
5315 real(real64), intent(out), optional, pointer, dimension(:) :: work
+
5316 integer(int32), intent(out), optional :: olwork
+
5317 class(errors), intent(inout), optional, target :: err
+
5318 end subroutine
+
5319
+
5350 module subroutine eigen_cmplx(a, vals, vecs, work, olwork, rwork, err)
+
5351 complex(real64), intent(inout), dimension(:,:) :: a
+
5352 complex(real64), intent(out), dimension(:) :: vals
+
5353 complex(real64), intent(out), optional, dimension(:,:) :: vecs
+
5354 complex(real64), intent(out), target, optional, dimension(:) :: work
+
5355 real(real64), intent(out), target, optional, dimension(:) :: rwork
+
5356 integer(int32), intent(out), optional :: olwork
+
5357 class(errors), intent(inout), optional, target :: err
+
5358 end subroutine
+
5359end interface
+
5360
+
5361! ******************************************************************************
+
5362! LINALG_SORTING.F90
+
5363! ------------------------------------------------------------------------------
+
5364interface
+
5365
+
5380 module subroutine sort_dbl_array(x, ascend)
+
5381 real(real64), intent(inout), dimension(:) :: x
+
5382 logical, intent(in), optional :: ascend
+
5383 end subroutine
+
5384
+
5409 module subroutine sort_dbl_array_ind(x, ind, ascend, err)
+
5410 real(real64), intent(inout), dimension(:) :: x
+
5411 integer(int32), intent(inout), dimension(:) :: ind
+
5412 logical, intent(in), optional :: ascend
+
5413 class(errors), intent(inout), optional, target :: err
+
5414 end subroutine
+
5415
+
5432 module subroutine sort_cmplx_array(x, ascend)
+
5433 complex(real64), intent(inout), dimension(:) :: x
+
5434 logical, intent(in), optional :: ascend
+
5435 end subroutine
+
5436
+
5466 module subroutine sort_cmplx_array_ind(x, ind, ascend, err)
+
5467 complex(real64), intent(inout), dimension(:) :: x
+
5468 integer(int32), intent(inout), dimension(:) :: ind
+
5469 logical, intent(in), optional :: ascend
+
5470 class(errors), intent(inout), optional, target :: err
+
5471 end subroutine
+
5472
+
5492 module subroutine sort_eigen_cmplx(vals, vecs, ascend, err)
+
5493 complex(real64), intent(inout), dimension(:) :: vals
+
5494 complex(real64), intent(inout), dimension(:,:) :: vecs
+
5495 logical, intent(in), optional :: ascend
+
5496 class(errors), intent(inout), optional, target :: err
+
5497 end subroutine
+
5498
+
5518 module subroutine sort_eigen_dbl(vals, vecs, ascend, err)
+
5519 real(real64), intent(inout), dimension(:) :: vals
+
5520 real(real64), intent(inout), dimension(:,:) :: vecs
+
5521 logical, intent(in), optional :: ascend
+
5522 class(errors), intent(inout), optional, target :: err
+
5523 end subroutine
+
5524
+
5525end interface
+
5526
+
5527end module
+
Computes the Cholesky factorization of a symmetric, positive definite matrix.
+
Computes the rank 1 downdate to a Cholesky factored matrix (upper triangular).
+
Computes the rank 1 update to a Cholesky factored matrix (upper triangular).
+
Computes the determinant of a square matrix.
+
Multiplies a diagonal matrix with another matrix or array.
+
Computes the eigenvalues, and optionally the eigenvectors, of a matrix.
+
Extracts the L and U matrices from the condensed [L\U] storage format used by the lu_factor.
+
Forms the full M-by-M orthogonal matrix Q from the elementary reflectors returned by the base QR fact...
+
Computes the LU factorization of an M-by-N matrix.
+
Computes the inverse of a square matrix.
+
Performs the matrix operation: .
+
Computes the Moore-Penrose pseudo-inverse of a M-by-N matrix using the singular value decomposition o...
+
Computes the rank of a matrix.
+
Multiplies a general matrix by the orthogonal matrix Q from a QR factorization.
+
Multiplies a general matrix by the orthogonal matrix Z from an RZ factorization.
+
Computes the QR factorization of an M-by-N matrix.
+
Computes the rank 1 update to an M-by-N QR factored matrix A (M >= N) where A = Q * R,...
+
Performs the rank-1 update to matrix A such that: , where is an M-by-N matrix, is a scalar,...
+
Multiplies a vector by the reciprocal of a real scalar.
+
Factors an upper trapezoidal matrix by means of orthogonal transformations such that A = R * Z = (R 0...
+
Solves a system of Cholesky factored equations.
+
Solves the overdetermined or underdetermined system (A*X = B) of M equations of N unknowns,...
+
Solves the overdetermined or underdetermined system (A*X = B) of M equations of N unknowns using a si...
+
Solves the overdetermined or underdetermined system (A*X = B) of M equations of N unknowns.
+
Solves a system of LU-factored equations.
+
Solves a system of M QR-factored equations of N unknowns.
+
Solves a triangular system of equations.
+
Sorts an array.
+
Computes the singular value decomposition of a matrix A. The SVD is defined as: A = U * S * V**T,...
+
Swaps the contents of two arrays.
+
Computes the trace of a matrix (the sum of the main diagonal elements).
+
Computes the triangular matrix operation: B = alpha * A**T * A + beta * B, or B = alpha * A * A**T + ...
+
Provides a set of constants and error flags for the library.
+
Provides a set of common linear algebra routines.
Definition: linalg_core.f90:15
-
Solves the overdetermined or underdetermined system (A*X = B) of M equations of N unknowns using a si...
-
Provides a set of common linear algebra routines.
Definition: linalg_core.f90:15
-
Computes the triangular matrix operation: B = alpha * A**T * A + beta * B, or B = alpha * A * A**T + ...
-
Computes the singular value decomposition of a matrix A. The SVD is defined as: A = U * S * V**T,...
-
Swaps the contents of two arrays.
-
Multiplies a diagonal matrix with another matrix or array.
-
Computes the Cholesky factorization of a symmetric, positive definite matrix.
-
Computes the Moore-Penrose pseudo-inverse of a M-by-N matrix using the singular value decomposition o...
-
Solves the overdetermined or underdetermined system (A*X = B) of M equations of N unknowns.
-
Multiplies a general matrix by the orthogonal matrix Z from an RZ factorization.
-
Provides a set of constants and error flags for the library.
-
Computes the determinant of a square matrix.
-
Solves a system of Cholesky factored equations.
-
Sorts an array.
-
Computes the rank 1 downdate to a Cholesky factored matrix (upper triangular).
-
Solves a system of M QR-factored equations of N unknowns.
-
Computes the eigenvalues, and optionally the eigenvectors, of a matrix.
-
Computes the LU factorization of an M-by-N matrix.
-
Solves a system of LU-factored equations.
-
Performs the rank-1 update to matrix A such that: A = alpha * X * Y**T + A, where A is an M-by-N matr...
Definition: linalg_core.f90:72
-
Forms the full M-by-M orthogonal matrix Q from the elementary reflectors returned by the base QR fact...
-
Computes the rank 1 update to a Cholesky factored matrix (upper triangular).
-
Computes the rank 1 update to an M-by-N QR factored matrix A (M >= N) where A = Q * R,...
-
Extracts the L and U matrices from the condensed [L\U] storage format used by the lu_factor.
-
Performs the matrix operation: C = alpha * op(A) * op(B) + beta * C.
Definition: linalg_core.f90:60
-
Computes the rank of a matrix.
-
Solves a triangular system of equations.
-
Solves the overdetermined or underdetermined system (A*X = B) of M equations of N unknowns,...
-
Computes the trace of a matrix (the sum of the main diagonal elements).
-
Multiplies a vector by the reciprocal of a real scalar.
-
Computes the inverse of a square matrix.
-
Computes the QR factorization of an M-by-N matrix.
-
Factors an upper trapezoidal matrix by means of orthogonal transformations such that A = R * Z = (R 0...
-
Multiplies a general matrix by the orthogonal matrix Q from a QR factorization.
diff --git a/doc/html/linalg__eigen_8f90_source.html b/doc/html/linalg__eigen_8f90_source.html index 3d565220..87027855 100644 --- a/doc/html/linalg__eigen_8f90_source.html +++ b/doc/html/linalg__eigen_8f90_source.html @@ -1,11 +1,11 @@ - + - - + + -linalg: C:/Users/jchri/Documents/github/linalg/src/linalg_eigen.f90 Source File +linalg: D:/Code/linalg/src/linalg_eigen.f90 Source File @@ -13,13 +13,16 @@ - + + @@ -27,10 +30,9 @@
- - + @@ -39,21 +41,22 @@
-
linalg -  1.6.0 +
+
linalg 1.6.1
A linear algebra library that provides a user-friendly interface to several BLAS and LAPACK routines.
- + +/* @license-end */ +
@@ -67,8 +70,8 @@
@@ -81,615 +84,619 @@
- +
+
+
+
+
Loading...
+
Searching...
+
No Matches
+
+
+
-
-
linalg_eigen.f90
+
linalg_eigen.f90
-
1 ! linalg_eigen.f90
-
2 
-
7 submodule(linalg_core) linalg_eigen
-
8 contains
-
9 ! ------------------------------------------------------------------------------
-
10  module subroutine eigen_symm(vecs, a, vals, work, olwork, err)
-
11  ! Arguments
-
12  logical, intent(in) :: vecs
-
13  real(real64), intent(inout), dimension(:,:) :: a
-
14  real(real64), intent(out), dimension(:) :: vals
-
15  real(real64), intent(out), pointer, optional, dimension(:) :: work
-
16  integer(int32), intent(out), optional :: olwork
-
17  class(errors), intent(inout), optional, target :: err
-
18 
-
19  ! Local Variables
-
20  character :: jobz
-
21  integer(int32) :: n, istat, flag, lwork
-
22  real(real64), pointer, dimension(:) :: wptr
-
23  real(real64), allocatable, target, dimension(:) :: wrk
-
24  real(real64), dimension(1) :: temp
-
25  class(errors), pointer :: errmgr
-
26  type(errors), target :: deferr
-
27  character(len = 128) :: errmsg
-
28 
-
29  ! Initialization
-
30  n = size(a, 1)
-
31  if (vecs) then
-
32  jobz = 'V'
-
33  else
-
34  jobz = 'N'
-
35  end if
-
36  if (present(err)) then
-
37  errmgr => err
-
38  else
-
39  errmgr => deferr
-
40  end if
-
41 
-
42  ! Input Check
-
43  flag = 0
-
44  if (size(a, 2) /= n) then
-
45  flag = 2
-
46  else if (size(vals) /= n) then
-
47  flag = 3
-
48  end if
-
49  if (flag /= 0) then
-
50  ! ERROR: One of the input arrays is not sized correctly
-
51  write(errmsg, '(AI0A)') "Input number ", flag, &
-
52  " is not sized correctly."
-
53  call errmgr%report_error("eigen_symm", trim(errmsg), &
-
54  la_array_size_error)
-
55  return
-
56  end if
-
57 
-
58  ! Workspace Query
-
59  call dsyev(jobz, 'L', n, a, n, vals, temp, -1, flag)
-
60  lwork = int(temp(1), int32)
-
61  if (present(olwork)) then
-
62  olwork = lwork
-
63  return
-
64  end if
-
65 
-
66  ! Local Memory Allocation
-
67  if (present(work)) then
-
68  if (size(work) < lwork) then
-
69  ! ERROR: WORK not sized correctly
-
70  call errmgr%report_error("eigen_symm", &
-
71  "Incorrectly sized input array WORK, argument 5.", &
-
72  la_array_size_error)
-
73  return
-
74  end if
-
75  wptr => work(1:lwork)
-
76  else
-
77  allocate(wrk(lwork), stat = istat)
-
78  if (istat /= 0) then
-
79  ! ERROR: Out of memory
-
80  call errmgr%report_error("eigen_symm", &
-
81  "Insufficient memory available.", &
-
82  la_out_of_memory_error)
-
83  return
-
84  end if
-
85  wptr => wrk
-
86  end if
-
87 
-
88  ! Process
-
89  call dsyev(jobz, 'L', n, a, n, vals, wptr, lwork, flag)
-
90  if (flag > 0) then
-
91  call errmgr%report_error("eigen_symm", &
-
92  "The algorithm failed to converge.", la_convergence_error)
-
93  end if
-
94  end subroutine
-
95 
-
96 ! ------------------------------------------------------------------------------
-
97  module subroutine eigen_asymm(a, vals, vecs, work, olwork, err)
-
98  ! Arguments
-
99  real(real64), intent(inout), dimension(:,:) :: a
-
100  complex(real64), intent(out), dimension(:) :: vals
-
101  complex(real64), intent(out), optional, dimension(:,:) :: vecs
-
102  real(real64), intent(out), pointer, optional, dimension(:) :: work
-
103  integer(int32), intent(out), optional :: olwork
-
104  class(errors), intent(inout), optional, target :: err
-
105 
-
106  ! Parameters
-
107  real(real64), parameter :: zero = 0.0d0
-
108  real(real64), parameter :: two = 2.0d0
-
109 
-
110  ! Local Variables
-
111  character :: jobvl, jobvr
-
112  integer(int32) :: i, j, jp1, n, n1, n2a, n2b, n3a, n3b, istat, flag, &
-
113  lwork, lwork1
-
114  real(real64) :: eps
-
115  real(real64), dimension(1) :: dummy, temp
-
116  real(real64), dimension(1,1) :: dummy_mtx
-
117  real(real64), pointer, dimension(:) :: wr, wi, wptr, w
-
118  real(real64), pointer, dimension(:,:) :: vr
-
119  real(real64), allocatable, target, dimension(:) :: wrk
-
120  class(errors), pointer :: errmgr
-
121  type(errors), target :: deferr
-
122  character(len = 128) :: errmsg
-
123 
-
124  ! Initialization
-
125  jobvl = 'N'
-
126  if (present(vecs)) then
-
127  jobvr = 'V'
-
128  else
-
129  jobvr = 'N'
-
130  end if
-
131  n = size(a, 1)
-
132  eps = two * epsilon(eps)
-
133  if (present(err)) then
-
134  errmgr => err
-
135  else
-
136  errmgr => deferr
-
137  end if
-
138 
-
139  ! Input Check
-
140  flag = 0
-
141  if (size(a, 2) /= n) then
-
142  flag = 1
-
143  else if (size(vals) /= n) then
-
144  flag = 2
-
145  else if (present(vecs)) then
-
146  if (size(vecs, 1) /= n .or. size(vecs, 2) /= n) then
-
147  flag = 3
-
148  end if
-
149  end if
-
150  if (flag /= 0) then
-
151  ! ERROR: One of the input arrays is not sized correctly
-
152  write(errmsg, '(AI0A)') "Input number ", flag, &
-
153  " is not sized correctly."
-
154  call errmgr%report_error("eigen_asymm", trim(errmsg), &
-
155  la_array_size_error)
-
156  return
-
157  end if
-
158 
-
159  ! Workspace Query
-
160  call dgeev(jobvl, jobvr, n, a, n, dummy, dummy, dummy_mtx, n, &
-
161  dummy_mtx, n, temp, -1, flag)
-
162  lwork1 = int(temp(1), int32)
-
163  if (present(vecs)) then
-
164  lwork = lwork1 + 2 * n + n * n
-
165  else
-
166  lwork = lwork1 + 2 * n
-
167  end if
-
168  if (present(olwork)) then
-
169  olwork = lwork
-
170  return
-
171  end if
-
172 
-
173  ! Local Memory Allocation
-
174  if (present(work)) then
-
175  if (size(work) < lwork) then
-
176  ! ERROR: WORK not sized correctly
-
177  call errmgr%report_error("eigen_asymm", &
-
178  "Incorrectly sized input array WORK, argument 5.", &
-
179  la_array_size_error)
-
180  return
-
181  end if
-
182  wptr => work(1:lwork)
-
183  else
-
184  allocate(wrk(lwork), stat = istat)
-
185  if (istat /= 0) then
-
186  ! ERROR: Out of memory
-
187  call errmgr%report_error("eigen_asymm", &
-
188  "Insufficient memory available.", &
-
189  la_out_of_memory_error)
-
190  return
-
191  end if
-
192  wptr => wrk
-
193  end if
-
194 
-
195  ! Locate each array within the workspace array
-
196  n1 = n
-
197  n2a = n1 + 1
-
198  n2b = n2a + n - 1
-
199  n3a = n2b + 1
-
200  n3b = n3a + lwork1 - 1
-
201 
-
202  ! Assign pointers
-
203  wr => wptr(1:n1)
-
204  wi => wptr(n2a:n2b)
-
205  w => wptr(n3a:n3b)
-
206 
-
207  ! Process
-
208  if (present(vecs)) then
-
209  ! Assign a pointer to the eigenvector matrix
-
210  vr(1:n,1:n) => wptr(n3b+1:lwork)
-
211 
-
212  ! Compute the eigenvectors and eigenvalues
-
213  call dgeev(jobvl, jobvr, n, a, n, wr, wi, dummy_mtx, n, vr, n, &
-
214  w, lwork1, flag)
-
215 
-
216  ! Check for convergence
-
217  if (flag > 0) then
-
218  call errmgr%report_error("eigen_asymm", &
-
219  "The algorithm failed to converge.", la_convergence_error)
-
220  return
-
221  end if
-
222 
-
223  ! Store the eigenvalues and eigenvectors
-
224  j = 1
-
225  do while (j <= n)
-
226  if (abs(wi(j)) < eps) then
-
227  ! We've got a real-valued eigenvalue
-
228  vals(j) = cmplx(wr(j), zero, real64)
-
229  do i = 1, n
-
230  vecs(i,j) = cmplx(vr(i,j), zero, real64)
-
231  end do
-
232  else
-
233  ! We've got a complex cojugate pair of eigenvalues
-
234  jp1 = j + 1
-
235  vals(j) = cmplx(wr(j), wi(j), real64)
-
236  vals(jp1) = conjg(vals(j))
-
237  do i = 1, n
-
238  vecs(i,j) = cmplx(vr(i,j), vr(i,jp1), real64)
-
239  vecs(i,jp1) = conjg(vecs(i,j))
-
240  end do
-
241 
-
242  ! Increment j and continue the loop
-
243  j = j + 2
-
244  cycle
-
245  end if
-
246 
-
247  ! Increment j
-
248  j = j + 1
-
249  end do
-
250  else
-
251  ! Compute just the eigenvalues
-
252  call dgeev(jobvl, jobvr, n, a, n, wr, wi, dummy_mtx, n, &
-
253  dummy_mtx, n, w, lwork1, flag)
-
254 
-
255  ! Check for convergence
-
256  if (flag > 0) then
-
257  call errmgr%report_error("eigen_asymm", &
-
258  "The algorithm failed to converge.", la_convergence_error)
-
259  return
-
260  end if
-
261 
-
262  ! Store the eigenvalues
-
263  do i = 1, n
-
264  vals(i) = cmplx(wr(i), wi(i), real64)
-
265  end do
-
266  end if
-
267  end subroutine
-
268 
-
269 ! ------------------------------------------------------------------------------
-
270  module subroutine eigen_gen(a, b, alpha, beta, vecs, work, olwork, err)
-
271  ! Arguments
-
272  real(real64), intent(inout), dimension(:,:) :: a, b
-
273  complex(real64), intent(out), dimension(:) :: alpha
-
274  real(real64), intent(out), optional, dimension(:) :: beta
-
275  complex(real64), intent(out), optional, dimension(:,:) :: vecs
-
276  real(real64), intent(out), optional, pointer, dimension(:) :: work
-
277  integer(int32), intent(out), optional :: olwork
-
278  class(errors), intent(inout), optional, target :: err
-
279 
-
280  ! Parameters
-
281  real(real64), parameter :: zero = 0.0d0
-
282  real(real64), parameter :: two = 2.0d0
-
283 
-
284  ! Local Variables
-
285  character :: jobvl, jobvr
-
286  integer(int32) :: i, j, jp1, n, n1, n2a, n2b, n3a, n3b, n4a, n4b, &
-
287  istat, flag, lwork, lwork1
-
288  real(real64), dimension(1) :: temp
-
289  real(real64), dimension(1,1) :: dummy
-
290  real(real64), pointer, dimension(:) :: wptr, w, alphar, alphai, bptr
-
291  real(real64), pointer, dimension(:,:) :: vr
-
292  real(real64), allocatable, target, dimension(:) :: wrk
-
293  real(real64) :: eps
-
294  class(errors), pointer :: errmgr
-
295  type(errors), target :: deferr
-
296  character(len = 128) :: errmsg
-
297 
-
298  ! Initialization
-
299  jobvl = 'N'
-
300  jobvr = 'N'
-
301  if (present(vecs)) then
-
302  jobvr = 'V'
-
303  else
-
304  jobvr = 'N'
-
305  end if
-
306  n = size(a, 1)
-
307  eps = two * epsilon(eps)
-
308  if (present(err)) then
-
309  errmgr => err
-
310  else
-
311  errmgr => deferr
-
312  end if
-
313 
-
314  ! Input Check
-
315  flag = 0
-
316  if (size(a, 2) /= n) then
-
317  flag = 1
-
318  else if (size(b, 1) /= n .or. size(b, 2) /= n) then
-
319  flag = 2
-
320  else if (size(alpha) /= n) then
-
321  flag = 3
-
322  else if (present(beta)) then
-
323  if (size(beta) /= n) flag = 4
-
324  else if (present(vecs)) then
-
325  if (size(vecs, 1) /= n .or. size(vecs, 2) /= n) flag = 5
-
326  end if
-
327  if (flag /= 0) then
-
328  ! ERROR: One of the input arrays is not sized correctly
-
329  write(errmsg, '(AI0A)') "Input number ", flag, &
-
330  " is not sized correctly."
-
331  call errmgr%report_error("eigen_gen", trim(errmsg), &
-
332  la_array_size_error)
-
333  return
-
334  end if
-
335 
-
336  ! Workspace Query
-
337  call dggev(jobvl, jobvr, n, a, n, b, n, temp, temp, temp, dummy, n, &
-
338  dummy, n, temp, -1, flag)
-
339  lwork1 = int(temp(1), int32)
-
340  lwork = lwork1 + 2 * n
-
341  if (.not.present(beta)) then
-
342  lwork = lwork + n
-
343  end if
-
344  if (present(vecs)) then
-
345  lwork = lwork + n * n
-
346  end if
-
347  if (present(olwork)) then
-
348  olwork = lwork
-
349  return
-
350  end if
-
351 
-
352  ! Local Memory Allocation
-
353  if (present(work)) then
-
354  if (size(work) < lwork) then
-
355  ! ERROR: WORK not sized correctly
-
356  call errmgr%report_error("eigen_gen", &
-
357  "Incorrectly sized input array WORK, argument 5.", &
-
358  la_array_size_error)
-
359  return
-
360  end if
-
361  wptr => work(1:lwork)
-
362  else
-
363  allocate(wrk(lwork), stat = istat)
-
364  if (istat /= 0) then
-
365  ! ERROR: Out of memory
-
366  call errmgr%report_error("eigen_gen", &
-
367  "Insufficient memory available.", &
-
368  la_out_of_memory_error)
-
369  return
-
370  end if
-
371  wptr => wrk
-
372  end if
-
373 
-
374  ! Locate each array within the workspace array & assign pointers
-
375  n1 = n
-
376  n2a = n1 + 1
-
377  n2b = n2a + n - 1
-
378  n3a = n2b + 1
-
379  n3b = n3a + lwork1 - 1
-
380  n4b = n3b
-
381  alphar => wptr(1:n1)
-
382  alphai => wptr(n2a:n2b)
-
383  w => wptr(n3a:n3b)
-
384  if (.not.present(beta)) then
-
385  n4a = n3b + 1
-
386  n4b = n4a + n - 1
-
387  bptr => wptr(n4a:n4b)
-
388  end if
-
389 
-
390  ! Process
-
391  if (present(vecs)) then
-
392  ! Assign a pointer to the eigenvector matrix
-
393  vr(1:n,1:n) => wptr(n4b+1:lwork)
-
394 
-
395  ! Compute the eigenvalues and eigenvectors
-
396  if (present(beta)) then
-
397  call dggev(jobvl, jobvr, n, a, n, b, n, alphar, alphai, &
-
398  beta, dummy, n, vr, n, w, lwork1, flag)
-
399  else
-
400  call dggev(jobvl, jobvr, n, a, n, b, n, alphar, alphai, &
-
401  bptr, dummy, n, vr, n, w, lwork1, flag)
-
402  end if
-
403 
-
404  ! Check for convergence
-
405  if (flag > 0) then
-
406  call errmgr%report_error("eigen_gen", &
-
407  "The algorithm failed to converge.", la_convergence_error)
-
408  return
-
409  end if
-
410 
-
411  ! Store the eigenvalues and eigenvectors
-
412  j = 1
-
413  do while (j <= n)
-
414  if (abs(alphai(j)) < eps) then
-
415  ! Real-Valued
-
416  alpha(j) = cmplx(alphar(j), zero, real64)
-
417  do i = 1, n
-
418  vecs(i,j) = cmplx(vr(i,j), zero, real64)
-
419  end do
-
420  else
-
421  ! Complex-Valued
-
422  jp1 = j + 1
-
423  alpha(j) = cmplx(alphar(j), alphai(j), real64)
-
424  alpha(jp1) = cmplx(alphar(jp1), alphai(jp1), real64)
-
425  do i = 1, n
-
426  vecs(i,j) = cmplx(vr(i,j), vr(i,jp1), real64)
-
427  vecs(i,jp1) = conjg(vecs(i,j))
-
428  end do
-
429 
-
430  ! Increment j and continue
-
431  j = j + 2
-
432  cycle
-
433  end if
-
434 
-
435  ! Increment j
-
436  j = j + 1
-
437  end do
-
438  if (.not.present(beta)) alpha = alpha / bptr
-
439  else
-
440  ! Compute just the eigenvalues
-
441  if (present(beta)) then
-
442  call dggev(jobvl, jobvr, n, a, n, b, n, alphar, alphai, &
-
443  beta, dummy, n, dummy, n, w, lwork1, flag)
-
444  else
-
445  call dggev(jobvl, jobvr, n, a, n, b, n, alphar, alphai, &
-
446  bptr, dummy, n, dummy, n, w, lwork1, flag)
-
447  end if
-
448 
-
449  ! Check for convergence
-
450  if (flag > 0) then
-
451  call errmgr%report_error("eigen_gen", &
-
452  "The algorithm failed to converge.", la_convergence_error)
-
453  return
-
454  end if
-
455 
-
456  ! Store the eigenvalues
-
457  do i = 1, n
-
458  alpha(i) = cmplx(alphar(i), alphai(i), real64)
-
459  end do
-
460  if (.not.present(beta)) alpha = alpha / bptr
-
461  end if
-
462  end subroutine
-
463 
-
464 ! ------------------------------------------------------------------------------
-
465  module subroutine eigen_cmplx(a, vals, vecs, work, olwork, rwork, err)
-
466  ! Arguments
-
467  complex(real64), intent(inout), dimension(:,:) :: a
-
468  complex(real64), intent(out), dimension(:) :: vals
-
469  complex(real64), intent(out), optional, dimension(:,:) :: vecs
-
470  complex(real64), intent(out), target, optional, dimension(:) :: work
-
471  real(real64), intent(out), target, optional, dimension(:) :: rwork
-
472  integer(int32), intent(out), optional :: olwork
-
473  class(errors), intent(inout), optional, target :: err
-
474 
-
475  ! Local Variables
-
476  character :: jobvl, jobvr
-
477  character(len = 128) :: errmsg
-
478  integer(int32) :: n, flag, lwork, lrwork
-
479  real(real64) :: rdummy(1)
-
480  complex(real64) :: temp(1), dummy(1), dummy_mtx(1,1)
-
481  complex(real64), allocatable, target, dimension(:) :: wrk
-
482  complex(real64), pointer, dimension(:) :: wptr
-
483  real(real64), allocatable, target, dimension(:) :: rwrk
-
484  real(real64), pointer, dimension(:) :: rwptr
-
485  class(errors), pointer :: errmgr
-
486  type(errors), target :: deferr
-
487 
-
488  ! Initialization
-
489  if (present(err)) then
-
490  errmgr => err
-
491  else
-
492  errmgr => deferr
-
493  end if
-
494  jobvl = 'N'
-
495  if (present(vecs)) then
-
496  jobvr = 'V'
-
497  else
-
498  jobvr = 'N'
-
499  end if
-
500  n = size(a, 1)
-
501  lrwork = 2 * n
-
502 
-
503  ! Input Check
-
504  flag = 0
-
505  if (size(a, 2) /= n) then
-
506  flag = 1
-
507  else if (size(vals) /= n) then
-
508  flag = 2
-
509  else if (present(vecs)) then
-
510  if (size(vecs, 1) /= n .or. size(vecs, 2) /= n) then
-
511  flag = 3
-
512  end if
-
513  end if
-
514  if (flag /= 0) then
-
515  ! ERROR: One of the input arrays is not sized correctly
-
516  write(errmsg, '(AI0A)') "Input number ", flag, &
-
517  " is not sized correctly."
-
518  call errmgr%report_error("eigen_cmplx", trim(errmsg), &
-
519  la_array_size_error)
-
520  return
-
521  end if
-
522 
-
523  ! Workspace Query
-
524  call zgeev(jobvl, jobvr, n, a, n, dummy, dummy_mtx, n, dummy_mtx, n, temp, &
-
525  -1, rdummy, flag)
-
526  lwork = int(temp(1), int32)
-
527  if (present(olwork)) then
-
528  olwork = lwork
-
529  return
-
530  end if
-
531 
-
532  ! Local Memory Allocation
-
533  if (present(work)) then
-
534  if (size(work) < lwork) then
-
535  ! ERROR: WORK not sized correctly
-
536  call errmgr%report_error("eigen_cmplx", &
-
537  "Incorrectly sized input array WORK.", &
-
538  la_array_size_error)
-
539  return
-
540  end if
-
541  wptr => work
-
542  else
-
543  allocate(wrk(lwork), stat = flag)
-
544  if (flag /= 0) then
-
545  ! ERROR: Out of memory
-
546  call errmgr%report_error("eigen_cmplx", &
-
547  "Insufficient memory available.", &
-
548  la_out_of_memory_error)
-
549  return
-
550  end if
-
551  wptr => wrk
-
552  end if
-
553 
-
554  if (present(rwork)) then
-
555  if (size(work) < lrwork) then
-
556  ! ERROR: RWORK not sized correctly
-
557  call errmgr%report_error("eigen_cmplx", &
-
558  "Incorrectly sized input array RWORK.", &
-
559  la_array_size_error)
-
560  return
-
561  end if
-
562  rwptr => rwork
-
563  else
-
564  allocate(rwrk(lrwork), stat = flag)
-
565  if (flag /= 0) then
-
566  ! ERROR: Out of memory
-
567  call errmgr%report_error("eigen_cmplx", &
-
568  "Insufficient memory available.", &
-
569  la_out_of_memory_error)
-
570  return
-
571  end if
-
572  rwptr => rwrk
-
573  end if
-
574 
-
575  ! Process
-
576  if (present(vecs)) then
-
577  call zgeev(jobvl, jobvr, n, a, n, vals, dummy_mtx, n, vecs, n, &
-
578  wptr, lwork, rwptr, flag)
-
579  else
-
580  call zgeev(jobvl, jobvr, n, a, n, vals, dummy_mtx, n, dummy_mtx, n, &
-
581  wptr, lwork, rwptr, flag)
-
582  end if
-
583 
-
584  if (flag > 0) then
-
585  call errmgr%report_error("eigen_cmplx", &
-
586  "The algorithm failed to converge.", &
-
587  la_convergence_error)
-
588  return
-
589  end if
-
590  end subroutine
-
591 
-
592 ! ------------------------------------------------------------------------------
-
593 end submodule
+
1! linalg_eigen.f90
+
2
+
7submodule(linalg_core) linalg_eigen
+
8contains
+
9! ------------------------------------------------------------------------------
+
10 module subroutine eigen_symm(vecs, a, vals, work, olwork, err)
+
11 ! Arguments
+
12 logical, intent(in) :: vecs
+
13 real(real64), intent(inout), dimension(:,:) :: a
+
14 real(real64), intent(out), dimension(:) :: vals
+
15 real(real64), intent(out), pointer, optional, dimension(:) :: work
+
16 integer(int32), intent(out), optional :: olwork
+
17 class(errors), intent(inout), optional, target :: err
+
18
+
19 ! Local Variables
+
20 character :: jobz
+
21 integer(int32) :: n, istat, flag, lwork
+
22 real(real64), pointer, dimension(:) :: wptr
+
23 real(real64), allocatable, target, dimension(:) :: wrk
+
24 real(real64), dimension(1) :: temp
+
25 class(errors), pointer :: errmgr
+
26 type(errors), target :: deferr
+
27 character(len = 128) :: errmsg
+
28
+
29 ! Initialization
+
30 n = size(a, 1)
+
31 if (vecs) then
+
32 jobz = 'V'
+
33 else
+
34 jobz = 'N'
+
35 end if
+
36 if (present(err)) then
+
37 errmgr => err
+
38 else
+
39 errmgr => deferr
+
40 end if
+
41
+
42 ! Input Check
+
43 flag = 0
+
44 if (size(a, 2) /= n) then
+
45 flag = 2
+
46 else if (size(vals) /= n) then
+
47 flag = 3
+
48 end if
+
49 if (flag /= 0) then
+
50 ! ERROR: One of the input arrays is not sized correctly
+
51 write(errmsg, '(AI0A)') "Input number ", flag, &
+
52 " is not sized correctly."
+
53 call errmgr%report_error("eigen_symm", trim(errmsg), &
+
54 la_array_size_error)
+
55 return
+
56 end if
+
57
+
58 ! Workspace Query
+
59 call dsyev(jobz, 'L', n, a, n, vals, temp, -1, flag)
+
60 lwork = int(temp(1), int32)
+
61 if (present(olwork)) then
+
62 olwork = lwork
+
63 return
+
64 end if
+
65
+
66 ! Local Memory Allocation
+
67 if (present(work)) then
+
68 if (size(work) < lwork) then
+
69 ! ERROR: WORK not sized correctly
+
70 call errmgr%report_error("eigen_symm", &
+
71 "Incorrectly sized input array WORK, argument 5.", &
+
72 la_array_size_error)
+
73 return
+
74 end if
+
75 wptr => work(1:lwork)
+
76 else
+
77 allocate(wrk(lwork), stat = istat)
+
78 if (istat /= 0) then
+
79 ! ERROR: Out of memory
+
80 call errmgr%report_error("eigen_symm", &
+
81 "Insufficient memory available.", &
+
82 la_out_of_memory_error)
+
83 return
+
84 end if
+
85 wptr => wrk
+
86 end if
+
87
+
88 ! Process
+
89 call dsyev(jobz, 'L', n, a, n, vals, wptr, lwork, flag)
+
90 if (flag > 0) then
+
91 call errmgr%report_error("eigen_symm", &
+
92 "The algorithm failed to converge.", la_convergence_error)
+
93 end if
+
94 end subroutine
+
95
+
96! ------------------------------------------------------------------------------
+
97 module subroutine eigen_asymm(a, vals, vecs, work, olwork, err)
+
98 ! Arguments
+
99 real(real64), intent(inout), dimension(:,:) :: a
+
100 complex(real64), intent(out), dimension(:) :: vals
+
101 complex(real64), intent(out), optional, dimension(:,:) :: vecs
+
102 real(real64), intent(out), pointer, optional, dimension(:) :: work
+
103 integer(int32), intent(out), optional :: olwork
+
104 class(errors), intent(inout), optional, target :: err
+
105
+
106 ! Parameters
+
107 real(real64), parameter :: zero = 0.0d0
+
108 real(real64), parameter :: two = 2.0d0
+
109
+
110 ! Local Variables
+
111 character :: jobvl, jobvr
+
112 integer(int32) :: i, j, jp1, n, n1, n2a, n2b, n3a, n3b, istat, flag, &
+
113 lwork, lwork1
+
114 real(real64) :: eps
+
115 real(real64), dimension(1) :: dummy, temp
+
116 real(real64), dimension(1,1) :: dummy_mtx
+
117 real(real64), pointer, dimension(:) :: wr, wi, wptr, w
+
118 real(real64), pointer, dimension(:,:) :: vr
+
119 real(real64), allocatable, target, dimension(:) :: wrk
+
120 class(errors), pointer :: errmgr
+
121 type(errors), target :: deferr
+
122 character(len = 128) :: errmsg
+
123
+
124 ! Initialization
+
125 jobvl = 'N'
+
126 if (present(vecs)) then
+
127 jobvr = 'V'
+
128 else
+
129 jobvr = 'N'
+
130 end if
+
131 n = size(a, 1)
+
132 eps = two * epsilon(eps)
+
133 if (present(err)) then
+
134 errmgr => err
+
135 else
+
136 errmgr => deferr
+
137 end if
+
138
+
139 ! Input Check
+
140 flag = 0
+
141 if (size(a, 2) /= n) then
+
142 flag = 1
+
143 else if (size(vals) /= n) then
+
144 flag = 2
+
145 else if (present(vecs)) then
+
146 if (size(vecs, 1) /= n .or. size(vecs, 2) /= n) then
+
147 flag = 3
+
148 end if
+
149 end if
+
150 if (flag /= 0) then
+
151 ! ERROR: One of the input arrays is not sized correctly
+
152 write(errmsg, '(AI0A)') "Input number ", flag, &
+
153 " is not sized correctly."
+
154 call errmgr%report_error("eigen_asymm", trim(errmsg), &
+
155 la_array_size_error)
+
156 return
+
157 end if
+
158
+
159 ! Workspace Query
+
160 call dgeev(jobvl, jobvr, n, a, n, dummy, dummy, dummy_mtx, n, &
+
161 dummy_mtx, n, temp, -1, flag)
+
162 lwork1 = int(temp(1), int32)
+
163 if (present(vecs)) then
+
164 lwork = lwork1 + 2 * n + n * n
+
165 else
+
166 lwork = lwork1 + 2 * n
+
167 end if
+
168 if (present(olwork)) then
+
169 olwork = lwork
+
170 return
+
171 end if
+
172
+
173 ! Local Memory Allocation
+
174 if (present(work)) then
+
175 if (size(work) < lwork) then
+
176 ! ERROR: WORK not sized correctly
+
177 call errmgr%report_error("eigen_asymm", &
+
178 "Incorrectly sized input array WORK, argument 5.", &
+
179 la_array_size_error)
+
180 return
+
181 end if
+
182 wptr => work(1:lwork)
+
183 else
+
184 allocate(wrk(lwork), stat = istat)
+
185 if (istat /= 0) then
+
186 ! ERROR: Out of memory
+
187 call errmgr%report_error("eigen_asymm", &
+
188 "Insufficient memory available.", &
+
189 la_out_of_memory_error)
+
190 return
+
191 end if
+
192 wptr => wrk
+
193 end if
+
194
+
195 ! Locate each array within the workspace array
+
196 n1 = n
+
197 n2a = n1 + 1
+
198 n2b = n2a + n - 1
+
199 n3a = n2b + 1
+
200 n3b = n3a + lwork1 - 1
+
201
+
202 ! Assign pointers
+
203 wr => wptr(1:n1)
+
204 wi => wptr(n2a:n2b)
+
205 w => wptr(n3a:n3b)
+
206
+
207 ! Process
+
208 if (present(vecs)) then
+
209 ! Assign a pointer to the eigenvector matrix
+
210 vr(1:n,1:n) => wptr(n3b+1:lwork)
+
211
+
212 ! Compute the eigenvectors and eigenvalues
+
213 call dgeev(jobvl, jobvr, n, a, n, wr, wi, dummy_mtx, n, vr, n, &
+
214 w, lwork1, flag)
+
215
+
216 ! Check for convergence
+
217 if (flag > 0) then
+
218 call errmgr%report_error("eigen_asymm", &
+
219 "The algorithm failed to converge.", la_convergence_error)
+
220 return
+
221 end if
+
222
+
223 ! Store the eigenvalues and eigenvectors
+
224 j = 1
+
225 do while (j <= n)
+
226 if (abs(wi(j)) < eps) then
+
227 ! We've got a real-valued eigenvalue
+
228 vals(j) = cmplx(wr(j), zero, real64)
+
229 do i = 1, n
+
230 vecs(i,j) = cmplx(vr(i,j), zero, real64)
+
231 end do
+
232 else
+
233 ! We've got a complex cojugate pair of eigenvalues
+
234 jp1 = j + 1
+
235 vals(j) = cmplx(wr(j), wi(j), real64)
+
236 vals(jp1) = conjg(vals(j))
+
237 do i = 1, n
+
238 vecs(i,j) = cmplx(vr(i,j), vr(i,jp1), real64)
+
239 vecs(i,jp1) = conjg(vecs(i,j))
+
240 end do
+
241
+
242 ! Increment j and continue the loop
+
243 j = j + 2
+
244 cycle
+
245 end if
+
246
+
247 ! Increment j
+
248 j = j + 1
+
249 end do
+
250 else
+
251 ! Compute just the eigenvalues
+
252 call dgeev(jobvl, jobvr, n, a, n, wr, wi, dummy_mtx, n, &
+
253 dummy_mtx, n, w, lwork1, flag)
+
254
+
255 ! Check for convergence
+
256 if (flag > 0) then
+
257 call errmgr%report_error("eigen_asymm", &
+
258 "The algorithm failed to converge.", la_convergence_error)
+
259 return
+
260 end if
+
261
+
262 ! Store the eigenvalues
+
263 do i = 1, n
+
264 vals(i) = cmplx(wr(i), wi(i), real64)
+
265 end do
+
266 end if
+
267 end subroutine
+
268
+
269! ------------------------------------------------------------------------------
+
270 module subroutine eigen_gen(a, b, alpha, beta, vecs, work, olwork, err)
+
271 ! Arguments
+
272 real(real64), intent(inout), dimension(:,:) :: a, b
+
273 complex(real64), intent(out), dimension(:) :: alpha
+
274 real(real64), intent(out), optional, dimension(:) :: beta
+
275 complex(real64), intent(out), optional, dimension(:,:) :: vecs
+
276 real(real64), intent(out), optional, pointer, dimension(:) :: work
+
277 integer(int32), intent(out), optional :: olwork
+
278 class(errors), intent(inout), optional, target :: err
+
279
+
280 ! Parameters
+
281 real(real64), parameter :: zero = 0.0d0
+
282 real(real64), parameter :: two = 2.0d0
+
283
+
284 ! Local Variables
+
285 character :: jobvl, jobvr
+
286 integer(int32) :: i, j, jp1, n, n1, n2a, n2b, n3a, n3b, n4a, n4b, &
+
287 istat, flag, lwork, lwork1
+
288 real(real64), dimension(1) :: temp
+
289 real(real64), dimension(1,1) :: dummy
+
290 real(real64), pointer, dimension(:) :: wptr, w, alphar, alphai, bptr
+
291 real(real64), pointer, dimension(:,:) :: vr
+
292 real(real64), allocatable, target, dimension(:) :: wrk
+
293 real(real64) :: eps
+
294 class(errors), pointer :: errmgr
+
295 type(errors), target :: deferr
+
296 character(len = 128) :: errmsg
+
297
+
298 ! Initialization
+
299 jobvl = 'N'
+
300 jobvr = 'N'
+
301 if (present(vecs)) then
+
302 jobvr = 'V'
+
303 else
+
304 jobvr = 'N'
+
305 end if
+
306 n = size(a, 1)
+
307 eps = two * epsilon(eps)
+
308 if (present(err)) then
+
309 errmgr => err
+
310 else
+
311 errmgr => deferr
+
312 end if
+
313
+
314 ! Input Check
+
315 flag = 0
+
316 if (size(a, 2) /= n) then
+
317 flag = 1
+
318 else if (size(b, 1) /= n .or. size(b, 2) /= n) then
+
319 flag = 2
+
320 else if (size(alpha) /= n) then
+
321 flag = 3
+
322 else if (present(beta)) then
+
323 if (size(beta) /= n) flag = 4
+
324 else if (present(vecs)) then
+
325 if (size(vecs, 1) /= n .or. size(vecs, 2) /= n) flag = 5
+
326 end if
+
327 if (flag /= 0) then
+
328 ! ERROR: One of the input arrays is not sized correctly
+
329 write(errmsg, '(AI0A)') "Input number ", flag, &
+
330 " is not sized correctly."
+
331 call errmgr%report_error("eigen_gen", trim(errmsg), &
+
332 la_array_size_error)
+
333 return
+
334 end if
+
335
+
336 ! Workspace Query
+
337 call dggev(jobvl, jobvr, n, a, n, b, n, temp, temp, temp, dummy, n, &
+
338 dummy, n, temp, -1, flag)
+
339 lwork1 = int(temp(1), int32)
+
340 lwork = lwork1 + 2 * n
+
341 if (.not.present(beta)) then
+
342 lwork = lwork + n
+
343 end if
+
344 if (present(vecs)) then
+
345 lwork = lwork + n * n
+
346 end if
+
347 if (present(olwork)) then
+
348 olwork = lwork
+
349 return
+
350 end if
+
351
+
352 ! Local Memory Allocation
+
353 if (present(work)) then
+
354 if (size(work) < lwork) then
+
355 ! ERROR: WORK not sized correctly
+
356 call errmgr%report_error("eigen_gen", &
+
357 "Incorrectly sized input array WORK, argument 5.", &
+
358 la_array_size_error)
+
359 return
+
360 end if
+
361 wptr => work(1:lwork)
+
362 else
+
363 allocate(wrk(lwork), stat = istat)
+
364 if (istat /= 0) then
+
365 ! ERROR: Out of memory
+
366 call errmgr%report_error("eigen_gen", &
+
367 "Insufficient memory available.", &
+
368 la_out_of_memory_error)
+
369 return
+
370 end if
+
371 wptr => wrk
+
372 end if
+
373
+
374 ! Locate each array within the workspace array & assign pointers
+
375 n1 = n
+
376 n2a = n1 + 1
+
377 n2b = n2a + n - 1
+
378 n3a = n2b + 1
+
379 n3b = n3a + lwork1 - 1
+
380 n4b = n3b
+
381 alphar => wptr(1:n1)
+
382 alphai => wptr(n2a:n2b)
+
383 w => wptr(n3a:n3b)
+
384 if (.not.present(beta)) then
+
385 n4a = n3b + 1
+
386 n4b = n4a + n - 1
+
387 bptr => wptr(n4a:n4b)
+
388 end if
+
389
+
390 ! Process
+
391 if (present(vecs)) then
+
392 ! Assign a pointer to the eigenvector matrix
+
393 vr(1:n,1:n) => wptr(n4b+1:lwork)
+
394
+
395 ! Compute the eigenvalues and eigenvectors
+
396 if (present(beta)) then
+
397 call dggev(jobvl, jobvr, n, a, n, b, n, alphar, alphai, &
+
398 beta, dummy, n, vr, n, w, lwork1, flag)
+
399 else
+
400 call dggev(jobvl, jobvr, n, a, n, b, n, alphar, alphai, &
+
401 bptr, dummy, n, vr, n, w, lwork1, flag)
+
402 end if
+
403
+
404 ! Check for convergence
+
405 if (flag > 0) then
+
406 call errmgr%report_error("eigen_gen", &
+
407 "The algorithm failed to converge.", la_convergence_error)
+
408 return
+
409 end if
+
410
+
411 ! Store the eigenvalues and eigenvectors
+
412 j = 1
+
413 do while (j <= n)
+
414 if (abs(alphai(j)) < eps) then
+
415 ! Real-Valued
+
416 alpha(j) = cmplx(alphar(j), zero, real64)
+
417 do i = 1, n
+
418 vecs(i,j) = cmplx(vr(i,j), zero, real64)
+
419 end do
+
420 else
+
421 ! Complex-Valued
+
422 jp1 = j + 1
+
423 alpha(j) = cmplx(alphar(j), alphai(j), real64)
+
424 alpha(jp1) = cmplx(alphar(jp1), alphai(jp1), real64)
+
425 do i = 1, n
+
426 vecs(i,j) = cmplx(vr(i,j), vr(i,jp1), real64)
+
427 vecs(i,jp1) = conjg(vecs(i,j))
+
428 end do
+
429
+
430 ! Increment j and continue
+
431 j = j + 2
+
432 cycle
+
433 end if
+
434
+
435 ! Increment j
+
436 j = j + 1
+
437 end do
+
438 if (.not.present(beta)) alpha = alpha / bptr
+
439 else
+
440 ! Compute just the eigenvalues
+
441 if (present(beta)) then
+
442 call dggev(jobvl, jobvr, n, a, n, b, n, alphar, alphai, &
+
443 beta, dummy, n, dummy, n, w, lwork1, flag)
+
444 else
+
445 call dggev(jobvl, jobvr, n, a, n, b, n, alphar, alphai, &
+
446 bptr, dummy, n, dummy, n, w, lwork1, flag)
+
447 end if
+
448
+
449 ! Check for convergence
+
450 if (flag > 0) then
+
451 call errmgr%report_error("eigen_gen", &
+
452 "The algorithm failed to converge.", la_convergence_error)
+
453 return
+
454 end if
+
455
+
456 ! Store the eigenvalues
+
457 do i = 1, n
+
458 alpha(i) = cmplx(alphar(i), alphai(i), real64)
+
459 end do
+
460 if (.not.present(beta)) alpha = alpha / bptr
+
461 end if
+
462 end subroutine
+
463
+
464! ------------------------------------------------------------------------------
+
465 module subroutine eigen_cmplx(a, vals, vecs, work, olwork, rwork, err)
+
466 ! Arguments
+
467 complex(real64), intent(inout), dimension(:,:) :: a
+
468 complex(real64), intent(out), dimension(:) :: vals
+
469 complex(real64), intent(out), optional, dimension(:,:) :: vecs
+
470 complex(real64), intent(out), target, optional, dimension(:) :: work
+
471 real(real64), intent(out), target, optional, dimension(:) :: rwork
+
472 integer(int32), intent(out), optional :: olwork
+
473 class(errors), intent(inout), optional, target :: err
+
474
+
475 ! Local Variables
+
476 character :: jobvl, jobvr
+
477 character(len = 128) :: errmsg
+
478 integer(int32) :: n, flag, lwork, lrwork
+
479 real(real64) :: rdummy(1)
+
480 complex(real64) :: temp(1), dummy(1), dummy_mtx(1,1)
+
481 complex(real64), allocatable, target, dimension(:) :: wrk
+
482 complex(real64), pointer, dimension(:) :: wptr
+
483 real(real64), allocatable, target, dimension(:) :: rwrk
+
484 real(real64), pointer, dimension(:) :: rwptr
+
485 class(errors), pointer :: errmgr
+
486 type(errors), target :: deferr
+
487
+
488 ! Initialization
+
489 if (present(err)) then
+
490 errmgr => err
+
491 else
+
492 errmgr => deferr
+
493 end if
+
494 jobvl = 'N'
+
495 if (present(vecs)) then
+
496 jobvr = 'V'
+
497 else
+
498 jobvr = 'N'
+
499 end if
+
500 n = size(a, 1)
+
501 lrwork = 2 * n
+
502
+
503 ! Input Check
+
504 flag = 0
+
505 if (size(a, 2) /= n) then
+
506 flag = 1
+
507 else if (size(vals) /= n) then
+
508 flag = 2
+
509 else if (present(vecs)) then
+
510 if (size(vecs, 1) /= n .or. size(vecs, 2) /= n) then
+
511 flag = 3
+
512 end if
+
513 end if
+
514 if (flag /= 0) then
+
515 ! ERROR: One of the input arrays is not sized correctly
+
516 write(errmsg, '(AI0A)') "Input number ", flag, &
+
517 " is not sized correctly."
+
518 call errmgr%report_error("eigen_cmplx", trim(errmsg), &
+
519 la_array_size_error)
+
520 return
+
521 end if
+
522
+
523 ! Workspace Query
+
524 call zgeev(jobvl, jobvr, n, a, n, dummy, dummy_mtx, n, dummy_mtx, n, temp, &
+
525 -1, rdummy, flag)
+
526 lwork = int(temp(1), int32)
+
527 if (present(olwork)) then
+
528 olwork = lwork
+
529 return
+
530 end if
+
531
+
532 ! Local Memory Allocation
+
533 if (present(work)) then
+
534 if (size(work) < lwork) then
+
535 ! ERROR: WORK not sized correctly
+
536 call errmgr%report_error("eigen_cmplx", &
+
537 "Incorrectly sized input array WORK.", &
+
538 la_array_size_error)
+
539 return
+
540 end if
+
541 wptr => work
+
542 else
+
543 allocate(wrk(lwork), stat = flag)
+
544 if (flag /= 0) then
+
545 ! ERROR: Out of memory
+
546 call errmgr%report_error("eigen_cmplx", &
+
547 "Insufficient memory available.", &
+
548 la_out_of_memory_error)
+
549 return
+
550 end if
+
551 wptr => wrk
+
552 end if
+
553
+
554 if (present(rwork)) then
+
555 if (size(work) < lrwork) then
+
556 ! ERROR: RWORK not sized correctly
+
557 call errmgr%report_error("eigen_cmplx", &
+
558 "Incorrectly sized input array RWORK.", &
+
559 la_array_size_error)
+
560 return
+
561 end if
+
562 rwptr => rwork
+
563 else
+
564 allocate(rwrk(lrwork), stat = flag)
+
565 if (flag /= 0) then
+
566 ! ERROR: Out of memory
+
567 call errmgr%report_error("eigen_cmplx", &
+
568 "Insufficient memory available.", &
+
569 la_out_of_memory_error)
+
570 return
+
571 end if
+
572 rwptr => rwrk
+
573 end if
+
574
+
575 ! Process
+
576 if (present(vecs)) then
+
577 call zgeev(jobvl, jobvr, n, a, n, vals, dummy_mtx, n, vecs, n, &
+
578 wptr, lwork, rwptr, flag)
+
579 else
+
580 call zgeev(jobvl, jobvr, n, a, n, vals, dummy_mtx, n, dummy_mtx, n, &
+
581 wptr, lwork, rwptr, flag)
+
582 end if
+
583
+
584 if (flag > 0) then
+
585 call errmgr%report_error("eigen_cmplx", &
+
586 "The algorithm failed to converge.", &
+
587 la_convergence_error)
+
588 return
+
589 end if
+
590 end subroutine
+
591
+
592! ------------------------------------------------------------------------------
+
593end submodule
+
Provides a set of common linear algebra routines.
Definition: linalg_core.f90:15
-
Provides a set of common linear algebra routines.
Definition: linalg_core.f90:15
diff --git a/doc/html/linalg__factor_8f90_source.html b/doc/html/linalg__factor_8f90_source.html index 916928ef..efc07787 100644 --- a/doc/html/linalg__factor_8f90_source.html +++ b/doc/html/linalg__factor_8f90_source.html @@ -1,11 +1,11 @@ - + - - + + -linalg: C:/Users/jchri/Documents/github/linalg/src/linalg_factor.f90 Source File +linalg: D:/Code/linalg/src/linalg_factor.f90 Source File @@ -13,13 +13,16 @@ - + + @@ -27,10 +30,9 @@
- - + @@ -39,21 +41,22 @@
-
linalg -  1.6.0 +
+
linalg 1.6.1
A linear algebra library that provides a user-friendly interface to several BLAS and LAPACK routines.
- + +/* @license-end */ +
@@ -67,8 +70,8 @@
@@ -81,2787 +84,2791 @@
- +
+
+
+
+
Loading...
+
Searching...
+
No Matches
+
+
+
-
-
linalg_factor.f90
+
linalg_factor.f90
-
1 ! linalg_factor.f90
-
2 
-
7 submodule(linalg_core) linalg_factor
-
8 contains
-
9 ! ******************************************************************************
-
10 ! LU FACTORIZATION
-
11 ! ------------------------------------------------------------------------------
-
12  module subroutine lu_factor_dbl(a, ipvt, err)
-
13  ! Arguments
-
14  real(real64), intent(inout), dimension(:,:) :: a
-
15  integer(int32), intent(out), dimension(:) :: ipvt
-
16  class(errors), intent(inout), optional, target :: err
-
17 
-
18  ! Local Variables
-
19  integer(int32) :: m, n, mn, flag
-
20  class(errors), pointer :: errmgr
-
21  type(errors), target :: deferr
-
22  character(len = 128) :: errmsg
-
23 
-
24  ! Initialization
-
25  m = size(a, 1)
-
26  n = size(a, 2)
-
27  mn = min(m, n)
-
28  if (present(err)) then
-
29  errmgr => err
-
30  else
-
31  errmgr => deferr
-
32  end if
-
33 
-
34  ! Input Check
-
35  flag = 0
-
36  if (size(ipvt) /= mn) then
-
37  ! ERROR: IPVT not sized correctly
-
38  call errmgr%report_error("lu_factor_dbl", &
-
39  "Incorrectly sized input array IPVT, argument 2.", &
-
40  la_array_size_error)
-
41  return
-
42  end if
-
43 
-
44  ! Compute the LU factorization by calling the LAPACK routine DGETRF
-
45  call dgetrf(m, n, a, m, ipvt, flag)
-
46 
-
47  ! If flag > 0, the matrix is singular. Notice, flag should not be
-
48  ! able to be < 0 as we've already verrified inputs prior to making the
-
49  ! call to LAPACK
-
50  if (flag > 0) then
-
51  ! WARNING: Singular matrix
-
52  write(errmsg, '(AI0A)') &
-
53  "Singular matrix encountered (row ", flag, ")"
-
54  call errmgr%report_warning("lu_factor_dbl", trim(errmsg), &
-
55  la_singular_matrix_error)
-
56  end if
-
57  end subroutine
-
58 
-
59 ! ------------------------------------------------------------------------------
-
60  module subroutine lu_factor_cmplx(a, ipvt, err)
-
61  ! Arguments
-
62  complex(real64), intent(inout), dimension(:,:) :: a
-
63  integer(int32), intent(out), dimension(:) :: ipvt
-
64  class(errors), intent(inout), optional, target :: err
-
65 
-
66  ! Local Variables
-
67  integer(int32) :: m, n, mn, flag
-
68  class(errors), pointer :: errmgr
-
69  type(errors), target :: deferr
-
70  character(len = 128) :: errmsg
-
71 
-
72  ! Initialization
-
73  m = size(a, 1)
-
74  n = size(a, 2)
-
75  mn = min(m, n)
-
76  if (present(err)) then
-
77  errmgr => err
-
78  else
-
79  errmgr => deferr
-
80  end if
-
81 
-
82  ! Input Check
-
83  flag = 0
-
84  if (size(ipvt) /= mn) then
-
85  ! ERROR: IPVT not sized correctly
-
86  call errmgr%report_error("lu_factor_cmplx", &
-
87  "Incorrectly sized input array IPVT, argument 2.", &
-
88  la_array_size_error)
-
89  return
-
90  end if
-
91 
-
92  ! Compute the LU factorization by calling the LAPACK routine ZGETRF
-
93  call zgetrf(m, n, a, m, ipvt, flag)
-
94 
-
95  ! If flag > 0, the matrix is singular. Notice, flag should not be
-
96  ! able to be < 0 as we've already verrified inputs prior to making the
-
97  ! call to LAPACK
-
98  if (flag > 0) then
-
99  ! WARNING: Singular matrix
-
100  write(errmsg, '(AI0A)') &
-
101  "Singular matrix encountered (row ", flag, ")"
-
102  call errmgr%report_warning("lu_factor_cmplx", trim(errmsg), &
-
103  la_singular_matrix_error)
-
104  end if
-
105  end subroutine
-
106 
-
107 ! ------------------------------------------------------------------------------
-
108  module subroutine form_lu_all(lu, ipvt, u, p, err)
-
109  ! Arguments
-
110  real(real64), intent(inout), dimension(:,:) :: lu
-
111  integer(int32), intent(in), dimension(:) :: ipvt
-
112  real(real64), intent(out), dimension(:,:) :: u, p
-
113  class(errors), intent(inout), optional, target :: err
-
114 
-
115  ! Local Variables
-
116  integer(int32) :: j, jp, n, flag
-
117  class(errors), pointer :: errmgr
-
118  type(errors), target :: deferr
-
119  character(len = 128) :: errmsg
-
120 
-
121  ! Parameters
-
122  real(real64), parameter :: zero = 0.0d0
-
123  real(real64), parameter :: one = 1.0d0
-
124 
-
125  ! Initialization
-
126  n = size(lu, 1)
-
127  if (present(err)) then
-
128  errmgr => err
-
129  else
-
130  errmgr => deferr
-
131  end if
-
132 
-
133  ! Input Check
-
134  flag = 0
-
135  if (size(lu, 2) /= n) then
-
136  flag = 1
-
137  else if (size(ipvt) /= n) then
-
138  flag = 2
-
139  else if (size(u, 1) /= n .or. size(u, 2) /= n) then
-
140  flag = 3
-
141  else if (size(p, 1) /= n .or. size(p, 2) /= n) then
-
142  flag = 4
-
143  end if
-
144  if (flag /= 0) then
-
145  ! One of the input arrays is not sized correctly
-
146  write(errmsg, '(AI0A)') "Input number ", flag, &
-
147  " is not sized correctly."
-
148  call errmgr%report_error("form_lu_all", trim(errmsg), &
-
149  la_array_size_error)
-
150  return
-
151  end if
-
152 
-
153  ! Ensure P starts off as an identity matrix
-
154  call dlaset('A', n, n, zero, one, p, n)
-
155 
-
156  ! Process
-
157  do j = 1, n
-
158  ! Define the pivot matrix
-
159  jp = ipvt(j)
-
160  if (j /= jp) call swap(p(j,1:n), p(jp,1:n))
-
161 
-
162  ! Build L and U
-
163  u(1:j,j) = lu(1:j,j)
-
164  u(j+1:n,j) = zero
-
165 
-
166  if (j > 1) lu(1:j-1,j) = zero
-
167  lu(j,j) = one
-
168  end do
-
169  end subroutine
-
170 
-
171 ! ------------------------------------------------------------------------------
-
172  module subroutine form_lu_all_cmplx(lu, ipvt, u, p, err)
-
173  ! Arguments
-
174  complex(real64), intent(inout), dimension(:,:) :: lu
-
175  integer(int32), intent(in), dimension(:) :: ipvt
-
176  complex(real64), intent(out), dimension(:,:) :: u
-
177  real(real64), intent(out), dimension(:,:) :: p
-
178  class(errors), intent(inout), optional, target :: err
-
179 
-
180  ! Local Variables
-
181  integer(int32) :: j, jp, n, flag
-
182  class(errors), pointer :: errmgr
-
183  type(errors), target :: deferr
-
184  character(len = 128) :: errmsg
-
185 
-
186  ! Parameters
-
187  real(real64), parameter :: zero = 0.0d0
-
188  real(real64), parameter :: one = 1.0d0
-
189  complex(real64), parameter :: c_zero = (0.0d0, 0.0d0)
-
190  complex(real64), parameter :: c_one = (1.0d0, 0.0d0)
-
191 
-
192  ! Initialization
-
193  n = size(lu, 1)
-
194  if (present(err)) then
-
195  errmgr => err
-
196  else
-
197  errmgr => deferr
-
198  end if
-
199 
-
200  ! Input Check
-
201  flag = 0
-
202  if (size(lu, 2) /= n) then
-
203  flag = 1
-
204  else if (size(ipvt) /= n) then
-
205  flag = 2
-
206  else if (size(u, 1) /= n .or. size(u, 2) /= n) then
-
207  flag = 3
-
208  else if (size(p, 1) /= n .or. size(p, 2) /= n) then
-
209  flag = 4
-
210  end if
-
211  if (flag /= 0) then
-
212  ! One of the input arrays is not sized correctly
-
213  write(errmsg, '(AI0A)') "Input number ", flag, &
-
214  " is not sized correctly."
-
215  call errmgr%report_error("form_lu_all_cmplx", trim(errmsg), &
-
216  la_array_size_error)
-
217  return
-
218  end if
-
219 
-
220  ! Ensure P starts off as an identity matrix
-
221  call dlaset('A', n, n, zero, one, p, n)
-
222 
-
223  ! Process
-
224  do j = 1, n
-
225  ! Define the pivot matrix
-
226  jp = ipvt(j)
-
227  if (j /= jp) call swap(p(j,1:n), p(jp,1:n))
-
228 
-
229  ! Build L and U
-
230  u(1:j,j) = lu(1:j,j)
-
231  u(j+1:n,j) = c_zero
-
232 
-
233  if (j > 1) lu(1:j-1,j) = c_zero
-
234  lu(j,j) = c_one
-
235  end do
-
236  end subroutine
-
237 
-
238 ! ------------------------------------------------------------------------------
-
239  module subroutine form_lu_only(lu, u, err)
-
240  ! Arguments
-
241  real(real64), intent(inout), dimension(:,:) :: lu
-
242  real(real64), intent(out), dimension(:,:) :: u
-
243  class(errors), intent(inout), optional, target :: err
-
244 
-
245  ! Local Variables
-
246  integer(int32) :: j, n, flag
-
247  class(errors), pointer :: errmgr
-
248  type(errors), target :: deferr
-
249  character(len = 128) :: errmsg
-
250 
-
251  ! Parameters
-
252  real(real64), parameter :: zero = 0.0d0
-
253  real(real64), parameter :: one = 1.0d0
-
254 
-
255  ! Initialization
-
256  n = size(lu, 1)
-
257  if (present(err)) then
-
258  errmgr => err
-
259  else
-
260  errmgr => deferr
-
261  end if
-
262 
-
263  ! Input Check
-
264  flag = 0
-
265  if (size(lu, 2) /= n) then
-
266  flag = 2
-
267  else if (size(u, 1) /= n .or. size(u, 2) /= n) then
-
268  flag = 3
-
269  end if
-
270  if (flag /= 0) then
-
271  ! One of the input arrays is not sized correctly
-
272  write(errmsg, '(AI0A)') "Input number ", flag, &
-
273  " is not sized correctly."
-
274  call errmgr%report_error("form_lu_only", trim(errmsg), &
-
275  la_array_size_error)
-
276  return
-
277  end if
-
278 
-
279  ! Process
-
280  do j = 1, n
-
281  ! Build L and U
-
282  u(1:j,j) = lu(1:j,j)
-
283  u(j+1:n,j) = zero
-
284 
-
285  if (j > 1) lu(1:j-1,j) = zero
-
286  lu(j,j) = one
-
287  end do
-
288  end subroutine
-
289 
-
290 ! ------------------------------------------------------------------------------
-
291  module subroutine form_lu_only_cmplx(lu, u, err)
-
292  ! Arguments
-
293  complex(real64), intent(inout), dimension(:,:) :: lu
-
294  complex(real64), intent(out), dimension(:,:) :: u
-
295  class(errors), intent(inout), optional, target :: err
-
296 
-
297  ! Local Variables
-
298  integer(int32) :: j, n, flag
-
299  class(errors), pointer :: errmgr
-
300  type(errors), target :: deferr
-
301  character(len = 128) :: errmsg
-
302 
-
303  ! Parameters
-
304  complex(real64), parameter :: zero = (0.0d0, 0.0d0)
-
305  complex(real64), parameter :: one = (1.0d0, 0.0d0)
-
306 
-
307  ! Initialization
-
308  n = size(lu, 1)
-
309  if (present(err)) then
-
310  errmgr => err
-
311  else
-
312  errmgr => deferr
-
313  end if
-
314 
-
315  ! Input Check
-
316  flag = 0
-
317  if (size(lu, 2) /= n) then
-
318  flag = 2
-
319  else if (size(u, 1) /= n .or. size(u, 2) /= n) then
-
320  flag = 3
-
321  end if
-
322  if (flag /= 0) then
-
323  ! One of the input arrays is not sized correctly
-
324  write(errmsg, '(AI0A)') "Input number ", flag, &
-
325  " is not sized correctly."
-
326  call errmgr%report_error("form_lu_only_cmplx", trim(errmsg), &
-
327  la_array_size_error)
-
328  return
-
329  end if
-
330 
-
331  ! Process
-
332  do j = 1, n
-
333  ! Build L and U
-
334  u(1:j,j) = lu(1:j,j)
-
335  u(j+1:n,j) = zero
-
336 
-
337  if (j > 1) lu(1:j-1,j) = zero
-
338  lu(j,j) = one
-
339  end do
-
340  end subroutine
-
341 
-
342 ! ******************************************************************************
-
343 ! QR FACTORIZATION
-
344 ! ------------------------------------------------------------------------------
-
345  module subroutine qr_factor_no_pivot(a, tau, work, olwork, err)
-
346  ! Arguments
-
347  real(real64), intent(inout), dimension(:,:) :: a
-
348  real(real64), intent(out), dimension(:) :: tau
-
349  real(real64), intent(out), target, dimension(:), optional :: work
-
350  integer(int32), intent(out), optional :: olwork
-
351  class(errors), intent(inout), optional, target :: err
-
352 
-
353  ! Local Variables
-
354  integer(int32) :: m, n, mn, istat, lwork, flag
-
355  real(real64), dimension(1) :: temp
-
356  real(real64), pointer, dimension(:) :: wptr
-
357  real(real64), allocatable, target, dimension(:) :: wrk
-
358  class(errors), pointer :: errmgr
-
359  type(errors), target :: deferr
-
360 
-
361  ! Initialization
-
362  m = size(a, 1)
-
363  n = size(a, 2)
-
364  mn = min(m, n)
-
365  if (present(err)) then
-
366  errmgr => err
-
367  else
-
368  errmgr => deferr
-
369  end if
-
370 
-
371  ! Input Check
-
372  if (size(tau) /= mn) then
-
373  ! ERROR: TAU not sized correctly
-
374  call errmgr%report_error("qr_factor_no_pivot", &
-
375  "Incorrectly sized input array TAU, argument 2.", &
-
376  la_array_size_error)
-
377  return
-
378  end if
-
379 
-
380  ! Workspace Query
-
381  call dgeqrf(m, n, a, m, tau, temp, -1, flag)
-
382  lwork = int(temp(1), int32)
-
383  if (present(olwork)) then
-
384  olwork = lwork
-
385  return
-
386  end if
-
387 
-
388  ! Local Memory Allocation
-
389  if (present(work)) then
-
390  if (size(work) < lwork) then
-
391  ! ERROR: WORK not sized correctly
-
392  call errmgr%report_error("qr_factor_no_pivot", &
-
393  "Incorrectly sized input array WORK, argument 3.", &
-
394  la_array_size_error)
-
395  return
-
396  end if
-
397  wptr => work(1:lwork)
-
398  else
-
399  allocate(wrk(lwork), stat = istat)
-
400  if (istat /= 0) then
-
401  ! ERROR: Out of memory
-
402  call errmgr%report_error("qr_factor_no_pivot", &
-
403  "Insufficient memory available.", &
-
404  la_out_of_memory_error)
-
405  return
-
406  end if
-
407  wptr => wrk
-
408  end if
-
409 
-
410  ! Call DGEQRF
-
411  call dgeqrf(m, n, a, m, tau, wptr, lwork, flag)
-
412  end subroutine
-
413 
-
414 ! ------------------------------------------------------------------------------
-
415  module subroutine qr_factor_no_pivot_cmplx(a, tau, work, olwork, err)
-
416  ! Arguments
-
417  complex(real64), intent(inout), dimension(:,:) :: a
-
418  complex(real64), intent(out), dimension(:) :: tau
-
419  complex(real64), intent(out), target, dimension(:), optional :: work
-
420  integer(int32), intent(out), optional :: olwork
-
421  class(errors), intent(inout), optional, target :: err
-
422 
-
423  ! Local Variables
-
424  integer(int32) :: m, n, mn, istat, lwork, flag
-
425  complex(real64), dimension(1) :: temp
-
426  complex(real64), pointer, dimension(:) :: wptr
-
427  complex(real64), allocatable, target, dimension(:) :: wrk
-
428  class(errors), pointer :: errmgr
-
429  type(errors), target :: deferr
-
430 
-
431  ! Initialization
-
432  m = size(a, 1)
-
433  n = size(a, 2)
-
434  mn = min(m, n)
-
435  if (present(err)) then
-
436  errmgr => err
-
437  else
-
438  errmgr => deferr
-
439  end if
-
440 
-
441  ! Input Check
-
442  if (size(tau) /= mn) then
-
443  ! ERROR: TAU not sized correctly
-
444  call errmgr%report_error("qr_factor_no_pivot_cmplx", &
-
445  "Incorrectly sized input array TAU, argument 2.", &
-
446  la_array_size_error)
-
447  return
-
448  end if
-
449 
-
450  ! Workspace Query
-
451  call zgeqrf(m, n, a, m, tau, temp, -1, flag)
-
452  lwork = int(temp(1), int32)
-
453  if (present(olwork)) then
-
454  olwork = lwork
-
455  return
-
456  end if
-
457 
-
458  ! Local Memory Allocation
-
459  if (present(work)) then
-
460  if (size(work) < lwork) then
-
461  ! ERROR: WORK not sized correctly
-
462  call errmgr%report_error("qr_factor_no_pivot_cmplx", &
-
463  "Incorrectly sized input array WORK, argument 3.", &
-
464  la_array_size_error)
-
465  return
-
466  end if
-
467  wptr => work(1:lwork)
-
468  else
-
469  allocate(wrk(lwork), stat = istat)
-
470  if (istat /= 0) then
-
471  ! ERROR: Out of memory
-
472  call errmgr%report_error("qr_factor_no_pivot_cmplx", &
-
473  "Insufficient memory available.", &
-
474  la_out_of_memory_error)
-
475  return
-
476  end if
-
477  wptr => wrk
-
478  end if
-
479 
-
480  ! Call ZGEQRF
-
481  call zgeqrf(m, n, a, m, tau, wptr, lwork, flag)
-
482  end subroutine
-
483 
-
484 ! ------------------------------------------------------------------------------
-
485  module subroutine qr_factor_pivot(a, tau, jpvt, work, olwork, err)
-
486  ! Arguments
-
487  real(real64), intent(inout), dimension(:,:) :: a
-
488  real(real64), intent(out), dimension(:) :: tau
-
489  integer(int32), intent(inout), dimension(:) :: jpvt
-
490  real(real64), intent(out), target, dimension(:), optional :: work
-
491  integer(int32), intent(out), optional :: olwork
-
492  class(errors), intent(inout), optional, target :: err
-
493 
-
494  ! Local Variables
-
495  integer(int32) :: m, n, mn, istat, lwork, flag
-
496  real(real64), dimension(1) :: temp
-
497  real(real64), pointer, dimension(:) :: wptr
-
498  real(real64), allocatable, target, dimension(:) :: wrk
-
499  class(errors), pointer :: errmgr
-
500  type(errors), target :: deferr
-
501  character(len = 128) :: errmsg
-
502 
-
503  ! Initialization
-
504  m = size(a, 1)
-
505  n = size(a, 2)
-
506  mn = min(m, n)
-
507  if (present(err)) then
-
508  errmgr => err
-
509  else
-
510  errmgr => deferr
-
511  end if
-
512 
-
513  ! Input Check
-
514  flag = 0
-
515  if (size(tau) /= mn) then
-
516  flag = 2
-
517  else if (size(jpvt) /= n) then
-
518  flag = 3
-
519  end if
-
520  if (flag /= 0) then
-
521  ! ERROR: One of the input arrays is not sized correctly
-
522  write(errmsg, '(AI0A)') "Input number ", flag, &
-
523  " is not sized correctly."
-
524  call errmgr%report_error("qr_factor_pivot", trim(errmsg), &
-
525  la_array_size_error)
-
526  return
-
527  end if
-
528 
-
529  ! Workspace Query
-
530  call dgeqp3(m, n, a, m, jpvt, tau, temp, -1, flag)
-
531  lwork = int(temp(1), int32)
-
532  if (present(olwork)) then
-
533  olwork = lwork
-
534  return
-
535  end if
-
536 
-
537  ! Local Memory Allocation
-
538  if (present(work)) then
-
539  if (size(work) < lwork) then
-
540  ! ERROR: WORK not sized correctly
-
541  call errmgr%report_error("qr_factor_pivot", &
-
542  "Incorrectly sized input array WORK, argument 4.", &
-
543  la_array_size_error)
-
544  return
-
545  end if
-
546  wptr => work(1:lwork)
-
547  else
-
548  allocate(wrk(lwork), stat = istat)
-
549  if (istat /= 0) then
-
550  ! ERROR: Out of memory
-
551  call errmgr%report_error("qr_factor_pivot", &
-
552  "Insufficient memory available.", &
-
553  la_out_of_memory_error)
-
554  return
-
555  end if
-
556  wptr => wrk
-
557  end if
-
558 
-
559  ! Call DGEQP3
-
560  call dgeqp3(m, n, a, m, jpvt, tau, wptr, lwork, flag)
-
561 
-
562  ! End
-
563  if (allocated(wrk)) deallocate(wrk)
-
564  end subroutine
-
565 
-
566 ! ------------------------------------------------------------------------------
-
567  module subroutine qr_factor_pivot_cmplx(a, tau, jpvt, work, olwork, rwork, &
-
568  err)
-
569  ! Arguments
-
570  complex(real64), intent(inout), dimension(:,:) :: a
-
571  complex(real64), intent(out), dimension(:) :: tau
-
572  integer(int32), intent(inout), dimension(:) :: jpvt
-
573  complex(real64), intent(out), target, dimension(:), optional :: work
-
574  integer(int32), intent(out), optional :: olwork
-
575  real(real64), intent(out), target, dimension(:), optional :: rwork
-
576  class(errors), intent(inout), optional, target :: err
-
577 
-
578  ! Local Variables
-
579  integer(int32) :: m, n, mn, istat, lwork, flag
-
580  complex(real64), dimension(1) :: temp
-
581  complex(real64), pointer, dimension(:) :: wptr
-
582  complex(real64), allocatable, target, dimension(:) :: wrk
-
583  real(real64), pointer, dimension(:) :: rptr
-
584  real(real64), allocatable, target, dimension(:) :: rwrk
-
585  class(errors), pointer :: errmgr
-
586  type(errors), target :: deferr
-
587  character(len = 128) :: errmsg
-
588 
-
589  ! Initialization
-
590  m = size(a, 1)
-
591  n = size(a, 2)
-
592  mn = min(m, n)
-
593  if (present(err)) then
-
594  errmgr => err
-
595  else
-
596  errmgr => deferr
-
597  end if
-
598 
-
599  ! Input Check
-
600  flag = 0
-
601  if (size(tau) /= mn) then
-
602  flag = 2
-
603  else if (size(jpvt) /= n) then
-
604  flag = 3
-
605  end if
-
606  if (flag /= 0) then
-
607  ! ERROR: One of the input arrays is not sized correctly
-
608  write(errmsg, '(AI0A)') "Input number ", flag, &
-
609  " is not sized correctly."
-
610  call errmgr%report_error("qr_factor_pivot_cmplx", trim(errmsg), &
-
611  la_array_size_error)
-
612  return
-
613  end if
-
614  if (present(rwork)) then
-
615  if (size(rwork) < 2 * n) then
-
616  call errmgr%report_error("qr_factor_pivot_cmplx", &
-
617  "Incorrectly sized input array RWORK, argument 6.", &
-
618  la_array_size_error)
-
619  return
-
620  end if
-
621  rptr => rwork(1:2*n)
-
622  else
-
623  allocate(rwrk(2 * n), stat = flag)
-
624  if (flag /= 0) then
-
625  call errmgr%report_error("qr_factor_pivot_cmplx", &
-
626  "Insufficient memory available.", &
-
627  la_out_of_memory_error)
-
628  return
-
629  end if
-
630  rptr => rwrk
-
631  end if
-
632 
-
633  ! Workspace Query
-
634  call zgeqp3(m, n, a, m, jpvt, tau, temp, -1, rptr, flag)
-
635  lwork = int(temp(1), int32)
-
636  if (present(olwork)) then
-
637  olwork = lwork
-
638  return
-
639  end if
-
640 
-
641  ! Local Memory Allocation
-
642  if (present(work)) then
-
643  if (size(work) < lwork) then
-
644  ! ERROR: WORK not sized correctly
-
645  call errmgr%report_error("qr_factor_pivot_cmplx", &
-
646  "Incorrectly sized input array WORK, argument 4.", &
-
647  la_array_size_error)
-
648  return
-
649  end if
-
650  wptr => work(1:lwork)
-
651  else
-
652  allocate(wrk(lwork), stat = istat)
-
653  if (istat /= 0) then
-
654  ! ERROR: Out of memory
-
655  call errmgr%report_error("qr_factor_pivot_cmplx", &
-
656  "Insufficient memory available.", &
-
657  la_out_of_memory_error)
-
658  return
-
659  end if
-
660  wptr => wrk
-
661  end if
-
662 
-
663  ! Call ZGEQP3
-
664  call zgeqp3(m, n, a, m, jpvt, tau, wptr, lwork, rptr, flag)
-
665 
-
666  ! End
-
667  if (allocated(wrk)) deallocate(wrk)
-
668  end subroutine
-
669 
-
670 ! ------------------------------------------------------------------------------
-
671  module subroutine form_qr_no_pivot(r, tau, q, work, olwork, err)
-
672  ! Arguments
-
673  real(real64), intent(inout), dimension(:,:) :: r
-
674  real(real64), intent(in), dimension(:) :: tau
-
675  real(real64), intent(out), dimension(:,:) :: q
-
676  real(real64), intent(out), target, dimension(:), optional :: work
-
677  integer(int32), intent(out), optional :: olwork
-
678  class(errors), intent(inout), optional, target :: err
-
679 
-
680  ! Parameters
-
681  real(real64), parameter :: zero = 0.0d0
-
682 
-
683  ! Local Variables
-
684  integer(int32) :: j, m, n, mn, qcol, istat, flag, lwork
-
685  real(real64), pointer, dimension(:) :: wptr
-
686  real(real64), allocatable, target, dimension(:) :: wrk
-
687  real(real64), dimension(1) :: temp
-
688  class(errors), pointer :: errmgr
-
689  type(errors), target :: deferr
-
690  character(len = 128) :: errmsg
-
691 
-
692  ! Initialization
-
693  m = size(r, 1)
-
694  n = size(r, 2)
-
695  mn = min(m, n)
-
696  qcol = size(q, 2)
-
697  if (present(err)) then
-
698  errmgr => err
-
699  else
-
700  errmgr => deferr
-
701  end if
-
702 
-
703  ! Input Check
-
704  flag = 0
-
705  if (size(tau) /= mn) then
-
706  flag = 2
-
707  else if (size(q, 1) /= m .or. (qcol /= m .and. qcol /= n)) then
-
708  flag = 3
-
709  else if (qcol == n .and. m < n) then
-
710  flag = 3
-
711  end if
-
712  if (flag /= 0) then
-
713  ! ERROR: One of the input arrays is not sized correctly
-
714  write(errmsg, '(AI0A)') "Input number ", flag, &
-
715  " is not sized correctly."
-
716  call errmgr%report_error("form_qr_no_pivot", trim(errmsg), &
-
717  la_array_size_error)
-
718  return
-
719  end if
-
720 
-
721  ! Workspace Query
-
722  call dorgqr(m, qcol, mn, q, m, tau, temp, -1, flag)
-
723  lwork = int(temp(1), int32)
-
724  if (present(olwork)) then
-
725  olwork = lwork
-
726  return
-
727  end if
-
728 
-
729  ! Local Memory Allocation
-
730  if (present(work)) then
-
731  if (size(work) < lwork) then
-
732  ! ERROR: WORK not sized correctly
-
733  call errmgr%report_error("form_qr_no_pivot", &
-
734  "Incorrectly sized input array WORK, argument 4.", &
-
735  la_array_size_error)
-
736  return
-
737  end if
-
738  wptr => work(1:lwork)
-
739  else
-
740  allocate(wrk(lwork), stat = istat)
-
741  if (istat /= 0) then
-
742  ! ERROR: Out of memory
-
743  call errmgr%report_error("form_qr_no_pivot", &
-
744  "Insufficient memory available.", &
-
745  la_out_of_memory_error)
-
746  return
-
747  end if
-
748  wptr => wrk
-
749  end if
-
750 
-
751  ! Copy the sub-diagonal portion of R to Q, and then zero out the
-
752  ! sub-diagonal portion of R
-
753  do j = 1, mn
-
754  q(j+1:m,j) = r(j+1:m,j)
-
755  r(j+1:m,j) = zero
-
756  end do
-
757 
-
758  ! Build Q - Build M-by-M or M-by-N, but M-by-N only for M >= N
-
759  call dorgqr(m, qcol, mn, q, m, tau, wptr, lwork, flag)
-
760 
-
761  ! End
-
762  if (allocated(wrk)) deallocate(wrk)
-
763  end subroutine
-
764 
-
765 ! ------------------------------------------------------------------------------
-
766  module subroutine form_qr_no_pivot_cmplx(r, tau, q, work, olwork, err)
-
767  ! Arguments
-
768  complex(real64), intent(inout), dimension(:,:) :: r
-
769  complex(real64), intent(in), dimension(:) :: tau
-
770  complex(real64), intent(out), dimension(:,:) :: q
-
771  complex(real64), intent(out), target, dimension(:), optional :: work
-
772  integer(int32), intent(out), optional :: olwork
-
773  class(errors), intent(inout), optional, target :: err
-
774 
-
775  ! Parameters
-
776  complex(real64), parameter :: zero = (0.0d0, 0.0d0)
-
777 
-
778  ! Local Variables
-
779  integer(int32) :: j, m, n, mn, qcol, istat, flag, lwork
-
780  complex(real64), pointer, dimension(:) :: wptr
-
781  complex(real64), allocatable, target, dimension(:) :: wrk
-
782  complex(real64), dimension(1) :: temp
-
783  class(errors), pointer :: errmgr
-
784  type(errors), target :: deferr
-
785  character(len = 128) :: errmsg
-
786 
-
787  ! Initialization
-
788  m = size(r, 1)
-
789  n = size(r, 2)
-
790  mn = min(m, n)
-
791  qcol = size(q, 2)
-
792  if (present(err)) then
-
793  errmgr => err
-
794  else
-
795  errmgr => deferr
-
796  end if
-
797 
-
798  ! Input Check
-
799  flag = 0
-
800  if (size(tau) /= mn) then
-
801  flag = 2
-
802  else if (size(q, 1) /= m .or. (qcol /= m .and. qcol /= n)) then
-
803  flag = 3
-
804  else if (qcol == n .and. m < n) then
-
805  flag = 3
-
806  end if
-
807  if (flag /= 0) then
-
808  ! ERROR: One of the input arrays is not sized correctly
-
809  write(errmsg, '(AI0A)') "Input number ", flag, &
-
810  " is not sized correctly."
-
811  call errmgr%report_error("form_qr_no_pivot_cmplx", trim(errmsg), &
-
812  la_array_size_error)
-
813  return
-
814  end if
-
815 
-
816  ! Workspace Query
-
817  call zungqr(m, qcol, mn, q, m, tau, temp, -1, flag)
-
818  lwork = int(temp(1), int32)
-
819  if (present(olwork)) then
-
820  olwork = lwork
-
821  return
-
822  end if
-
823 
-
824  ! Local Memory Allocation
-
825  if (present(work)) then
-
826  if (size(work) < lwork) then
-
827  ! ERROR: WORK not sized correctly
-
828  call errmgr%report_error("form_qr_no_pivot_cmplx", &
-
829  "Incorrectly sized input array WORK, argument 4.", &
-
830  la_array_size_error)
-
831  return
-
832  end if
-
833  wptr => work(1:lwork)
-
834  else
-
835  allocate(wrk(lwork), stat = istat)
-
836  if (istat /= 0) then
-
837  ! ERROR: Out of memory
-
838  call errmgr%report_error("form_qr_no_pivot_cmplx", &
-
839  "Insufficient memory available.", &
-
840  la_out_of_memory_error)
-
841  return
-
842  end if
-
843  wptr => wrk
-
844  end if
-
845 
-
846  ! Copy the sub-diagonal portion of R to Q, and then zero out the
-
847  ! sub-diagonal portion of R
-
848  do j = 1, mn
-
849  q(j+1:m,j) = r(j+1:m,j)
-
850  r(j+1:m,j) = zero
-
851  end do
-
852 
-
853  ! Build Q - Build M-by-M or M-by-N, but M-by-N only for M >= N
-
854  call zungqr(m, qcol, mn, q, m, tau, wptr, lwork, flag)
-
855 
-
856  ! End
-
857  if (allocated(wrk)) deallocate(wrk)
-
858  end subroutine
-
859 
-
860 ! ------------------------------------------------------------------------------
-
861  module subroutine form_qr_pivot(r, tau, pvt, q, p, work, olwork, err)
-
862  ! Arguments
-
863  real(real64), intent(inout), dimension(:,:) :: r
-
864  real(real64), intent(in), dimension(:) :: tau
-
865  integer(int32), intent(in), dimension(:) :: pvt
-
866  real(real64), intent(out), dimension(:,:) :: q, p
-
867  real(real64), intent(out), target, dimension(:), optional :: work
-
868  integer(int32), intent(out), optional :: olwork
-
869  class(errors), intent(inout), optional, target :: err
-
870 
-
871  ! Parameters
-
872  real(real64), parameter :: zero = 0.0d0
-
873  real(real64), parameter :: one = 1.0d0
-
874 
-
875  ! Local Variables
-
876  integer(int32) :: j, jp, m, n, mn, flag
-
877  class(errors), pointer :: errmgr
-
878  type(errors), target :: deferr
-
879  character(len = 128) :: errmsg
-
880 
-
881  ! Initialization
-
882  m = size(r, 1)
-
883  n = size(r, 2)
-
884  mn = min(m, n)
-
885  if (present(err)) then
-
886  errmgr => err
-
887  else
-
888  errmgr => deferr
-
889  end if
-
890 
-
891  ! Input Check
-
892  flag = 0
-
893  if (size(tau) /= mn) then
-
894  flag = 2
-
895  else if (size(pvt) /= n) then
-
896  flag = 3
-
897  else if (size(q, 1) /= m .or. &
-
898  (size(q, 2) /= m .and. size(q, 2) /= n)) then
-
899  flag = 4
-
900  else if (size(q, 2) == n .and. m < n) then
-
901  flag = 4
-
902  else if (size(p, 1) /= n .or. size(p, 2) /= n) then
-
903  flag = 5
-
904  end if
-
905  if (flag /= 0) then
-
906  ! ERROR: One of the input arrays is not sized correctly
-
907  write(errmsg, '(AI0A)') "Input number ", flag, &
-
908  " is not sized correctly."
-
909  call errmgr%report_error("form_qr_pivot", trim(errmsg), &
-
910  la_array_size_error)
-
911  return
-
912  end if
-
913 
-
914  ! Generate Q and R
-
915  call form_qr_no_pivot(r, tau, q, work = work, olwork = olwork, &
-
916  err = errmgr)
-
917  if (present(olwork)) return ! Just a workspace query
-
918  if (errmgr%has_error_occurred()) return
-
919 
-
920  ! Form P
-
921  do j = 1, n
-
922  jp = pvt(j)
-
923  p(:,j) = zero
-
924  p(jp,j) = one
-
925  end do
-
926  end subroutine
-
927 
-
928 ! ------------------------------------------------------------------------------
-
929  module subroutine form_qr_pivot_cmplx(r, tau, pvt, q, p, work, olwork, err)
-
930  ! Arguments
-
931  complex(real64), intent(inout), dimension(:,:) :: r
-
932  complex(real64), intent(in), dimension(:) :: tau
-
933  integer(int32), intent(in), dimension(:) :: pvt
-
934  complex(real64), intent(out), dimension(:,:) :: q, p
-
935  complex(real64), intent(out), target, dimension(:), optional :: work
-
936  integer(int32), intent(out), optional :: olwork
-
937  class(errors), intent(inout), optional, target :: err
-
938 
-
939  ! Parameters
-
940  complex(real64), parameter :: zero = (0.0d0, 0.0d0)
-
941  complex(real64), parameter :: one = (1.0d0, 0.0d0)
-
942 
-
943  ! Local Variables
-
944  integer(int32) :: j, jp, m, n, mn, flag
-
945  class(errors), pointer :: errmgr
-
946  type(errors), target :: deferr
-
947  character(len = 128) :: errmsg
-
948 
-
949  ! Initialization
-
950  m = size(r, 1)
-
951  n = size(r, 2)
-
952  mn = min(m, n)
-
953  if (present(err)) then
-
954  errmgr => err
-
955  else
-
956  errmgr => deferr
-
957  end if
-
958 
-
959  ! Input Check
-
960  flag = 0
-
961  if (size(tau) /= mn) then
-
962  flag = 2
-
963  else if (size(pvt) /= n) then
-
964  flag = 3
-
965  else if (size(q, 1) /= m .or. &
-
966  (size(q, 2) /= m .and. size(q, 2) /= n)) then
-
967  flag = 4
-
968  else if (size(q, 2) == n .and. m < n) then
-
969  flag = 4
-
970  else if (size(p, 1) /= n .or. size(p, 2) /= n) then
-
971  flag = 5
-
972  end if
-
973  if (flag /= 0) then
-
974  ! ERROR: One of the input arrays is not sized correctly
-
975  write(errmsg, '(AI0A)') "Input number ", flag, &
-
976  " is not sized correctly."
-
977  call errmgr%report_error("form_qr_pivot_cmplx", trim(errmsg), &
-
978  la_array_size_error)
-
979  return
-
980  end if
-
981 
-
982  ! Generate Q and R
-
983  call form_qr_no_pivot_cmplx(r, tau, q, work = work, olwork = olwork, &
-
984  err = errmgr)
-
985  if (present(olwork)) return ! Just a workspace query
-
986  if (errmgr%has_error_occurred()) return
-
987 
-
988  ! Form P
-
989  do j = 1, n
-
990  jp = pvt(j)
-
991  p(:,j) = zero
-
992  p(jp,j) = one
-
993  end do
-
994  end subroutine
-
995 
-
996 ! ------------------------------------------------------------------------------
-
997  module subroutine mult_qr_mtx(lside, trans, a, tau, c, work, olwork, err)
-
998  ! Arguments
-
999  logical, intent(in) :: lside, trans
-
1000  real(real64), intent(in), dimension(:) :: tau
-
1001  real(real64), intent(inout), dimension(:,:) :: a, c
-
1002  real(real64), intent(out), target, dimension(:), optional :: work
-
1003  integer(int32), intent(out), optional :: olwork
-
1004  class(errors), intent(inout), optional, target :: err
-
1005 
-
1006  ! Parameters
-
1007  real(real64), parameter :: one = 1.0d0
-
1008 
-
1009  ! Local Variables
-
1010  character :: side, t
-
1011  integer(int32) :: m, n, k, nrowa, istat, flag, lwork
-
1012  real(real64), pointer, dimension(:) :: wptr
-
1013  real(real64), allocatable, target, dimension(:) :: wrk
-
1014  real(real64), dimension(1) :: temp
-
1015  class(errors), pointer :: errmgr
-
1016  type(errors), target :: deferr
-
1017  character(len = 128) :: errmsg
-
1018 
-
1019  ! Initialization
-
1020  m = size(c, 1)
-
1021  n = size(c, 2)
-
1022  k = size(tau)
-
1023  if (lside) then
-
1024  side = 'L'
-
1025  nrowa = m
-
1026  else
-
1027  side = 'R'
-
1028  nrowa = n
-
1029  end if
-
1030  if (trans) then
-
1031  t = 'T'
-
1032  else
-
1033  t = 'N'
-
1034  end if
-
1035  if (present(err)) then
-
1036  errmgr => err
-
1037  else
-
1038  errmgr => deferr
-
1039  end if
-
1040 
-
1041  ! Input Check
-
1042  flag = 0
-
1043  if (lside) then
-
1044  ! A is M-by-K, M >= K >= 0
-
1045  if (size(a, 1) /= m .or. size(a, 2) < k) flag = 3
-
1046  else
-
1047  ! A is N-by-K, N >= K >= 0
-
1048  if (size(a, 1) /= n .or. size(a, 2) < k) flag = 3
-
1049  end if
-
1050  if (flag /= 0) then
-
1051  ! ERROR: One of the input arrays is not sized correctly
-
1052  write(errmsg, '(AI0A)') "Input number ", flag, &
-
1053  " is not sized correctly."
-
1054  call errmgr%report_error("mult_qr_mtx", trim(errmsg), &
-
1055  la_array_size_error)
-
1056  return
-
1057  end if
-
1058 
-
1059  ! Workspace Query
-
1060  call dormqr(side, t, m, n, k, a, nrowa, tau, c, m, temp, -1, flag)
-
1061  lwork = int(temp(1), int32)
-
1062  if (present(olwork)) then
-
1063  olwork = lwork
-
1064  return
-
1065  end if
-
1066 
-
1067  ! Local Memory Allocation
-
1068  if (present(work)) then
-
1069  if (size(work) < lwork) then
-
1070  ! ERROR: WORK not sized correctly
-
1071  call errmgr%report_error("mult_qr_mtx", &
-
1072  "Incorrectly sized input array WORK, argument 6.", &
-
1073  la_array_size_error)
-
1074  return
-
1075  end if
-
1076  wptr => work(1:lwork)
-
1077  else
-
1078  allocate(wrk(lwork), stat = istat)
-
1079  if (istat /= 0) then
-
1080  ! ERROR: Out of memory
-
1081  call errmgr%report_error("mult_qr_mtx", &
-
1082  "Insufficient memory available.", &
-
1083  la_out_of_memory_error)
-
1084  return
-
1085  end if
-
1086  wptr => wrk
-
1087  end if
-
1088 
-
1089  ! Call DORMQR
-
1090  call dormqr(side, t, m, n, k, a, nrowa, tau, c, m, wptr, lwork, flag)
-
1091  end subroutine
-
1092 
-
1093 ! ------------------------------------------------------------------------------
-
1094  module subroutine mult_qr_mtx_cmplx(lside, trans, a, tau, c, work, olwork, err)
-
1095  ! Arguments
-
1096  logical, intent(in) :: lside, trans
-
1097  complex(real64), intent(in), dimension(:) :: tau
-
1098  complex(real64), intent(inout), dimension(:,:) :: a, c
-
1099  complex(real64), intent(out), target, dimension(:), optional :: work
-
1100  integer(int32), intent(out), optional :: olwork
-
1101  class(errors), intent(inout), optional, target :: err
-
1102 
-
1103  ! Parameters
-
1104  complex(real64), parameter :: one = (1.0d0, 0.0d0)
-
1105 
-
1106  ! Local Variables
-
1107  character :: side, t
-
1108  integer(int32) :: m, n, k, nrowa, istat, flag, lwork
-
1109  complex(real64), pointer, dimension(:) :: wptr
-
1110  complex(real64), allocatable, target, dimension(:) :: wrk
-
1111  complex(real64), dimension(1) :: temp
-
1112  class(errors), pointer :: errmgr
-
1113  type(errors), target :: deferr
-
1114  character(len = 128) :: errmsg
-
1115 
-
1116  ! Initialization
-
1117  m = size(c, 1)
-
1118  n = size(c, 2)
-
1119  k = size(tau)
-
1120  if (lside) then
-
1121  side = 'L'
-
1122  nrowa = m
-
1123  else
-
1124  side = 'R'
-
1125  nrowa = n
-
1126  end if
-
1127  if (trans) then
-
1128  t = 'C'
-
1129  else
-
1130  t = 'N'
-
1131  end if
-
1132  if (present(err)) then
-
1133  errmgr => err
-
1134  else
-
1135  errmgr => deferr
-
1136  end if
-
1137 
-
1138  ! Input Check
-
1139  flag = 0
-
1140  if (lside) then
-
1141  ! A is M-by-K, M >= K >= 0
-
1142  if (size(a, 1) /= m .or. size(a, 2) < k) flag = 3
-
1143  else
-
1144  ! A is N-by-K, N >= K >= 0
-
1145  if (size(a, 1) /= n .or. size(a, 2) < k) flag = 3
-
1146  end if
-
1147  if (flag /= 0) then
-
1148  ! ERROR: One of the input arrays is not sized correctly
-
1149  write(errmsg, '(AI0A)') "Input number ", flag, &
-
1150  " is not sized correctly."
-
1151  call errmgr%report_error("mult_qr_mtx_cmplx", trim(errmsg), &
-
1152  la_array_size_error)
-
1153  return
-
1154  end if
-
1155 
-
1156  ! Workspace Query
-
1157  call zunmqr(side, t, m, n, k, a, nrowa, tau, c, m, temp, -1, flag)
-
1158  lwork = int(temp(1), int32)
-
1159  if (present(olwork)) then
-
1160  olwork = lwork
-
1161  return
-
1162  end if
-
1163 
-
1164  ! Local Memory Allocation
-
1165  if (present(work)) then
-
1166  if (size(work) < lwork) then
-
1167  ! ERROR: WORK not sized correctly
-
1168  call errmgr%report_error("mult_qr_mtx_cmplx", &
-
1169  "Incorrectly sized input array WORK, argument 6.", &
-
1170  la_array_size_error)
-
1171  return
-
1172  end if
-
1173  wptr => work(1:lwork)
-
1174  else
-
1175  allocate(wrk(lwork), stat = istat)
-
1176  if (istat /= 0) then
-
1177  ! ERROR: Out of memory
-
1178  call errmgr%report_error("mult_qr_mtx_cmplx", &
-
1179  "Insufficient memory available.", &
-
1180  la_out_of_memory_error)
-
1181  return
-
1182  end if
-
1183  wptr => wrk
-
1184  end if
-
1185 
-
1186  ! Call ZUNMQR
-
1187  call zunmqr(side, t, m, n, k, a, nrowa, tau, c, m, wptr, lwork, flag)
-
1188  end subroutine
-
1189 
-
1190 ! ------------------------------------------------------------------------------
-
1191  module subroutine mult_qr_vec(trans, a, tau, c, work, olwork, err)
-
1192  ! Arguments
-
1193  logical, intent(in) :: trans
-
1194  real(real64), intent(inout), dimension(:,:) :: a
-
1195  real(real64), intent(in), dimension(:) :: tau
-
1196  real(real64), intent(inout), dimension(:) :: c
-
1197  real(real64), intent(out), target, dimension(:), optional :: work
-
1198  integer(int32), intent(out), optional :: olwork
-
1199  class(errors), intent(inout), optional, target :: err
-
1200 
-
1201  ! Parameters
-
1202  real(real64), parameter :: one = 1.0d0
-
1203 
-
1204  ! Local Variables
-
1205  character :: side, t
-
1206  integer(int32) :: m, k, nrowa, istat, flag, lwork
-
1207  real(real64), pointer, dimension(:) :: wptr
-
1208  real(real64), allocatable, target, dimension(:) :: wrk
-
1209  real(real64), dimension(1) :: temp
-
1210  class(errors), pointer :: errmgr
-
1211  type(errors), target :: deferr
-
1212  character(len = 128) :: errmsg
-
1213 
-
1214  ! Initialization
-
1215  m = size(c)
-
1216  k = size(tau)
-
1217  side = 'L'
-
1218  nrowa = m
-
1219  if (trans) then
-
1220  t = 'T'
-
1221  else
-
1222  t = 'N'
-
1223  end if
-
1224  if (present(err)) then
-
1225  errmgr => err
-
1226  else
-
1227  errmgr => deferr
-
1228  end if
-
1229 
-
1230  ! Input Check
-
1231  flag = 0
-
1232  if (size(a, 1) /= m .or. size(a, 2) < k) flag = 3
-
1233  if (flag /= 0) then
-
1234  ! ERROR: One of the input arrays is not sized correctly
-
1235  write(errmsg, '(AI0A)') "Input number ", flag, &
-
1236  " is not sized correctly."
-
1237  call errmgr%report_error("mult_qr_vec", trim(errmsg), &
-
1238  la_array_size_error)
-
1239  return
-
1240  end if
-
1241 
-
1242  ! Workspace Query
-
1243  call dormqr(side, t, m, 1, k, a, nrowa, tau, c, m, temp, -1, flag)
-
1244  lwork = int(temp(1), int32)
-
1245  if (present(olwork)) then
-
1246  olwork = lwork
-
1247  return
-
1248  end if
-
1249 
-
1250  ! Local Memory Allocation
-
1251  if (present(work)) then
-
1252  if (size(work) < lwork) then
-
1253  ! ERROR: WORK not sized correctly
-
1254  call errmgr%report_error("mult_qr_vec", &
-
1255  "Incorrectly sized input array WORK, argument 6.", &
-
1256  la_array_size_error)
-
1257  return
-
1258  end if
-
1259  wptr => work(1:lwork)
-
1260  else
-
1261  allocate(wrk(lwork), stat = istat)
-
1262  if (istat /= 0) then
-
1263  ! ERROR: Out of memory
-
1264  call errmgr%report_error("mult_qr_vec", &
-
1265  "Insufficient memory available.", &
-
1266  la_out_of_memory_error)
-
1267  return
-
1268  end if
-
1269  wptr => wrk
-
1270  end if
-
1271 
-
1272  ! Call DORMQR
-
1273  call dormqr(side, t, m, 1, k, a, nrowa, tau, c, m, wptr, lwork, flag)
-
1274  end subroutine
-
1275 
-
1276 ! ------------------------------------------------------------------------------
-
1277  module subroutine mult_qr_vec_cmplx(trans, a, tau, c, work, olwork, err)
-
1278  ! Arguments
-
1279  logical, intent(in) :: trans
-
1280  complex(real64), intent(inout), dimension(:,:) :: a
-
1281  complex(real64), intent(in), dimension(:) :: tau
-
1282  complex(real64), intent(inout), dimension(:) :: c
-
1283  complex(real64), intent(out), target, dimension(:), optional :: work
-
1284  integer(int32), intent(out), optional :: olwork
-
1285  class(errors), intent(inout), optional, target :: err
-
1286 
-
1287  ! Parameters
-
1288  complex(real64), parameter :: one = (1.0d0, 0.0d0)
-
1289 
-
1290  ! Local Variables
-
1291  character :: side, t
-
1292  integer(int32) :: m, k, nrowa, istat, flag, lwork
-
1293  complex(real64), pointer, dimension(:) :: wptr
-
1294  complex(real64), allocatable, target, dimension(:) :: wrk
-
1295  complex(real64), dimension(1) :: temp
-
1296  class(errors), pointer :: errmgr
-
1297  type(errors), target :: deferr
-
1298  character(len = 128) :: errmsg
-
1299 
-
1300  ! Initialization
-
1301  m = size(c)
-
1302  k = size(tau)
-
1303  side = 'L'
-
1304  nrowa = m
-
1305  if (trans) then
-
1306  t = 'C'
-
1307  else
-
1308  t = 'N'
-
1309  end if
-
1310  if (present(err)) then
-
1311  errmgr => err
-
1312  else
-
1313  errmgr => deferr
-
1314  end if
-
1315 
-
1316  ! Input Check
-
1317  flag = 0
-
1318  if (size(a, 1) /= m .or. size(a, 2) < k) flag = 3
-
1319  if (flag /= 0) then
-
1320  ! ERROR: One of the input arrays is not sized correctly
-
1321  write(errmsg, '(AI0A)') "Input number ", flag, &
-
1322  " is not sized correctly."
-
1323  call errmgr%report_error("mult_qr_vec", trim(errmsg), &
-
1324  la_array_size_error)
-
1325  return
-
1326  end if
-
1327 
-
1328  ! Workspace Query
-
1329  call zunmqr(side, t, m, 1, k, a, nrowa, tau, c, m, temp, -1, flag)
-
1330  lwork = int(temp(1), int32)
-
1331  if (present(olwork)) then
-
1332  olwork = lwork
-
1333  return
-
1334  end if
-
1335 
-
1336  ! Local Memory Allocation
-
1337  if (present(work)) then
-
1338  if (size(work) < lwork) then
-
1339  ! ERROR: WORK not sized correctly
-
1340  call errmgr%report_error("mult_qr_vec", &
-
1341  "Incorrectly sized input array WORK, argument 6.", &
-
1342  la_array_size_error)
-
1343  return
-
1344  end if
-
1345  wptr => work(1:lwork)
-
1346  else
-
1347  allocate(wrk(lwork), stat = istat)
-
1348  if (istat /= 0) then
-
1349  ! ERROR: Out of memory
-
1350  call errmgr%report_error("mult_qr_vec", &
-
1351  "Insufficient memory available.", &
-
1352  la_out_of_memory_error)
-
1353  return
-
1354  end if
-
1355  wptr => wrk
-
1356  end if
-
1357 
-
1358  ! Call ZUNMQR
-
1359  call zunmqr(side, t, m, 1, k, a, nrowa, tau, c, m, wptr, lwork, flag)
-
1360  end subroutine
-
1361 
-
1362 ! ------------------------------------------------------------------------------
-
1363  module subroutine qr_rank1_update_dbl(q, r, u, v, work, err)
-
1364  ! Arguments
-
1365  real(real64), intent(inout), dimension(:,:) :: q, r
-
1366  real(real64), intent(inout), dimension(:) :: u, v
-
1367  real(real64), intent(out), target, optional, dimension(:) :: work
-
1368  class(errors), intent(inout), optional, target :: err
-
1369 
-
1370  ! Local Variables
-
1371  logical :: full
-
1372  integer(int32) :: m, n, k, lwork, istat, flag
-
1373  real(real64), pointer, dimension(:) :: wptr
-
1374  real(real64), allocatable, target, dimension(:) :: wrk
-
1375  class(errors), pointer :: errmgr
-
1376  type(errors), target :: deferr
-
1377  character(len = 128) :: errmsg
-
1378 
-
1379  ! Initialization
-
1380  m = size(u, 1)
-
1381  n = size(r, 2)
-
1382  k = min(m, n)
-
1383  full = size(q, 2) == m
-
1384  lwork = 2 * k
-
1385  if (present(err)) then
-
1386  errmgr => err
-
1387  else
-
1388  errmgr => deferr
-
1389  end if
-
1390 
-
1391  ! Input Check
-
1392  flag = 0
-
1393  if (m < n) then
-
1394  flag = 1
-
1395  else if (.not.full .and. size(q, 2) /= k) then
-
1396  flag = 1
-
1397  else if (size(r, 1) /= m) then
-
1398  flag = 2
-
1399  else if (size(u) /= m) then
-
1400  flag = 3
-
1401  else if (size(v) /= n) then
-
1402  flag = 4
-
1403  end if
-
1404  if (flag /= 0) then
-
1405  ! ERROR: One of the input arrays is not sized correctly
-
1406  write(errmsg, '(AI0A)') "Input number ", flag, &
-
1407  " is not sized correctly."
-
1408  call errmgr%report_error("qr_rank1_update", trim(errmsg), &
-
1409  la_array_size_error)
-
1410  return
-
1411  end if
-
1412 
-
1413  ! Local Memory Allocation
-
1414  if (present(work)) then
-
1415  if (size(work) < lwork) then
-
1416  ! ERROR: WORK not sized correctly
-
1417  call errmgr%report_error("qr_rank1_update", &
-
1418  "Incorrectly sized input array WORK, argument 5.", &
-
1419  la_array_size_error)
-
1420  return
-
1421  end if
-
1422  wptr => work(1:lwork)
-
1423  else
-
1424  allocate(wrk(lwork), stat = istat)
-
1425  if (istat /= 0) then
-
1426  ! ERROR: Out of memory
-
1427  call errmgr%report_error("qr_rank1_update", &
-
1428  "Insufficient memory available.", &
-
1429  la_out_of_memory_error)
-
1430  return
-
1431  end if
-
1432  wptr => wrk
-
1433  end if
-
1434 
-
1435  ! Process
-
1436  call dqr1up(m, n, k, q, m, r, m, u, v, wptr)
-
1437 
-
1438  ! End
-
1439  if (allocated(wrk)) deallocate(wrk)
-
1440  end subroutine
-
1441 
-
1442 ! ------------------------------------------------------------------------------
-
1443  module subroutine qr_rank1_update_cmplx(q, r, u, v, work, rwork, err)
-
1444  ! Arguments
-
1445  complex(real64), intent(inout), dimension(:,:) :: q, r
-
1446  complex(real64), intent(inout), dimension(:) :: u, v
-
1447  complex(real64), intent(out), target, optional, dimension(:) :: work
-
1448  real(real64), intent(out), target, optional, dimension(:) :: rwork
-
1449  class(errors), intent(inout), optional, target :: err
-
1450 
-
1451  ! Local Variables
-
1452  logical :: full
-
1453  integer(int32) :: m, n, k, lwork, istat, flag, lrwork
-
1454  complex(real64), pointer, dimension(:) :: wptr
-
1455  complex(real64), allocatable, target, dimension(:) :: wrk
-
1456  real(real64), pointer, dimension(:) :: rwptr
-
1457  real(real64), allocatable, target, dimension(:) :: rwrk
-
1458  class(errors), pointer :: errmgr
-
1459  type(errors), target :: deferr
-
1460  character(len = 128) :: errmsg
-
1461 
-
1462  ! Initialization
-
1463  m = size(u, 1)
-
1464  n = size(r, 2)
-
1465  k = min(m, n)
-
1466  full = size(q, 2) == m
-
1467  lwork = k
-
1468  lrwork = k
-
1469  if (present(err)) then
-
1470  errmgr => err
-
1471  else
-
1472  errmgr => deferr
-
1473  end if
-
1474 
-
1475  ! Input Check
-
1476  flag = 0
-
1477  if (m < n) then
-
1478  flag = 1
-
1479  else if (.not.full .and. size(q, 2) /= k) then
-
1480  flag = 1
-
1481  else if (size(r, 1) /= m) then
-
1482  flag = 2
-
1483  else if (size(u) /= m) then
-
1484  flag = 3
-
1485  else if (size(v) /= n) then
-
1486  flag = 4
-
1487  end if
-
1488  if (flag /= 0) then
-
1489  ! ERROR: One of the input arrays is not sized correctly
-
1490  write(errmsg, '(AI0A)') "Input number ", flag, &
-
1491  " is not sized correctly."
-
1492  call errmgr%report_error("qr_rank1_update_cmplx", trim(errmsg), &
-
1493  la_array_size_error)
-
1494  return
-
1495  end if
-
1496 
-
1497  ! Local Memory Allocation
-
1498  if (present(work)) then
-
1499  if (size(work) < lwork) then
-
1500  ! ERROR: WORK not sized correctly
-
1501  call errmgr%report_error("qr_rank1_update_cmplx", &
-
1502  "Incorrectly sized input array WORK, argument 5.", &
-
1503  la_array_size_error)
-
1504  return
-
1505  end if
-
1506  wptr => work(1:lwork)
-
1507  else
-
1508  allocate(wrk(lwork), stat = istat)
-
1509  if (istat /= 0) then
-
1510  ! ERROR: Out of memory
-
1511  call errmgr%report_error("qr_rank1_update_cmplx", &
-
1512  "Insufficient memory available.", &
-
1513  la_out_of_memory_error)
-
1514  return
-
1515  end if
-
1516  wptr => wrk
-
1517  end if
-
1518 
-
1519  if (present(rwork)) then
-
1520  if (size(rwork) < lrwork) then
-
1521  ! ERROR: WORK not sized correctly
-
1522  call errmgr%report_error("qr_rank1_update_cmplx", &
-
1523  "Incorrectly sized input array RWORK, argument 6.", &
-
1524  la_array_size_error)
-
1525  return
-
1526  end if
-
1527  wptr => work(1:lrwork)
-
1528  else
-
1529  allocate(rwrk(lrwork), stat = istat)
-
1530  if (istat /= 0) then
-
1531  ! ERROR: Out of memory
-
1532  call errmgr%report_error("qr_rank1_update_cmplx", &
-
1533  "Insufficient memory available.", &
-
1534  la_out_of_memory_error)
-
1535  return
-
1536  end if
-
1537  rwptr => rwrk
-
1538  end if
-
1539 
-
1540  ! Process
-
1541  call zqr1up(m, n, k, q, m, r, m, u, v, wptr, rwptr)
-
1542 
-
1543  ! End
-
1544  if (allocated(wrk)) deallocate(wrk)
-
1545  end subroutine
-
1546 
-
1547 ! ******************************************************************************
-
1548 ! CHOLESKY FACTORIZATION
-
1549 ! ------------------------------------------------------------------------------
-
1550  module subroutine cholesky_factor_dbl(a, upper, err)
-
1551  ! Arguments
-
1552  real(real64), intent(inout), dimension(:,:) :: a
-
1553  logical, intent(in), optional :: upper
-
1554  class(errors), intent(inout), optional, target :: err
-
1555 
-
1556  ! Parameters
-
1557  real(real64), parameter :: zero = 0.0d0
-
1558 
-
1559  ! Local Variables
-
1560  character :: uplo
-
1561  integer(int32) :: i, n, flag
-
1562  class(errors), pointer :: errmgr
-
1563  type(errors), target :: deferr
-
1564  character(len = 128) :: errmsg
-
1565 
-
1566  ! Initialization
-
1567  n = size(a, 1)
-
1568  if (present(upper)) then
-
1569  if (upper) then
-
1570  uplo = 'U'
-
1571  else
-
1572  uplo = 'L'
-
1573  end if
-
1574  else
-
1575  uplo = 'U'
-
1576  end if
-
1577  if (present(err)) then
-
1578  errmgr => err
-
1579  else
-
1580  errmgr => deferr
-
1581  end if
-
1582 
-
1583  ! Input Check
-
1584  if (size(a, 2) /= n) then
-
1585  ! ERROR: A must be square
-
1586  call errmgr%report_error("cholesky_factor", &
-
1587  "The input matrix must be square.", la_array_size_error)
-
1588  return
-
1589  end if
-
1590 
-
1591  ! Process
-
1592  call dpotrf(uplo, n, a, n, flag)
-
1593  if (flag > 0) then
-
1594  ! ERROR: Matrix is not positive definite
-
1595  write(errmsg, '(AI0A)') "The leading minor of order ", flag, &
-
1596  " is not positive definite."
-
1597  call errmgr%report_error("cholesky_factor", trim(errmsg), &
-
1598  la_matrix_format_error)
-
1599  end if
-
1600 
-
1601  ! Zero out the non-used upper or lower diagonal
-
1602  if (uplo == 'U') then
-
1603  ! Zero out the lower
-
1604  do i = 1, n - 1
-
1605  a(i+1:n,i) = zero
-
1606  end do
-
1607  else
-
1608  ! Zero out the upper
-
1609  do i = 2, n
-
1610  a(1:i-1,i) = zero
-
1611  end do
-
1612  end if
-
1613  end subroutine
-
1614 
-
1615 ! ------------------------------------------------------------------------------
-
1616  module subroutine cholesky_factor_cmplx(a, upper, err)
-
1617  ! Arguments
-
1618  complex(real64), intent(inout), dimension(:,:) :: a
-
1619  logical, intent(in), optional :: upper
-
1620  class(errors), intent(inout), optional, target :: err
-
1621 
-
1622  ! Parameters
-
1623  complex(real64), parameter :: zero = (0.0d0, 0.0d0)
-
1624 
-
1625  ! Local Variables
-
1626  character :: uplo
-
1627  integer(int32) :: i, n, flag
-
1628  class(errors), pointer :: errmgr
-
1629  type(errors), target :: deferr
-
1630  character(len = 128) :: errmsg
-
1631 
-
1632  ! Initialization
-
1633  n = size(a, 1)
-
1634  if (present(upper)) then
-
1635  if (upper) then
-
1636  uplo = 'U'
-
1637  else
-
1638  uplo = 'L'
-
1639  end if
-
1640  else
-
1641  uplo = 'U'
-
1642  end if
-
1643  if (present(err)) then
-
1644  errmgr => err
-
1645  else
-
1646  errmgr => deferr
-
1647  end if
-
1648 
-
1649  ! Input Check
-
1650  if (size(a, 2) /= n) then
-
1651  ! ERROR: A must be square
-
1652  call errmgr%report_error("cholesky_factor_cmplx", &
-
1653  "The input matrix must be square.", la_array_size_error)
-
1654  return
-
1655  end if
-
1656 
-
1657  ! Process
-
1658  call zpotrf(uplo, n, a, n, flag)
-
1659  if (flag > 0) then
-
1660  ! ERROR: Matrix is not positive definite
-
1661  write(errmsg, '(AI0A)') "The leading minor of order ", flag, &
-
1662  " is not positive definite."
-
1663  call errmgr%report_error("cholesky_factor_cmplx", trim(errmsg), &
-
1664  la_matrix_format_error)
-
1665  end if
-
1666 
-
1667  ! Zero out the non-used upper or lower diagonal
-
1668  if (uplo == 'U') then
-
1669  ! Zero out the lower
-
1670  do i = 1, n - 1
-
1671  a(i+1:n,i) = zero
-
1672  end do
-
1673  else
-
1674  ! Zero out the upper
-
1675  do i = 2, n
-
1676  a(1:i-1,i) = zero
-
1677  end do
-
1678  end if
-
1679  end subroutine
-
1680 
-
1681 ! ------------------------------------------------------------------------------
-
1682  module subroutine cholesky_rank1_update_dbl(r, u, work, err)
-
1683  ! Arguments
-
1684  real(real64), intent(inout), dimension(:,:) :: r
-
1685  real(real64), intent(inout), dimension(:) :: u
-
1686  real(real64), intent(out), target, optional, dimension(:) :: work
-
1687  class(errors), intent(inout), optional, target :: err
-
1688 
-
1689  ! Local Variables
-
1690  integer(int32) :: n, lwork, istat, flag
-
1691  real(real64), pointer, dimension(:) :: wptr
-
1692  real(real64), allocatable, target, dimension(:) :: wrk
-
1693  class(errors), pointer :: errmgr
-
1694  type(errors), target :: deferr
-
1695  character(len = 128) :: errmsg
-
1696 
-
1697  ! Initialization
-
1698  n = size(r, 1)
-
1699  lwork = n
-
1700  if (present(err)) then
-
1701  errmgr => err
-
1702  else
-
1703  errmgr => deferr
-
1704  end if
-
1705 
-
1706  ! Input Check
-
1707  flag = 0
-
1708  if (size(r, 2) /= n) then
-
1709  flag = 1
-
1710  else if (size(u) /= n) then
-
1711  flag = 2
-
1712  end if
-
1713  if (flag /= 0) then
-
1714  write(errmsg, '(AI0A)') "Input number ", flag, &
-
1715  " is not sized correctly."
-
1716  call errmgr%report_error("cholesky_rank1_update", trim(errmsg), &
-
1717  la_array_size_error)
-
1718  return
-
1719  end if
-
1720 
-
1721  ! Local Memory Allocation
-
1722  if (present(work)) then
-
1723  if (size(work) < lwork) then
-
1724  ! ERROR: Workspace array is not sized correctly
-
1725  call errmgr%report_error("cholesky_rank1_update", &
-
1726  "The workspace array is too short.", &
-
1727  la_array_size_error)
-
1728  return
-
1729  end if
-
1730  wptr => work(1:lwork)
-
1731  else
-
1732  allocate(wrk(lwork), stat = istat)
-
1733  if (istat /= 0) then
-
1734  call errmgr%report_error("cholesky_rank1_update", &
-
1735  "Insufficient memory available.", &
-
1736  la_out_of_memory_error)
-
1737  return
-
1738  end if
-
1739  wptr => wrk
-
1740  end if
-
1741 
-
1742  ! Process
-
1743  call dch1up(n, r, n, u, wptr)
-
1744  end subroutine
-
1745 
-
1746 ! ------------------------------------------------------------------------------
-
1747  module subroutine cholesky_rank1_update_cmplx(r, u, work, err)
-
1748  ! Arguments
-
1749  complex(real64), intent(inout), dimension(:,:) :: r
-
1750  complex(real64), intent(inout), dimension(:) :: u
-
1751  real(real64), intent(out), target, optional, dimension(:) :: work
-
1752  class(errors), intent(inout), optional, target :: err
-
1753 
-
1754  ! Local Variables
-
1755  integer(int32) :: n, lwork, istat, flag
-
1756  real(real64), pointer, dimension(:) :: wptr
-
1757  real(real64), allocatable, target, dimension(:) :: wrk
-
1758  class(errors), pointer :: errmgr
-
1759  type(errors), target :: deferr
-
1760  character(len = 128) :: errmsg
-
1761 
-
1762  ! Initialization
-
1763  n = size(r, 1)
-
1764  lwork = n
-
1765  if (present(err)) then
-
1766  errmgr => err
-
1767  else
-
1768  errmgr => deferr
-
1769  end if
-
1770 
-
1771  ! Input Check
-
1772  flag = 0
-
1773  if (size(r, 2) /= n) then
-
1774  flag = 1
-
1775  else if (size(u) /= n) then
-
1776  flag = 2
-
1777  end if
-
1778  if (flag /= 0) then
-
1779  write(errmsg, '(AI0A)') "Input number ", flag, &
-
1780  " is not sized correctly."
-
1781  call errmgr%report_error("cholesky_rank1_update_cmplx", &
-
1782  trim(errmsg), &
-
1783  la_array_size_error)
-
1784  return
-
1785  end if
-
1786 
-
1787  ! Local Memory Allocation
-
1788  if (present(work)) then
-
1789  if (size(work) < lwork) then
-
1790  ! ERROR: Workspace array is not sized correctly
-
1791  call errmgr%report_error("cholesky_rank1_update_cmplx", &
-
1792  "The workspace array is too short.", &
-
1793  la_array_size_error)
-
1794  return
-
1795  end if
-
1796  wptr => work(1:lwork)
-
1797  else
-
1798  allocate(wrk(lwork), stat = istat)
-
1799  if (istat /= 0) then
-
1800  call errmgr%report_error("cholesky_rank1_update", &
-
1801  "Insufficient memory available.", &
-
1802  la_out_of_memory_error)
-
1803  return
-
1804  end if
-
1805  wptr => wrk
-
1806  end if
-
1807 
-
1808  ! Process
-
1809  call zch1up(n, r, n, u, wptr)
-
1810  end subroutine
-
1811 
-
1812 ! ------------------------------------------------------------------------------
-
1813  module subroutine cholesky_rank1_downdate_dbl(r, u, work, err)
-
1814  ! Arguments
-
1815  real(real64), intent(inout), dimension(:,:) :: r
-
1816  real(real64), intent(inout), dimension(:) :: u
-
1817  real(real64), intent(out), target, optional, dimension(:) :: work
-
1818  class(errors), intent(inout), optional, target :: err
-
1819 
-
1820  ! Local Variables
-
1821  integer(int32) :: n, lwork, istat, flag
-
1822  real(real64), pointer, dimension(:) :: wptr
-
1823  real(real64), allocatable, target, dimension(:) :: wrk
-
1824  class(errors), pointer :: errmgr
-
1825  type(errors), target :: deferr
-
1826  character(len = 128) :: errmsg
-
1827 
-
1828  ! Initialization
-
1829  n = size(r, 1)
-
1830  lwork = n
-
1831  if (present(err)) then
-
1832  errmgr => err
-
1833  else
-
1834  errmgr => deferr
-
1835  end if
-
1836 
-
1837  ! Input Check
-
1838  flag = 0
-
1839  if (size(r, 2) /= n) then
-
1840  flag = 1
-
1841  else if (size(u) /= n) then
-
1842  flag = 2
-
1843  end if
-
1844  if (flag /= 0) then
-
1845  write(errmsg, '(AI0A)') "Input number ", flag, &
-
1846  " is not sized correctly."
-
1847  call errmgr%report_error("cholesky_rank1_downdate", trim(errmsg), &
-
1848  la_array_size_error)
-
1849  return
-
1850  end if
-
1851 
-
1852  ! Local Memory Allocation
-
1853  if (present(work)) then
-
1854  if (size(work) < lwork) then
-
1855  ! ERROR: Workspace array is not sized correctly
-
1856  call errmgr%report_error("cholesky_rank1_downdate", &
-
1857  "The workspace array is too short.", &
-
1858  la_array_size_error)
-
1859  return
-
1860  end if
-
1861  wptr => work(1:lwork)
-
1862  else
-
1863  allocate(wrk(lwork), stat = istat)
-
1864  if (istat /= 0) then
-
1865  call errmgr%report_error("cholesky_rank1_downdate", &
-
1866  "Insufficient memory available.", &
-
1867  la_out_of_memory_error)
-
1868  return
-
1869  end if
-
1870  wptr => wrk
-
1871  end if
-
1872 
-
1873  ! Process
-
1874  call dch1dn(n, r, n, u, wptr, flag)
-
1875  if (flag == 1) then
-
1876  ! ERROR: The matrix is not positive definite
-
1877  call errmgr%report_error("cholesky_rank1_downdate", &
-
1878  "The downdated matrix is not positive definite.", &
-
1879  la_matrix_format_error)
-
1880  else if (flag == 2) then
-
1881  ! ERROR: The matrix is singular
-
1882  call errmgr%report_error("cholesky_rank1_downdate", &
-
1883  "The input matrix is singular.", la_singular_matrix_error)
-
1884  end if
-
1885  end subroutine
-
1886 
-
1887 ! ------------------------------------------------------------------------------
-
1888  module subroutine cholesky_rank1_downdate_cmplx(r, u, work, err)
-
1889  ! Arguments
-
1890  complex(real64), intent(inout), dimension(:,:) :: r
-
1891  complex(real64), intent(inout), dimension(:) :: u
-
1892  real(real64), intent(out), target, optional, dimension(:) :: work
-
1893  class(errors), intent(inout), optional, target :: err
-
1894 
-
1895  ! Local Variables
-
1896  integer(int32) :: n, lwork, istat, flag
-
1897  real(real64), pointer, dimension(:) :: wptr
-
1898  real(real64), allocatable, target, dimension(:) :: wrk
-
1899  class(errors), pointer :: errmgr
-
1900  type(errors), target :: deferr
-
1901  character(len = 128) :: errmsg
-
1902 
-
1903  ! Initialization
-
1904  n = size(r, 1)
-
1905  lwork = n
-
1906  if (present(err)) then
-
1907  errmgr => err
-
1908  else
-
1909  errmgr => deferr
-
1910  end if
-
1911 
-
1912  ! Input Check
-
1913  flag = 0
-
1914  if (size(r, 2) /= n) then
-
1915  flag = 1
-
1916  else if (size(u) /= n) then
-
1917  flag = 2
-
1918  end if
-
1919  if (flag /= 0) then
-
1920  write(errmsg, '(AI0A)') "Input number ", flag, &
-
1921  " is not sized correctly."
-
1922  call errmgr%report_error("cholesky_rank1_downdate_cmplx", &
-
1923  trim(errmsg), &
-
1924  la_array_size_error)
-
1925  return
-
1926  end if
-
1927 
-
1928  ! Local Memory Allocation
-
1929  if (present(work)) then
-
1930  if (size(work) < lwork) then
-
1931  ! ERROR: Workspace array is not sized correctly
-
1932  call errmgr%report_error("cholesky_rank1_downdate_cmplx", &
-
1933  "The workspace array is too short.", &
-
1934  la_array_size_error)
-
1935  return
-
1936  end if
-
1937  wptr => work(1:lwork)
-
1938  else
-
1939  allocate(wrk(lwork), stat = istat)
-
1940  if (istat /= 0) then
-
1941  call errmgr%report_error("cholesky_rank1_downdate_cmplx", &
-
1942  "Insufficient memory available.", &
-
1943  la_out_of_memory_error)
-
1944  return
-
1945  end if
-
1946  wptr => wrk
-
1947  end if
-
1948 
-
1949  ! Process
-
1950  call zch1dn(n, r, n, u, wptr, flag)
-
1951  if (flag == 1) then
-
1952  ! ERROR: The matrix is not positive definite
-
1953  call errmgr%report_error("cholesky_rank1_downdate_cmplx", &
-
1954  "The downdated matrix is not positive definite.", &
-
1955  la_matrix_format_error)
-
1956  else if (flag == 2) then
-
1957  ! ERROR: The matrix is singular
-
1958  call errmgr%report_error("cholesky_rank1_downdate_cmplx", &
-
1959  "The input matrix is singular.", la_singular_matrix_error)
-
1960  end if
-
1961  end subroutine
-
1962 
-
1963 ! ******************************************************************************
-
1964 ! RZ FACTORIZATION ROUTINES
-
1965 ! ------------------------------------------------------------------------------
-
1966  module subroutine rz_factor_dbl(a, tau, work, olwork, err)
-
1967  ! Arguments
-
1968  real(real64), intent(inout), dimension(:,:) :: a
-
1969  real(real64), intent(out), dimension(:) :: tau
-
1970  real(real64), intent(out), target, optional, dimension(:) :: work
-
1971  integer(int32), intent(out), optional :: olwork
-
1972  class(errors), intent(inout), optional, target :: err
-
1973 
-
1974  ! Local Variables
-
1975  integer(int32) :: m, n, lwork, flag, istat
-
1976  real(real64), pointer, dimension(:) :: wptr
-
1977  real(real64), allocatable, target, dimension(:) :: wrk
-
1978  real(real64), dimension(1) :: temp
-
1979  class(errors), pointer :: errmgr
-
1980  type(errors), target :: deferr
-
1981  character(len = 128) :: errmsg
-
1982 
-
1983  ! Initialization
-
1984  m = size(a, 1)
-
1985  n = size(a, 2)
-
1986  if (present(err)) then
-
1987  errmgr => err
-
1988  else
-
1989  errmgr => deferr
-
1990  end if
-
1991 
-
1992  ! Input Check
-
1993  flag = 0
-
1994  if (size(tau) /= m) then
-
1995  flag = 3
-
1996  end if
-
1997  if (flag /= 0) then
-
1998  ! ERROR: One of the input arrays is not sized correctly
-
1999  write(errmsg, '(AI0A)') "Input number ", flag, &
-
2000  " is not sized correctly."
-
2001  call errmgr%report_error("rz_factor", trim(errmsg), &
-
2002  la_array_size_error)
-
2003  return
-
2004  end if
-
2005 
-
2006  ! Workspace Query
-
2007  call dtzrzf(m, n, a, m, tau, temp, -1, flag)
-
2008  lwork = int(temp(1), int32)
-
2009  if (present(olwork)) then
-
2010  olwork = lwork
-
2011  return
-
2012  end if
-
2013 
-
2014  ! Local Memory Allocation
-
2015  if (present(work)) then
-
2016  if (size(work) < lwork) then
-
2017  ! ERROR: WORK not sized correctly
-
2018  call errmgr%report_error("rz_factor", &
-
2019  "Incorrectly sized input array WORK, argument 3.", &
-
2020  la_array_size_error)
-
2021  return
-
2022  end if
-
2023  wptr => work(1:lwork)
-
2024  else
-
2025  allocate(wrk(lwork), stat = istat)
-
2026  if (istat /= 0) then
-
2027  ! ERROR: Out of memory
-
2028  call errmgr%report_error("rz_factor", &
-
2029  "Insufficient memory available.", &
-
2030  la_out_of_memory_error)
-
2031  return
-
2032  end if
-
2033  wptr => wrk
-
2034  end if
-
2035 
-
2036  ! Call DTZRZF
-
2037  call dtzrzf(m, n, a, m, tau, wptr, lwork, flag)
-
2038  end subroutine
-
2039 
-
2040 ! ------------------------------------------------------------------------------
-
2041  module subroutine rz_factor_cmplx(a, tau, work, olwork, err)
-
2042  ! Arguments
-
2043  complex(real64), intent(inout), dimension(:,:) :: a
-
2044  complex(real64), intent(out), dimension(:) :: tau
-
2045  complex(real64), intent(out), target, optional, dimension(:) :: work
-
2046  integer(int32), intent(out), optional :: olwork
-
2047  class(errors), intent(inout), optional, target :: err
-
2048 
-
2049  ! Local Variables
-
2050  integer(int32) :: m, n, lwork, flag, istat
-
2051  complex(real64), pointer, dimension(:) :: wptr
-
2052  complex(real64), allocatable, target, dimension(:) :: wrk
-
2053  complex(real64), dimension(1) :: temp
-
2054  class(errors), pointer :: errmgr
-
2055  type(errors), target :: deferr
-
2056  character(len = 128) :: errmsg
-
2057 
-
2058  ! Initialization
-
2059  m = size(a, 1)
-
2060  n = size(a, 2)
-
2061  if (present(err)) then
-
2062  errmgr => err
-
2063  else
-
2064  errmgr => deferr
-
2065  end if
-
2066 
-
2067  ! Input Check
-
2068  flag = 0
-
2069  if (size(tau) /= m) then
-
2070  flag = 3
-
2071  end if
-
2072  if (flag /= 0) then
-
2073  ! ERROR: One of the input arrays is not sized correctly
-
2074  write(errmsg, '(AI0A)') "Input number ", flag, &
-
2075  " is not sized correctly."
-
2076  call errmgr%report_error("rz_factor_cmplx", trim(errmsg), &
-
2077  la_array_size_error)
-
2078  return
-
2079  end if
-
2080 
-
2081  ! Workspace Query
-
2082  call ztzrzf(m, n, a, m, tau, temp, -1, flag)
-
2083  lwork = int(temp(1), int32)
-
2084  if (present(olwork)) then
-
2085  olwork = lwork
-
2086  return
-
2087  end if
-
2088 
-
2089  ! Local Memory Allocation
-
2090  if (present(work)) then
-
2091  if (size(work) < lwork) then
-
2092  ! ERROR: WORK not sized correctly
-
2093  call errmgr%report_error("rz_factor_cmplx", &
-
2094  "Incorrectly sized input array WORK, argument 3.", &
-
2095  la_array_size_error)
-
2096  return
-
2097  end if
-
2098  wptr => work(1:lwork)
-
2099  else
-
2100  allocate(wrk(lwork), stat = istat)
-
2101  if (istat /= 0) then
-
2102  ! ERROR: Out of memory
-
2103  call errmgr%report_error("rz_factor_cmplx", &
-
2104  "Insufficient memory available.", &
-
2105  la_out_of_memory_error)
-
2106  return
-
2107  end if
-
2108  wptr => wrk
-
2109  end if
-
2110 
-
2111  ! Call ZTZRZF
-
2112  call ztzrzf(m, n, a, m, tau, wptr, lwork, flag)
-
2113  end subroutine
-
2114 
-
2115 ! ------------------------------------------------------------------------------
-
2116  module subroutine mult_rz_mtx(lside, trans, l, a, tau, c, work, olwork, err)
-
2117  ! Arguments
-
2118  logical, intent(in) :: lside, trans
-
2119  integer(int32), intent(in) :: l
-
2120  real(real64), intent(inout), dimension(:,:) :: a, c
-
2121  real(real64), intent(in), dimension(:) :: tau
-
2122  real(real64), intent(out), target, optional, dimension(:) :: work
-
2123  integer(int32), intent(out), optional :: olwork
-
2124  class(errors), intent(inout), optional, target :: err
-
2125 
-
2126  ! Local Variables
-
2127  character :: side, t
-
2128  integer(int32) :: m, n, k, lwork, flag, istat, lda
-
2129  real(real64), pointer, dimension(:) :: wptr
-
2130  real(real64), allocatable, target, dimension(:) :: wrk
-
2131  real(real64), dimension(1) :: temp
-
2132  class(errors), pointer :: errmgr
-
2133  type(errors), target :: deferr
-
2134  character(len = 128) :: errmsg
-
2135 
-
2136  ! Initialization
-
2137  m = size(c, 1)
-
2138  n = size(c, 2)
-
2139  k = size(tau)
-
2140  lda = size(a, 1)
-
2141  if (lside) then
-
2142  side = 'L'
-
2143  else
-
2144  side = 'R'
-
2145  end if
-
2146  if (trans) then
-
2147  t = 'T'
-
2148  else
-
2149  t = 'N'
-
2150  end if
-
2151  if (present(err)) then
-
2152  errmgr => err
-
2153  else
-
2154  errmgr => deferr
-
2155  end if
-
2156 
-
2157  ! Input Check
-
2158  flag = 0
-
2159  if (lside) then
-
2160  if (l > m .or. l < 0) then
-
2161  flag = 3
-
2162  else if (k > m) then
-
2163  flag = 5
-
2164  else if (size(a, 1) < k .or. size(a, 2) /= m) then
-
2165  flag = 4
-
2166  end if
-
2167  else
-
2168  if (l > n .or. l < 0) then
-
2169  flag = 3
-
2170  else if (k > n) then
-
2171  flag = 5
-
2172  else if (size(a, 1) < k .or. size(a, 2) /= n) then
-
2173  flag = 4
-
2174  end if
-
2175  end if
-
2176  if (flag /= 0) then
-
2177  ! ERROR: One of the input arrays is not sized correctly
-
2178  write(errmsg, '(AI0A)') "Input number ", flag, &
-
2179  " is not sized correctly."
-
2180  call errmgr%report_error("mult_rz_mtx", trim(errmsg), &
-
2181  la_array_size_error)
-
2182  return
-
2183  end if
-
2184 
-
2185  ! Workspace Query
-
2186  call dormrz(side, t, m, n, k, l, a, lda, tau, c, m, temp, -1, flag)
-
2187  lwork = int(temp(1), int32)
-
2188  if (present(olwork)) then
-
2189  olwork = lwork
-
2190  return
-
2191  end if
-
2192 
-
2193  ! Local Memory Allocation
-
2194  if (present(work)) then
-
2195  if (size(work) < lwork) then
-
2196  ! ERROR: WORK not sized correctly
-
2197  call errmgr%report_error("mult_rz_mtx", &
-
2198  "Incorrectly sized input array WORK, argument 7.", &
-
2199  la_array_size_error)
-
2200  return
-
2201  end if
-
2202  wptr => work(1:lwork)
-
2203  else
-
2204  allocate(wrk(lwork), stat = istat)
-
2205  if (istat /= 0) then
-
2206  ! ERROR: Out of memory
-
2207  call errmgr%report_error("mult_rz_mtx", &
-
2208  "Insufficient memory available.", &
-
2209  la_out_of_memory_error)
-
2210  return
-
2211  end if
-
2212  wptr => wrk
-
2213  end if
-
2214 
-
2215  ! Call DORMRZ
-
2216  call dormrz(side, t, m, n, k, l, a, lda, tau, c, m, wptr, lwork, flag)
-
2217  end subroutine
-
2218 
-
2219 ! ------------------------------------------------------------------------------
-
2220  module subroutine mult_rz_mtx_cmplx(lside, trans, l, a, tau, c, work, olwork, err)
-
2221  ! Arguments
-
2222  logical, intent(in) :: lside, trans
-
2223  integer(int32), intent(in) :: l
-
2224  complex(real64), intent(inout), dimension(:,:) :: a, c
-
2225  complex(real64), intent(in), dimension(:) :: tau
-
2226  complex(real64), intent(out), target, optional, dimension(:) :: work
-
2227  integer(int32), intent(out), optional :: olwork
-
2228  class(errors), intent(inout), optional, target :: err
-
2229 
-
2230  ! Local Variables
-
2231  character :: side, t
-
2232  integer(int32) :: m, n, k, lwork, flag, istat, lda
-
2233  complex(real64), pointer, dimension(:) :: wptr
-
2234  complex(real64), allocatable, target, dimension(:) :: wrk
-
2235  complex(real64), dimension(1) :: temp
-
2236  class(errors), pointer :: errmgr
-
2237  type(errors), target :: deferr
-
2238  character(len = 128) :: errmsg
-
2239 
-
2240  ! Initialization
-
2241  m = size(c, 1)
-
2242  n = size(c, 2)
-
2243  k = size(tau)
-
2244  lda = size(a, 1)
-
2245  if (lside) then
-
2246  side = 'L'
-
2247  else
-
2248  side = 'R'
-
2249  end if
-
2250  if (trans) then
-
2251  t = 'C'
-
2252  else
-
2253  t = 'N'
-
2254  end if
-
2255  if (present(err)) then
-
2256  errmgr => err
-
2257  else
-
2258  errmgr => deferr
-
2259  end if
-
2260 
-
2261  ! Input Check
-
2262  flag = 0
-
2263  if (lside) then
-
2264  if (l > m .or. l < 0) then
-
2265  flag = 3
-
2266  else if (k > m) then
-
2267  flag = 5
-
2268  else if (size(a, 1) < k .or. size(a, 2) /= m) then
-
2269  flag = 4
-
2270  end if
-
2271  else
-
2272  if (l > n .or. l < 0) then
-
2273  flag = 3
-
2274  else if (k > n) then
-
2275  flag = 5
-
2276  else if (size(a, 1) < k .or. size(a, 2) /= n) then
-
2277  flag = 4
-
2278  end if
-
2279  end if
-
2280  if (flag /= 0) then
-
2281  ! ERROR: One of the input arrays is not sized correctly
-
2282  write(errmsg, '(AI0A)') "Input number ", flag, &
-
2283  " is not sized correctly."
-
2284  call errmgr%report_error("mult_rz_mtx_cmplx", trim(errmsg), &
-
2285  la_array_size_error)
-
2286  return
-
2287  end if
-
2288 
-
2289  ! Workspace Query
-
2290  call zunmrz(side, t, m, n, k, l, a, lda, tau, c, m, temp, -1, flag)
-
2291  lwork = int(temp(1), int32)
-
2292  if (present(olwork)) then
-
2293  olwork = lwork
-
2294  return
-
2295  end if
-
2296 
-
2297  ! Local Memory Allocation
-
2298  if (present(work)) then
-
2299  if (size(work) < lwork) then
-
2300  ! ERROR: WORK not sized correctly
-
2301  call errmgr%report_error("mult_rz_mtx_cmplx", &
-
2302  "Incorrectly sized input array WORK, argument 7.", &
-
2303  la_array_size_error)
-
2304  return
-
2305  end if
-
2306  wptr => work(1:lwork)
-
2307  else
-
2308  allocate(wrk(lwork), stat = istat)
-
2309  if (istat /= 0) then
-
2310  ! ERROR: Out of memory
-
2311  call errmgr%report_error("mult_rz_mtx_cmplx", &
-
2312  "Insufficient memory available.", &
-
2313  la_out_of_memory_error)
-
2314  return
-
2315  end if
-
2316  wptr => wrk
-
2317  end if
-
2318 
-
2319  ! Call ZUNMRZ
-
2320  call zunmrz(side, t, m, n, k, l, a, lda, tau, c, m, wptr, lwork, flag)
-
2321  end subroutine
-
2322 
-
2323 ! ------------------------------------------------------------------------------
-
2324  module subroutine mult_rz_vec(trans, l, a, tau, c, work, olwork, err)
-
2325  ! Arguments
-
2326  logical, intent(in) :: trans
-
2327  integer(int32), intent(in) :: l
-
2328  real(real64), intent(inout), dimension(:,:) :: a
-
2329  real(real64), intent(in), dimension(:) :: tau
-
2330  real(real64), intent(inout), dimension(:) :: c
-
2331  real(real64), intent(out), target, optional, dimension(:) :: work
-
2332  integer(int32), intent(out), optional :: olwork
-
2333  class(errors), intent(inout), optional, target :: err
-
2334 
-
2335  ! Local Variables
-
2336  character :: side, t
-
2337  integer(int32) :: m, k, lwork, flag, istat, lda
-
2338  real(real64), pointer, dimension(:) :: wptr
-
2339  real(real64), allocatable, target, dimension(:) :: wrk
-
2340  real(real64), dimension(1) :: temp
-
2341  class(errors), pointer :: errmgr
-
2342  type(errors), target :: deferr
-
2343  character(len = 128) :: errmsg
-
2344 
-
2345  ! Initialization
-
2346  m = size(c)
-
2347  k = size(tau)
-
2348  lda = size(a, 1)
-
2349  side = 'L'
-
2350  if (trans) then
-
2351  t = 'T'
-
2352  else
-
2353  t = 'N'
-
2354  end if
-
2355  if (present(err)) then
-
2356  errmgr => err
-
2357  else
-
2358  errmgr => deferr
-
2359  end if
-
2360 
-
2361  ! Input Check
-
2362  flag = 0
-
2363  if (l > m .or. l < 0) then
-
2364  flag = 2
-
2365  else if (k > m) then
-
2366  flag = 4
-
2367  else if (size(a, 1) < k .or. size(a, 2) /= m) then
-
2368  flag = 3
-
2369  end if
-
2370  if (flag /= 0) then
-
2371  ! ERROR: One of the input arrays is not sized correctly
-
2372  write(errmsg, '(AI0A)') "Input number ", flag, &
-
2373  " is not sized correctly."
-
2374  call errmgr%report_error("mult_rz_vec", trim(errmsg), &
-
2375  la_array_size_error)
-
2376  return
-
2377  end if
-
2378 
-
2379  ! Workspace Query
-
2380  call dormrz(side, t, m, 1, k, l, a, lda, tau, c, m, temp, -1, flag)
-
2381  lwork = int(temp(1), int32)
-
2382  if (present(olwork)) then
-
2383  olwork = lwork
-
2384  return
-
2385  end if
-
2386 
-
2387  ! Local Memory Allocation
-
2388  if (present(work)) then
-
2389  if (size(work) < lwork) then
-
2390  ! ERROR: WORK not sized correctly
-
2391  call errmgr%report_error("mult_rz_vec", &
-
2392  "Incorrectly sized input array WORK, argument 6.", &
-
2393  la_array_size_error)
-
2394  return
-
2395  end if
-
2396  wptr => work(1:lwork)
-
2397  else
-
2398  allocate(wrk(lwork), stat = istat)
-
2399  if (istat /= 0) then
-
2400  ! ERROR: Out of memory
-
2401  call errmgr%report_error("mult_rz_vec", &
-
2402  "Insufficient memory available.", &
-
2403  la_out_of_memory_error)
-
2404  return
-
2405  end if
-
2406  wptr => wrk
-
2407  end if
-
2408 
-
2409  ! Call DORMRZ
-
2410  call dormrz(side, t, m, 1, k, l, a, lda, tau, c, m, wptr, lwork, flag)
-
2411  end subroutine
-
2412 
-
2413 ! ------------------------------------------------------------------------------
-
2414  module subroutine mult_rz_vec_cmplx(trans, l, a, tau, c, work, olwork, err)
-
2415  ! Arguments
-
2416  logical, intent(in) :: trans
-
2417  integer(int32), intent(in) :: l
-
2418  complex(real64), intent(inout), dimension(:,:) :: a
-
2419  complex(real64), intent(in), dimension(:) :: tau
-
2420  complex(real64), intent(inout), dimension(:) :: c
-
2421  complex(real64), intent(out), target, optional, dimension(:) :: work
-
2422  integer(int32), intent(out), optional :: olwork
-
2423  class(errors), intent(inout), optional, target :: err
-
2424 
-
2425  ! Local Variables
-
2426  character :: side, t
-
2427  integer(int32) :: m, k, lwork, flag, istat, lda
-
2428  complex(real64), pointer, dimension(:) :: wptr
-
2429  complex(real64), allocatable, target, dimension(:) :: wrk
-
2430  complex(real64), dimension(1) :: temp
-
2431  class(errors), pointer :: errmgr
-
2432  type(errors), target :: deferr
-
2433  character(len = 128) :: errmsg
-
2434 
-
2435  ! Initialization
-
2436  m = size(c)
-
2437  k = size(tau)
-
2438  lda = size(a, 1)
-
2439  side = 'L'
-
2440  if (trans) then
-
2441  t = 'T'
-
2442  else
-
2443  t = 'N'
-
2444  end if
-
2445  if (present(err)) then
-
2446  errmgr => err
-
2447  else
-
2448  errmgr => deferr
-
2449  end if
-
2450 
-
2451  ! Input Check
-
2452  flag = 0
-
2453  if (l > m .or. l < 0) then
-
2454  flag = 2
-
2455  else if (k > m) then
-
2456  flag = 4
-
2457  else if (size(a, 1) < k .or. size(a, 2) /= m) then
-
2458  flag = 3
-
2459  end if
-
2460  if (flag /= 0) then
-
2461  ! ERROR: One of the input arrays is not sized correctly
-
2462  write(errmsg, '(AI0A)') "Input number ", flag, &
-
2463  " is not sized correctly."
-
2464  call errmgr%report_error("mult_rz_vec_cmplx", trim(errmsg), &
-
2465  la_array_size_error)
-
2466  return
-
2467  end if
-
2468 
-
2469  ! Workspace Query
-
2470  call zunmrz(side, t, m, 1, k, l, a, lda, tau, c, m, temp, -1, flag)
-
2471  lwork = int(temp(1), int32)
-
2472  if (present(olwork)) then
-
2473  olwork = lwork
-
2474  return
-
2475  end if
-
2476 
-
2477  ! Local Memory Allocation
-
2478  if (present(work)) then
-
2479  if (size(work) < lwork) then
-
2480  ! ERROR: WORK not sized correctly
-
2481  call errmgr%report_error("mult_rz_vec_cmplx", &
-
2482  "Incorrectly sized input array WORK, argument 6.", &
-
2483  la_array_size_error)
-
2484  return
-
2485  end if
-
2486  wptr => work(1:lwork)
-
2487  else
-
2488  allocate(wrk(lwork), stat = istat)
-
2489  if (istat /= 0) then
-
2490  ! ERROR: Out of memory
-
2491  call errmgr%report_error("mult_rz_vec_cmplx", &
-
2492  "Insufficient memory available.", &
-
2493  la_out_of_memory_error)
-
2494  return
-
2495  end if
-
2496  wptr => wrk
-
2497  end if
-
2498 
-
2499  ! Call ZUNMRZ
-
2500  call zunmrz(side, t, m, 1, k, l, a, lda, tau, c, m, wptr, lwork, flag)
-
2501  end subroutine
-
2502 
-
2503 ! ******************************************************************************
-
2504 ! SVD ROUTINES
-
2505 ! ------------------------------------------------------------------------------
-
2506  module subroutine svd_dbl(a, s, u, vt, work, olwork, err)
-
2507  ! Arguments
-
2508  real(real64), intent(inout), dimension(:,:) :: a
-
2509  real(real64), intent(out), dimension(:) :: s
-
2510  real(real64), intent(out), optional, dimension(:,:) :: u, vt
-
2511  real(real64), intent(out), target, optional, dimension(:) :: work
-
2512  integer(int32), intent(out), optional :: olwork
-
2513  class(errors), intent(inout), optional, target :: err
-
2514 
-
2515  ! Local Variables
-
2516  character :: jobu, jobvt
-
2517  integer(int32) :: m, n, mn, istat, lwork, flag
-
2518  real(real64), pointer, dimension(:) :: wptr
-
2519  real(real64), allocatable, target, dimension(:) :: wrk
-
2520  real(real64), dimension(1) :: temp
-
2521  class(errors), pointer :: errmgr
-
2522  type(errors), target :: deferr
-
2523  character(len = 128) :: errmsg
-
2524 
-
2525  ! Initialization
-
2526  m = size(a, 1)
-
2527  n = size(a, 2)
-
2528  mn = min(m, n)
-
2529  if (present(u)) then
-
2530  if (size(u, 2) == m) then
-
2531  jobu = 'A'
-
2532  else if (size(u, 2) == mn) then
-
2533  jobu = 'S'
-
2534  end if
-
2535  else
-
2536  jobu = 'N'
-
2537  end if
-
2538  if (present(vt)) then
-
2539  jobvt = 'A'
-
2540  else
-
2541  jobvt = 'N'
-
2542  end if
-
2543  if (present(err)) then
-
2544  errmgr => err
-
2545  else
-
2546  errmgr => deferr
-
2547  end if
-
2548 
-
2549  ! Input Check
-
2550  flag = 0
-
2551  if (size(s) /= mn) then
-
2552  flag = 2
-
2553  else if (present(u)) then
-
2554  if (size(u, 1) /= m) flag = 3
-
2555  if (size(u, 2) /= m .and. size(u, 2) /= mn) flag = 3
-
2556  else if (present(vt)) then
-
2557  if (size(vt, 1) /= n .or. size(vt, 2) /= n) flag = 4
-
2558  end if
-
2559  if (flag /= 0) then
-
2560  ! ERROR: One of the input arrays is not sized correctly
-
2561  write(errmsg, '(AI0A)') "Input number ", flag, &
-
2562  " is not sized correctly."
-
2563  call errmgr%report_error("svd", trim(errmsg), &
-
2564  la_array_size_error)
-
2565  return
-
2566  end if
-
2567 
-
2568  ! Workspace Query
-
2569  call dgesvd(jobu, jobvt, m, n, a, m, s, temp, m, temp, n, temp, -1, &
-
2570  flag)
-
2571  lwork = int(temp(1), int32)
-
2572  if (present(olwork)) then
-
2573  olwork = lwork
-
2574  return
-
2575  end if
-
2576 
-
2577  ! Local Memory Allocation
-
2578  if (present(work)) then
-
2579  if (size(work) < lwork) then
-
2580  ! ERROR: WORK not sized correctly
-
2581  call errmgr%report_error("svd", &
-
2582  "Incorrectly sized input array WORK, argument 5.", &
-
2583  la_array_size_error)
-
2584  return
-
2585  end if
-
2586  wptr => work(1:lwork)
-
2587  else
-
2588  allocate(wrk(lwork), stat = istat)
-
2589  if (istat /= 0) then
-
2590  ! ERROR: Out of memory
-
2591  call errmgr%report_error("svd", &
-
2592  "Insufficient memory available.", &
-
2593  la_out_of_memory_error)
-
2594  return
-
2595  end if
-
2596  wptr => wrk
-
2597  end if
-
2598 
-
2599  ! Call DGESVD
-
2600  if (present(u) .and. present(vt)) then
-
2601  call dgesvd(jobu, jobvt, m, n, a, m, s, u, m, vt, n, wptr, lwork, &
-
2602  flag)
-
2603  else if (present(u) .and. .not.present(vt)) then
-
2604  call dgesvd(jobu, jobvt, m, n, a, m, s, u, m, temp, n, wptr, &
-
2605  lwork, flag)
-
2606  else if (.not.present(u) .and. present(vt)) then
-
2607  call dgesvd(jobu, jobvt, m, n, a, m, s, temp, m, vt, n, wptr, &
-
2608  lwork, flag)
-
2609  else
-
2610  call dgesvd(jobu, jobvt, m, n, a, m, s, temp, m, temp, n, wptr, &
-
2611  lwork, flag)
-
2612  end if
-
2613 
-
2614  ! Check for convergence
-
2615  if (flag > 0) then
-
2616  write(errmsg, '(I0A)') flag, " superdiagonals could not " // &
-
2617  "converge to zero as part of the QR iteration process."
-
2618  call errmgr%report_warning("svd", errmsg, la_convergence_error)
-
2619  end if
-
2620  end subroutine
-
2621 
-
2622 ! ------------------------------------------------------------------------------
-
2623  module subroutine svd_cmplx(a, s, u, vt, work, olwork, rwork, err)
-
2624  ! Arguments
-
2625  complex(real64), intent(inout), dimension(:,:) :: a
-
2626  real(real64), intent(out), dimension(:) :: s
-
2627  complex(real64), intent(out), optional, dimension(:,:) :: u, vt
-
2628  complex(real64), intent(out), target, optional, dimension(:) :: work
-
2629  integer(int32), intent(out), optional :: olwork
-
2630  real(real64), intent(out), target, optional, dimension(:) :: rwork
-
2631  class(errors), intent(inout), optional, target :: err
-
2632 
-
2633  ! Local Variables
-
2634  character :: jobu, jobvt
-
2635  integer(int32) :: m, n, mn, istat, lwork, flag, lrwork
-
2636  complex(real64), pointer, dimension(:) :: wptr
-
2637  complex(real64), allocatable, target, dimension(:) :: wrk
-
2638  complex(real64), dimension(1) :: temp
-
2639  real(real64), dimension(1) :: rtemp
-
2640  real(real64), pointer, dimension(:) :: rwptr
-
2641  real(real64), allocatable, target, dimension(:) :: rwrk
-
2642  class(errors), pointer :: errmgr
-
2643  type(errors), target :: deferr
-
2644  character(len = 128) :: errmsg
-
2645 
-
2646  ! Initialization
-
2647  m = size(a, 1)
-
2648  n = size(a, 2)
-
2649  mn = min(m, n)
-
2650  lrwork = 5 * mn
-
2651  if (present(u)) then
-
2652  if (size(u, 2) == m) then
-
2653  jobu = 'A'
-
2654  else if (size(u, 2) == mn) then
-
2655  jobu = 'S'
-
2656  end if
-
2657  else
-
2658  jobu = 'N'
-
2659  end if
-
2660  if (present(vt)) then
-
2661  jobvt = 'A'
-
2662  else
-
2663  jobvt = 'N'
-
2664  end if
-
2665  if (present(err)) then
-
2666  errmgr => err
-
2667  else
-
2668  errmgr => deferr
-
2669  end if
-
2670 
-
2671  ! Input Check
-
2672  flag = 0
-
2673  if (size(s) /= mn) then
-
2674  flag = 2
-
2675  else if (present(u)) then
-
2676  if (size(u, 1) /= m) flag = 3
-
2677  if (size(u, 2) /= m .and. size(u, 2) /= mn) flag = 3
-
2678  else if (present(vt)) then
-
2679  if (size(vt, 1) /= n .or. size(vt, 2) /= n) flag = 4
-
2680  end if
-
2681  if (flag /= 0) then
-
2682  ! ERROR: One of the input arrays is not sized correctly
-
2683  write(errmsg, '(AI0A)') "Input number ", flag, &
-
2684  " is not sized correctly."
-
2685  call errmgr%report_error("svd_cmplx", trim(errmsg), &
-
2686  la_array_size_error)
-
2687  return
-
2688  end if
-
2689 
-
2690  ! Workspace Query
-
2691  call zgesvd(jobu, jobvt, m, n, a, m, s, temp, m, temp, n, temp, -1, &
-
2692  rtemp, flag)
-
2693  lwork = int(temp(1), int32)
-
2694  if (present(olwork)) then
-
2695  olwork = lwork
-
2696  return
-
2697  end if
-
2698 
-
2699  ! Local Memory Allocation
-
2700  if (present(work)) then
-
2701  if (size(work) < lwork) then
-
2702  ! ERROR: WORK not sized correctly
-
2703  call errmgr%report_error("svd_cmplx", &
-
2704  "Incorrectly sized input array WORK, argument 5.", &
-
2705  la_array_size_error)
-
2706  return
-
2707  end if
-
2708  wptr => work(1:lwork)
-
2709  else
-
2710  allocate(wrk(lwork), stat = istat)
-
2711  if (istat /= 0) then
-
2712  ! ERROR: Out of memory
-
2713  call errmgr%report_error("svd_cmplx", &
-
2714  "Insufficient memory available.", &
-
2715  la_out_of_memory_error)
-
2716  return
-
2717  end if
-
2718  wptr => wrk
-
2719  end if
-
2720 
-
2721  if (present(rwork)) then
-
2722  if (size(rwork) < lrwork) then
-
2723  ! ERROR: RWORK not sized correctly
-
2724  call errmgr%report_error("svd_cmplx", &
-
2725  "Incorrectly sized input array RWORK, argument 7.", &
-
2726  la_array_size_error)
-
2727  end if
-
2728  rwptr => rwork(1:lrwork)
-
2729  else
-
2730  allocate(rwrk(lrwork), stat = istat)
-
2731  if (istat /= 0) then
-
2732  ! ERROR: Out of memory
-
2733  call errmgr%report_error("svd_cmplx", &
-
2734  "Insufficient memory available.", &
-
2735  la_out_of_memory_error)
-
2736  return
-
2737  end if
-
2738  rwptr => rwrk
-
2739  end if
-
2740 
-
2741  ! Call ZGESVD
-
2742  if (present(u) .and. present(vt)) then
-
2743  call zgesvd(jobu, jobvt, m, n, a, m, s, u, m, vt, n, wptr, lwork, &
-
2744  rwptr, flag)
-
2745  else if (present(u) .and. .not.present(vt)) then
-
2746  call zgesvd(jobu, jobvt, m, n, a, m, s, u, m, temp, n, wptr, &
-
2747  rwptr, lwork, flag)
-
2748  else if (.not.present(u) .and. present(vt)) then
-
2749  call zgesvd(jobu, jobvt, m, n, a, m, s, temp, m, vt, n, wptr, &
-
2750  rwptr, lwork, flag)
-
2751  else
-
2752  call zgesvd(jobu, jobvt, m, n, a, m, s, temp, m, temp, n, wptr, &
-
2753  rwptr, lwork, flag)
-
2754  end if
-
2755 
-
2756  ! Check for convergence
-
2757  if (flag > 0) then
-
2758  write(errmsg, '(I0A)') flag, " superdiagonals could not " // &
-
2759  "converge to zero as part of the QR iteration process."
-
2760  call errmgr%report_warning("svd_cmplx", errmsg, &
-
2761  la_convergence_error)
-
2762  end if
-
2763  end subroutine
-
2764 
-
2765 end submodule
+
1! linalg_factor.f90
+
2
+
7submodule(linalg_core) linalg_factor
+
8contains
+
9! ******************************************************************************
+
10! LU FACTORIZATION
+
11! ------------------------------------------------------------------------------
+
12 module subroutine lu_factor_dbl(a, ipvt, err)
+
13 ! Arguments
+
14 real(real64), intent(inout), dimension(:,:) :: a
+
15 integer(int32), intent(out), dimension(:) :: ipvt
+
16 class(errors), intent(inout), optional, target :: err
+
17
+
18 ! Local Variables
+
19 integer(int32) :: m, n, mn, flag
+
20 class(errors), pointer :: errmgr
+
21 type(errors), target :: deferr
+
22 character(len = 128) :: errmsg
+
23
+
24 ! Initialization
+
25 m = size(a, 1)
+
26 n = size(a, 2)
+
27 mn = min(m, n)
+
28 if (present(err)) then
+
29 errmgr => err
+
30 else
+
31 errmgr => deferr
+
32 end if
+
33
+
34 ! Input Check
+
35 flag = 0
+
36 if (size(ipvt) /= mn) then
+
37 ! ERROR: IPVT not sized correctly
+
38 call errmgr%report_error("lu_factor_dbl", &
+
39 "Incorrectly sized input array IPVT, argument 2.", &
+
40 la_array_size_error)
+
41 return
+
42 end if
+
43
+
44 ! Compute the LU factorization by calling the LAPACK routine DGETRF
+
45 call dgetrf(m, n, a, m, ipvt, flag)
+
46
+
47 ! If flag > 0, the matrix is singular. Notice, flag should not be
+
48 ! able to be < 0 as we've already verrified inputs prior to making the
+
49 ! call to LAPACK
+
50 if (flag > 0) then
+
51 ! WARNING: Singular matrix
+
52 write(errmsg, '(AI0A)') &
+
53 "Singular matrix encountered (row ", flag, ")"
+
54 call errmgr%report_warning("lu_factor_dbl", trim(errmsg), &
+
55 la_singular_matrix_error)
+
56 end if
+
57 end subroutine
+
58
+
59! ------------------------------------------------------------------------------
+
60 module subroutine lu_factor_cmplx(a, ipvt, err)
+
61 ! Arguments
+
62 complex(real64), intent(inout), dimension(:,:) :: a
+
63 integer(int32), intent(out), dimension(:) :: ipvt
+
64 class(errors), intent(inout), optional, target :: err
+
65
+
66 ! Local Variables
+
67 integer(int32) :: m, n, mn, flag
+
68 class(errors), pointer :: errmgr
+
69 type(errors), target :: deferr
+
70 character(len = 128) :: errmsg
+
71
+
72 ! Initialization
+
73 m = size(a, 1)
+
74 n = size(a, 2)
+
75 mn = min(m, n)
+
76 if (present(err)) then
+
77 errmgr => err
+
78 else
+
79 errmgr => deferr
+
80 end if
+
81
+
82 ! Input Check
+
83 flag = 0
+
84 if (size(ipvt) /= mn) then
+
85 ! ERROR: IPVT not sized correctly
+
86 call errmgr%report_error("lu_factor_cmplx", &
+
87 "Incorrectly sized input array IPVT, argument 2.", &
+
88 la_array_size_error)
+
89 return
+
90 end if
+
91
+
92 ! Compute the LU factorization by calling the LAPACK routine ZGETRF
+
93 call zgetrf(m, n, a, m, ipvt, flag)
+
94
+
95 ! If flag > 0, the matrix is singular. Notice, flag should not be
+
96 ! able to be < 0 as we've already verrified inputs prior to making the
+
97 ! call to LAPACK
+
98 if (flag > 0) then
+
99 ! WARNING: Singular matrix
+
100 write(errmsg, '(AI0A)') &
+
101 "Singular matrix encountered (row ", flag, ")"
+
102 call errmgr%report_warning("lu_factor_cmplx", trim(errmsg), &
+
103 la_singular_matrix_error)
+
104 end if
+
105 end subroutine
+
106
+
107! ------------------------------------------------------------------------------
+
108 module subroutine form_lu_all(lu, ipvt, u, p, err)
+
109 ! Arguments
+
110 real(real64), intent(inout), dimension(:,:) :: lu
+
111 integer(int32), intent(in), dimension(:) :: ipvt
+
112 real(real64), intent(out), dimension(:,:) :: u, p
+
113 class(errors), intent(inout), optional, target :: err
+
114
+
115 ! Local Variables
+
116 integer(int32) :: j, jp, n, flag
+
117 class(errors), pointer :: errmgr
+
118 type(errors), target :: deferr
+
119 character(len = 128) :: errmsg
+
120
+
121 ! Parameters
+
122 real(real64), parameter :: zero = 0.0d0
+
123 real(real64), parameter :: one = 1.0d0
+
124
+
125 ! Initialization
+
126 n = size(lu, 1)
+
127 if (present(err)) then
+
128 errmgr => err
+
129 else
+
130 errmgr => deferr
+
131 end if
+
132
+
133 ! Input Check
+
134 flag = 0
+
135 if (size(lu, 2) /= n) then
+
136 flag = 1
+
137 else if (size(ipvt) /= n) then
+
138 flag = 2
+
139 else if (size(u, 1) /= n .or. size(u, 2) /= n) then
+
140 flag = 3
+
141 else if (size(p, 1) /= n .or. size(p, 2) /= n) then
+
142 flag = 4
+
143 end if
+
144 if (flag /= 0) then
+
145 ! One of the input arrays is not sized correctly
+
146 write(errmsg, '(AI0A)') "Input number ", flag, &
+
147 " is not sized correctly."
+
148 call errmgr%report_error("form_lu_all", trim(errmsg), &
+
149 la_array_size_error)
+
150 return
+
151 end if
+
152
+
153 ! Ensure P starts off as an identity matrix
+
154 call dlaset('A', n, n, zero, one, p, n)
+
155
+
156 ! Process
+
157 do j = 1, n
+
158 ! Define the pivot matrix
+
159 jp = ipvt(j)
+
160 if (j /= jp) call swap(p(j,1:n), p(jp,1:n))
+
161
+
162 ! Build L and U
+
163 u(1:j,j) = lu(1:j,j)
+
164 u(j+1:n,j) = zero
+
165
+
166 if (j > 1) lu(1:j-1,j) = zero
+
167 lu(j,j) = one
+
168 end do
+
169 end subroutine
+
170
+
171! ------------------------------------------------------------------------------
+
172 module subroutine form_lu_all_cmplx(lu, ipvt, u, p, err)
+
173 ! Arguments
+
174 complex(real64), intent(inout), dimension(:,:) :: lu
+
175 integer(int32), intent(in), dimension(:) :: ipvt
+
176 complex(real64), intent(out), dimension(:,:) :: u
+
177 real(real64), intent(out), dimension(:,:) :: p
+
178 class(errors), intent(inout), optional, target :: err
+
179
+
180 ! Local Variables
+
181 integer(int32) :: j, jp, n, flag
+
182 class(errors), pointer :: errmgr
+
183 type(errors), target :: deferr
+
184 character(len = 128) :: errmsg
+
185
+
186 ! Parameters
+
187 real(real64), parameter :: zero = 0.0d0
+
188 real(real64), parameter :: one = 1.0d0
+
189 complex(real64), parameter :: c_zero = (0.0d0, 0.0d0)
+
190 complex(real64), parameter :: c_one = (1.0d0, 0.0d0)
+
191
+
192 ! Initialization
+
193 n = size(lu, 1)
+
194 if (present(err)) then
+
195 errmgr => err
+
196 else
+
197 errmgr => deferr
+
198 end if
+
199
+
200 ! Input Check
+
201 flag = 0
+
202 if (size(lu, 2) /= n) then
+
203 flag = 1
+
204 else if (size(ipvt) /= n) then
+
205 flag = 2
+
206 else if (size(u, 1) /= n .or. size(u, 2) /= n) then
+
207 flag = 3
+
208 else if (size(p, 1) /= n .or. size(p, 2) /= n) then
+
209 flag = 4
+
210 end if
+
211 if (flag /= 0) then
+
212 ! One of the input arrays is not sized correctly
+
213 write(errmsg, '(AI0A)') "Input number ", flag, &
+
214 " is not sized correctly."
+
215 call errmgr%report_error("form_lu_all_cmplx", trim(errmsg), &
+
216 la_array_size_error)
+
217 return
+
218 end if
+
219
+
220 ! Ensure P starts off as an identity matrix
+
221 call dlaset('A', n, n, zero, one, p, n)
+
222
+
223 ! Process
+
224 do j = 1, n
+
225 ! Define the pivot matrix
+
226 jp = ipvt(j)
+
227 if (j /= jp) call swap(p(j,1:n), p(jp,1:n))
+
228
+
229 ! Build L and U
+
230 u(1:j,j) = lu(1:j,j)
+
231 u(j+1:n,j) = c_zero
+
232
+
233 if (j > 1) lu(1:j-1,j) = c_zero
+
234 lu(j,j) = c_one
+
235 end do
+
236 end subroutine
+
237
+
238! ------------------------------------------------------------------------------
+
239 module subroutine form_lu_only(lu, u, err)
+
240 ! Arguments
+
241 real(real64), intent(inout), dimension(:,:) :: lu
+
242 real(real64), intent(out), dimension(:,:) :: u
+
243 class(errors), intent(inout), optional, target :: err
+
244
+
245 ! Local Variables
+
246 integer(int32) :: j, n, flag
+
247 class(errors), pointer :: errmgr
+
248 type(errors), target :: deferr
+
249 character(len = 128) :: errmsg
+
250
+
251 ! Parameters
+
252 real(real64), parameter :: zero = 0.0d0
+
253 real(real64), parameter :: one = 1.0d0
+
254
+
255 ! Initialization
+
256 n = size(lu, 1)
+
257 if (present(err)) then
+
258 errmgr => err
+
259 else
+
260 errmgr => deferr
+
261 end if
+
262
+
263 ! Input Check
+
264 flag = 0
+
265 if (size(lu, 2) /= n) then
+
266 flag = 2
+
267 else if (size(u, 1) /= n .or. size(u, 2) /= n) then
+
268 flag = 3
+
269 end if
+
270 if (flag /= 0) then
+
271 ! One of the input arrays is not sized correctly
+
272 write(errmsg, '(AI0A)') "Input number ", flag, &
+
273 " is not sized correctly."
+
274 call errmgr%report_error("form_lu_only", trim(errmsg), &
+
275 la_array_size_error)
+
276 return
+
277 end if
+
278
+
279 ! Process
+
280 do j = 1, n
+
281 ! Build L and U
+
282 u(1:j,j) = lu(1:j,j)
+
283 u(j+1:n,j) = zero
+
284
+
285 if (j > 1) lu(1:j-1,j) = zero
+
286 lu(j,j) = one
+
287 end do
+
288 end subroutine
+
289
+
290! ------------------------------------------------------------------------------
+
291 module subroutine form_lu_only_cmplx(lu, u, err)
+
292 ! Arguments
+
293 complex(real64), intent(inout), dimension(:,:) :: lu
+
294 complex(real64), intent(out), dimension(:,:) :: u
+
295 class(errors), intent(inout), optional, target :: err
+
296
+
297 ! Local Variables
+
298 integer(int32) :: j, n, flag
+
299 class(errors), pointer :: errmgr
+
300 type(errors), target :: deferr
+
301 character(len = 128) :: errmsg
+
302
+
303 ! Parameters
+
304 complex(real64), parameter :: zero = (0.0d0, 0.0d0)
+
305 complex(real64), parameter :: one = (1.0d0, 0.0d0)
+
306
+
307 ! Initialization
+
308 n = size(lu, 1)
+
309 if (present(err)) then
+
310 errmgr => err
+
311 else
+
312 errmgr => deferr
+
313 end if
+
314
+
315 ! Input Check
+
316 flag = 0
+
317 if (size(lu, 2) /= n) then
+
318 flag = 2
+
319 else if (size(u, 1) /= n .or. size(u, 2) /= n) then
+
320 flag = 3
+
321 end if
+
322 if (flag /= 0) then
+
323 ! One of the input arrays is not sized correctly
+
324 write(errmsg, '(AI0A)') "Input number ", flag, &
+
325 " is not sized correctly."
+
326 call errmgr%report_error("form_lu_only_cmplx", trim(errmsg), &
+
327 la_array_size_error)
+
328 return
+
329 end if
+
330
+
331 ! Process
+
332 do j = 1, n
+
333 ! Build L and U
+
334 u(1:j,j) = lu(1:j,j)
+
335 u(j+1:n,j) = zero
+
336
+
337 if (j > 1) lu(1:j-1,j) = zero
+
338 lu(j,j) = one
+
339 end do
+
340 end subroutine
+
341
+
342! ******************************************************************************
+
343! QR FACTORIZATION
+
344! ------------------------------------------------------------------------------
+
345 module subroutine qr_factor_no_pivot(a, tau, work, olwork, err)
+
346 ! Arguments
+
347 real(real64), intent(inout), dimension(:,:) :: a
+
348 real(real64), intent(out), dimension(:) :: tau
+
349 real(real64), intent(out), target, dimension(:), optional :: work
+
350 integer(int32), intent(out), optional :: olwork
+
351 class(errors), intent(inout), optional, target :: err
+
352
+
353 ! Local Variables
+
354 integer(int32) :: m, n, mn, istat, lwork, flag
+
355 real(real64), dimension(1) :: temp
+
356 real(real64), pointer, dimension(:) :: wptr
+
357 real(real64), allocatable, target, dimension(:) :: wrk
+
358 class(errors), pointer :: errmgr
+
359 type(errors), target :: deferr
+
360
+
361 ! Initialization
+
362 m = size(a, 1)
+
363 n = size(a, 2)
+
364 mn = min(m, n)
+
365 if (present(err)) then
+
366 errmgr => err
+
367 else
+
368 errmgr => deferr
+
369 end if
+
370
+
371 ! Input Check
+
372 if (size(tau) /= mn) then
+
373 ! ERROR: TAU not sized correctly
+
374 call errmgr%report_error("qr_factor_no_pivot", &
+
375 "Incorrectly sized input array TAU, argument 2.", &
+
376 la_array_size_error)
+
377 return
+
378 end if
+
379
+
380 ! Workspace Query
+
381 call dgeqrf(m, n, a, m, tau, temp, -1, flag)
+
382 lwork = int(temp(1), int32)
+
383 if (present(olwork)) then
+
384 olwork = lwork
+
385 return
+
386 end if
+
387
+
388 ! Local Memory Allocation
+
389 if (present(work)) then
+
390 if (size(work) < lwork) then
+
391 ! ERROR: WORK not sized correctly
+
392 call errmgr%report_error("qr_factor_no_pivot", &
+
393 "Incorrectly sized input array WORK, argument 3.", &
+
394 la_array_size_error)
+
395 return
+
396 end if
+
397 wptr => work(1:lwork)
+
398 else
+
399 allocate(wrk(lwork), stat = istat)
+
400 if (istat /= 0) then
+
401 ! ERROR: Out of memory
+
402 call errmgr%report_error("qr_factor_no_pivot", &
+
403 "Insufficient memory available.", &
+
404 la_out_of_memory_error)
+
405 return
+
406 end if
+
407 wptr => wrk
+
408 end if
+
409
+
410 ! Call DGEQRF
+
411 call dgeqrf(m, n, a, m, tau, wptr, lwork, flag)
+
412 end subroutine
+
413
+
414! ------------------------------------------------------------------------------
+
415 module subroutine qr_factor_no_pivot_cmplx(a, tau, work, olwork, err)
+
416 ! Arguments
+
417 complex(real64), intent(inout), dimension(:,:) :: a
+
418 complex(real64), intent(out), dimension(:) :: tau
+
419 complex(real64), intent(out), target, dimension(:), optional :: work
+
420 integer(int32), intent(out), optional :: olwork
+
421 class(errors), intent(inout), optional, target :: err
+
422
+
423 ! Local Variables
+
424 integer(int32) :: m, n, mn, istat, lwork, flag
+
425 complex(real64), dimension(1) :: temp
+
426 complex(real64), pointer, dimension(:) :: wptr
+
427 complex(real64), allocatable, target, dimension(:) :: wrk
+
428 class(errors), pointer :: errmgr
+
429 type(errors), target :: deferr
+
430
+
431 ! Initialization
+
432 m = size(a, 1)
+
433 n = size(a, 2)
+
434 mn = min(m, n)
+
435 if (present(err)) then
+
436 errmgr => err
+
437 else
+
438 errmgr => deferr
+
439 end if
+
440
+
441 ! Input Check
+
442 if (size(tau) /= mn) then
+
443 ! ERROR: TAU not sized correctly
+
444 call errmgr%report_error("qr_factor_no_pivot_cmplx", &
+
445 "Incorrectly sized input array TAU, argument 2.", &
+
446 la_array_size_error)
+
447 return
+
448 end if
+
449
+
450 ! Workspace Query
+
451 call zgeqrf(m, n, a, m, tau, temp, -1, flag)
+
452 lwork = int(temp(1), int32)
+
453 if (present(olwork)) then
+
454 olwork = lwork
+
455 return
+
456 end if
+
457
+
458 ! Local Memory Allocation
+
459 if (present(work)) then
+
460 if (size(work) < lwork) then
+
461 ! ERROR: WORK not sized correctly
+
462 call errmgr%report_error("qr_factor_no_pivot_cmplx", &
+
463 "Incorrectly sized input array WORK, argument 3.", &
+
464 la_array_size_error)
+
465 return
+
466 end if
+
467 wptr => work(1:lwork)
+
468 else
+
469 allocate(wrk(lwork), stat = istat)
+
470 if (istat /= 0) then
+
471 ! ERROR: Out of memory
+
472 call errmgr%report_error("qr_factor_no_pivot_cmplx", &
+
473 "Insufficient memory available.", &
+
474 la_out_of_memory_error)
+
475 return
+
476 end if
+
477 wptr => wrk
+
478 end if
+
479
+
480 ! Call ZGEQRF
+
481 call zgeqrf(m, n, a, m, tau, wptr, lwork, flag)
+
482 end subroutine
+
483
+
484! ------------------------------------------------------------------------------
+
485 module subroutine qr_factor_pivot(a, tau, jpvt, work, olwork, err)
+
486 ! Arguments
+
487 real(real64), intent(inout), dimension(:,:) :: a
+
488 real(real64), intent(out), dimension(:) :: tau
+
489 integer(int32), intent(inout), dimension(:) :: jpvt
+
490 real(real64), intent(out), target, dimension(:), optional :: work
+
491 integer(int32), intent(out), optional :: olwork
+
492 class(errors), intent(inout), optional, target :: err
+
493
+
494 ! Local Variables
+
495 integer(int32) :: m, n, mn, istat, lwork, flag
+
496 real(real64), dimension(1) :: temp
+
497 real(real64), pointer, dimension(:) :: wptr
+
498 real(real64), allocatable, target, dimension(:) :: wrk
+
499 class(errors), pointer :: errmgr
+
500 type(errors), target :: deferr
+
501 character(len = 128) :: errmsg
+
502
+
503 ! Initialization
+
504 m = size(a, 1)
+
505 n = size(a, 2)
+
506 mn = min(m, n)
+
507 if (present(err)) then
+
508 errmgr => err
+
509 else
+
510 errmgr => deferr
+
511 end if
+
512
+
513 ! Input Check
+
514 flag = 0
+
515 if (size(tau) /= mn) then
+
516 flag = 2
+
517 else if (size(jpvt) /= n) then
+
518 flag = 3
+
519 end if
+
520 if (flag /= 0) then
+
521 ! ERROR: One of the input arrays is not sized correctly
+
522 write(errmsg, '(AI0A)') "Input number ", flag, &
+
523 " is not sized correctly."
+
524 call errmgr%report_error("qr_factor_pivot", trim(errmsg), &
+
525 la_array_size_error)
+
526 return
+
527 end if
+
528
+
529 ! Workspace Query
+
530 call dgeqp3(m, n, a, m, jpvt, tau, temp, -1, flag)
+
531 lwork = int(temp(1), int32)
+
532 if (present(olwork)) then
+
533 olwork = lwork
+
534 return
+
535 end if
+
536
+
537 ! Local Memory Allocation
+
538 if (present(work)) then
+
539 if (size(work) < lwork) then
+
540 ! ERROR: WORK not sized correctly
+
541 call errmgr%report_error("qr_factor_pivot", &
+
542 "Incorrectly sized input array WORK, argument 4.", &
+
543 la_array_size_error)
+
544 return
+
545 end if
+
546 wptr => work(1:lwork)
+
547 else
+
548 allocate(wrk(lwork), stat = istat)
+
549 if (istat /= 0) then
+
550 ! ERROR: Out of memory
+
551 call errmgr%report_error("qr_factor_pivot", &
+
552 "Insufficient memory available.", &
+
553 la_out_of_memory_error)
+
554 return
+
555 end if
+
556 wptr => wrk
+
557 end if
+
558
+
559 ! Call DGEQP3
+
560 call dgeqp3(m, n, a, m, jpvt, tau, wptr, lwork, flag)
+
561
+
562 ! End
+
563 if (allocated(wrk)) deallocate(wrk)
+
564 end subroutine
+
565
+
566! ------------------------------------------------------------------------------
+
567 module subroutine qr_factor_pivot_cmplx(a, tau, jpvt, work, olwork, rwork, &
+
568 err)
+
569 ! Arguments
+
570 complex(real64), intent(inout), dimension(:,:) :: a
+
571 complex(real64), intent(out), dimension(:) :: tau
+
572 integer(int32), intent(inout), dimension(:) :: jpvt
+
573 complex(real64), intent(out), target, dimension(:), optional :: work
+
574 integer(int32), intent(out), optional :: olwork
+
575 real(real64), intent(out), target, dimension(:), optional :: rwork
+
576 class(errors), intent(inout), optional, target :: err
+
577
+
578 ! Local Variables
+
579 integer(int32) :: m, n, mn, istat, lwork, flag
+
580 complex(real64), dimension(1) :: temp
+
581 complex(real64), pointer, dimension(:) :: wptr
+
582 complex(real64), allocatable, target, dimension(:) :: wrk
+
583 real(real64), pointer, dimension(:) :: rptr
+
584 real(real64), allocatable, target, dimension(:) :: rwrk
+
585 class(errors), pointer :: errmgr
+
586 type(errors), target :: deferr
+
587 character(len = 128) :: errmsg
+
588
+
589 ! Initialization
+
590 m = size(a, 1)
+
591 n = size(a, 2)
+
592 mn = min(m, n)
+
593 if (present(err)) then
+
594 errmgr => err
+
595 else
+
596 errmgr => deferr
+
597 end if
+
598
+
599 ! Input Check
+
600 flag = 0
+
601 if (size(tau) /= mn) then
+
602 flag = 2
+
603 else if (size(jpvt) /= n) then
+
604 flag = 3
+
605 end if
+
606 if (flag /= 0) then
+
607 ! ERROR: One of the input arrays is not sized correctly
+
608 write(errmsg, '(AI0A)') "Input number ", flag, &
+
609 " is not sized correctly."
+
610 call errmgr%report_error("qr_factor_pivot_cmplx", trim(errmsg), &
+
611 la_array_size_error)
+
612 return
+
613 end if
+
614 if (present(rwork)) then
+
615 if (size(rwork) < 2 * n) then
+
616 call errmgr%report_error("qr_factor_pivot_cmplx", &
+
617 "Incorrectly sized input array RWORK, argument 6.", &
+
618 la_array_size_error)
+
619 return
+
620 end if
+
621 rptr => rwork(1:2*n)
+
622 else
+
623 allocate(rwrk(2 * n), stat = flag)
+
624 if (flag /= 0) then
+
625 call errmgr%report_error("qr_factor_pivot_cmplx", &
+
626 "Insufficient memory available.", &
+
627 la_out_of_memory_error)
+
628 return
+
629 end if
+
630 rptr => rwrk
+
631 end if
+
632
+
633 ! Workspace Query
+
634 call zgeqp3(m, n, a, m, jpvt, tau, temp, -1, rptr, flag)
+
635 lwork = int(temp(1), int32)
+
636 if (present(olwork)) then
+
637 olwork = lwork
+
638 return
+
639 end if
+
640
+
641 ! Local Memory Allocation
+
642 if (present(work)) then
+
643 if (size(work) < lwork) then
+
644 ! ERROR: WORK not sized correctly
+
645 call errmgr%report_error("qr_factor_pivot_cmplx", &
+
646 "Incorrectly sized input array WORK, argument 4.", &
+
647 la_array_size_error)
+
648 return
+
649 end if
+
650 wptr => work(1:lwork)
+
651 else
+
652 allocate(wrk(lwork), stat = istat)
+
653 if (istat /= 0) then
+
654 ! ERROR: Out of memory
+
655 call errmgr%report_error("qr_factor_pivot_cmplx", &
+
656 "Insufficient memory available.", &
+
657 la_out_of_memory_error)
+
658 return
+
659 end if
+
660 wptr => wrk
+
661 end if
+
662
+
663 ! Call ZGEQP3
+
664 call zgeqp3(m, n, a, m, jpvt, tau, wptr, lwork, rptr, flag)
+
665
+
666 ! End
+
667 if (allocated(wrk)) deallocate(wrk)
+
668 end subroutine
+
669
+
670! ------------------------------------------------------------------------------
+
671 module subroutine form_qr_no_pivot(r, tau, q, work, olwork, err)
+
672 ! Arguments
+
673 real(real64), intent(inout), dimension(:,:) :: r
+
674 real(real64), intent(in), dimension(:) :: tau
+
675 real(real64), intent(out), dimension(:,:) :: q
+
676 real(real64), intent(out), target, dimension(:), optional :: work
+
677 integer(int32), intent(out), optional :: olwork
+
678 class(errors), intent(inout), optional, target :: err
+
679
+
680 ! Parameters
+
681 real(real64), parameter :: zero = 0.0d0
+
682
+
683 ! Local Variables
+
684 integer(int32) :: j, m, n, mn, qcol, istat, flag, lwork
+
685 real(real64), pointer, dimension(:) :: wptr
+
686 real(real64), allocatable, target, dimension(:) :: wrk
+
687 real(real64), dimension(1) :: temp
+
688 class(errors), pointer :: errmgr
+
689 type(errors), target :: deferr
+
690 character(len = 128) :: errmsg
+
691
+
692 ! Initialization
+
693 m = size(r, 1)
+
694 n = size(r, 2)
+
695 mn = min(m, n)
+
696 qcol = size(q, 2)
+
697 if (present(err)) then
+
698 errmgr => err
+
699 else
+
700 errmgr => deferr
+
701 end if
+
702
+
703 ! Input Check
+
704 flag = 0
+
705 if (size(tau) /= mn) then
+
706 flag = 2
+
707 else if (size(q, 1) /= m .or. (qcol /= m .and. qcol /= n)) then
+
708 flag = 3
+
709 else if (qcol == n .and. m < n) then
+
710 flag = 3
+
711 end if
+
712 if (flag /= 0) then
+
713 ! ERROR: One of the input arrays is not sized correctly
+
714 write(errmsg, '(AI0A)') "Input number ", flag, &
+
715 " is not sized correctly."
+
716 call errmgr%report_error("form_qr_no_pivot", trim(errmsg), &
+
717 la_array_size_error)
+
718 return
+
719 end if
+
720
+
721 ! Workspace Query
+
722 call dorgqr(m, qcol, mn, q, m, tau, temp, -1, flag)
+
723 lwork = int(temp(1), int32)
+
724 if (present(olwork)) then
+
725 olwork = lwork
+
726 return
+
727 end if
+
728
+
729 ! Local Memory Allocation
+
730 if (present(work)) then
+
731 if (size(work) < lwork) then
+
732 ! ERROR: WORK not sized correctly
+
733 call errmgr%report_error("form_qr_no_pivot", &
+
734 "Incorrectly sized input array WORK, argument 4.", &
+
735 la_array_size_error)
+
736 return
+
737 end if
+
738 wptr => work(1:lwork)
+
739 else
+
740 allocate(wrk(lwork), stat = istat)
+
741 if (istat /= 0) then
+
742 ! ERROR: Out of memory
+
743 call errmgr%report_error("form_qr_no_pivot", &
+
744 "Insufficient memory available.", &
+
745 la_out_of_memory_error)
+
746 return
+
747 end if
+
748 wptr => wrk
+
749 end if
+
750
+
751 ! Copy the sub-diagonal portion of R to Q, and then zero out the
+
752 ! sub-diagonal portion of R
+
753 do j = 1, mn
+
754 q(j+1:m,j) = r(j+1:m,j)
+
755 r(j+1:m,j) = zero
+
756 end do
+
757
+
758 ! Build Q - Build M-by-M or M-by-N, but M-by-N only for M >= N
+
759 call dorgqr(m, qcol, mn, q, m, tau, wptr, lwork, flag)
+
760
+
761 ! End
+
762 if (allocated(wrk)) deallocate(wrk)
+
763 end subroutine
+
764
+
765! ------------------------------------------------------------------------------
+
766 module subroutine form_qr_no_pivot_cmplx(r, tau, q, work, olwork, err)
+
767 ! Arguments
+
768 complex(real64), intent(inout), dimension(:,:) :: r
+
769 complex(real64), intent(in), dimension(:) :: tau
+
770 complex(real64), intent(out), dimension(:,:) :: q
+
771 complex(real64), intent(out), target, dimension(:), optional :: work
+
772 integer(int32), intent(out), optional :: olwork
+
773 class(errors), intent(inout), optional, target :: err
+
774
+
775 ! Parameters
+
776 complex(real64), parameter :: zero = (0.0d0, 0.0d0)
+
777
+
778 ! Local Variables
+
779 integer(int32) :: j, m, n, mn, qcol, istat, flag, lwork
+
780 complex(real64), pointer, dimension(:) :: wptr
+
781 complex(real64), allocatable, target, dimension(:) :: wrk
+
782 complex(real64), dimension(1) :: temp
+
783 class(errors), pointer :: errmgr
+
784 type(errors), target :: deferr
+
785 character(len = 128) :: errmsg
+
786
+
787 ! Initialization
+
788 m = size(r, 1)
+
789 n = size(r, 2)
+
790 mn = min(m, n)
+
791 qcol = size(q, 2)
+
792 if (present(err)) then
+
793 errmgr => err
+
794 else
+
795 errmgr => deferr
+
796 end if
+
797
+
798 ! Input Check
+
799 flag = 0
+
800 if (size(tau) /= mn) then
+
801 flag = 2
+
802 else if (size(q, 1) /= m .or. (qcol /= m .and. qcol /= n)) then
+
803 flag = 3
+
804 else if (qcol == n .and. m < n) then
+
805 flag = 3
+
806 end if
+
807 if (flag /= 0) then
+
808 ! ERROR: One of the input arrays is not sized correctly
+
809 write(errmsg, '(AI0A)') "Input number ", flag, &
+
810 " is not sized correctly."
+
811 call errmgr%report_error("form_qr_no_pivot_cmplx", trim(errmsg), &
+
812 la_array_size_error)
+
813 return
+
814 end if
+
815
+
816 ! Workspace Query
+
817 call zungqr(m, qcol, mn, q, m, tau, temp, -1, flag)
+
818 lwork = int(temp(1), int32)
+
819 if (present(olwork)) then
+
820 olwork = lwork
+
821 return
+
822 end if
+
823
+
824 ! Local Memory Allocation
+
825 if (present(work)) then
+
826 if (size(work) < lwork) then
+
827 ! ERROR: WORK not sized correctly
+
828 call errmgr%report_error("form_qr_no_pivot_cmplx", &
+
829 "Incorrectly sized input array WORK, argument 4.", &
+
830 la_array_size_error)
+
831 return
+
832 end if
+
833 wptr => work(1:lwork)
+
834 else
+
835 allocate(wrk(lwork), stat = istat)
+
836 if (istat /= 0) then
+
837 ! ERROR: Out of memory
+
838 call errmgr%report_error("form_qr_no_pivot_cmplx", &
+
839 "Insufficient memory available.", &
+
840 la_out_of_memory_error)
+
841 return
+
842 end if
+
843 wptr => wrk
+
844 end if
+
845
+
846 ! Copy the sub-diagonal portion of R to Q, and then zero out the
+
847 ! sub-diagonal portion of R
+
848 do j = 1, mn
+
849 q(j+1:m,j) = r(j+1:m,j)
+
850 r(j+1:m,j) = zero
+
851 end do
+
852
+
853 ! Build Q - Build M-by-M or M-by-N, but M-by-N only for M >= N
+
854 call zungqr(m, qcol, mn, q, m, tau, wptr, lwork, flag)
+
855
+
856 ! End
+
857 if (allocated(wrk)) deallocate(wrk)
+
858 end subroutine
+
859
+
860! ------------------------------------------------------------------------------
+
861 module subroutine form_qr_pivot(r, tau, pvt, q, p, work, olwork, err)
+
862 ! Arguments
+
863 real(real64), intent(inout), dimension(:,:) :: r
+
864 real(real64), intent(in), dimension(:) :: tau
+
865 integer(int32), intent(in), dimension(:) :: pvt
+
866 real(real64), intent(out), dimension(:,:) :: q, p
+
867 real(real64), intent(out), target, dimension(:), optional :: work
+
868 integer(int32), intent(out), optional :: olwork
+
869 class(errors), intent(inout), optional, target :: err
+
870
+
871 ! Parameters
+
872 real(real64), parameter :: zero = 0.0d0
+
873 real(real64), parameter :: one = 1.0d0
+
874
+
875 ! Local Variables
+
876 integer(int32) :: j, jp, m, n, mn, flag
+
877 class(errors), pointer :: errmgr
+
878 type(errors), target :: deferr
+
879 character(len = 128) :: errmsg
+
880
+
881 ! Initialization
+
882 m = size(r, 1)
+
883 n = size(r, 2)
+
884 mn = min(m, n)
+
885 if (present(err)) then
+
886 errmgr => err
+
887 else
+
888 errmgr => deferr
+
889 end if
+
890
+
891 ! Input Check
+
892 flag = 0
+
893 if (size(tau) /= mn) then
+
894 flag = 2
+
895 else if (size(pvt) /= n) then
+
896 flag = 3
+
897 else if (size(q, 1) /= m .or. &
+
898 (size(q, 2) /= m .and. size(q, 2) /= n)) then
+
899 flag = 4
+
900 else if (size(q, 2) == n .and. m < n) then
+
901 flag = 4
+
902 else if (size(p, 1) /= n .or. size(p, 2) /= n) then
+
903 flag = 5
+
904 end if
+
905 if (flag /= 0) then
+
906 ! ERROR: One of the input arrays is not sized correctly
+
907 write(errmsg, '(AI0A)') "Input number ", flag, &
+
908 " is not sized correctly."
+
909 call errmgr%report_error("form_qr_pivot", trim(errmsg), &
+
910 la_array_size_error)
+
911 return
+
912 end if
+
913
+
914 ! Generate Q and R
+
915 call form_qr_no_pivot(r, tau, q, work = work, olwork = olwork, &
+
916 err = errmgr)
+
917 if (present(olwork)) return ! Just a workspace query
+
918 if (errmgr%has_error_occurred()) return
+
919
+
920 ! Form P
+
921 do j = 1, n
+
922 jp = pvt(j)
+
923 p(:,j) = zero
+
924 p(jp,j) = one
+
925 end do
+
926 end subroutine
+
927
+
928! ------------------------------------------------------------------------------
+
929 module subroutine form_qr_pivot_cmplx(r, tau, pvt, q, p, work, olwork, err)
+
930 ! Arguments
+
931 complex(real64), intent(inout), dimension(:,:) :: r
+
932 complex(real64), intent(in), dimension(:) :: tau
+
933 integer(int32), intent(in), dimension(:) :: pvt
+
934 complex(real64), intent(out), dimension(:,:) :: q, p
+
935 complex(real64), intent(out), target, dimension(:), optional :: work
+
936 integer(int32), intent(out), optional :: olwork
+
937 class(errors), intent(inout), optional, target :: err
+
938
+
939 ! Parameters
+
940 complex(real64), parameter :: zero = (0.0d0, 0.0d0)
+
941 complex(real64), parameter :: one = (1.0d0, 0.0d0)
+
942
+
943 ! Local Variables
+
944 integer(int32) :: j, jp, m, n, mn, flag
+
945 class(errors), pointer :: errmgr
+
946 type(errors), target :: deferr
+
947 character(len = 128) :: errmsg
+
948
+
949 ! Initialization
+
950 m = size(r, 1)
+
951 n = size(r, 2)
+
952 mn = min(m, n)
+
953 if (present(err)) then
+
954 errmgr => err
+
955 else
+
956 errmgr => deferr
+
957 end if
+
958
+
959 ! Input Check
+
960 flag = 0
+
961 if (size(tau) /= mn) then
+
962 flag = 2
+
963 else if (size(pvt) /= n) then
+
964 flag = 3
+
965 else if (size(q, 1) /= m .or. &
+
966 (size(q, 2) /= m .and. size(q, 2) /= n)) then
+
967 flag = 4
+
968 else if (size(q, 2) == n .and. m < n) then
+
969 flag = 4
+
970 else if (size(p, 1) /= n .or. size(p, 2) /= n) then
+
971 flag = 5
+
972 end if
+
973 if (flag /= 0) then
+
974 ! ERROR: One of the input arrays is not sized correctly
+
975 write(errmsg, '(AI0A)') "Input number ", flag, &
+
976 " is not sized correctly."
+
977 call errmgr%report_error("form_qr_pivot_cmplx", trim(errmsg), &
+
978 la_array_size_error)
+
979 return
+
980 end if
+
981
+
982 ! Generate Q and R
+
983 call form_qr_no_pivot_cmplx(r, tau, q, work = work, olwork = olwork, &
+
984 err = errmgr)
+
985 if (present(olwork)) return ! Just a workspace query
+
986 if (errmgr%has_error_occurred()) return
+
987
+
988 ! Form P
+
989 do j = 1, n
+
990 jp = pvt(j)
+
991 p(:,j) = zero
+
992 p(jp,j) = one
+
993 end do
+
994 end subroutine
+
995
+
996! ------------------------------------------------------------------------------
+
997 module subroutine mult_qr_mtx(lside, trans, a, tau, c, work, olwork, err)
+
998 ! Arguments
+
999 logical, intent(in) :: lside, trans
+
1000 real(real64), intent(in), dimension(:) :: tau
+
1001 real(real64), intent(inout), dimension(:,:) :: a, c
+
1002 real(real64), intent(out), target, dimension(:), optional :: work
+
1003 integer(int32), intent(out), optional :: olwork
+
1004 class(errors), intent(inout), optional, target :: err
+
1005
+
1006 ! Parameters
+
1007 real(real64), parameter :: one = 1.0d0
+
1008
+
1009 ! Local Variables
+
1010 character :: side, t
+
1011 integer(int32) :: m, n, k, nrowa, istat, flag, lwork
+
1012 real(real64), pointer, dimension(:) :: wptr
+
1013 real(real64), allocatable, target, dimension(:) :: wrk
+
1014 real(real64), dimension(1) :: temp
+
1015 class(errors), pointer :: errmgr
+
1016 type(errors), target :: deferr
+
1017 character(len = 128) :: errmsg
+
1018
+
1019 ! Initialization
+
1020 m = size(c, 1)
+
1021 n = size(c, 2)
+
1022 k = size(tau)
+
1023 if (lside) then
+
1024 side = 'L'
+
1025 nrowa = m
+
1026 else
+
1027 side = 'R'
+
1028 nrowa = n
+
1029 end if
+
1030 if (trans) then
+
1031 t = 'T'
+
1032 else
+
1033 t = 'N'
+
1034 end if
+
1035 if (present(err)) then
+
1036 errmgr => err
+
1037 else
+
1038 errmgr => deferr
+
1039 end if
+
1040
+
1041 ! Input Check
+
1042 flag = 0
+
1043 if (lside) then
+
1044 ! A is M-by-K, M >= K >= 0
+
1045 if (size(a, 1) /= m .or. size(a, 2) < k) flag = 3
+
1046 else
+
1047 ! A is N-by-K, N >= K >= 0
+
1048 if (size(a, 1) /= n .or. size(a, 2) < k) flag = 3
+
1049 end if
+
1050 if (flag /= 0) then
+
1051 ! ERROR: One of the input arrays is not sized correctly
+
1052 write(errmsg, '(AI0A)') "Input number ", flag, &
+
1053 " is not sized correctly."
+
1054 call errmgr%report_error("mult_qr_mtx", trim(errmsg), &
+
1055 la_array_size_error)
+
1056 return
+
1057 end if
+
1058
+
1059 ! Workspace Query
+
1060 call dormqr(side, t, m, n, k, a, nrowa, tau, c, m, temp, -1, flag)
+
1061 lwork = int(temp(1), int32)
+
1062 if (present(olwork)) then
+
1063 olwork = lwork
+
1064 return
+
1065 end if
+
1066
+
1067 ! Local Memory Allocation
+
1068 if (present(work)) then
+
1069 if (size(work) < lwork) then
+
1070 ! ERROR: WORK not sized correctly
+
1071 call errmgr%report_error("mult_qr_mtx", &
+
1072 "Incorrectly sized input array WORK, argument 6.", &
+
1073 la_array_size_error)
+
1074 return
+
1075 end if
+
1076 wptr => work(1:lwork)
+
1077 else
+
1078 allocate(wrk(lwork), stat = istat)
+
1079 if (istat /= 0) then
+
1080 ! ERROR: Out of memory
+
1081 call errmgr%report_error("mult_qr_mtx", &
+
1082 "Insufficient memory available.", &
+
1083 la_out_of_memory_error)
+
1084 return
+
1085 end if
+
1086 wptr => wrk
+
1087 end if
+
1088
+
1089 ! Call DORMQR
+
1090 call dormqr(side, t, m, n, k, a, nrowa, tau, c, m, wptr, lwork, flag)
+
1091 end subroutine
+
1092
+
1093! ------------------------------------------------------------------------------
+
1094 module subroutine mult_qr_mtx_cmplx(lside, trans, a, tau, c, work, olwork, err)
+
1095 ! Arguments
+
1096 logical, intent(in) :: lside, trans
+
1097 complex(real64), intent(in), dimension(:) :: tau
+
1098 complex(real64), intent(inout), dimension(:,:) :: a, c
+
1099 complex(real64), intent(out), target, dimension(:), optional :: work
+
1100 integer(int32), intent(out), optional :: olwork
+
1101 class(errors), intent(inout), optional, target :: err
+
1102
+
1103 ! Parameters
+
1104 complex(real64), parameter :: one = (1.0d0, 0.0d0)
+
1105
+
1106 ! Local Variables
+
1107 character :: side, t
+
1108 integer(int32) :: m, n, k, nrowa, istat, flag, lwork
+
1109 complex(real64), pointer, dimension(:) :: wptr
+
1110 complex(real64), allocatable, target, dimension(:) :: wrk
+
1111 complex(real64), dimension(1) :: temp
+
1112 class(errors), pointer :: errmgr
+
1113 type(errors), target :: deferr
+
1114 character(len = 128) :: errmsg
+
1115
+
1116 ! Initialization
+
1117 m = size(c, 1)
+
1118 n = size(c, 2)
+
1119 k = size(tau)
+
1120 if (lside) then
+
1121 side = 'L'
+
1122 nrowa = m
+
1123 else
+
1124 side = 'R'
+
1125 nrowa = n
+
1126 end if
+
1127 if (trans) then
+
1128 t = 'C'
+
1129 else
+
1130 t = 'N'
+
1131 end if
+
1132 if (present(err)) then
+
1133 errmgr => err
+
1134 else
+
1135 errmgr => deferr
+
1136 end if
+
1137
+
1138 ! Input Check
+
1139 flag = 0
+
1140 if (lside) then
+
1141 ! A is M-by-K, M >= K >= 0
+
1142 if (size(a, 1) /= m .or. size(a, 2) < k) flag = 3
+
1143 else
+
1144 ! A is N-by-K, N >= K >= 0
+
1145 if (size(a, 1) /= n .or. size(a, 2) < k) flag = 3
+
1146 end if
+
1147 if (flag /= 0) then
+
1148 ! ERROR: One of the input arrays is not sized correctly
+
1149 write(errmsg, '(AI0A)') "Input number ", flag, &
+
1150 " is not sized correctly."
+
1151 call errmgr%report_error("mult_qr_mtx_cmplx", trim(errmsg), &
+
1152 la_array_size_error)
+
1153 return
+
1154 end if
+
1155
+
1156 ! Workspace Query
+
1157 call zunmqr(side, t, m, n, k, a, nrowa, tau, c, m, temp, -1, flag)
+
1158 lwork = int(temp(1), int32)
+
1159 if (present(olwork)) then
+
1160 olwork = lwork
+
1161 return
+
1162 end if
+
1163
+
1164 ! Local Memory Allocation
+
1165 if (present(work)) then
+
1166 if (size(work) < lwork) then
+
1167 ! ERROR: WORK not sized correctly
+
1168 call errmgr%report_error("mult_qr_mtx_cmplx", &
+
1169 "Incorrectly sized input array WORK, argument 6.", &
+
1170 la_array_size_error)
+
1171 return
+
1172 end if
+
1173 wptr => work(1:lwork)
+
1174 else
+
1175 allocate(wrk(lwork), stat = istat)
+
1176 if (istat /= 0) then
+
1177 ! ERROR: Out of memory
+
1178 call errmgr%report_error("mult_qr_mtx_cmplx", &
+
1179 "Insufficient memory available.", &
+
1180 la_out_of_memory_error)
+
1181 return
+
1182 end if
+
1183 wptr => wrk
+
1184 end if
+
1185
+
1186 ! Call ZUNMQR
+
1187 call zunmqr(side, t, m, n, k, a, nrowa, tau, c, m, wptr, lwork, flag)
+
1188 end subroutine
+
1189
+
1190! ------------------------------------------------------------------------------
+
1191 module subroutine mult_qr_vec(trans, a, tau, c, work, olwork, err)
+
1192 ! Arguments
+
1193 logical, intent(in) :: trans
+
1194 real(real64), intent(inout), dimension(:,:) :: a
+
1195 real(real64), intent(in), dimension(:) :: tau
+
1196 real(real64), intent(inout), dimension(:) :: c
+
1197 real(real64), intent(out), target, dimension(:), optional :: work
+
1198 integer(int32), intent(out), optional :: olwork
+
1199 class(errors), intent(inout), optional, target :: err
+
1200
+
1201 ! Parameters
+
1202 real(real64), parameter :: one = 1.0d0
+
1203
+
1204 ! Local Variables
+
1205 character :: side, t
+
1206 integer(int32) :: m, k, nrowa, istat, flag, lwork
+
1207 real(real64), pointer, dimension(:) :: wptr
+
1208 real(real64), allocatable, target, dimension(:) :: wrk
+
1209 real(real64), dimension(1) :: temp
+
1210 class(errors), pointer :: errmgr
+
1211 type(errors), target :: deferr
+
1212 character(len = 128) :: errmsg
+
1213
+
1214 ! Initialization
+
1215 m = size(c)
+
1216 k = size(tau)
+
1217 side = 'L'
+
1218 nrowa = m
+
1219 if (trans) then
+
1220 t = 'T'
+
1221 else
+
1222 t = 'N'
+
1223 end if
+
1224 if (present(err)) then
+
1225 errmgr => err
+
1226 else
+
1227 errmgr => deferr
+
1228 end if
+
1229
+
1230 ! Input Check
+
1231 flag = 0
+
1232 if (size(a, 1) /= m .or. size(a, 2) < k) flag = 3
+
1233 if (flag /= 0) then
+
1234 ! ERROR: One of the input arrays is not sized correctly
+
1235 write(errmsg, '(AI0A)') "Input number ", flag, &
+
1236 " is not sized correctly."
+
1237 call errmgr%report_error("mult_qr_vec", trim(errmsg), &
+
1238 la_array_size_error)
+
1239 return
+
1240 end if
+
1241
+
1242 ! Workspace Query
+
1243 call dormqr(side, t, m, 1, k, a, nrowa, tau, c, m, temp, -1, flag)
+
1244 lwork = int(temp(1), int32)
+
1245 if (present(olwork)) then
+
1246 olwork = lwork
+
1247 return
+
1248 end if
+
1249
+
1250 ! Local Memory Allocation
+
1251 if (present(work)) then
+
1252 if (size(work) < lwork) then
+
1253 ! ERROR: WORK not sized correctly
+
1254 call errmgr%report_error("mult_qr_vec", &
+
1255 "Incorrectly sized input array WORK, argument 6.", &
+
1256 la_array_size_error)
+
1257 return
+
1258 end if
+
1259 wptr => work(1:lwork)
+
1260 else
+
1261 allocate(wrk(lwork), stat = istat)
+
1262 if (istat /= 0) then
+
1263 ! ERROR: Out of memory
+
1264 call errmgr%report_error("mult_qr_vec", &
+
1265 "Insufficient memory available.", &
+
1266 la_out_of_memory_error)
+
1267 return
+
1268 end if
+
1269 wptr => wrk
+
1270 end if
+
1271
+
1272 ! Call DORMQR
+
1273 call dormqr(side, t, m, 1, k, a, nrowa, tau, c, m, wptr, lwork, flag)
+
1274 end subroutine
+
1275
+
1276! ------------------------------------------------------------------------------
+
1277 module subroutine mult_qr_vec_cmplx(trans, a, tau, c, work, olwork, err)
+
1278 ! Arguments
+
1279 logical, intent(in) :: trans
+
1280 complex(real64), intent(inout), dimension(:,:) :: a
+
1281 complex(real64), intent(in), dimension(:) :: tau
+
1282 complex(real64), intent(inout), dimension(:) :: c
+
1283 complex(real64), intent(out), target, dimension(:), optional :: work
+
1284 integer(int32), intent(out), optional :: olwork
+
1285 class(errors), intent(inout), optional, target :: err
+
1286
+
1287 ! Parameters
+
1288 complex(real64), parameter :: one = (1.0d0, 0.0d0)
+
1289
+
1290 ! Local Variables
+
1291 character :: side, t
+
1292 integer(int32) :: m, k, nrowa, istat, flag, lwork
+
1293 complex(real64), pointer, dimension(:) :: wptr
+
1294 complex(real64), allocatable, target, dimension(:) :: wrk
+
1295 complex(real64), dimension(1) :: temp
+
1296 class(errors), pointer :: errmgr
+
1297 type(errors), target :: deferr
+
1298 character(len = 128) :: errmsg
+
1299
+
1300 ! Initialization
+
1301 m = size(c)
+
1302 k = size(tau)
+
1303 side = 'L'
+
1304 nrowa = m
+
1305 if (trans) then
+
1306 t = 'C'
+
1307 else
+
1308 t = 'N'
+
1309 end if
+
1310 if (present(err)) then
+
1311 errmgr => err
+
1312 else
+
1313 errmgr => deferr
+
1314 end if
+
1315
+
1316 ! Input Check
+
1317 flag = 0
+
1318 if (size(a, 1) /= m .or. size(a, 2) < k) flag = 3
+
1319 if (flag /= 0) then
+
1320 ! ERROR: One of the input arrays is not sized correctly
+
1321 write(errmsg, '(AI0A)') "Input number ", flag, &
+
1322 " is not sized correctly."
+
1323 call errmgr%report_error("mult_qr_vec", trim(errmsg), &
+
1324 la_array_size_error)
+
1325 return
+
1326 end if
+
1327
+
1328 ! Workspace Query
+
1329 call zunmqr(side, t, m, 1, k, a, nrowa, tau, c, m, temp, -1, flag)
+
1330 lwork = int(temp(1), int32)
+
1331 if (present(olwork)) then
+
1332 olwork = lwork
+
1333 return
+
1334 end if
+
1335
+
1336 ! Local Memory Allocation
+
1337 if (present(work)) then
+
1338 if (size(work) < lwork) then
+
1339 ! ERROR: WORK not sized correctly
+
1340 call errmgr%report_error("mult_qr_vec", &
+
1341 "Incorrectly sized input array WORK, argument 6.", &
+
1342 la_array_size_error)
+
1343 return
+
1344 end if
+
1345 wptr => work(1:lwork)
+
1346 else
+
1347 allocate(wrk(lwork), stat = istat)
+
1348 if (istat /= 0) then
+
1349 ! ERROR: Out of memory
+
1350 call errmgr%report_error("mult_qr_vec", &
+
1351 "Insufficient memory available.", &
+
1352 la_out_of_memory_error)
+
1353 return
+
1354 end if
+
1355 wptr => wrk
+
1356 end if
+
1357
+
1358 ! Call ZUNMQR
+
1359 call zunmqr(side, t, m, 1, k, a, nrowa, tau, c, m, wptr, lwork, flag)
+
1360 end subroutine
+
1361
+
1362! ------------------------------------------------------------------------------
+
1363 module subroutine qr_rank1_update_dbl(q, r, u, v, work, err)
+
1364 ! Arguments
+
1365 real(real64), intent(inout), dimension(:,:) :: q, r
+
1366 real(real64), intent(inout), dimension(:) :: u, v
+
1367 real(real64), intent(out), target, optional, dimension(:) :: work
+
1368 class(errors), intent(inout), optional, target :: err
+
1369
+
1370 ! Local Variables
+
1371 logical :: full
+
1372 integer(int32) :: m, n, k, lwork, istat, flag
+
1373 real(real64), pointer, dimension(:) :: wptr
+
1374 real(real64), allocatable, target, dimension(:) :: wrk
+
1375 class(errors), pointer :: errmgr
+
1376 type(errors), target :: deferr
+
1377 character(len = 128) :: errmsg
+
1378
+
1379 ! Initialization
+
1380 m = size(u, 1)
+
1381 n = size(r, 2)
+
1382 k = min(m, n)
+
1383 full = size(q, 2) == m
+
1384 lwork = 2 * k
+
1385 if (present(err)) then
+
1386 errmgr => err
+
1387 else
+
1388 errmgr => deferr
+
1389 end if
+
1390
+
1391 ! Input Check
+
1392 flag = 0
+
1393 if (m < n) then
+
1394 flag = 1
+
1395 else if (.not.full .and. size(q, 2) /= k) then
+
1396 flag = 1
+
1397 else if (size(r, 1) /= m) then
+
1398 flag = 2
+
1399 else if (size(u) /= m) then
+
1400 flag = 3
+
1401 else if (size(v) /= n) then
+
1402 flag = 4
+
1403 end if
+
1404 if (flag /= 0) then
+
1405 ! ERROR: One of the input arrays is not sized correctly
+
1406 write(errmsg, '(AI0A)') "Input number ", flag, &
+
1407 " is not sized correctly."
+
1408 call errmgr%report_error("qr_rank1_update", trim(errmsg), &
+
1409 la_array_size_error)
+
1410 return
+
1411 end if
+
1412
+
1413 ! Local Memory Allocation
+
1414 if (present(work)) then
+
1415 if (size(work) < lwork) then
+
1416 ! ERROR: WORK not sized correctly
+
1417 call errmgr%report_error("qr_rank1_update", &
+
1418 "Incorrectly sized input array WORK, argument 5.", &
+
1419 la_array_size_error)
+
1420 return
+
1421 end if
+
1422 wptr => work(1:lwork)
+
1423 else
+
1424 allocate(wrk(lwork), stat = istat)
+
1425 if (istat /= 0) then
+
1426 ! ERROR: Out of memory
+
1427 call errmgr%report_error("qr_rank1_update", &
+
1428 "Insufficient memory available.", &
+
1429 la_out_of_memory_error)
+
1430 return
+
1431 end if
+
1432 wptr => wrk
+
1433 end if
+
1434
+
1435 ! Process
+
1436 call dqr1up(m, n, k, q, m, r, m, u, v, wptr)
+
1437
+
1438 ! End
+
1439 if (allocated(wrk)) deallocate(wrk)
+
1440 end subroutine
+
1441
+
1442! ------------------------------------------------------------------------------
+
1443 module subroutine qr_rank1_update_cmplx(q, r, u, v, work, rwork, err)
+
1444 ! Arguments
+
1445 complex(real64), intent(inout), dimension(:,:) :: q, r
+
1446 complex(real64), intent(inout), dimension(:) :: u, v
+
1447 complex(real64), intent(out), target, optional, dimension(:) :: work
+
1448 real(real64), intent(out), target, optional, dimension(:) :: rwork
+
1449 class(errors), intent(inout), optional, target :: err
+
1450
+
1451 ! Local Variables
+
1452 logical :: full
+
1453 integer(int32) :: m, n, k, lwork, istat, flag, lrwork
+
1454 complex(real64), pointer, dimension(:) :: wptr
+
1455 complex(real64), allocatable, target, dimension(:) :: wrk
+
1456 real(real64), pointer, dimension(:) :: rwptr
+
1457 real(real64), allocatable, target, dimension(:) :: rwrk
+
1458 class(errors), pointer :: errmgr
+
1459 type(errors), target :: deferr
+
1460 character(len = 128) :: errmsg
+
1461
+
1462 ! Initialization
+
1463 m = size(u, 1)
+
1464 n = size(r, 2)
+
1465 k = min(m, n)
+
1466 full = size(q, 2) == m
+
1467 lwork = k
+
1468 lrwork = k
+
1469 if (present(err)) then
+
1470 errmgr => err
+
1471 else
+
1472 errmgr => deferr
+
1473 end if
+
1474
+
1475 ! Input Check
+
1476 flag = 0
+
1477 if (m < n) then
+
1478 flag = 1
+
1479 else if (.not.full .and. size(q, 2) /= k) then
+
1480 flag = 1
+
1481 else if (size(r, 1) /= m) then
+
1482 flag = 2
+
1483 else if (size(u) /= m) then
+
1484 flag = 3
+
1485 else if (size(v) /= n) then
+
1486 flag = 4
+
1487 end if
+
1488 if (flag /= 0) then
+
1489 ! ERROR: One of the input arrays is not sized correctly
+
1490 write(errmsg, '(AI0A)') "Input number ", flag, &
+
1491 " is not sized correctly."
+
1492 call errmgr%report_error("qr_rank1_update_cmplx", trim(errmsg), &
+
1493 la_array_size_error)
+
1494 return
+
1495 end if
+
1496
+
1497 ! Local Memory Allocation
+
1498 if (present(work)) then
+
1499 if (size(work) < lwork) then
+
1500 ! ERROR: WORK not sized correctly
+
1501 call errmgr%report_error("qr_rank1_update_cmplx", &
+
1502 "Incorrectly sized input array WORK, argument 5.", &
+
1503 la_array_size_error)
+
1504 return
+
1505 end if
+
1506 wptr => work(1:lwork)
+
1507 else
+
1508 allocate(wrk(lwork), stat = istat)
+
1509 if (istat /= 0) then
+
1510 ! ERROR: Out of memory
+
1511 call errmgr%report_error("qr_rank1_update_cmplx", &
+
1512 "Insufficient memory available.", &
+
1513 la_out_of_memory_error)
+
1514 return
+
1515 end if
+
1516 wptr => wrk
+
1517 end if
+
1518
+
1519 if (present(rwork)) then
+
1520 if (size(rwork) < lrwork) then
+
1521 ! ERROR: WORK not sized correctly
+
1522 call errmgr%report_error("qr_rank1_update_cmplx", &
+
1523 "Incorrectly sized input array RWORK, argument 6.", &
+
1524 la_array_size_error)
+
1525 return
+
1526 end if
+
1527 wptr => work(1:lrwork)
+
1528 else
+
1529 allocate(rwrk(lrwork), stat = istat)
+
1530 if (istat /= 0) then
+
1531 ! ERROR: Out of memory
+
1532 call errmgr%report_error("qr_rank1_update_cmplx", &
+
1533 "Insufficient memory available.", &
+
1534 la_out_of_memory_error)
+
1535 return
+
1536 end if
+
1537 rwptr => rwrk
+
1538 end if
+
1539
+
1540 ! Process
+
1541 call zqr1up(m, n, k, q, m, r, m, u, v, wptr, rwptr)
+
1542
+
1543 ! End
+
1544 if (allocated(wrk)) deallocate(wrk)
+
1545 end subroutine
+
1546
+
1547! ******************************************************************************
+
1548! CHOLESKY FACTORIZATION
+
1549! ------------------------------------------------------------------------------
+
1550 module subroutine cholesky_factor_dbl(a, upper, err)
+
1551 ! Arguments
+
1552 real(real64), intent(inout), dimension(:,:) :: a
+
1553 logical, intent(in), optional :: upper
+
1554 class(errors), intent(inout), optional, target :: err
+
1555
+
1556 ! Parameters
+
1557 real(real64), parameter :: zero = 0.0d0
+
1558
+
1559 ! Local Variables
+
1560 character :: uplo
+
1561 integer(int32) :: i, n, flag
+
1562 class(errors), pointer :: errmgr
+
1563 type(errors), target :: deferr
+
1564 character(len = 128) :: errmsg
+
1565
+
1566 ! Initialization
+
1567 n = size(a, 1)
+
1568 if (present(upper)) then
+
1569 if (upper) then
+
1570 uplo = 'U'
+
1571 else
+
1572 uplo = 'L'
+
1573 end if
+
1574 else
+
1575 uplo = 'U'
+
1576 end if
+
1577 if (present(err)) then
+
1578 errmgr => err
+
1579 else
+
1580 errmgr => deferr
+
1581 end if
+
1582
+
1583 ! Input Check
+
1584 if (size(a, 2) /= n) then
+
1585 ! ERROR: A must be square
+
1586 call errmgr%report_error("cholesky_factor", &
+
1587 "The input matrix must be square.", la_array_size_error)
+
1588 return
+
1589 end if
+
1590
+
1591 ! Process
+
1592 call dpotrf(uplo, n, a, n, flag)
+
1593 if (flag > 0) then
+
1594 ! ERROR: Matrix is not positive definite
+
1595 write(errmsg, '(AI0A)') "The leading minor of order ", flag, &
+
1596 " is not positive definite."
+
1597 call errmgr%report_error("cholesky_factor", trim(errmsg), &
+
1598 la_matrix_format_error)
+
1599 end if
+
1600
+
1601 ! Zero out the non-used upper or lower diagonal
+
1602 if (uplo == 'U') then
+
1603 ! Zero out the lower
+
1604 do i = 1, n - 1
+
1605 a(i+1:n,i) = zero
+
1606 end do
+
1607 else
+
1608 ! Zero out the upper
+
1609 do i = 2, n
+
1610 a(1:i-1,i) = zero
+
1611 end do
+
1612 end if
+
1613 end subroutine
+
1614
+
1615! ------------------------------------------------------------------------------
+
1616 module subroutine cholesky_factor_cmplx(a, upper, err)
+
1617 ! Arguments
+
1618 complex(real64), intent(inout), dimension(:,:) :: a
+
1619 logical, intent(in), optional :: upper
+
1620 class(errors), intent(inout), optional, target :: err
+
1621
+
1622 ! Parameters
+
1623 complex(real64), parameter :: zero = (0.0d0, 0.0d0)
+
1624
+
1625 ! Local Variables
+
1626 character :: uplo
+
1627 integer(int32) :: i, n, flag
+
1628 class(errors), pointer :: errmgr
+
1629 type(errors), target :: deferr
+
1630 character(len = 128) :: errmsg
+
1631
+
1632 ! Initialization
+
1633 n = size(a, 1)
+
1634 if (present(upper)) then
+
1635 if (upper) then
+
1636 uplo = 'U'
+
1637 else
+
1638 uplo = 'L'
+
1639 end if
+
1640 else
+
1641 uplo = 'U'
+
1642 end if
+
1643 if (present(err)) then
+
1644 errmgr => err
+
1645 else
+
1646 errmgr => deferr
+
1647 end if
+
1648
+
1649 ! Input Check
+
1650 if (size(a, 2) /= n) then
+
1651 ! ERROR: A must be square
+
1652 call errmgr%report_error("cholesky_factor_cmplx", &
+
1653 "The input matrix must be square.", la_array_size_error)
+
1654 return
+
1655 end if
+
1656
+
1657 ! Process
+
1658 call zpotrf(uplo, n, a, n, flag)
+
1659 if (flag > 0) then
+
1660 ! ERROR: Matrix is not positive definite
+
1661 write(errmsg, '(AI0A)') "The leading minor of order ", flag, &
+
1662 " is not positive definite."
+
1663 call errmgr%report_error("cholesky_factor_cmplx", trim(errmsg), &
+
1664 la_matrix_format_error)
+
1665 end if
+
1666
+
1667 ! Zero out the non-used upper or lower diagonal
+
1668 if (uplo == 'U') then
+
1669 ! Zero out the lower
+
1670 do i = 1, n - 1
+
1671 a(i+1:n,i) = zero
+
1672 end do
+
1673 else
+
1674 ! Zero out the upper
+
1675 do i = 2, n
+
1676 a(1:i-1,i) = zero
+
1677 end do
+
1678 end if
+
1679 end subroutine
+
1680
+
1681! ------------------------------------------------------------------------------
+
1682 module subroutine cholesky_rank1_update_dbl(r, u, work, err)
+
1683 ! Arguments
+
1684 real(real64), intent(inout), dimension(:,:) :: r
+
1685 real(real64), intent(inout), dimension(:) :: u
+
1686 real(real64), intent(out), target, optional, dimension(:) :: work
+
1687 class(errors), intent(inout), optional, target :: err
+
1688
+
1689 ! Local Variables
+
1690 integer(int32) :: n, lwork, istat, flag
+
1691 real(real64), pointer, dimension(:) :: wptr
+
1692 real(real64), allocatable, target, dimension(:) :: wrk
+
1693 class(errors), pointer :: errmgr
+
1694 type(errors), target :: deferr
+
1695 character(len = 128) :: errmsg
+
1696
+
1697 ! Initialization
+
1698 n = size(r, 1)
+
1699 lwork = n
+
1700 if (present(err)) then
+
1701 errmgr => err
+
1702 else
+
1703 errmgr => deferr
+
1704 end if
+
1705
+
1706 ! Input Check
+
1707 flag = 0
+
1708 if (size(r, 2) /= n) then
+
1709 flag = 1
+
1710 else if (size(u) /= n) then
+
1711 flag = 2
+
1712 end if
+
1713 if (flag /= 0) then
+
1714 write(errmsg, '(AI0A)') "Input number ", flag, &
+
1715 " is not sized correctly."
+
1716 call errmgr%report_error("cholesky_rank1_update", trim(errmsg), &
+
1717 la_array_size_error)
+
1718 return
+
1719 end if
+
1720
+
1721 ! Local Memory Allocation
+
1722 if (present(work)) then
+
1723 if (size(work) < lwork) then
+
1724 ! ERROR: Workspace array is not sized correctly
+
1725 call errmgr%report_error("cholesky_rank1_update", &
+
1726 "The workspace array is too short.", &
+
1727 la_array_size_error)
+
1728 return
+
1729 end if
+
1730 wptr => work(1:lwork)
+
1731 else
+
1732 allocate(wrk(lwork), stat = istat)
+
1733 if (istat /= 0) then
+
1734 call errmgr%report_error("cholesky_rank1_update", &
+
1735 "Insufficient memory available.", &
+
1736 la_out_of_memory_error)
+
1737 return
+
1738 end if
+
1739 wptr => wrk
+
1740 end if
+
1741
+
1742 ! Process
+
1743 call dch1up(n, r, n, u, wptr)
+
1744 end subroutine
+
1745
+
1746! ------------------------------------------------------------------------------
+
1747 module subroutine cholesky_rank1_update_cmplx(r, u, work, err)
+
1748 ! Arguments
+
1749 complex(real64), intent(inout), dimension(:,:) :: r
+
1750 complex(real64), intent(inout), dimension(:) :: u
+
1751 real(real64), intent(out), target, optional, dimension(:) :: work
+
1752 class(errors), intent(inout), optional, target :: err
+
1753
+
1754 ! Local Variables
+
1755 integer(int32) :: n, lwork, istat, flag
+
1756 real(real64), pointer, dimension(:) :: wptr
+
1757 real(real64), allocatable, target, dimension(:) :: wrk
+
1758 class(errors), pointer :: errmgr
+
1759 type(errors), target :: deferr
+
1760 character(len = 128) :: errmsg
+
1761
+
1762 ! Initialization
+
1763 n = size(r, 1)
+
1764 lwork = n
+
1765 if (present(err)) then
+
1766 errmgr => err
+
1767 else
+
1768 errmgr => deferr
+
1769 end if
+
1770
+
1771 ! Input Check
+
1772 flag = 0
+
1773 if (size(r, 2) /= n) then
+
1774 flag = 1
+
1775 else if (size(u) /= n) then
+
1776 flag = 2
+
1777 end if
+
1778 if (flag /= 0) then
+
1779 write(errmsg, '(AI0A)') "Input number ", flag, &
+
1780 " is not sized correctly."
+
1781 call errmgr%report_error("cholesky_rank1_update_cmplx", &
+
1782 trim(errmsg), &
+
1783 la_array_size_error)
+
1784 return
+
1785 end if
+
1786
+
1787 ! Local Memory Allocation
+
1788 if (present(work)) then
+
1789 if (size(work) < lwork) then
+
1790 ! ERROR: Workspace array is not sized correctly
+
1791 call errmgr%report_error("cholesky_rank1_update_cmplx", &
+
1792 "The workspace array is too short.", &
+
1793 la_array_size_error)
+
1794 return
+
1795 end if
+
1796 wptr => work(1:lwork)
+
1797 else
+
1798 allocate(wrk(lwork), stat = istat)
+
1799 if (istat /= 0) then
+
1800 call errmgr%report_error("cholesky_rank1_update", &
+
1801 "Insufficient memory available.", &
+
1802 la_out_of_memory_error)
+
1803 return
+
1804 end if
+
1805 wptr => wrk
+
1806 end if
+
1807
+
1808 ! Process
+
1809 call zch1up(n, r, n, u, wptr)
+
1810 end subroutine
+
1811
+
1812! ------------------------------------------------------------------------------
+
1813 module subroutine cholesky_rank1_downdate_dbl(r, u, work, err)
+
1814 ! Arguments
+
1815 real(real64), intent(inout), dimension(:,:) :: r
+
1816 real(real64), intent(inout), dimension(:) :: u
+
1817 real(real64), intent(out), target, optional, dimension(:) :: work
+
1818 class(errors), intent(inout), optional, target :: err
+
1819
+
1820 ! Local Variables
+
1821 integer(int32) :: n, lwork, istat, flag
+
1822 real(real64), pointer, dimension(:) :: wptr
+
1823 real(real64), allocatable, target, dimension(:) :: wrk
+
1824 class(errors), pointer :: errmgr
+
1825 type(errors), target :: deferr
+
1826 character(len = 128) :: errmsg
+
1827
+
1828 ! Initialization
+
1829 n = size(r, 1)
+
1830 lwork = n
+
1831 if (present(err)) then
+
1832 errmgr => err
+
1833 else
+
1834 errmgr => deferr
+
1835 end if
+
1836
+
1837 ! Input Check
+
1838 flag = 0
+
1839 if (size(r, 2) /= n) then
+
1840 flag = 1
+
1841 else if (size(u) /= n) then
+
1842 flag = 2
+
1843 end if
+
1844 if (flag /= 0) then
+
1845 write(errmsg, '(AI0A)') "Input number ", flag, &
+
1846 " is not sized correctly."
+
1847 call errmgr%report_error("cholesky_rank1_downdate", trim(errmsg), &
+
1848 la_array_size_error)
+
1849 return
+
1850 end if
+
1851
+
1852 ! Local Memory Allocation
+
1853 if (present(work)) then
+
1854 if (size(work) < lwork) then
+
1855 ! ERROR: Workspace array is not sized correctly
+
1856 call errmgr%report_error("cholesky_rank1_downdate", &
+
1857 "The workspace array is too short.", &
+
1858 la_array_size_error)
+
1859 return
+
1860 end if
+
1861 wptr => work(1:lwork)
+
1862 else
+
1863 allocate(wrk(lwork), stat = istat)
+
1864 if (istat /= 0) then
+
1865 call errmgr%report_error("cholesky_rank1_downdate", &
+
1866 "Insufficient memory available.", &
+
1867 la_out_of_memory_error)
+
1868 return
+
1869 end if
+
1870 wptr => wrk
+
1871 end if
+
1872
+
1873 ! Process
+
1874 call dch1dn(n, r, n, u, wptr, flag)
+
1875 if (flag == 1) then
+
1876 ! ERROR: The matrix is not positive definite
+
1877 call errmgr%report_error("cholesky_rank1_downdate", &
+
1878 "The downdated matrix is not positive definite.", &
+
1879 la_matrix_format_error)
+
1880 else if (flag == 2) then
+
1881 ! ERROR: The matrix is singular
+
1882 call errmgr%report_error("cholesky_rank1_downdate", &
+
1883 "The input matrix is singular.", la_singular_matrix_error)
+
1884 end if
+
1885 end subroutine
+
1886
+
1887! ------------------------------------------------------------------------------
+
1888 module subroutine cholesky_rank1_downdate_cmplx(r, u, work, err)
+
1889 ! Arguments
+
1890 complex(real64), intent(inout), dimension(:,:) :: r
+
1891 complex(real64), intent(inout), dimension(:) :: u
+
1892 real(real64), intent(out), target, optional, dimension(:) :: work
+
1893 class(errors), intent(inout), optional, target :: err
+
1894
+
1895 ! Local Variables
+
1896 integer(int32) :: n, lwork, istat, flag
+
1897 real(real64), pointer, dimension(:) :: wptr
+
1898 real(real64), allocatable, target, dimension(:) :: wrk
+
1899 class(errors), pointer :: errmgr
+
1900 type(errors), target :: deferr
+
1901 character(len = 128) :: errmsg
+
1902
+
1903 ! Initialization
+
1904 n = size(r, 1)
+
1905 lwork = n
+
1906 if (present(err)) then
+
1907 errmgr => err
+
1908 else
+
1909 errmgr => deferr
+
1910 end if
+
1911
+
1912 ! Input Check
+
1913 flag = 0
+
1914 if (size(r, 2) /= n) then
+
1915 flag = 1
+
1916 else if (size(u) /= n) then
+
1917 flag = 2
+
1918 end if
+
1919 if (flag /= 0) then
+
1920 write(errmsg, '(AI0A)') "Input number ", flag, &
+
1921 " is not sized correctly."
+
1922 call errmgr%report_error("cholesky_rank1_downdate_cmplx", &
+
1923 trim(errmsg), &
+
1924 la_array_size_error)
+
1925 return
+
1926 end if
+
1927
+
1928 ! Local Memory Allocation
+
1929 if (present(work)) then
+
1930 if (size(work) < lwork) then
+
1931 ! ERROR: Workspace array is not sized correctly
+
1932 call errmgr%report_error("cholesky_rank1_downdate_cmplx", &
+
1933 "The workspace array is too short.", &
+
1934 la_array_size_error)
+
1935 return
+
1936 end if
+
1937 wptr => work(1:lwork)
+
1938 else
+
1939 allocate(wrk(lwork), stat = istat)
+
1940 if (istat /= 0) then
+
1941 call errmgr%report_error("cholesky_rank1_downdate_cmplx", &
+
1942 "Insufficient memory available.", &
+
1943 la_out_of_memory_error)
+
1944 return
+
1945 end if
+
1946 wptr => wrk
+
1947 end if
+
1948
+
1949 ! Process
+
1950 call zch1dn(n, r, n, u, wptr, flag)
+
1951 if (flag == 1) then
+
1952 ! ERROR: The matrix is not positive definite
+
1953 call errmgr%report_error("cholesky_rank1_downdate_cmplx", &
+
1954 "The downdated matrix is not positive definite.", &
+
1955 la_matrix_format_error)
+
1956 else if (flag == 2) then
+
1957 ! ERROR: The matrix is singular
+
1958 call errmgr%report_error("cholesky_rank1_downdate_cmplx", &
+
1959 "The input matrix is singular.", la_singular_matrix_error)
+
1960 end if
+
1961 end subroutine
+
1962
+
1963! ******************************************************************************
+
1964! RZ FACTORIZATION ROUTINES
+
1965! ------------------------------------------------------------------------------
+
1966 module subroutine rz_factor_dbl(a, tau, work, olwork, err)
+
1967 ! Arguments
+
1968 real(real64), intent(inout), dimension(:,:) :: a
+
1969 real(real64), intent(out), dimension(:) :: tau
+
1970 real(real64), intent(out), target, optional, dimension(:) :: work
+
1971 integer(int32), intent(out), optional :: olwork
+
1972 class(errors), intent(inout), optional, target :: err
+
1973
+
1974 ! Local Variables
+
1975 integer(int32) :: m, n, lwork, flag, istat
+
1976 real(real64), pointer, dimension(:) :: wptr
+
1977 real(real64), allocatable, target, dimension(:) :: wrk
+
1978 real(real64), dimension(1) :: temp
+
1979 class(errors), pointer :: errmgr
+
1980 type(errors), target :: deferr
+
1981 character(len = 128) :: errmsg
+
1982
+
1983 ! Initialization
+
1984 m = size(a, 1)
+
1985 n = size(a, 2)
+
1986 if (present(err)) then
+
1987 errmgr => err
+
1988 else
+
1989 errmgr => deferr
+
1990 end if
+
1991
+
1992 ! Input Check
+
1993 flag = 0
+
1994 if (size(tau) /= m) then
+
1995 flag = 3
+
1996 end if
+
1997 if (flag /= 0) then
+
1998 ! ERROR: One of the input arrays is not sized correctly
+
1999 write(errmsg, '(AI0A)') "Input number ", flag, &
+
2000 " is not sized correctly."
+
2001 call errmgr%report_error("rz_factor", trim(errmsg), &
+
2002 la_array_size_error)
+
2003 return
+
2004 end if
+
2005
+
2006 ! Workspace Query
+
2007 call dtzrzf(m, n, a, m, tau, temp, -1, flag)
+
2008 lwork = int(temp(1), int32)
+
2009 if (present(olwork)) then
+
2010 olwork = lwork
+
2011 return
+
2012 end if
+
2013
+
2014 ! Local Memory Allocation
+
2015 if (present(work)) then
+
2016 if (size(work) < lwork) then
+
2017 ! ERROR: WORK not sized correctly
+
2018 call errmgr%report_error("rz_factor", &
+
2019 "Incorrectly sized input array WORK, argument 3.", &
+
2020 la_array_size_error)
+
2021 return
+
2022 end if
+
2023 wptr => work(1:lwork)
+
2024 else
+
2025 allocate(wrk(lwork), stat = istat)
+
2026 if (istat /= 0) then
+
2027 ! ERROR: Out of memory
+
2028 call errmgr%report_error("rz_factor", &
+
2029 "Insufficient memory available.", &
+
2030 la_out_of_memory_error)
+
2031 return
+
2032 end if
+
2033 wptr => wrk
+
2034 end if
+
2035
+
2036 ! Call DTZRZF
+
2037 call dtzrzf(m, n, a, m, tau, wptr, lwork, flag)
+
2038 end subroutine
+
2039
+
2040! ------------------------------------------------------------------------------
+
2041 module subroutine rz_factor_cmplx(a, tau, work, olwork, err)
+
2042 ! Arguments
+
2043 complex(real64), intent(inout), dimension(:,:) :: a
+
2044 complex(real64), intent(out), dimension(:) :: tau
+
2045 complex(real64), intent(out), target, optional, dimension(:) :: work
+
2046 integer(int32), intent(out), optional :: olwork
+
2047 class(errors), intent(inout), optional, target :: err
+
2048
+
2049 ! Local Variables
+
2050 integer(int32) :: m, n, lwork, flag, istat
+
2051 complex(real64), pointer, dimension(:) :: wptr
+
2052 complex(real64), allocatable, target, dimension(:) :: wrk
+
2053 complex(real64), dimension(1) :: temp
+
2054 class(errors), pointer :: errmgr
+
2055 type(errors), target :: deferr
+
2056 character(len = 128) :: errmsg
+
2057
+
2058 ! Initialization
+
2059 m = size(a, 1)
+
2060 n = size(a, 2)
+
2061 if (present(err)) then
+
2062 errmgr => err
+
2063 else
+
2064 errmgr => deferr
+
2065 end if
+
2066
+
2067 ! Input Check
+
2068 flag = 0
+
2069 if (size(tau) /= m) then
+
2070 flag = 3
+
2071 end if
+
2072 if (flag /= 0) then
+
2073 ! ERROR: One of the input arrays is not sized correctly
+
2074 write(errmsg, '(AI0A)') "Input number ", flag, &
+
2075 " is not sized correctly."
+
2076 call errmgr%report_error("rz_factor_cmplx", trim(errmsg), &
+
2077 la_array_size_error)
+
2078 return
+
2079 end if
+
2080
+
2081 ! Workspace Query
+
2082 call ztzrzf(m, n, a, m, tau, temp, -1, flag)
+
2083 lwork = int(temp(1), int32)
+
2084 if (present(olwork)) then
+
2085 olwork = lwork
+
2086 return
+
2087 end if
+
2088
+
2089 ! Local Memory Allocation
+
2090 if (present(work)) then
+
2091 if (size(work) < lwork) then
+
2092 ! ERROR: WORK not sized correctly
+
2093 call errmgr%report_error("rz_factor_cmplx", &
+
2094 "Incorrectly sized input array WORK, argument 3.", &
+
2095 la_array_size_error)
+
2096 return
+
2097 end if
+
2098 wptr => work(1:lwork)
+
2099 else
+
2100 allocate(wrk(lwork), stat = istat)
+
2101 if (istat /= 0) then
+
2102 ! ERROR: Out of memory
+
2103 call errmgr%report_error("rz_factor_cmplx", &
+
2104 "Insufficient memory available.", &
+
2105 la_out_of_memory_error)
+
2106 return
+
2107 end if
+
2108 wptr => wrk
+
2109 end if
+
2110
+
2111 ! Call ZTZRZF
+
2112 call ztzrzf(m, n, a, m, tau, wptr, lwork, flag)
+
2113 end subroutine
+
2114
+
2115! ------------------------------------------------------------------------------
+
2116 module subroutine mult_rz_mtx(lside, trans, l, a, tau, c, work, olwork, err)
+
2117 ! Arguments
+
2118 logical, intent(in) :: lside, trans
+
2119 integer(int32), intent(in) :: l
+
2120 real(real64), intent(inout), dimension(:,:) :: a, c
+
2121 real(real64), intent(in), dimension(:) :: tau
+
2122 real(real64), intent(out), target, optional, dimension(:) :: work
+
2123 integer(int32), intent(out), optional :: olwork
+
2124 class(errors), intent(inout), optional, target :: err
+
2125
+
2126 ! Local Variables
+
2127 character :: side, t
+
2128 integer(int32) :: m, n, k, lwork, flag, istat, lda
+
2129 real(real64), pointer, dimension(:) :: wptr
+
2130 real(real64), allocatable, target, dimension(:) :: wrk
+
2131 real(real64), dimension(1) :: temp
+
2132 class(errors), pointer :: errmgr
+
2133 type(errors), target :: deferr
+
2134 character(len = 128) :: errmsg
+
2135
+
2136 ! Initialization
+
2137 m = size(c, 1)
+
2138 n = size(c, 2)
+
2139 k = size(tau)
+
2140 lda = size(a, 1)
+
2141 if (lside) then
+
2142 side = 'L'
+
2143 else
+
2144 side = 'R'
+
2145 end if
+
2146 if (trans) then
+
2147 t = 'T'
+
2148 else
+
2149 t = 'N'
+
2150 end if
+
2151 if (present(err)) then
+
2152 errmgr => err
+
2153 else
+
2154 errmgr => deferr
+
2155 end if
+
2156
+
2157 ! Input Check
+
2158 flag = 0
+
2159 if (lside) then
+
2160 if (l > m .or. l < 0) then
+
2161 flag = 3
+
2162 else if (k > m) then
+
2163 flag = 5
+
2164 else if (size(a, 1) < k .or. size(a, 2) /= m) then
+
2165 flag = 4
+
2166 end if
+
2167 else
+
2168 if (l > n .or. l < 0) then
+
2169 flag = 3
+
2170 else if (k > n) then
+
2171 flag = 5
+
2172 else if (size(a, 1) < k .or. size(a, 2) /= n) then
+
2173 flag = 4
+
2174 end if
+
2175 end if
+
2176 if (flag /= 0) then
+
2177 ! ERROR: One of the input arrays is not sized correctly
+
2178 write(errmsg, '(AI0A)') "Input number ", flag, &
+
2179 " is not sized correctly."
+
2180 call errmgr%report_error("mult_rz_mtx", trim(errmsg), &
+
2181 la_array_size_error)
+
2182 return
+
2183 end if
+
2184
+
2185 ! Workspace Query
+
2186 call dormrz(side, t, m, n, k, l, a, lda, tau, c, m, temp, -1, flag)
+
2187 lwork = int(temp(1), int32)
+
2188 if (present(olwork)) then
+
2189 olwork = lwork
+
2190 return
+
2191 end if
+
2192
+
2193 ! Local Memory Allocation
+
2194 if (present(work)) then
+
2195 if (size(work) < lwork) then
+
2196 ! ERROR: WORK not sized correctly
+
2197 call errmgr%report_error("mult_rz_mtx", &
+
2198 "Incorrectly sized input array WORK, argument 7.", &
+
2199 la_array_size_error)
+
2200 return
+
2201 end if
+
2202 wptr => work(1:lwork)
+
2203 else
+
2204 allocate(wrk(lwork), stat = istat)
+
2205 if (istat /= 0) then
+
2206 ! ERROR: Out of memory
+
2207 call errmgr%report_error("mult_rz_mtx", &
+
2208 "Insufficient memory available.", &
+
2209 la_out_of_memory_error)
+
2210 return
+
2211 end if
+
2212 wptr => wrk
+
2213 end if
+
2214
+
2215 ! Call DORMRZ
+
2216 call dormrz(side, t, m, n, k, l, a, lda, tau, c, m, wptr, lwork, flag)
+
2217 end subroutine
+
2218
+
2219! ------------------------------------------------------------------------------
+
2220 module subroutine mult_rz_mtx_cmplx(lside, trans, l, a, tau, c, work, olwork, err)
+
2221 ! Arguments
+
2222 logical, intent(in) :: lside, trans
+
2223 integer(int32), intent(in) :: l
+
2224 complex(real64), intent(inout), dimension(:,:) :: a, c
+
2225 complex(real64), intent(in), dimension(:) :: tau
+
2226 complex(real64), intent(out), target, optional, dimension(:) :: work
+
2227 integer(int32), intent(out), optional :: olwork
+
2228 class(errors), intent(inout), optional, target :: err
+
2229
+
2230 ! Local Variables
+
2231 character :: side, t
+
2232 integer(int32) :: m, n, k, lwork, flag, istat, lda
+
2233 complex(real64), pointer, dimension(:) :: wptr
+
2234 complex(real64), allocatable, target, dimension(:) :: wrk
+
2235 complex(real64), dimension(1) :: temp
+
2236 class(errors), pointer :: errmgr
+
2237 type(errors), target :: deferr
+
2238 character(len = 128) :: errmsg
+
2239
+
2240 ! Initialization
+
2241 m = size(c, 1)
+
2242 n = size(c, 2)
+
2243 k = size(tau)
+
2244 lda = size(a, 1)
+
2245 if (lside) then
+
2246 side = 'L'
+
2247 else
+
2248 side = 'R'
+
2249 end if
+
2250 if (trans) then
+
2251 t = 'C'
+
2252 else
+
2253 t = 'N'
+
2254 end if
+
2255 if (present(err)) then
+
2256 errmgr => err
+
2257 else
+
2258 errmgr => deferr
+
2259 end if
+
2260
+
2261 ! Input Check
+
2262 flag = 0
+
2263 if (lside) then
+
2264 if (l > m .or. l < 0) then
+
2265 flag = 3
+
2266 else if (k > m) then
+
2267 flag = 5
+
2268 else if (size(a, 1) < k .or. size(a, 2) /= m) then
+
2269 flag = 4
+
2270 end if
+
2271 else
+
2272 if (l > n .or. l < 0) then
+
2273 flag = 3
+
2274 else if (k > n) then
+
2275 flag = 5
+
2276 else if (size(a, 1) < k .or. size(a, 2) /= n) then
+
2277 flag = 4
+
2278 end if
+
2279 end if
+
2280 if (flag /= 0) then
+
2281 ! ERROR: One of the input arrays is not sized correctly
+
2282 write(errmsg, '(AI0A)') "Input number ", flag, &
+
2283 " is not sized correctly."
+
2284 call errmgr%report_error("mult_rz_mtx_cmplx", trim(errmsg), &
+
2285 la_array_size_error)
+
2286 return
+
2287 end if
+
2288
+
2289 ! Workspace Query
+
2290 call zunmrz(side, t, m, n, k, l, a, lda, tau, c, m, temp, -1, flag)
+
2291 lwork = int(temp(1), int32)
+
2292 if (present(olwork)) then
+
2293 olwork = lwork
+
2294 return
+
2295 end if
+
2296
+
2297 ! Local Memory Allocation
+
2298 if (present(work)) then
+
2299 if (size(work) < lwork) then
+
2300 ! ERROR: WORK not sized correctly
+
2301 call errmgr%report_error("mult_rz_mtx_cmplx", &
+
2302 "Incorrectly sized input array WORK, argument 7.", &
+
2303 la_array_size_error)
+
2304 return
+
2305 end if
+
2306 wptr => work(1:lwork)
+
2307 else
+
2308 allocate(wrk(lwork), stat = istat)
+
2309 if (istat /= 0) then
+
2310 ! ERROR: Out of memory
+
2311 call errmgr%report_error("mult_rz_mtx_cmplx", &
+
2312 "Insufficient memory available.", &
+
2313 la_out_of_memory_error)
+
2314 return
+
2315 end if
+
2316 wptr => wrk
+
2317 end if
+
2318
+
2319 ! Call ZUNMRZ
+
2320 call zunmrz(side, t, m, n, k, l, a, lda, tau, c, m, wptr, lwork, flag)
+
2321 end subroutine
+
2322
+
2323! ------------------------------------------------------------------------------
+
2324 module subroutine mult_rz_vec(trans, l, a, tau, c, work, olwork, err)
+
2325 ! Arguments
+
2326 logical, intent(in) :: trans
+
2327 integer(int32), intent(in) :: l
+
2328 real(real64), intent(inout), dimension(:,:) :: a
+
2329 real(real64), intent(in), dimension(:) :: tau
+
2330 real(real64), intent(inout), dimension(:) :: c
+
2331 real(real64), intent(out), target, optional, dimension(:) :: work
+
2332 integer(int32), intent(out), optional :: olwork
+
2333 class(errors), intent(inout), optional, target :: err
+
2334
+
2335 ! Local Variables
+
2336 character :: side, t
+
2337 integer(int32) :: m, k, lwork, flag, istat, lda
+
2338 real(real64), pointer, dimension(:) :: wptr
+
2339 real(real64), allocatable, target, dimension(:) :: wrk
+
2340 real(real64), dimension(1) :: temp
+
2341 class(errors), pointer :: errmgr
+
2342 type(errors), target :: deferr
+
2343 character(len = 128) :: errmsg
+
2344
+
2345 ! Initialization
+
2346 m = size(c)
+
2347 k = size(tau)
+
2348 lda = size(a, 1)
+
2349 side = 'L'
+
2350 if (trans) then
+
2351 t = 'T'
+
2352 else
+
2353 t = 'N'
+
2354 end if
+
2355 if (present(err)) then
+
2356 errmgr => err
+
2357 else
+
2358 errmgr => deferr
+
2359 end if
+
2360
+
2361 ! Input Check
+
2362 flag = 0
+
2363 if (l > m .or. l < 0) then
+
2364 flag = 2
+
2365 else if (k > m) then
+
2366 flag = 4
+
2367 else if (size(a, 1) < k .or. size(a, 2) /= m) then
+
2368 flag = 3
+
2369 end if
+
2370 if (flag /= 0) then
+
2371 ! ERROR: One of the input arrays is not sized correctly
+
2372 write(errmsg, '(AI0A)') "Input number ", flag, &
+
2373 " is not sized correctly."
+
2374 call errmgr%report_error("mult_rz_vec", trim(errmsg), &
+
2375 la_array_size_error)
+
2376 return
+
2377 end if
+
2378
+
2379 ! Workspace Query
+
2380 call dormrz(side, t, m, 1, k, l, a, lda, tau, c, m, temp, -1, flag)
+
2381 lwork = int(temp(1), int32)
+
2382 if (present(olwork)) then
+
2383 olwork = lwork
+
2384 return
+
2385 end if
+
2386
+
2387 ! Local Memory Allocation
+
2388 if (present(work)) then
+
2389 if (size(work) < lwork) then
+
2390 ! ERROR: WORK not sized correctly
+
2391 call errmgr%report_error("mult_rz_vec", &
+
2392 "Incorrectly sized input array WORK, argument 6.", &
+
2393 la_array_size_error)
+
2394 return
+
2395 end if
+
2396 wptr => work(1:lwork)
+
2397 else
+
2398 allocate(wrk(lwork), stat = istat)
+
2399 if (istat /= 0) then
+
2400 ! ERROR: Out of memory
+
2401 call errmgr%report_error("mult_rz_vec", &
+
2402 "Insufficient memory available.", &
+
2403 la_out_of_memory_error)
+
2404 return
+
2405 end if
+
2406 wptr => wrk
+
2407 end if
+
2408
+
2409 ! Call DORMRZ
+
2410 call dormrz(side, t, m, 1, k, l, a, lda, tau, c, m, wptr, lwork, flag)
+
2411 end subroutine
+
2412
+
2413! ------------------------------------------------------------------------------
+
2414 module subroutine mult_rz_vec_cmplx(trans, l, a, tau, c, work, olwork, err)
+
2415 ! Arguments
+
2416 logical, intent(in) :: trans
+
2417 integer(int32), intent(in) :: l
+
2418 complex(real64), intent(inout), dimension(:,:) :: a
+
2419 complex(real64), intent(in), dimension(:) :: tau
+
2420 complex(real64), intent(inout), dimension(:) :: c
+
2421 complex(real64), intent(out), target, optional, dimension(:) :: work
+
2422 integer(int32), intent(out), optional :: olwork
+
2423 class(errors), intent(inout), optional, target :: err
+
2424
+
2425 ! Local Variables
+
2426 character :: side, t
+
2427 integer(int32) :: m, k, lwork, flag, istat, lda
+
2428 complex(real64), pointer, dimension(:) :: wptr
+
2429 complex(real64), allocatable, target, dimension(:) :: wrk
+
2430 complex(real64), dimension(1) :: temp
+
2431 class(errors), pointer :: errmgr
+
2432 type(errors), target :: deferr
+
2433 character(len = 128) :: errmsg
+
2434
+
2435 ! Initialization
+
2436 m = size(c)
+
2437 k = size(tau)
+
2438 lda = size(a, 1)
+
2439 side = 'L'
+
2440 if (trans) then
+
2441 t = 'T'
+
2442 else
+
2443 t = 'N'
+
2444 end if
+
2445 if (present(err)) then
+
2446 errmgr => err
+
2447 else
+
2448 errmgr => deferr
+
2449 end if
+
2450
+
2451 ! Input Check
+
2452 flag = 0
+
2453 if (l > m .or. l < 0) then
+
2454 flag = 2
+
2455 else if (k > m) then
+
2456 flag = 4
+
2457 else if (size(a, 1) < k .or. size(a, 2) /= m) then
+
2458 flag = 3
+
2459 end if
+
2460 if (flag /= 0) then
+
2461 ! ERROR: One of the input arrays is not sized correctly
+
2462 write(errmsg, '(AI0A)') "Input number ", flag, &
+
2463 " is not sized correctly."
+
2464 call errmgr%report_error("mult_rz_vec_cmplx", trim(errmsg), &
+
2465 la_array_size_error)
+
2466 return
+
2467 end if
+
2468
+
2469 ! Workspace Query
+
2470 call zunmrz(side, t, m, 1, k, l, a, lda, tau, c, m, temp, -1, flag)
+
2471 lwork = int(temp(1), int32)
+
2472 if (present(olwork)) then
+
2473 olwork = lwork
+
2474 return
+
2475 end if
+
2476
+
2477 ! Local Memory Allocation
+
2478 if (present(work)) then
+
2479 if (size(work) < lwork) then
+
2480 ! ERROR: WORK not sized correctly
+
2481 call errmgr%report_error("mult_rz_vec_cmplx", &
+
2482 "Incorrectly sized input array WORK, argument 6.", &
+
2483 la_array_size_error)
+
2484 return
+
2485 end if
+
2486 wptr => work(1:lwork)
+
2487 else
+
2488 allocate(wrk(lwork), stat = istat)
+
2489 if (istat /= 0) then
+
2490 ! ERROR: Out of memory
+
2491 call errmgr%report_error("mult_rz_vec_cmplx", &
+
2492 "Insufficient memory available.", &
+
2493 la_out_of_memory_error)
+
2494 return
+
2495 end if
+
2496 wptr => wrk
+
2497 end if
+
2498
+
2499 ! Call ZUNMRZ
+
2500 call zunmrz(side, t, m, 1, k, l, a, lda, tau, c, m, wptr, lwork, flag)
+
2501 end subroutine
+
2502
+
2503! ******************************************************************************
+
2504! SVD ROUTINES
+
2505! ------------------------------------------------------------------------------
+
2506 module subroutine svd_dbl(a, s, u, vt, work, olwork, err)
+
2507 ! Arguments
+
2508 real(real64), intent(inout), dimension(:,:) :: a
+
2509 real(real64), intent(out), dimension(:) :: s
+
2510 real(real64), intent(out), optional, dimension(:,:) :: u, vt
+
2511 real(real64), intent(out), target, optional, dimension(:) :: work
+
2512 integer(int32), intent(out), optional :: olwork
+
2513 class(errors), intent(inout), optional, target :: err
+
2514
+
2515 ! Local Variables
+
2516 character :: jobu, jobvt
+
2517 integer(int32) :: m, n, mn, istat, lwork, flag
+
2518 real(real64), pointer, dimension(:) :: wptr
+
2519 real(real64), allocatable, target, dimension(:) :: wrk
+
2520 real(real64), dimension(1) :: temp
+
2521 class(errors), pointer :: errmgr
+
2522 type(errors), target :: deferr
+
2523 character(len = 128) :: errmsg
+
2524
+
2525 ! Initialization
+
2526 m = size(a, 1)
+
2527 n = size(a, 2)
+
2528 mn = min(m, n)
+
2529 if (present(u)) then
+
2530 if (size(u, 2) == m) then
+
2531 jobu = 'A'
+
2532 else if (size(u, 2) == mn) then
+
2533 jobu = 'S'
+
2534 end if
+
2535 else
+
2536 jobu = 'N'
+
2537 end if
+
2538 if (present(vt)) then
+
2539 jobvt = 'A'
+
2540 else
+
2541 jobvt = 'N'
+
2542 end if
+
2543 if (present(err)) then
+
2544 errmgr => err
+
2545 else
+
2546 errmgr => deferr
+
2547 end if
+
2548
+
2549 ! Input Check
+
2550 flag = 0
+
2551 if (size(s) /= mn) then
+
2552 flag = 2
+
2553 else if (present(u)) then
+
2554 if (size(u, 1) /= m) flag = 3
+
2555 if (size(u, 2) /= m .and. size(u, 2) /= mn) flag = 3
+
2556 else if (present(vt)) then
+
2557 if (size(vt, 1) /= n .or. size(vt, 2) /= n) flag = 4
+
2558 end if
+
2559 if (flag /= 0) then
+
2560 ! ERROR: One of the input arrays is not sized correctly
+
2561 write(errmsg, '(AI0A)') "Input number ", flag, &
+
2562 " is not sized correctly."
+
2563 call errmgr%report_error("svd", trim(errmsg), &
+
2564 la_array_size_error)
+
2565 return
+
2566 end if
+
2567
+
2568 ! Workspace Query
+
2569 call dgesvd(jobu, jobvt, m, n, a, m, s, temp, m, temp, n, temp, -1, &
+
2570 flag)
+
2571 lwork = int(temp(1), int32)
+
2572 if (present(olwork)) then
+
2573 olwork = lwork
+
2574 return
+
2575 end if
+
2576
+
2577 ! Local Memory Allocation
+
2578 if (present(work)) then
+
2579 if (size(work) < lwork) then
+
2580 ! ERROR: WORK not sized correctly
+
2581 call errmgr%report_error("svd", &
+
2582 "Incorrectly sized input array WORK, argument 5.", &
+
2583 la_array_size_error)
+
2584 return
+
2585 end if
+
2586 wptr => work(1:lwork)
+
2587 else
+
2588 allocate(wrk(lwork), stat = istat)
+
2589 if (istat /= 0) then
+
2590 ! ERROR: Out of memory
+
2591 call errmgr%report_error("svd", &
+
2592 "Insufficient memory available.", &
+
2593 la_out_of_memory_error)
+
2594 return
+
2595 end if
+
2596 wptr => wrk
+
2597 end if
+
2598
+
2599 ! Call DGESVD
+
2600 if (present(u) .and. present(vt)) then
+
2601 call dgesvd(jobu, jobvt, m, n, a, m, s, u, m, vt, n, wptr, lwork, &
+
2602 flag)
+
2603 else if (present(u) .and. .not.present(vt)) then
+
2604 call dgesvd(jobu, jobvt, m, n, a, m, s, u, m, temp, n, wptr, &
+
2605 lwork, flag)
+
2606 else if (.not.present(u) .and. present(vt)) then
+
2607 call dgesvd(jobu, jobvt, m, n, a, m, s, temp, m, vt, n, wptr, &
+
2608 lwork, flag)
+
2609 else
+
2610 call dgesvd(jobu, jobvt, m, n, a, m, s, temp, m, temp, n, wptr, &
+
2611 lwork, flag)
+
2612 end if
+
2613
+
2614 ! Check for convergence
+
2615 if (flag > 0) then
+
2616 write(errmsg, '(I0A)') flag, " superdiagonals could not " // &
+
2617 "converge to zero as part of the QR iteration process."
+
2618 call errmgr%report_warning("svd", errmsg, la_convergence_error)
+
2619 end if
+
2620 end subroutine
+
2621
+
2622! ------------------------------------------------------------------------------
+
2623 module subroutine svd_cmplx(a, s, u, vt, work, olwork, rwork, err)
+
2624 ! Arguments
+
2625 complex(real64), intent(inout), dimension(:,:) :: a
+
2626 real(real64), intent(out), dimension(:) :: s
+
2627 complex(real64), intent(out), optional, dimension(:,:) :: u, vt
+
2628 complex(real64), intent(out), target, optional, dimension(:) :: work
+
2629 integer(int32), intent(out), optional :: olwork
+
2630 real(real64), intent(out), target, optional, dimension(:) :: rwork
+
2631 class(errors), intent(inout), optional, target :: err
+
2632
+
2633 ! Local Variables
+
2634 character :: jobu, jobvt
+
2635 integer(int32) :: m, n, mn, istat, lwork, flag, lrwork
+
2636 complex(real64), pointer, dimension(:) :: wptr
+
2637 complex(real64), allocatable, target, dimension(:) :: wrk
+
2638 complex(real64), dimension(1) :: temp
+
2639 real(real64), dimension(1) :: rtemp
+
2640 real(real64), pointer, dimension(:) :: rwptr
+
2641 real(real64), allocatable, target, dimension(:) :: rwrk
+
2642 class(errors), pointer :: errmgr
+
2643 type(errors), target :: deferr
+
2644 character(len = 128) :: errmsg
+
2645
+
2646 ! Initialization
+
2647 m = size(a, 1)
+
2648 n = size(a, 2)
+
2649 mn = min(m, n)
+
2650 lrwork = 5 * mn
+
2651 if (present(u)) then
+
2652 if (size(u, 2) == m) then
+
2653 jobu = 'A'
+
2654 else if (size(u, 2) == mn) then
+
2655 jobu = 'S'
+
2656 end if
+
2657 else
+
2658 jobu = 'N'
+
2659 end if
+
2660 if (present(vt)) then
+
2661 jobvt = 'A'
+
2662 else
+
2663 jobvt = 'N'
+
2664 end if
+
2665 if (present(err)) then
+
2666 errmgr => err
+
2667 else
+
2668 errmgr => deferr
+
2669 end if
+
2670
+
2671 ! Input Check
+
2672 flag = 0
+
2673 if (size(s) /= mn) then
+
2674 flag = 2
+
2675 else if (present(u)) then
+
2676 if (size(u, 1) /= m) flag = 3
+
2677 if (size(u, 2) /= m .and. size(u, 2) /= mn) flag = 3
+
2678 else if (present(vt)) then
+
2679 if (size(vt, 1) /= n .or. size(vt, 2) /= n) flag = 4
+
2680 end if
+
2681 if (flag /= 0) then
+
2682 ! ERROR: One of the input arrays is not sized correctly
+
2683 write(errmsg, '(AI0A)') "Input number ", flag, &
+
2684 " is not sized correctly."
+
2685 call errmgr%report_error("svd_cmplx", trim(errmsg), &
+
2686 la_array_size_error)
+
2687 return
+
2688 end if
+
2689
+
2690 ! Workspace Query
+
2691 call zgesvd(jobu, jobvt, m, n, a, m, s, temp, m, temp, n, temp, -1, &
+
2692 rtemp, flag)
+
2693 lwork = int(temp(1), int32)
+
2694 if (present(olwork)) then
+
2695 olwork = lwork
+
2696 return
+
2697 end if
+
2698
+
2699 ! Local Memory Allocation
+
2700 if (present(work)) then
+
2701 if (size(work) < lwork) then
+
2702 ! ERROR: WORK not sized correctly
+
2703 call errmgr%report_error("svd_cmplx", &
+
2704 "Incorrectly sized input array WORK, argument 5.", &
+
2705 la_array_size_error)
+
2706 return
+
2707 end if
+
2708 wptr => work(1:lwork)
+
2709 else
+
2710 allocate(wrk(lwork), stat = istat)
+
2711 if (istat /= 0) then
+
2712 ! ERROR: Out of memory
+
2713 call errmgr%report_error("svd_cmplx", &
+
2714 "Insufficient memory available.", &
+
2715 la_out_of_memory_error)
+
2716 return
+
2717 end if
+
2718 wptr => wrk
+
2719 end if
+
2720
+
2721 if (present(rwork)) then
+
2722 if (size(rwork) < lrwork) then
+
2723 ! ERROR: RWORK not sized correctly
+
2724 call errmgr%report_error("svd_cmplx", &
+
2725 "Incorrectly sized input array RWORK, argument 7.", &
+
2726 la_array_size_error)
+
2727 end if
+
2728 rwptr => rwork(1:lrwork)
+
2729 else
+
2730 allocate(rwrk(lrwork), stat = istat)
+
2731 if (istat /= 0) then
+
2732 ! ERROR: Out of memory
+
2733 call errmgr%report_error("svd_cmplx", &
+
2734 "Insufficient memory available.", &
+
2735 la_out_of_memory_error)
+
2736 return
+
2737 end if
+
2738 rwptr => rwrk
+
2739 end if
+
2740
+
2741 ! Call ZGESVD
+
2742 if (present(u) .and. present(vt)) then
+
2743 call zgesvd(jobu, jobvt, m, n, a, m, s, u, m, vt, n, wptr, lwork, &
+
2744 rwptr, flag)
+
2745 else if (present(u) .and. .not.present(vt)) then
+
2746 call zgesvd(jobu, jobvt, m, n, a, m, s, u, m, temp, n, wptr, &
+
2747 rwptr, lwork, flag)
+
2748 else if (.not.present(u) .and. present(vt)) then
+
2749 call zgesvd(jobu, jobvt, m, n, a, m, s, temp, m, vt, n, wptr, &
+
2750 rwptr, lwork, flag)
+
2751 else
+
2752 call zgesvd(jobu, jobvt, m, n, a, m, s, temp, m, temp, n, wptr, &
+
2753 rwptr, lwork, flag)
+
2754 end if
+
2755
+
2756 ! Check for convergence
+
2757 if (flag > 0) then
+
2758 write(errmsg, '(I0A)') flag, " superdiagonals could not " // &
+
2759 "converge to zero as part of the QR iteration process."
+
2760 call errmgr%report_warning("svd_cmplx", errmsg, &
+
2761 la_convergence_error)
+
2762 end if
+
2763 end subroutine
+
2764
+
2765end submodule
+
Provides a set of common linear algebra routines.
Definition: linalg_core.f90:15
-
Provides a set of common linear algebra routines.
Definition: linalg_core.f90:15
diff --git a/doc/html/linalg__immutable_8f90_source.html b/doc/html/linalg__immutable_8f90_source.html index 538d625e..938b7dc7 100644 --- a/doc/html/linalg__immutable_8f90_source.html +++ b/doc/html/linalg__immutable_8f90_source.html @@ -1,11 +1,11 @@ - + - - + + -linalg: C:/Users/jchri/Documents/github/linalg/src/linalg_immutable.f90 Source File +linalg: D:/Code/linalg/src/linalg_immutable.f90 Source File @@ -13,13 +13,16 @@ - + + @@ -27,10 +30,9 @@
- - + @@ -39,21 +41,22 @@
-
linalg -  1.6.0 +
+
linalg 1.6.1
A linear algebra library that provides a user-friendly interface to several BLAS and LAPACK routines.
- + +/* @license-end */ +
@@ -67,8 +70,8 @@
@@ -81,804 +84,808 @@
- +
+
+
+
+
Loading...
+
Searching...
+
No Matches
+
+
+
-
-
linalg_immutable.f90
+
linalg_immutable.f90
-
1 ! linalg_immutable.f90
-
2 
- -
15  use, intrinsic :: iso_fortran_env, only : int32, real64
-
16  use linalg_core
- -
18  implicit none
-
19  private
-
20  public :: mat_rank1_update
-
21  public :: mat_mult_diag
-
22  public :: mat_mult_upper_tri
-
23  public :: mat_mult_lower_tri
-
24  public :: mat_det
-
25  public :: mat_lu
-
26  public :: mat_qr
-
27  public :: mat_qr_rank1_update
-
28  public :: mat_svd
-
29  public :: mat_cholesky
-
30  public :: mat_cholesky_rank1_update
-
31  public :: mat_cholesky_rank1_downdate
-
32  public :: mat_inverse
-
33  public :: mat_pinverse
-
34  public :: mat_solve_upper_tri
-
35  public :: mat_solve_lower_tri
-
36  public :: mat_eigen
-
37  public :: lu_results
-
38  public :: lu_results_cmplx
-
39  public :: qr_results
-
40  public :: qr_results_cmplx
-
41  public :: svd_results
-
42  public :: svd_results_cmplx
-
43  public :: eigen_results
-
44  public :: identity
-
45 
-
46 ! ------------------------------------------------------------------------------
-
49  interface mat_mult_diag
-
50  module procedure :: mat_mult_diag_1
-
51  module procedure :: mat_mult_diag_2
-
52  module procedure :: mat_mult_diag_3
-
53  module procedure :: mat_mult_diag_1_cmplx
-
54  module procedure :: mat_mult_diag_2_cmplx
-
55  module procedure :: mat_mult_diag_3_cmplx
-
56  end interface
-
57 
-
58 ! ------------------------------------------------------------------------------
- -
62  module procedure :: mat_mult_upper_tri_1
-
63  module procedure :: mat_mult_upper_tri_2
-
64  module procedure :: mat_mult_upper_tri_1_cmplx
-
65  module procedure :: mat_mult_upper_tri_2_cmplx
-
66  end interface
-
67 
-
68 ! ------------------------------------------------------------------------------
- -
72  module procedure :: mat_mult_lower_tri_1
-
73  module procedure :: mat_mult_lower_tri_2
-
74  module procedure :: mat_mult_lower_tri_1_cmplx
-
75  module procedure :: mat_mult_lower_tri_2_cmplx
-
76  end interface
-
77 
-
78 ! ------------------------------------------------------------------------------
- -
82  module procedure :: mat_solve_upper_tri_1
-
83  module procedure :: mat_solve_upper_tri_2
-
84  module procedure :: mat_solve_upper_tri_1_cmplx
-
85  module procedure :: mat_solve_upper_tri_2_cmplx
-
86  end interface
-
87 
-
88 ! ------------------------------------------------------------------------------
- -
92  module procedure :: mat_solve_lower_tri_1
-
93  module procedure :: mat_solve_lower_tri_2
-
94  module procedure :: mat_solve_lower_tri_1_cmplx
-
95  module procedure :: mat_solve_lower_tri_2_cmplx
-
96  end interface
-
97 
-
98 ! ------------------------------------------------------------------------------
-
101  interface mat_lu
-
102  module procedure :: mat_lu_dbl
-
103  module procedure :: mat_lu_cmplx
-
104  end interface
-
105 
-
106 ! ------------------------------------------------------------------------------
-
109  interface mat_eigen
-
110  module procedure :: mat_eigen_1
-
111  module procedure :: mat_eigen_2
-
112  end interface
-
113 
-
114 ! ------------------------------------------------------------------------------
- -
118  real(real64), allocatable, dimension(:,:) :: l
-
120  real(real64), allocatable, dimension(:,:) :: u
-
122  real(real64), allocatable, dimension(:,:) :: p
-
123  end type
-
124 
-
125 ! ------------------------------------------------------------------------------
- -
129  complex(real64), allocatable, dimension(:,:) :: l
-
131  complex(real64), allocatable, dimension(:,:) :: u
-
133  real(real64), allocatable, dimension(:,:) :: p
-
134  end type
-
135 
-
136 ! ------------------------------------------------------------------------------
- -
140  real(real64), allocatable, dimension(:,:) :: q
-
142  real(real64), allocatable, dimension(:,:) :: r
-
145  real(real64), allocatable, dimension(:,:) :: p
-
146  end type
-
147 
-
148 ! ------------------------------------------------------------------------------
- -
152  complex(real64), allocatable, dimension(:,:) :: q
-
154  complex(real64), allocatable, dimension(:,:) :: r
-
157  complex(real64), allocatable, dimension(:,:) :: p
-
158  end type
-
159 
-
160 ! ------------------------------------------------------------------------------
- -
165  real(real64), allocatable, dimension(:,:) :: u
-
167  real(real64), allocatable, dimension(:,:) :: s
-
169  real(real64), allocatable, dimension(:,:) :: vt
-
170  end type
-
171 
-
172 ! ------------------------------------------------------------------------------
- -
177  complex(real64), allocatable, dimension(:,:) :: u
-
179  real(real64), allocatable, dimension(:,:) :: s
-
181  complex(real64), allocatable, dimension(:,:) :: vt
-
182  end type
-
183 
-
184 ! ------------------------------------------------------------------------------
- -
189  complex(real64), allocatable, dimension(:) :: values
-
192  complex(real64), allocatable, dimension(:,:) :: vectors
-
193  end type
-
194 
-
195 contains
-
196 ! ------------------------------------------------------------------------------
-
205  function mat_rank1_update(a, x, y) result(b)
-
206  ! Arguments
-
207  real(real64), intent(in), dimension(:,:) :: a
-
208  real(real64), intent(in), dimension(:) :: x, y
-
209  real(real64), dimension(size(a, 1), size(a, 2)) :: b
-
210 
-
211  ! Process
-
212  b = a
-
213  call rank1_update(1.0d0, x, y, b)
-
214  end function
-
215 
-
216 ! ------------------------------------------------------------------------------
-
224  function mat_mult_diag_1(a, b) result(c)
-
225  ! Arguments
-
226  real(real64), intent(in), dimension(:) :: a
-
227  real(real64), intent(in), dimension(:,:) :: b
-
228  real(real64), dimension(size(a), size(b, 2)) :: c
-
229 
-
230  ! Process
-
231  if (size(b, 1) > size(a)) then
-
232  call diag_mtx_mult(.true., .false., 1.0d0, a, b(1:size(a),:), &
-
233  0.0d0, c)
-
234  else
-
235  call diag_mtx_mult(.true., .false., 1.0d0, a, b, 0.0d0, c)
-
236  end if
-
237  end function
-
238 
-
239 ! ------------------------------------------------------------------------------
-
247  function mat_mult_diag_2(a, b) result(c)
-
248  ! Arguments
-
249  real(real64), intent(in), dimension(:) :: a, b
-
250  real(real64), dimension(size(a)) :: c
-
251 
-
252  ! Local Variables
-
253  real(real64), dimension(size(a), 1) :: bc, cc
-
254 
-
255  ! Process
-
256  bc(:,1) = b(1:min(size(a), size(b)))
-
257  call diag_mtx_mult(.true., .false., 1.0d0, a, bc, 0.0d0, cc)
-
258  c = cc(:,1)
-
259  end function
-
260 
-
261 ! ------------------------------------------------------------------------------
-
269  function mat_mult_diag_3(a, b) result(c)
-
270  ! Arguments
-
271  real(real64), intent(in), dimension(:,:) :: a
-
272  real(real64), intent(in), dimension(:) :: b
-
273  real(real64), dimension(size(a, 1), size(b)) :: c
-
274 
-
275  ! Process
-
276  if (size(a, 2) > size(b)) then
-
277  call diag_mtx_mult(.false., .false., 1.0d0, b, a(:,1:size(b)), &
-
278  0.0d0, c)
-
279  else
-
280  call diag_mtx_mult(.false., .false., 1.0d0, b, a, 0.0d0, c)
-
281  end if
-
282  end function
-
283 
-
284 ! ------------------------------------------------------------------------------
-
292  function mat_mult_diag_1_cmplx(a, b) result(c)
-
293  ! Arguments
-
294  complex(real64), intent(in), dimension(:) :: a
-
295  complex(real64), intent(in), dimension(:,:) :: b
-
296  complex(real64), dimension(size(a), size(b, 2)) :: c
-
297 
-
298  ! Parameters
-
299  complex(real64), parameter :: zero = (0.0d0, 0.0d0)
-
300  complex(real64), parameter :: one = (1.0d0, 0.0d0)
-
301 
-
302  ! Process
-
303  if (size(b, 1) > size(a)) then
-
304  call diag_mtx_mult(.true., no_operation, one, a, b(1:size(a),:), &
-
305  zero, c)
-
306  else
-
307  call diag_mtx_mult(.true., no_operation, one, a, b, zero, c)
-
308  end if
-
309  end function
-
310 
-
311 ! ------------------------------------------------------------------------------
-
319  function mat_mult_diag_2_cmplx(a, b) result(c)
-
320  ! Arguments
-
321  complex(real64), intent(in), dimension(:) :: a, b
-
322  complex(real64), dimension(size(a)) :: c
-
323 
-
324  ! Parameters
-
325  complex(real64), parameter :: zero = (0.0d0, 0.0d0)
-
326  complex(real64), parameter :: one = (1.0d0, 0.0d0)
-
327 
-
328  ! Local Variables
-
329  complex(real64), dimension(size(a), 1) :: bc, cc
-
330 
-
331  ! Process
-
332  bc(:,1) = b(1:min(size(a), size(b)))
-
333  call diag_mtx_mult(.true., no_operation, one, a, bc, zero, cc)
-
334  c = cc(:,1)
-
335  end function
-
336 
-
337 ! ------------------------------------------------------------------------------
-
345  function mat_mult_diag_3_cmplx(a, b) result(c)
-
346  ! Arguments
-
347  complex(real64), intent(in), dimension(:,:) :: a
-
348  complex(real64), intent(in), dimension(:) :: b
-
349  complex(real64), dimension(size(a, 1), size(b)) :: c
-
350 
-
351  ! Process
-
352  if (size(a, 2) > size(b)) then
-
353  call diag_mtx_mult(.false., no_operation, 1.0d0, b, a(:,1:size(b)), &
-
354  0.0d0, c)
-
355  else
-
356  call diag_mtx_mult(.false., no_operation, 1.0d0, b, a, 0.0d0, c)
-
357  end if
-
358  end function
-
359 
-
360 ! ------------------------------------------------------------------------------
-
367  function mat_mult_upper_tri_1(a, b) result(c)
-
368  ! Arguments
-
369  real(real64), intent(in), dimension(:,:) :: a, b
-
370  real(real64), dimension(size(a, 1), size(b, 2)) :: c
-
371 
-
372  ! Process
-
373  c = b
-
374  call dtrmm('L', 'U', 'N', 'N', size(b, 1), size(b, 2), 1.0d0, &
-
375  a, size(a, 1), c, size(c, 1))
-
376  end function
-
377 
-
378 ! ------------------------------------------------------------------------------
-
385  function mat_mult_upper_tri_2(a, b) result(c)
-
386  ! Arguments
-
387  real(real64), intent(in), dimension(:,:) :: a
-
388  real(real64), intent(in), dimension(:) :: b
-
389  real(real64), dimension(size(a, 1)) :: c
-
390 
-
391  ! Process
-
392  c = b
-
393  call dtrmv('U', 'N', 'N', size(a, 1), a, size(a, 1), c, 1)
-
394  end function
-
395 
-
396  ! ------------------------------------------------------------------------------
-
403  function mat_mult_lower_tri_1(a, b) result(c)
-
404  ! Arguments
-
405  real(real64), intent(in), dimension(:,:) :: a, b
-
406  real(real64), dimension(size(a, 1), size(b, 2)) :: c
-
407 
-
408  ! Process
-
409  c = b
-
410  call dtrmm('L', 'L', 'N', 'N', size(b, 1), size(b, 2), 1.0d0, &
-
411  a, size(a, 1), c, size(c, 1))
-
412  end function
-
413 
-
414  ! ------------------------------------------------------------------------------
-
421  function mat_mult_lower_tri_2(a, b) result(c)
-
422  ! Arguments
-
423  real(real64), intent(in), dimension(:,:) :: a
-
424  real(real64), intent(in), dimension(:) :: b
-
425  real(real64), dimension(size(a, 1)) :: c
-
426 
-
427  ! Process
-
428  c = b
-
429  call dtrmv('L', 'N', 'N', size(a, 1), a, size(a, 1), c, 1)
-
430  end function
-
431 
-
432 ! ------------------------------------------------------------------------------
-
439  function mat_mult_upper_tri_1_cmplx(a, b) result(c)
-
440  ! Arguments
-
441  complex(real64), intent(in), dimension(:,:) :: a, b
-
442  complex(real64), dimension(size(a, 1), size(b, 2)) :: c
-
443 
-
444  ! Process
-
445  c = b
-
446  call ztrmm('L', 'U', 'N', 'N', size(b, 1), size(b, 2), 1.0d0, &
-
447  a, size(a, 1), c, size(c, 1))
-
448  end function
-
449 
-
450 ! ------------------------------------------------------------------------------
-
457  function mat_mult_upper_tri_2_cmplx(a, b) result(c)
-
458  ! Arguments
-
459  complex(real64), intent(in), dimension(:,:) :: a
-
460  complex(real64), intent(in), dimension(:) :: b
-
461  complex(real64), dimension(size(a, 1)) :: c
-
462 
-
463  ! Process
-
464  c = b
-
465  call ztrmv('U', 'N', 'N', size(a, 1), a, size(a, 1), c, 1)
-
466  end function
-
467 
-
468  ! ------------------------------------------------------------------------------
-
475  function mat_mult_lower_tri_1_cmplx(a, b) result(c)
-
476  ! Arguments
-
477  complex(real64), intent(in), dimension(:,:) :: a, b
-
478  complex(real64), dimension(size(a, 1), size(b, 2)) :: c
-
479 
-
480  ! Process
-
481  c = b
-
482  call ztrmm('L', 'L', 'N', 'N', size(b, 1), size(b, 2), 1.0d0, &
-
483  a, size(a, 1), c, size(c, 1))
-
484  end function
-
485 
-
486  ! ------------------------------------------------------------------------------
-
493  function mat_mult_lower_tri_2_cmplx(a, b) result(c)
-
494  ! Arguments
-
495  complex(real64), intent(in), dimension(:,:) :: a
-
496  complex(real64), intent(in), dimension(:) :: b
-
497  complex(real64), dimension(size(a, 1)) :: c
-
498 
-
499  ! Process
-
500  c = b
-
501  call ztrmv('L', 'N', 'N', size(a, 1), a, size(a, 1), c, 1)
-
502  end function
-
503 
-
504 ! ------------------------------------------------------------------------------
-
509  function mat_det(a) result(x)
-
510  ! Arguments
-
511  real(real64), intent(in), dimension(:,:) :: a
-
512  real(real64) :: x
-
513 
-
514  ! Local Variables
-
515  real(real64), dimension(size(a, 1), size(a, 2)) :: b
-
516 
-
517  ! Process
-
518  b = a
-
519  x = det(b)
-
520  end function
-
521 
-
522 ! ------------------------------------------------------------------------------
-
528  function mat_lu_dbl(a) result(x)
-
529  ! Arguments
-
530  real(real64), intent(in), dimension(:,:) :: a
-
531  type(lu_results) :: x
-
532 
-
533  ! Local Variables
-
534  integer(int32) :: n
-
535  integer(int32), allocatable, dimension(:) :: ipvt
-
536 
-
537  ! Memory Allocation
-
538  n = size(a, 1)
-
539  allocate(ipvt(n))
-
540  allocate(x%l(n,n))
-
541  allocate(x%u(n,n))
-
542  allocate(x%p(n,n))
-
543 
-
544  ! Compute the factorization
-
545  x%l = a
-
546  call lu_factor(x%l, ipvt)
-
547 
-
548  ! Form L, U, and P
-
549  call form_lu(x%l, ipvt, x%u, x%p)
-
550  end function
-
551 
-
552 ! ------------------------------------------------------------------------------
-
558  function mat_lu_cmplx(a) result(x)
-
559  ! Arguments
-
560  complex(real64), intent(in), dimension(:,:) :: a
-
561  type(lu_results_cmplx) :: x
-
562 
-
563  ! Local Variables
-
564  integer(int32) :: n
-
565  integer(int32), allocatable, dimension(:) :: ipvt
-
566 
-
567  ! Memory Allocation
-
568  n = size(a, 1)
-
569  allocate(ipvt(n))
-
570  allocate(x%l(n,n))
-
571  allocate(x%u(n,n))
-
572  allocate(x%p(n,n))
-
573 
-
574  ! Compute the factorization
-
575  x%l = a
-
576  call lu_factor(x%l, ipvt)
-
577 
-
578  ! Form L, U, and P
-
579  call form_lu(x%l, ipvt, x%u, x%p)
-
580  end function
-
581 
-
582 ! ------------------------------------------------------------------------------
-
592  function mat_qr(a, pvt) result(x)
-
593  ! Arguments
-
594  real(real64), intent(in), dimension(:,:) :: a
-
595  logical, intent(in), optional :: pvt
-
596  type(qr_results) :: x
-
597 
-
598  ! Local Variables
-
599  logical :: use_pivot
-
600  integer(int32) :: m, n, mn
-
601  integer(int32), allocatable, dimension(:) :: jpvt
-
602  real(real64), allocatable, dimension(:) :: tau
-
603 
-
604  ! Memory Allocation
-
605  use_pivot = .false.
-
606  if (present(pvt)) use_pivot = pvt
-
607  m = size(a, 1)
-
608  n = size(a, 2)
-
609  mn = min(m, n)
-
610  allocate(tau(mn))
-
611  allocate(x%q(m,m))
-
612  allocate(x%r(m,n))
-
613 
-
614  ! Compute the factorization, and then form Q, R, and P
-
615  x%r = a
-
616  if (use_pivot) then
-
617  allocate(x%p(n,n))
-
618  allocate(jpvt(n))
-
619  jpvt = 0 ! Ensure all columns are free columns
-
620  call qr_factor(x%r, tau, jpvt)
-
621  call form_qr(x%r, tau, jpvt, x%q, x%p)
-
622  else
-
623  call qr_factor(x%r, tau)
-
624  call form_qr(x%r, tau, x%q)
-
625  end if
-
626  end function
-
627 
-
628 ! ------------------------------------------------------------------------------
-
638  function mat_qr_rank1_update(q, r, x, y) result(rst)
-
639  ! Arguments
-
640  real(real64), intent(in), dimension(:,:) :: q, r
-
641  real(real64), intent(in), dimension(:) :: x, y
-
642  type(qr_results) :: rst
-
643 
-
644  ! Local Variables
-
645  integer(int32) :: i, m, n
-
646  real(real64), allocatable, dimension(:) :: xc, yc
-
647 
-
648  ! Memory allocation
-
649  m = size(q, 1)
-
650  n = size(r, 2)
-
651  allocate(xc(m))
-
652  allocate(yc(n))
-
653  allocate(rst%q(m,m))
-
654  allocate(rst%r(m,n))
-
655 
-
656  ! Process
-
657  do i = 1, m
-
658  xc(i) = x(i)
-
659  rst%q(:,i) = q(:,i)
-
660  end do
-
661  do i = 1, n
-
662  yc(i) = y(i)
-
663  rst%r(:,i) = r(:,i)
-
664  end do
-
665  call qr_rank1_update(rst%q, rst%r, xc, yc)
-
666  end function
-
667 
-
668 ! ------------------------------------------------------------------------------
-
674  function mat_svd(a) result(x)
-
675  ! Arguments
-
676  real(real64), intent(in), dimension(:,:) :: a
-
677  type(svd_results) :: x
-
678 
-
679  ! Local Variables
-
680  integer(int32) :: i, m, n, mn
-
681  real(real64), allocatable, dimension(:) :: s
-
682  real(real64), allocatable, dimension(:,:) :: ac
-
683 
-
684  ! Memory Allocation
-
685  m = size(a, 1)
-
686  n = size(a, 2)
-
687  mn = min(m, n)
-
688  allocate(s(mn))
-
689  allocate(ac(m,n))
-
690  allocate(x%u(m,m))
-
691  allocate(x%s(m,n))
-
692  allocate(x%vt(n,n))
-
693 
-
694  ! Process
-
695  ac = a
-
696  call svd(ac, s, x%u, x%vt)
-
697 
-
698  ! Extract the singular values, and populate the results matrix
-
699  x%s = 0.0d0
-
700  do i = 1, mn
-
701  x%s(i,i) = s(i)
-
702  end do
-
703  end function
-
704 
-
705 ! ------------------------------------------------------------------------------
-
715  function mat_cholesky(a, upper) result(r)
-
716  ! Arguments
-
717  real(real64), intent(in), dimension(:,:) :: a
-
718  logical, intent(in), optional :: upper
-
719  real(real64), dimension(size(a, 1), size(a, 2)) :: r
-
720 
-
721  ! Local Variables
-
722  logical :: compute_upper
-
723 
-
724  ! Process
-
725  compute_upper = .true.
-
726  if (present(upper)) compute_upper = upper
-
727  r = a
-
728  call cholesky_factor(r, compute_upper)
-
729  end function
-
730 
-
731 ! ------------------------------------------------------------------------------
-
738  function mat_cholesky_rank1_update(a, x) result(r)
-
739  ! Arguments
-
740  real(real64), intent(in), dimension(:,:) :: a
-
741  real(real64), intent(in), dimension(:) :: x
-
742  real(real64), dimension(size(a, 1), size(a, 2)) :: r
-
743 
-
744  ! Local Variables
-
745  real(real64), dimension(size(x)) :: xc
-
746 
-
747  ! Process
-
748  r = a
-
749  xc = x
-
750  call cholesky_rank1_update(r, xc)
-
751  end function
-
752 
-
753 ! ------------------------------------------------------------------------------
-
760  function mat_cholesky_rank1_downdate(a, x) result(r)
-
761  ! Arguments
-
762  real(real64), intent(in), dimension(:,:) :: a
-
763  real(real64), intent(in), dimension(:) :: x
-
764  real(real64), dimension(size(a, 1), size(a, 2)) :: r
-
765 
-
766  ! Local Variables
-
767  real(real64), dimension(size(x)) :: xc
-
768 
-
769  ! Process
-
770  r = a
-
771  xc = x
-
772  call cholesky_rank1_downdate(r, xc)
-
773  end function
-
774 
-
775 ! ------------------------------------------------------------------------------
-
780  function mat_inverse(a) result(x)
-
781  ! Arguments
-
782  real(real64), intent(in), dimension(:,:) :: a
-
783  real(real64), dimension(size(a, 2), size(a, 1)) :: x
-
784 
-
785  ! Compute the inverse of A
-
786  x = a
-
787  call mtx_inverse(x)
-
788  end function
-
789 
-
790 ! ------------------------------------------------------------------------------
-
795  function mat_pinverse(a) result(x)
-
796  ! Arguments
-
797  real(real64), intent(in), dimension(:,:) :: a
-
798  real(real64), dimension(size(a, 2), size(a, 1)) :: x
-
799 
-
800  ! Local Variables
-
801  real(real64), dimension(size(a, 1), size(a, 2)) :: ac
-
802 
-
803  ! Compute the inverse of A
-
804  ac = a
-
805  call mtx_pinverse(ac, x)
-
806  end function
-
807 
-
808 ! ------------------------------------------------------------------------------
-
815  function mat_solve_upper_tri_1(a, b) result(x)
-
816  ! Arguments
-
817  real(real64), intent(in), dimension(:,:) :: a, b
-
818  real(real64), dimension(size(b, 1), size(b, 2)) :: x
-
819 
-
820  ! Process
-
821  x = b
-
822  call solve_triangular_system(.true., .true., .false., .true., 1.0d0, &
-
823  a, x)
-
824  end function
-
825 
-
826 ! ------------------------------------------------------------------------------
-
833  function mat_solve_upper_tri_2(a, b) result(x)
-
834  ! Arguments
-
835  real(real64), intent(in), dimension(:,:) :: a
-
836  real(real64), intent(in), dimension(:) :: b
-
837  real(real64), dimension(size(b)) :: x
-
838 
-
839  ! Process
-
840  x = b
-
841  call solve_triangular_system(.true., .false., .true., a, x)
-
842  end function
-
843 
-
844 ! ------------------------------------------------------------------------------
-
851  function mat_solve_upper_tri_1_cmplx(a, b) result(x)
-
852  ! Arguments
-
853  complex(real64), intent(in), dimension(:,:) :: a, b
-
854  complex(real64), dimension(size(b, 1), size(b, 2)) :: x
-
855 
-
856  ! Process
-
857  x = b
-
858  call solve_triangular_system(.true., .true., .false., .true., &
-
859  (1.0d0, 0.0d0), a, x)
-
860  end function
-
861 
-
862 ! ------------------------------------------------------------------------------
-
869  function mat_solve_upper_tri_2_cmplx(a, b) result(x)
-
870  ! Arguments
-
871  complex(real64), intent(in), dimension(:,:) :: a
-
872  complex(real64), intent(in), dimension(:) :: b
-
873  complex(real64), dimension(size(b)) :: x
-
874 
-
875  ! Process
-
876  x = b
-
877  call solve_triangular_system(.true., .false., .true., a, x)
-
878  end function
-
879 
-
880 ! ------------------------------------------------------------------------------
-
887  function mat_solve_lower_tri_1(a, b) result(x)
-
888  ! Arguments
-
889  real(real64), intent(in), dimension(:,:) :: a, b
-
890  real(real64), dimension(size(b, 1), size(b, 2)) :: x
-
891 
-
892  ! Process
-
893  x = b
-
894  call solve_triangular_system(.true., .false., .false., .true., 1.0d0, &
-
895  a, x)
-
896  end function
-
897 
-
898 ! ------------------------------------------------------------------------------
-
905  function mat_solve_lower_tri_2(a, b) result(x)
-
906  ! Arguments
-
907  real(real64), intent(in), dimension(:,:) :: a
-
908  real(real64), intent(in), dimension(:) :: b
-
909  real(real64), dimension(size(b)) :: x
-
910 
-
911  ! Process
-
912  x = b
-
913  call solve_triangular_system(.false., .false., .true., a, x)
-
914  end function
-
915 
-
916 ! ------------------------------------------------------------------------------
-
923  function mat_solve_lower_tri_1_cmplx(a, b) result(x)
-
924  ! Arguments
-
925  complex(real64), intent(in), dimension(:,:) :: a, b
-
926  complex(real64), dimension(size(b, 1), size(b, 2)) :: x
-
927 
-
928  ! Process
-
929  x = b
-
930  call solve_triangular_system(.true., .false., .false., .true., &
-
931  (1.0d0, 0.0d0), a, x)
-
932  end function
-
933 
-
934 ! ------------------------------------------------------------------------------
-
941  function mat_solve_lower_tri_2_cmplx(a, b) result(x)
-
942  ! Arguments
-
943  complex(real64), intent(in), dimension(:,:) :: a
-
944  complex(real64), intent(in), dimension(:) :: b
-
945  complex(real64), dimension(size(b)) :: x
-
946 
-
947  ! Process
-
948  x = b
-
949  call solve_triangular_system(.false., .false., .true., a, x)
-
950  end function
-
951 
-
952 ! ------------------------------------------------------------------------------
-
959  function mat_eigen_1(a) result(x)
-
960  ! Arguments
-
961  real(real64), intent(in), dimension(:,:) :: a
-
962  type(eigen_results) :: x
-
963 
-
964  ! Local Variables
-
965  integer(int32) :: n
-
966  real(real64), dimension(size(a, 1), size(a, 2)) :: ac
-
967 
-
968  ! Memory Allocation
-
969  n = size(a, 1)
-
970  allocate(x%values(n))
-
971  allocate(x%vectors(n,n))
-
972 
-
973  ! Process
-
974  ac = a
-
975  call eigen(ac, x%values, x%vectors)
-
976 
-
977  ! Sort the eigenvalues and eigenvectors.
-
978  call sort(x%values, x%vectors, .true.)
-
979  end function
-
980 
-
981 ! ------------------------------------------------------------------------------
-
989  function mat_eigen_2(a, b) result(x)
-
990  ! Arguments
-
991  real(real64), intent(in), dimension(:,:) :: a, b
-
992  type(eigen_results) :: x
-
993 
-
994  ! Local Variables
-
995  integer(int32) :: i, j, n
-
996  real(real64), dimension(size(a, 1), size(a, 2)) :: ac
-
997  real(real64), dimension(size(b, 1), size(b, 2)) :: bc
-
998 
-
999  ! Memory Allocation
-
1000  n = size(a, 1)
-
1001  allocate(x%values(n))
-
1002  allocate(x%vectors(n,n))
-
1003 
-
1004  ! Process
-
1005  do j = 1, n
-
1006  do i = 1, n
-
1007  ac(i,j) = a(i,j)
-
1008  bc(i,j) = b(i,j)
-
1009  end do
-
1010  end do
-
1011  call eigen(ac, bc, x%values, vecs = x%vectors)
-
1012 
-
1013  ! Sort the eigenvalues and eigenvectors.
-
1014  call sort(x%values, x%vectors, .true.)
-
1015  end function
-
1016 
-
1017 ! ------------------------------------------------------------------------------
-
1022  pure function identity(n) result(x)
-
1023  integer(int32), intent(in) :: n
-
1024  real(real64), dimension(n, n) :: x
-
1025  integer(int32) :: i
-
1026  x = 0.0d0
-
1027  do i = 1, n
-
1028  x(i,i) = 1.0d0
-
1029  end do
-
1030  end function
-
1031 
-
1032 end module
-
-
-
Defines a container for the output of an Eigen analysis of a square matrix.
-
Provides a set of common linear algebra routines.
Definition: linalg_core.f90:15
-
Provides an immutable interface to many of the core linear algebra routines in this library....
-
Computes the singular value decomposition of a matrix A. The SVD is defined as: A = U * S * V**T,...
-
Multiplies a diagonal matrix with another matrix or array.
-
Defines a container for the output of a QR factorization.
-
Computes the Cholesky factorization of a symmetric, positive definite matrix.
-
Computes the Moore-Penrose pseudo-inverse of a M-by-N matrix using the singular value decomposition o...
+
1! linalg_immutable.f90
+
2
+ +
15 use, intrinsic :: iso_fortran_env, only : int32, real64
+
16 use linalg_core
+ +
18 implicit none
+
19 private
+
20 public :: mat_rank1_update
+
21 public :: mat_mult_diag
+
22 public :: mat_mult_upper_tri
+
23 public :: mat_mult_lower_tri
+
24 public :: mat_det
+
25 public :: mat_lu
+
26 public :: mat_qr
+
27 public :: mat_qr_rank1_update
+
28 public :: mat_svd
+
29 public :: mat_cholesky
+
30 public :: mat_cholesky_rank1_update
+
31 public :: mat_cholesky_rank1_downdate
+
32 public :: mat_inverse
+
33 public :: mat_pinverse
+
34 public :: mat_solve_upper_tri
+
35 public :: mat_solve_lower_tri
+
36 public :: mat_eigen
+
37 public :: lu_results
+
38 public :: lu_results_cmplx
+
39 public :: qr_results
+
40 public :: qr_results_cmplx
+
41 public :: svd_results
+
42 public :: svd_results_cmplx
+
43 public :: eigen_results
+
44 public :: identity
+
45
+
46! ------------------------------------------------------------------------------
+
49 interface mat_mult_diag
+
50 module procedure :: mat_mult_diag_1
+
51 module procedure :: mat_mult_diag_2
+
52 module procedure :: mat_mult_diag_3
+
53 module procedure :: mat_mult_diag_1_cmplx
+
54 module procedure :: mat_mult_diag_2_cmplx
+
55 module procedure :: mat_mult_diag_3_cmplx
+
56 end interface
+
57
+
58! ------------------------------------------------------------------------------
+ +
62 module procedure :: mat_mult_upper_tri_1
+
63 module procedure :: mat_mult_upper_tri_2
+
64 module procedure :: mat_mult_upper_tri_1_cmplx
+
65 module procedure :: mat_mult_upper_tri_2_cmplx
+
66 end interface
+
67
+
68! ------------------------------------------------------------------------------
+ +
72 module procedure :: mat_mult_lower_tri_1
+
73 module procedure :: mat_mult_lower_tri_2
+
74 module procedure :: mat_mult_lower_tri_1_cmplx
+
75 module procedure :: mat_mult_lower_tri_2_cmplx
+
76 end interface
+
77
+
78! ------------------------------------------------------------------------------
+ +
82 module procedure :: mat_solve_upper_tri_1
+
83 module procedure :: mat_solve_upper_tri_2
+
84 module procedure :: mat_solve_upper_tri_1_cmplx
+
85 module procedure :: mat_solve_upper_tri_2_cmplx
+
86 end interface
+
87
+
88! ------------------------------------------------------------------------------
+ +
92 module procedure :: mat_solve_lower_tri_1
+
93 module procedure :: mat_solve_lower_tri_2
+
94 module procedure :: mat_solve_lower_tri_1_cmplx
+
95 module procedure :: mat_solve_lower_tri_2_cmplx
+
96 end interface
+
97
+
98! ------------------------------------------------------------------------------
+
101 interface mat_lu
+
102 module procedure :: mat_lu_dbl
+
103 module procedure :: mat_lu_cmplx
+
104 end interface
+
105
+
106! ------------------------------------------------------------------------------
+
109 interface mat_eigen
+
110 module procedure :: mat_eigen_1
+
111 module procedure :: mat_eigen_2
+
112 end interface
+
113
+
114! ------------------------------------------------------------------------------
+ +
118 real(real64), allocatable, dimension(:,:) :: l
+
120 real(real64), allocatable, dimension(:,:) :: u
+
122 real(real64), allocatable, dimension(:,:) :: p
+
123 end type
+
124
+
125! ------------------------------------------------------------------------------
+ +
129 complex(real64), allocatable, dimension(:,:) :: l
+
131 complex(real64), allocatable, dimension(:,:) :: u
+
133 real(real64), allocatable, dimension(:,:) :: p
+
134 end type
+
135
+
136! ------------------------------------------------------------------------------
+ +
140 real(real64), allocatable, dimension(:,:) :: q
+
142 real(real64), allocatable, dimension(:,:) :: r
+
145 real(real64), allocatable, dimension(:,:) :: p
+
146 end type
+
147
+
148! ------------------------------------------------------------------------------
+ +
152 complex(real64), allocatable, dimension(:,:) :: q
+
154 complex(real64), allocatable, dimension(:,:) :: r
+
157 complex(real64), allocatable, dimension(:,:) :: p
+
158 end type
+
159
+
160! ------------------------------------------------------------------------------
+ +
165 real(real64), allocatable, dimension(:,:) :: u
+
167 real(real64), allocatable, dimension(:,:) :: s
+
169 real(real64), allocatable, dimension(:,:) :: vt
+
170 end type
+
171
+
172! ------------------------------------------------------------------------------
+ +
177 complex(real64), allocatable, dimension(:,:) :: u
+
179 real(real64), allocatable, dimension(:,:) :: s
+
181 complex(real64), allocatable, dimension(:,:) :: vt
+
182 end type
+
183
+
184! ------------------------------------------------------------------------------
+ +
189 complex(real64), allocatable, dimension(:) :: values
+
192 complex(real64), allocatable, dimension(:,:) :: vectors
+
193 end type
+
194
+
195contains
+
196! ------------------------------------------------------------------------------
+
205 function mat_rank1_update(a, x, y) result(b)
+
206 ! Arguments
+
207 real(real64), intent(in), dimension(:,:) :: a
+
208 real(real64), intent(in), dimension(:) :: x, y
+
209 real(real64), dimension(size(a, 1), size(a, 2)) :: b
+
210
+
211 ! Process
+
212 b = a
+
213 call rank1_update(1.0d0, x, y, b)
+
214 end function
+
215
+
216! ------------------------------------------------------------------------------
+
224 function mat_mult_diag_1(a, b) result(c)
+
225 ! Arguments
+
226 real(real64), intent(in), dimension(:) :: a
+
227 real(real64), intent(in), dimension(:,:) :: b
+
228 real(real64), dimension(size(a), size(b, 2)) :: c
+
229
+
230 ! Process
+
231 if (size(b, 1) > size(a)) then
+
232 call diag_mtx_mult(.true., .false., 1.0d0, a, b(1:size(a),:), &
+
233 0.0d0, c)
+
234 else
+
235 call diag_mtx_mult(.true., .false., 1.0d0, a, b, 0.0d0, c)
+
236 end if
+
237 end function
+
238
+
239! ------------------------------------------------------------------------------
+
247 function mat_mult_diag_2(a, b) result(c)
+
248 ! Arguments
+
249 real(real64), intent(in), dimension(:) :: a, b
+
250 real(real64), dimension(size(a)) :: c
+
251
+
252 ! Local Variables
+
253 real(real64), dimension(size(a), 1) :: bc, cc
+
254
+
255 ! Process
+
256 bc(:,1) = b(1:min(size(a), size(b)))
+
257 call diag_mtx_mult(.true., .false., 1.0d0, a, bc, 0.0d0, cc)
+
258 c = cc(:,1)
+
259 end function
+
260
+
261! ------------------------------------------------------------------------------
+
269 function mat_mult_diag_3(a, b) result(c)
+
270 ! Arguments
+
271 real(real64), intent(in), dimension(:,:) :: a
+
272 real(real64), intent(in), dimension(:) :: b
+
273 real(real64), dimension(size(a, 1), size(b)) :: c
+
274
+
275 ! Process
+
276 if (size(a, 2) > size(b)) then
+
277 call diag_mtx_mult(.false., .false., 1.0d0, b, a(:,1:size(b)), &
+
278 0.0d0, c)
+
279 else
+
280 call diag_mtx_mult(.false., .false., 1.0d0, b, a, 0.0d0, c)
+
281 end if
+
282 end function
+
283
+
284! ------------------------------------------------------------------------------
+
292 function mat_mult_diag_1_cmplx(a, b) result(c)
+
293 ! Arguments
+
294 complex(real64), intent(in), dimension(:) :: a
+
295 complex(real64), intent(in), dimension(:,:) :: b
+
296 complex(real64), dimension(size(a), size(b, 2)) :: c
+
297
+
298 ! Parameters
+
299 complex(real64), parameter :: zero = (0.0d0, 0.0d0)
+
300 complex(real64), parameter :: one = (1.0d0, 0.0d0)
+
301
+
302 ! Process
+
303 if (size(b, 1) > size(a)) then
+
304 call diag_mtx_mult(.true., no_operation, one, a, b(1:size(a),:), &
+
305 zero, c)
+
306 else
+
307 call diag_mtx_mult(.true., no_operation, one, a, b, zero, c)
+
308 end if
+
309 end function
+
310
+
311! ------------------------------------------------------------------------------
+
319 function mat_mult_diag_2_cmplx(a, b) result(c)
+
320 ! Arguments
+
321 complex(real64), intent(in), dimension(:) :: a, b
+
322 complex(real64), dimension(size(a)) :: c
+
323
+
324 ! Parameters
+
325 complex(real64), parameter :: zero = (0.0d0, 0.0d0)
+
326 complex(real64), parameter :: one = (1.0d0, 0.0d0)
+
327
+
328 ! Local Variables
+
329 complex(real64), dimension(size(a), 1) :: bc, cc
+
330
+
331 ! Process
+
332 bc(:,1) = b(1:min(size(a), size(b)))
+
333 call diag_mtx_mult(.true., no_operation, one, a, bc, zero, cc)
+
334 c = cc(:,1)
+
335 end function
+
336
+
337! ------------------------------------------------------------------------------
+
345 function mat_mult_diag_3_cmplx(a, b) result(c)
+
346 ! Arguments
+
347 complex(real64), intent(in), dimension(:,:) :: a
+
348 complex(real64), intent(in), dimension(:) :: b
+
349 complex(real64), dimension(size(a, 1), size(b)) :: c
+
350
+
351 ! Process
+
352 if (size(a, 2) > size(b)) then
+
353 call diag_mtx_mult(.false., no_operation, 1.0d0, b, a(:,1:size(b)), &
+
354 0.0d0, c)
+
355 else
+
356 call diag_mtx_mult(.false., no_operation, 1.0d0, b, a, 0.0d0, c)
+
357 end if
+
358 end function
+
359
+
360! ------------------------------------------------------------------------------
+
367 function mat_mult_upper_tri_1(a, b) result(c)
+
368 ! Arguments
+
369 real(real64), intent(in), dimension(:,:) :: a, b
+
370 real(real64), dimension(size(a, 1), size(b, 2)) :: c
+
371
+
372 ! Process
+
373 c = b
+
374 call dtrmm('L', 'U', 'N', 'N', size(b, 1), size(b, 2), 1.0d0, &
+
375 a, size(a, 1), c, size(c, 1))
+
376 end function
+
377
+
378! ------------------------------------------------------------------------------
+
385 function mat_mult_upper_tri_2(a, b) result(c)
+
386 ! Arguments
+
387 real(real64), intent(in), dimension(:,:) :: a
+
388 real(real64), intent(in), dimension(:) :: b
+
389 real(real64), dimension(size(a, 1)) :: c
+
390
+
391 ! Process
+
392 c = b
+
393 call dtrmv('U', 'N', 'N', size(a, 1), a, size(a, 1), c, 1)
+
394 end function
+
395
+
396 ! ------------------------------------------------------------------------------
+
403 function mat_mult_lower_tri_1(a, b) result(c)
+
404 ! Arguments
+
405 real(real64), intent(in), dimension(:,:) :: a, b
+
406 real(real64), dimension(size(a, 1), size(b, 2)) :: c
+
407
+
408 ! Process
+
409 c = b
+
410 call dtrmm('L', 'L', 'N', 'N', size(b, 1), size(b, 2), 1.0d0, &
+
411 a, size(a, 1), c, size(c, 1))
+
412 end function
+
413
+
414 ! ------------------------------------------------------------------------------
+
421 function mat_mult_lower_tri_2(a, b) result(c)
+
422 ! Arguments
+
423 real(real64), intent(in), dimension(:,:) :: a
+
424 real(real64), intent(in), dimension(:) :: b
+
425 real(real64), dimension(size(a, 1)) :: c
+
426
+
427 ! Process
+
428 c = b
+
429 call dtrmv('L', 'N', 'N', size(a, 1), a, size(a, 1), c, 1)
+
430 end function
+
431
+
432! ------------------------------------------------------------------------------
+
439 function mat_mult_upper_tri_1_cmplx(a, b) result(c)
+
440 ! Arguments
+
441 complex(real64), intent(in), dimension(:,:) :: a, b
+
442 complex(real64), dimension(size(a, 1), size(b, 2)) :: c
+
443
+
444 ! Process
+
445 c = b
+
446 call ztrmm('L', 'U', 'N', 'N', size(b, 1), size(b, 2), 1.0d0, &
+
447 a, size(a, 1), c, size(c, 1))
+
448 end function
+
449
+
450! ------------------------------------------------------------------------------
+
457 function mat_mult_upper_tri_2_cmplx(a, b) result(c)
+
458 ! Arguments
+
459 complex(real64), intent(in), dimension(:,:) :: a
+
460 complex(real64), intent(in), dimension(:) :: b
+
461 complex(real64), dimension(size(a, 1)) :: c
+
462
+
463 ! Process
+
464 c = b
+
465 call ztrmv('U', 'N', 'N', size(a, 1), a, size(a, 1), c, 1)
+
466 end function
+
467
+
468 ! ------------------------------------------------------------------------------
+
475 function mat_mult_lower_tri_1_cmplx(a, b) result(c)
+
476 ! Arguments
+
477 complex(real64), intent(in), dimension(:,:) :: a, b
+
478 complex(real64), dimension(size(a, 1), size(b, 2)) :: c
+
479
+
480 ! Process
+
481 c = b
+
482 call ztrmm('L', 'L', 'N', 'N', size(b, 1), size(b, 2), 1.0d0, &
+
483 a, size(a, 1), c, size(c, 1))
+
484 end function
+
485
+
486 ! ------------------------------------------------------------------------------
+
493 function mat_mult_lower_tri_2_cmplx(a, b) result(c)
+
494 ! Arguments
+
495 complex(real64), intent(in), dimension(:,:) :: a
+
496 complex(real64), intent(in), dimension(:) :: b
+
497 complex(real64), dimension(size(a, 1)) :: c
+
498
+
499 ! Process
+
500 c = b
+
501 call ztrmv('L', 'N', 'N', size(a, 1), a, size(a, 1), c, 1)
+
502 end function
+
503
+
504! ------------------------------------------------------------------------------
+
509 function mat_det(a) result(x)
+
510 ! Arguments
+
511 real(real64), intent(in), dimension(:,:) :: a
+
512 real(real64) :: x
+
513
+
514 ! Local Variables
+
515 real(real64), dimension(size(a, 1), size(a, 2)) :: b
+
516
+
517 ! Process
+
518 b = a
+
519 x = det(b)
+
520 end function
+
521
+
522! ------------------------------------------------------------------------------
+
528 function mat_lu_dbl(a) result(x)
+
529 ! Arguments
+
530 real(real64), intent(in), dimension(:,:) :: a
+
531 type(lu_results) :: x
+
532
+
533 ! Local Variables
+
534 integer(int32) :: n
+
535 integer(int32), allocatable, dimension(:) :: ipvt
+
536
+
537 ! Memory Allocation
+
538 n = size(a, 1)
+
539 allocate(ipvt(n))
+
540 allocate(x%l(n,n))
+
541 allocate(x%u(n,n))
+
542 allocate(x%p(n,n))
+
543
+
544 ! Compute the factorization
+
545 x%l = a
+
546 call lu_factor(x%l, ipvt)
+
547
+
548 ! Form L, U, and P
+
549 call form_lu(x%l, ipvt, x%u, x%p)
+
550 end function
+
551
+
552! ------------------------------------------------------------------------------
+
558 function mat_lu_cmplx(a) result(x)
+
559 ! Arguments
+
560 complex(real64), intent(in), dimension(:,:) :: a
+
561 type(lu_results_cmplx) :: x
+
562
+
563 ! Local Variables
+
564 integer(int32) :: n
+
565 integer(int32), allocatable, dimension(:) :: ipvt
+
566
+
567 ! Memory Allocation
+
568 n = size(a, 1)
+
569 allocate(ipvt(n))
+
570 allocate(x%l(n,n))
+
571 allocate(x%u(n,n))
+
572 allocate(x%p(n,n))
+
573
+
574 ! Compute the factorization
+
575 x%l = a
+
576 call lu_factor(x%l, ipvt)
+
577
+
578 ! Form L, U, and P
+
579 call form_lu(x%l, ipvt, x%u, x%p)
+
580 end function
+
581
+
582! ------------------------------------------------------------------------------
+
592 function mat_qr(a, pvt) result(x)
+
593 ! Arguments
+
594 real(real64), intent(in), dimension(:,:) :: a
+
595 logical, intent(in), optional :: pvt
+
596 type(qr_results) :: x
+
597
+
598 ! Local Variables
+
599 logical :: use_pivot
+
600 integer(int32) :: m, n, mn
+
601 integer(int32), allocatable, dimension(:) :: jpvt
+
602 real(real64), allocatable, dimension(:) :: tau
+
603
+
604 ! Memory Allocation
+
605 use_pivot = .false.
+
606 if (present(pvt)) use_pivot = pvt
+
607 m = size(a, 1)
+
608 n = size(a, 2)
+
609 mn = min(m, n)
+
610 allocate(tau(mn))
+
611 allocate(x%q(m,m))
+
612 allocate(x%r(m,n))
+
613
+
614 ! Compute the factorization, and then form Q, R, and P
+
615 x%r = a
+
616 if (use_pivot) then
+
617 allocate(x%p(n,n))
+
618 allocate(jpvt(n))
+
619 jpvt = 0 ! Ensure all columns are free columns
+
620 call qr_factor(x%r, tau, jpvt)
+
621 call form_qr(x%r, tau, jpvt, x%q, x%p)
+
622 else
+
623 call qr_factor(x%r, tau)
+
624 call form_qr(x%r, tau, x%q)
+
625 end if
+
626 end function
+
627
+
628! ------------------------------------------------------------------------------
+
638 function mat_qr_rank1_update(q, r, x, y) result(rst)
+
639 ! Arguments
+
640 real(real64), intent(in), dimension(:,:) :: q, r
+
641 real(real64), intent(in), dimension(:) :: x, y
+
642 type(qr_results) :: rst
+
643
+
644 ! Local Variables
+
645 integer(int32) :: i, m, n
+
646 real(real64), allocatable, dimension(:) :: xc, yc
+
647
+
648 ! Memory allocation
+
649 m = size(q, 1)
+
650 n = size(r, 2)
+
651 allocate(xc(m))
+
652 allocate(yc(n))
+
653 allocate(rst%q(m,m))
+
654 allocate(rst%r(m,n))
+
655
+
656 ! Process
+
657 do i = 1, m
+
658 xc(i) = x(i)
+
659 rst%q(:,i) = q(:,i)
+
660 end do
+
661 do i = 1, n
+
662 yc(i) = y(i)
+
663 rst%r(:,i) = r(:,i)
+
664 end do
+
665 call qr_rank1_update(rst%q, rst%r, xc, yc)
+
666 end function
+
667
+
668! ------------------------------------------------------------------------------
+
674 function mat_svd(a) result(x)
+
675 ! Arguments
+
676 real(real64), intent(in), dimension(:,:) :: a
+
677 type(svd_results) :: x
+
678
+
679 ! Local Variables
+
680 integer(int32) :: i, m, n, mn
+
681 real(real64), allocatable, dimension(:) :: s
+
682 real(real64), allocatable, dimension(:,:) :: ac
+
683
+
684 ! Memory Allocation
+
685 m = size(a, 1)
+
686 n = size(a, 2)
+
687 mn = min(m, n)
+
688 allocate(s(mn))
+
689 allocate(ac(m,n))
+
690 allocate(x%u(m,m))
+
691 allocate(x%s(m,n))
+
692 allocate(x%vt(n,n))
+
693
+
694 ! Process
+
695 ac = a
+
696 call svd(ac, s, x%u, x%vt)
+
697
+
698 ! Extract the singular values, and populate the results matrix
+
699 x%s = 0.0d0
+
700 do i = 1, mn
+
701 x%s(i,i) = s(i)
+
702 end do
+
703 end function
+
704
+
705! ------------------------------------------------------------------------------
+
715 function mat_cholesky(a, upper) result(r)
+
716 ! Arguments
+
717 real(real64), intent(in), dimension(:,:) :: a
+
718 logical, intent(in), optional :: upper
+
719 real(real64), dimension(size(a, 1), size(a, 2)) :: r
+
720
+
721 ! Local Variables
+
722 logical :: compute_upper
+
723
+
724 ! Process
+
725 compute_upper = .true.
+
726 if (present(upper)) compute_upper = upper
+
727 r = a
+
728 call cholesky_factor(r, compute_upper)
+
729 end function
+
730
+
731! ------------------------------------------------------------------------------
+
738 function mat_cholesky_rank1_update(a, x) result(r)
+
739 ! Arguments
+
740 real(real64), intent(in), dimension(:,:) :: a
+
741 real(real64), intent(in), dimension(:) :: x
+
742 real(real64), dimension(size(a, 1), size(a, 2)) :: r
+
743
+
744 ! Local Variables
+
745 real(real64), dimension(size(x)) :: xc
+
746
+
747 ! Process
+
748 r = a
+
749 xc = x
+
750 call cholesky_rank1_update(r, xc)
+
751 end function
+
752
+
753! ------------------------------------------------------------------------------
+
760 function mat_cholesky_rank1_downdate(a, x) result(r)
+
761 ! Arguments
+
762 real(real64), intent(in), dimension(:,:) :: a
+
763 real(real64), intent(in), dimension(:) :: x
+
764 real(real64), dimension(size(a, 1), size(a, 2)) :: r
+
765
+
766 ! Local Variables
+
767 real(real64), dimension(size(x)) :: xc
+
768
+
769 ! Process
+
770 r = a
+
771 xc = x
+
772 call cholesky_rank1_downdate(r, xc)
+
773 end function
+
774
+
775! ------------------------------------------------------------------------------
+
780 function mat_inverse(a) result(x)
+
781 ! Arguments
+
782 real(real64), intent(in), dimension(:,:) :: a
+
783 real(real64), dimension(size(a, 2), size(a, 1)) :: x
+
784
+
785 ! Compute the inverse of A
+
786 x = a
+
787 call mtx_inverse(x)
+
788 end function
+
789
+
790! ------------------------------------------------------------------------------
+
795 function mat_pinverse(a) result(x)
+
796 ! Arguments
+
797 real(real64), intent(in), dimension(:,:) :: a
+
798 real(real64), dimension(size(a, 2), size(a, 1)) :: x
+
799
+
800 ! Local Variables
+
801 real(real64), dimension(size(a, 1), size(a, 2)) :: ac
+
802
+
803 ! Compute the inverse of A
+
804 ac = a
+
805 call mtx_pinverse(ac, x)
+
806 end function
+
807
+
808! ------------------------------------------------------------------------------
+
815 function mat_solve_upper_tri_1(a, b) result(x)
+
816 ! Arguments
+
817 real(real64), intent(in), dimension(:,:) :: a, b
+
818 real(real64), dimension(size(b, 1), size(b, 2)) :: x
+
819
+
820 ! Process
+
821 x = b
+
822 call solve_triangular_system(.true., .true., .false., .true., 1.0d0, &
+
823 a, x)
+
824 end function
+
825
+
826! ------------------------------------------------------------------------------
+
833 function mat_solve_upper_tri_2(a, b) result(x)
+
834 ! Arguments
+
835 real(real64), intent(in), dimension(:,:) :: a
+
836 real(real64), intent(in), dimension(:) :: b
+
837 real(real64), dimension(size(b)) :: x
+
838
+
839 ! Process
+
840 x = b
+
841 call solve_triangular_system(.true., .false., .true., a, x)
+
842 end function
+
843
+
844! ------------------------------------------------------------------------------
+
851 function mat_solve_upper_tri_1_cmplx(a, b) result(x)
+
852 ! Arguments
+
853 complex(real64), intent(in), dimension(:,:) :: a, b
+
854 complex(real64), dimension(size(b, 1), size(b, 2)) :: x
+
855
+
856 ! Process
+
857 x = b
+
858 call solve_triangular_system(.true., .true., .false., .true., &
+
859 (1.0d0, 0.0d0), a, x)
+
860 end function
+
861
+
862! ------------------------------------------------------------------------------
+
869 function mat_solve_upper_tri_2_cmplx(a, b) result(x)
+
870 ! Arguments
+
871 complex(real64), intent(in), dimension(:,:) :: a
+
872 complex(real64), intent(in), dimension(:) :: b
+
873 complex(real64), dimension(size(b)) :: x
+
874
+
875 ! Process
+
876 x = b
+
877 call solve_triangular_system(.true., .false., .true., a, x)
+
878 end function
+
879
+
880! ------------------------------------------------------------------------------
+
887 function mat_solve_lower_tri_1(a, b) result(x)
+
888 ! Arguments
+
889 real(real64), intent(in), dimension(:,:) :: a, b
+
890 real(real64), dimension(size(b, 1), size(b, 2)) :: x
+
891
+
892 ! Process
+
893 x = b
+
894 call solve_triangular_system(.true., .false., .false., .true., 1.0d0, &
+
895 a, x)
+
896 end function
+
897
+
898! ------------------------------------------------------------------------------
+
905 function mat_solve_lower_tri_2(a, b) result(x)
+
906 ! Arguments
+
907 real(real64), intent(in), dimension(:,:) :: a
+
908 real(real64), intent(in), dimension(:) :: b
+
909 real(real64), dimension(size(b)) :: x
+
910
+
911 ! Process
+
912 x = b
+
913 call solve_triangular_system(.false., .false., .true., a, x)
+
914 end function
+
915
+
916! ------------------------------------------------------------------------------
+
923 function mat_solve_lower_tri_1_cmplx(a, b) result(x)
+
924 ! Arguments
+
925 complex(real64), intent(in), dimension(:,:) :: a, b
+
926 complex(real64), dimension(size(b, 1), size(b, 2)) :: x
+
927
+
928 ! Process
+
929 x = b
+
930 call solve_triangular_system(.true., .false., .false., .true., &
+
931 (1.0d0, 0.0d0), a, x)
+
932 end function
+
933
+
934! ------------------------------------------------------------------------------
+
941 function mat_solve_lower_tri_2_cmplx(a, b) result(x)
+
942 ! Arguments
+
943 complex(real64), intent(in), dimension(:,:) :: a
+
944 complex(real64), intent(in), dimension(:) :: b
+
945 complex(real64), dimension(size(b)) :: x
+
946
+
947 ! Process
+
948 x = b
+
949 call solve_triangular_system(.false., .false., .true., a, x)
+
950 end function
+
951
+
952! ------------------------------------------------------------------------------
+
959 function mat_eigen_1(a) result(x)
+
960 ! Arguments
+
961 real(real64), intent(in), dimension(:,:) :: a
+
962 type(eigen_results) :: x
+
963
+
964 ! Local Variables
+
965 integer(int32) :: n
+
966 real(real64), dimension(size(a, 1), size(a, 2)) :: ac
+
967
+
968 ! Memory Allocation
+
969 n = size(a, 1)
+
970 allocate(x%values(n))
+
971 allocate(x%vectors(n,n))
+
972
+
973 ! Process
+
974 ac = a
+
975 call eigen(ac, x%values, x%vectors)
+
976
+
977 ! Sort the eigenvalues and eigenvectors.
+
978 call sort(x%values, x%vectors, .true.)
+
979 end function
+
980
+
981! ------------------------------------------------------------------------------
+
989 function mat_eigen_2(a, b) result(x)
+
990 ! Arguments
+
991 real(real64), intent(in), dimension(:,:) :: a, b
+
992 type(eigen_results) :: x
+
993
+
994 ! Local Variables
+
995 integer(int32) :: i, j, n
+
996 real(real64), dimension(size(a, 1), size(a, 2)) :: ac
+
997 real(real64), dimension(size(b, 1), size(b, 2)) :: bc
+
998
+
999 ! Memory Allocation
+
1000 n = size(a, 1)
+
1001 allocate(x%values(n))
+
1002 allocate(x%vectors(n,n))
+
1003
+
1004 ! Process
+
1005 do j = 1, n
+
1006 do i = 1, n
+
1007 ac(i,j) = a(i,j)
+
1008 bc(i,j) = b(i,j)
+
1009 end do
+
1010 end do
+
1011 call eigen(ac, bc, x%values, vecs = x%vectors)
+
1012
+
1013 ! Sort the eigenvalues and eigenvectors.
+
1014 call sort(x%values, x%vectors, .true.)
+
1015 end function
+
1016
+
1017! ------------------------------------------------------------------------------
+
1022 pure function identity(n) result(x)
+
1023 integer(int32), intent(in) :: n
+
1024 real(real64), dimension(n, n) :: x
+
1025 integer(int32) :: i
+
1026 x = 0.0d0
+
1027 do i = 1, n
+
1028 x(i,i) = 1.0d0
+
1029 end do
+
1030 end function
+
1031
+
1032end module
+
Computes the Cholesky factorization of a symmetric, positive definite matrix.
+
Computes the rank 1 downdate to a Cholesky factored matrix (upper triangular).
+
Computes the rank 1 update to a Cholesky factored matrix (upper triangular).
+
Computes the determinant of a square matrix.
+
Multiplies a diagonal matrix with another matrix or array.
+
Computes the eigenvalues, and optionally the eigenvectors, of a matrix.
+
Extracts the L and U matrices from the condensed [L\U] storage format used by the lu_factor.
+
Forms the full M-by-M orthogonal matrix Q from the elementary reflectors returned by the base QR fact...
+
Computes the LU factorization of an M-by-N matrix.
+
Computes the inverse of a square matrix.
+
Computes the Moore-Penrose pseudo-inverse of a M-by-N matrix using the singular value decomposition o...
+
Computes the QR factorization of an M-by-N matrix.
+
Computes the rank 1 update to an M-by-N QR factored matrix A (M >= N) where A = Q * R,...
+
Performs the rank-1 update to matrix A such that: , where is an M-by-N matrix, is a scalar,...
+
Solves a triangular system of equations.
+
Sorts an array.
+
Computes the singular value decomposition of a matrix A. The SVD is defined as: A = U * S * V**T,...
Computes the eigenvalues and eigenvectors (right) of a general N-by-N matrix.
+
Computes the LU factorization of a square matrix. Notice, partial row pivoting is utilized.
+
Computes the matrix operation: C = A * B, where A is a diagonal matrix.
+
Computes the matrix operation C = A * B, where A is a lower triangular matrix.
+
Computes the matrix operation C = A * B, where A is an upper triangular matrix.
+
Solves the lower triangular system A X = B, where A is a lower triangular matrix.
+
Solves the upper triangular system A X = B, where A is an upper triangular matrix.
Provides a set of constants and error flags for the library.
-
Computes the determinant of a square matrix.
-
Sorts an array.
-
Computes the rank 1 downdate to a Cholesky factored matrix (upper triangular).
+
Provides a set of common linear algebra routines.
Definition: linalg_core.f90:15
+
Provides an immutable interface to many of the core linear algebra routines in this library....
+
Defines a container for the output of an Eigen analysis of a square matrix.
+
Defines a container for the output of an LU factorization.
Defines a container for the output of an LU factorization.
-
Solves the upper triangular system A X = B, where A is an upper triangular matrix.
-
Computes the eigenvalues, and optionally the eigenvectors, of a matrix.
-
Computes the LU factorization of an M-by-N matrix.
-
Solves the lower triangular system A X = B, where A is a lower triangular matrix.
-
Defines a container for the output of a singular value decomposition of a matrix.
-
Computes the matrix operation C = A * B, where A is a lower triangular matrix.
-
Performs the rank-1 update to matrix A such that: A = alpha * X * Y**T + A, where A is an M-by-N matr...
Definition: linalg_core.f90:72
-
Forms the full M-by-M orthogonal matrix Q from the elementary reflectors returned by the base QR fact...
-
Computes the rank 1 update to a Cholesky factored matrix (upper triangular).
-
Computes the rank 1 update to an M-by-N QR factored matrix A (M >= N) where A = Q * R,...
-
Extracts the L and U matrices from the condensed [L\U] storage format used by the lu_factor.
-
Solves a triangular system of equations.
Defines a container for the output of a QR factorization.
-
Defines a container for the output of an LU factorization.
-
Computes the inverse of a square matrix.
-
Computes the matrix operation: C = A * B, where A is a diagonal matrix.
+
Defines a container for the output of a QR factorization.
+
Defines a container for the output of a singular value decomposition of a matrix.
Defines a container for the output of a singular value decomposition of a matrix.
-
Computes the LU factorization of a square matrix. Notice, partial row pivoting is utilized.
-
Computes the matrix operation C = A * B, where A is an upper triangular matrix.
-
Computes the QR factorization of an M-by-N matrix.
+
+ diff --git a/doc/html/linalg__solve_8f90_source.html b/doc/html/linalg__solve_8f90_source.html index 7cc1bd3e..8a844ac2 100644 --- a/doc/html/linalg__solve_8f90_source.html +++ b/doc/html/linalg__solve_8f90_source.html @@ -1,11 +1,11 @@ - + - - + + -linalg: C:/Users/jchri/Documents/github/linalg/src/linalg_solve.f90 Source File +linalg: D:/Code/linalg/src/linalg_solve.f90 Source File @@ -13,13 +13,16 @@ - + + @@ -27,10 +30,9 @@
- - + @@ -39,21 +41,22 @@
-
linalg -  1.6.0 +
+
linalg 1.6.1
A linear algebra library that provides a user-friendly interface to several BLAS and LAPACK routines.
- + +/* @license-end */ +
@@ -67,8 +70,8 @@
@@ -81,3407 +84,3411 @@
- +
+
+
+
+
Loading...
+
Searching...
+
No Matches
+
+
+
-
-
linalg_solve.f90
+
linalg_solve.f90
-
1 ! linalg_solve.f90
-
2 
-
7 submodule(linalg_core) linalg_solve
-
8 contains
-
9 ! ******************************************************************************
-
10 ! TRIANGULAR MATRIX SOLUTION ROUTINES
-
11 ! ------------------------------------------------------------------------------
-
12  module subroutine solve_tri_mtx(lside, upper, trans, nounit, alpha, a, b, err)
-
13  ! Arguments
-
14  logical, intent(in) :: lside, upper, trans, nounit
-
15  real(real64), intent(in) :: alpha
-
16  real(real64), intent(in), dimension(:,:) :: a
-
17  real(real64), intent(inout), dimension(:,:) :: b
-
18  class(errors), intent(inout), optional, target :: err
-
19 
-
20  ! Parameters
-
21  character :: side, uplo, transa, diag
-
22 
-
23  ! Local Variables
-
24  integer(int32) :: m, n, nrowa
-
25  class(errors), pointer :: errmgr
-
26  type(errors), target :: deferr
-
27 
-
28  ! Initialization
-
29  m = size(b, 1)
-
30  n = size(b, 2)
-
31  if (lside) then
-
32  nrowa = m
-
33  side = 'L'
-
34  else
-
35  nrowa = n
-
36  side = 'R'
-
37  end if
-
38  if (upper) then
-
39  uplo = 'U'
-
40  else
-
41  uplo = 'L'
-
42  end if
-
43  if (trans) then
-
44  transa = 'T'
-
45  else
-
46  transa = 'N'
-
47  end if
-
48  if (nounit) then
-
49  diag = 'N'
-
50  else
-
51  diag = 'U'
-
52  end if
-
53  if (present(err)) then
-
54  errmgr => err
-
55  else
-
56  errmgr => deferr
-
57  end if
-
58 
-
59  ! Input Check - matrix A must be square
-
60  if (size(a, 1) /= nrowa .or. size(a, 2) /= nrowa) then
-
61  ! ERROR: A must be square
-
62  call errmgr%report_error("solve_tri_mtx", &
-
63  "The input matrix must be square.", la_array_size_error)
-
64  return
-
65  end if
-
66 
-
67  ! Call DTRSM
-
68  call dtrsm(side, uplo, transa, diag, m, n, alpha, a, nrowa, b, m)
-
69  end subroutine
-
70 
-
71 ! ------------------------------------------------------------------------------
-
72  module subroutine solve_tri_mtx_cmplx(lside, upper, trans, nounit, alpha, a, b, err)
-
73  ! Arguments
-
74  logical, intent(in) :: lside, upper, trans, nounit
-
75  complex(real64), intent(in) :: alpha
-
76  complex(real64), intent(in), dimension(:,:) :: a
-
77  complex(real64), intent(inout), dimension(:,:) :: b
-
78  class(errors), intent(inout), optional, target :: err
-
79 
-
80  ! Parameters
-
81  character :: side, uplo, transa, diag
-
82 
-
83  ! Local Variables
-
84  integer(int32) :: m, n, nrowa
-
85  class(errors), pointer :: errmgr
-
86  type(errors), target :: deferr
-
87 
-
88  ! Initialization
-
89  m = size(b, 1)
-
90  n = size(b, 2)
-
91  if (lside) then
-
92  nrowa = m
-
93  side = 'L'
-
94  else
-
95  nrowa = n
-
96  side = 'R'
-
97  end if
-
98  if (upper) then
-
99  uplo = 'U'
-
100  else
-
101  uplo = 'L'
-
102  end if
-
103  if (trans) then
-
104  transa = 'C'
-
105  else
-
106  transa = 'N'
-
107  end if
-
108  if (nounit) then
-
109  diag = 'N'
-
110  else
-
111  diag = 'U'
-
112  end if
-
113  if (present(err)) then
-
114  errmgr => err
-
115  else
-
116  errmgr => deferr
-
117  end if
-
118 
-
119  ! Input Check - matrix A must be square
-
120  if (size(a, 1) /= nrowa .or. size(a, 2) /= nrowa) then
-
121  ! ERROR: A must be square
-
122  call errmgr%report_error("solve_tri_mtx_cmplx", &
-
123  "The input matrix must be square.", la_array_size_error)
-
124  return
-
125  end if
-
126 
-
127  ! Call ZTRSM
-
128  call ztrsm(side, uplo, transa, diag, m, n, alpha, a, nrowa, b, m)
-
129  end subroutine
-
130 
-
131 ! ------------------------------------------------------------------------------
-
132  module subroutine solve_tri_vec(upper, trans, nounit, a, x, err)
-
133  ! Arguments
-
134  logical, intent(in) :: upper, trans, nounit
-
135  real(real64), intent(in), dimension(:,:) :: a
-
136  real(real64), intent(inout), dimension(:) :: x
-
137  class(errors), intent(inout), optional, target :: err
-
138 
-
139  ! Parameters
-
140  real(real64), parameter :: zero = 0.0d0
-
141 
-
142  ! Local Variables
-
143  character :: uplo, t, diag
-
144  integer(int32) :: n
-
145  class(errors), pointer :: errmgr
-
146  type(errors), target :: deferr
-
147 
-
148  ! Initialization
-
149  n = size(a, 1)
-
150  if (upper) then
-
151  uplo = 'U'
-
152  else
-
153  uplo = 'L'
-
154  end if
-
155  if (trans) then
-
156  t = 'T'
-
157  else
-
158  t = 'N'
-
159  end if
-
160  if (nounit) then
-
161  diag = 'N'
-
162  else
-
163  diag = 'U'
-
164  end if
-
165  if (present(err)) then
-
166  errmgr => err
-
167  else
-
168  errmgr => deferr
-
169  end if
-
170 
-
171  ! Input Check
-
172  if (size(a, 2) /= n) then
-
173  ! ERROR: A must be square
-
174  call errmgr%report_error("solve_tri_vec", &
-
175  "The input matrix must be square.", la_array_size_error)
-
176  return
-
177  else if (size(x) /= n) then
-
178  ! ERROR: Inner matrix dimensions must agree
-
179  call errmgr%report_error("solve_tri_vec", &
-
180  "The inner matrix dimensions must be equal.", &
-
181  la_array_size_error)
-
182  return
-
183  end if
-
184 
-
185  ! Call DTRSV
-
186  call dtrsv(uplo, t, diag, n, a, n, x, 1)
-
187  end subroutine
-
188 
-
189 ! ------------------------------------------------------------------------------
-
190  module subroutine solve_tri_vec_cmplx(upper, trans, nounit, a, x, err)
-
191  ! Arguments
-
192  logical, intent(in) :: upper, trans, nounit
-
193  complex(real64), intent(in), dimension(:,:) :: a
-
194  complex(real64), intent(inout), dimension(:) :: x
-
195  class(errors), intent(inout), optional, target :: err
-
196 
-
197  ! Parameters
-
198  real(real64), parameter :: zero = 0.0d0
-
199 
-
200  ! Local Variables
-
201  character :: uplo, t, diag
-
202  integer(int32) :: n
-
203  class(errors), pointer :: errmgr
-
204  type(errors), target :: deferr
-
205 
-
206  ! Initialization
-
207  n = size(a, 1)
-
208  if (upper) then
-
209  uplo = 'U'
-
210  else
-
211  uplo = 'L'
-
212  end if
-
213  if (trans) then
-
214  t = 'C'
-
215  else
-
216  t = 'N'
-
217  end if
-
218  if (nounit) then
-
219  diag = 'N'
-
220  else
-
221  diag = 'U'
-
222  end if
-
223  if (present(err)) then
-
224  errmgr => err
-
225  else
-
226  errmgr => deferr
-
227  end if
-
228 
-
229  ! Input Check
-
230  if (size(a, 2) /= n) then
-
231  ! ERROR: A must be square
-
232  call errmgr%report_error("solve_tri_vec_cmplx", &
-
233  "The input matrix must be square.", la_array_size_error)
-
234  return
-
235  else if (size(x) /= n) then
-
236  ! ERROR: Inner matrix dimensions must agree
-
237  call errmgr%report_error("solve_tri_vec_cmplx", &
-
238  "The inner matrix dimensions must be equal.", &
-
239  la_array_size_error)
-
240  return
-
241  end if
-
242 
-
243  ! Call ZTRSV
-
244  call ztrsv(uplo, t, diag, n, a, n, x, 1)
-
245  end subroutine
-
246 
-
247 ! ******************************************************************************
-
248 ! LU SOLUTION
-
249 ! ------------------------------------------------------------------------------
-
250  module subroutine solve_lu_mtx(a, ipvt, b, err)
-
251  ! Arguments
-
252  real(real64), intent(in), dimension(:,:) :: a
-
253  integer(int32), intent(in), dimension(:) :: ipvt
-
254  real(real64), intent(inout), dimension(:,:) :: b
-
255  class(errors), intent(inout), optional, target :: err
-
256 
-
257  ! Local Variables
-
258  integer(int32) :: n, nrhs, flag
-
259  class(errors), pointer :: errmgr
-
260  type(errors), target :: deferr
-
261  character(len = 128) :: errmsg
-
262 
-
263  ! Initialization
-
264  n = size(a, 1)
-
265  nrhs = size(b, 2)
-
266  if (present(err)) then
-
267  errmgr => err
-
268  else
-
269  errmgr => deferr
-
270  end if
-
271 
-
272  ! Input Check
-
273  flag = 0
-
274  if (size(a, 2) /= n) then
-
275  flag = 1
-
276  else if (size(ipvt) /= n) then
-
277  flag = 2
-
278  else if (size(b, 1) /= n) then
-
279  flag = 3
-
280  end if
-
281  if (flag /= 0) then
-
282  ! One of the input arrays is not sized correctly
-
283  write(errmsg, '(AI0A)') "Input number ", flag, &
-
284  " is not sized correctly."
-
285  call errmgr%report_error("solve_lu_mtx", trim(errmsg), &
-
286  la_array_size_error)
-
287  return
-
288  end if
-
289 
-
290  ! Call DGETRS
-
291  call dgetrs("N", n, nrhs, a, n, ipvt, b, n, flag)
-
292  end subroutine
-
293 
-
294 ! ------------------------------------------------------------------------------
-
295  module subroutine solve_lu_mtx_cmplx(a, ipvt, b, err)
-
296  ! Arguments
-
297  complex(real64), intent(in), dimension(:,:) :: a
-
298  integer(int32), intent(in), dimension(:) :: ipvt
-
299  complex(real64), intent(inout), dimension(:,:) :: b
-
300  class(errors), intent(inout), optional, target :: err
-
301 
-
302  ! Local Variables
-
303  integer(int32) :: n, nrhs, flag
-
304  class(errors), pointer :: errmgr
-
305  type(errors), target :: deferr
-
306  character(len = 128) :: errmsg
-
307 
-
308  ! Initialization
-
309  n = size(a, 1)
-
310  nrhs = size(b, 2)
-
311  if (present(err)) then
-
312  errmgr => err
-
313  else
-
314  errmgr => deferr
-
315  end if
-
316 
-
317  ! Input Check
-
318  flag = 0
-
319  if (size(a, 2) /= n) then
-
320  flag = 1
-
321  else if (size(ipvt) /= n) then
-
322  flag = 2
-
323  else if (size(b, 1) /= n) then
-
324  flag = 3
-
325  end if
-
326  if (flag /= 0) then
-
327  ! One of the input arrays is not sized correctly
-
328  write(errmsg, '(AI0A)') "Input number ", flag, &
-
329  " is not sized correctly."
-
330  call errmgr%report_error("solve_lu_mtx_cmplx", trim(errmsg), &
-
331  la_array_size_error)
-
332  return
-
333  end if
-
334 
-
335  ! Call ZGETRS
-
336  call zgetrs("N", n, nrhs, a, n, ipvt, b, n, flag)
-
337  end subroutine
-
338 
-
339 ! ------------------------------------------------------------------------------
-
340  module subroutine solve_lu_vec(a, ipvt, b, err)
-
341  ! Arguments
-
342  real(real64), intent(in), dimension(:,:) :: a
-
343  integer(int32), intent(in), dimension(:) :: ipvt
-
344  real(real64), intent(inout), dimension(:) :: b
-
345  class(errors), intent(inout), optional, target :: err
-
346 
-
347  ! Local Variables
-
348  integer(int32) :: n, flag
-
349  class(errors), pointer :: errmgr
-
350  type(errors), target :: deferr
-
351  character(len = 128) :: errmsg
-
352 
-
353  ! Initialization
-
354  n = size(a, 1)
-
355  if (present(err)) then
-
356  errmgr => err
-
357  else
-
358  errmgr => deferr
-
359  end if
-
360 
-
361  ! Input Check
-
362  flag = 0
-
363  if (size(a, 2) /= n) then
-
364  flag = 1
-
365  else if (size(ipvt) /= n) then
-
366  flag = 2
-
367  else if (size(b) /= n) then
-
368  flag = 3
-
369  end if
-
370  if (flag /= 0) then
-
371  ! One of the input arrays is not sized correctly
-
372  write(errmsg, '(AI0A)') "Input number ", flag, &
-
373  " is not sized correctly."
-
374  call errmgr%report_error("solve_lu_vec", trim(errmsg), &
-
375  la_array_size_error)
-
376  return
-
377  end if
-
378 
-
379  ! Call DGETRS
-
380  call dgetrs("N", n, 1, a, n, ipvt, b, n, flag)
-
381  end subroutine
-
382 
-
383 ! ------------------------------------------------------------------------------
-
384  module subroutine solve_lu_vec_cmplx(a, ipvt, b, err)
-
385  ! Arguments
-
386  complex(real64), intent(in), dimension(:,:) :: a
-
387  integer(int32), intent(in), dimension(:) :: ipvt
-
388  complex(real64), intent(inout), dimension(:) :: b
-
389  class(errors), intent(inout), optional, target :: err
-
390 
-
391  ! Local Variables
-
392  integer(int32) :: n, flag
-
393  class(errors), pointer :: errmgr
-
394  type(errors), target :: deferr
-
395  character(len = 128) :: errmsg
-
396 
-
397  ! Initialization
-
398  n = size(a, 1)
-
399  if (present(err)) then
-
400  errmgr => err
-
401  else
-
402  errmgr => deferr
-
403  end if
-
404 
-
405  ! Input Check
-
406  flag = 0
-
407  if (size(a, 2) /= n) then
-
408  flag = 1
-
409  else if (size(ipvt) /= n) then
-
410  flag = 2
-
411  else if (size(b) /= n) then
-
412  flag = 3
-
413  end if
-
414  if (flag /= 0) then
-
415  ! One of the input arrays is not sized correctly
-
416  write(errmsg, '(AI0A)') "Input number ", flag, &
-
417  " is not sized correctly."
-
418  call errmgr%report_error("solve_lu_vec_cmplx", trim(errmsg), &
-
419  la_array_size_error)
-
420  return
-
421  end if
-
422 
-
423  ! Call ZGETRS
-
424  call zgetrs("N", n, 1, a, n, ipvt, b, n, flag)
-
425  end subroutine
-
426 
-
427 ! ******************************************************************************
-
428 ! QR SOLUTION
-
429 ! ------------------------------------------------------------------------------
-
430  module subroutine solve_qr_no_pivot_mtx(a, tau, b, work, olwork, err)
-
431  ! Arguments
-
432  real(real64), intent(inout), dimension(:,:) :: a, b
-
433  real(real64), intent(in), dimension(:) :: tau
-
434  real(real64), intent(out), target, optional, dimension(:) :: work
-
435  integer(int32), intent(out), optional :: olwork
-
436  class(errors), intent(inout), optional, target :: err
-
437 
-
438  ! Parameters
-
439  real(real64), parameter :: one = 1.0d0
-
440 
-
441  ! Local Variables
-
442  integer(int32) :: m, n, nrhs, k, lwork, flag, istat
-
443  real(real64), pointer, dimension(:) :: wptr
-
444  real(real64), allocatable, target, dimension(:) :: wrk
-
445  class(errors), pointer :: errmgr
-
446  type(errors), target :: deferr
-
447  character(len = 128) :: errmsg
-
448 
-
449  ! Initialization
-
450  m = size(a, 1)
-
451  n = size(a, 2)
-
452  nrhs = size(b, 2)
-
453  k = min(m, n)
-
454  if (present(err)) then
-
455  errmgr => err
-
456  else
-
457  errmgr => deferr
-
458  end if
-
459 
-
460  ! Input Check
-
461  flag = 0
-
462  if (m < n) then
-
463  flag = 1
-
464  else if (size(tau) /= k) then
-
465  flag = 2
-
466  else if (size(b, 1) /= m) then
-
467  flag = 3
-
468  end if
-
469  if (flag /= 0) then
-
470  ! ERROR: One of the input arrays is not sized correctly
-
471  write(errmsg, '(AI0A)') "Input number ", flag, &
-
472  " is not sized correctly."
-
473  call errmgr%report_error("solve_qr_no_pivot_mtx", trim(errmsg), &
-
474  la_array_size_error)
-
475  return
-
476  end if
-
477 
-
478  ! Workspace Query
-
479  call mult_qr(.true., .true., a, tau, b, olwork = lwork)
-
480  if (present(olwork)) then
-
481  olwork = lwork
-
482  return
-
483  end if
-
484 
-
485  ! Local Memory Allocation
-
486  if (present(work)) then
-
487  if (size(work) < lwork) then
-
488  ! ERROR: WORK not sized correctly
-
489  call errmgr%report_error("solve_qr_no_pivot_mtx", &
-
490  "Incorrectly sized input array WORK, argument 4.", &
-
491  la_array_size_error)
-
492  return
-
493  end if
-
494  wptr => work(1:lwork)
-
495  else
-
496  allocate(wrk(lwork), stat = istat)
-
497  if (istat /= 0) then
-
498  ! ERROR: Out of memory
-
499  call errmgr%report_error("solve_qr_no_pivot_mtx", &
-
500  "Insufficient memory available.", &
-
501  la_out_of_memory_error)
-
502  return
-
503  end if
-
504  wptr => wrk
-
505  end if
-
506 
-
507  ! Compute Q**T * B, and store in B
-
508  call mult_qr(.true., .true., a, tau, b, wptr)
-
509 
-
510  ! Solve the triangular system: A(1:N,1:N)*X = B(1:N,:)
-
511  call solve_triangular_system(.true., .true., .false., .true., one, &
-
512  a(1:n,1:n), b(1:n,:))
-
513  end subroutine
-
514 
-
515 ! ------------------------------------------------------------------------------
-
516  module subroutine solve_qr_no_pivot_mtx_cmplx(a, tau, b, work, olwork, err)
-
517  ! Arguments
-
518  complex(real64), intent(inout), dimension(:,:) :: a, b
-
519  complex(real64), intent(in), dimension(:) :: tau
-
520  complex(real64), intent(out), target, optional, dimension(:) :: work
-
521  integer(int32), intent(out), optional :: olwork
-
522  class(errors), intent(inout), optional, target :: err
-
523 
-
524  ! Parameters
-
525  complex(real64), parameter :: one = (1.0d0, 0.0d0)
-
526 
-
527  ! Local Variables
-
528  integer(int32) :: m, n, nrhs, k, lwork, flag, istat
-
529  complex(real64), pointer, dimension(:) :: wptr
-
530  complex(real64), allocatable, target, dimension(:) :: wrk
-
531  class(errors), pointer :: errmgr
-
532  type(errors), target :: deferr
-
533  character(len = 128) :: errmsg
-
534 
-
535  ! Initialization
-
536  m = size(a, 1)
-
537  n = size(a, 2)
-
538  nrhs = size(b, 2)
-
539  k = min(m, n)
-
540  if (present(err)) then
-
541  errmgr => err
-
542  else
-
543  errmgr => deferr
-
544  end if
-
545 
-
546  ! Input Check
-
547  flag = 0
-
548  if (m < n) then
-
549  flag = 1
-
550  else if (size(tau) /= k) then
-
551  flag = 2
-
552  else if (size(b, 1) /= m) then
-
553  flag = 3
-
554  end if
-
555  if (flag /= 0) then
-
556  ! ERROR: One of the input arrays is not sized correctly
-
557  write(errmsg, '(AI0A)') "Input number ", flag, &
-
558  " is not sized correctly."
-
559  call errmgr%report_error("solve_qr_no_pivot_mtx_cmplx", &
-
560  trim(errmsg), la_array_size_error)
-
561  return
-
562  end if
-
563 
-
564  ! Workspace Query
-
565  call mult_qr(.true., .true., a, tau, b, olwork = lwork)
-
566  if (present(olwork)) then
-
567  olwork = lwork
-
568  return
-
569  end if
-
570 
-
571  ! Local Memory Allocation
-
572  if (present(work)) then
-
573  if (size(work) < lwork) then
-
574  ! ERROR: WORK not sized correctly
-
575  call errmgr%report_error("solve_qr_no_pivot_mtx_cmplx", &
-
576  "Incorrectly sized input array WORK, argument 4.", &
-
577  la_array_size_error)
-
578  return
-
579  end if
-
580  wptr => work(1:lwork)
-
581  else
-
582  allocate(wrk(lwork), stat = istat)
-
583  if (istat /= 0) then
-
584  ! ERROR: Out of memory
-
585  call errmgr%report_error("solve_qr_no_pivot_mtx_cmplx", &
-
586  "Insufficient memory available.", &
-
587  la_out_of_memory_error)
-
588  return
-
589  end if
-
590  wptr => wrk
-
591  end if
-
592 
-
593  ! Compute Q**T * B, and store in B
-
594  call mult_qr(.true., .true., a, tau, b, wptr)
-
595 
-
596  ! Solve the triangular system: A(1:N,1:N)*X = B(1:N,:)
-
597  call solve_triangular_system(.true., .true., .false., .true., one, &
-
598  a(1:n,1:n), b(1:n,:))
-
599  end subroutine
-
600 
-
601 ! ------------------------------------------------------------------------------
-
602  module subroutine solve_qr_no_pivot_vec(a, tau, b, work, olwork, err)
-
603  ! Arguments
-
604  real(real64), intent(inout), dimension(:,:) :: a
-
605  real(real64), intent(in), dimension(:) :: tau
-
606  real(real64), intent(inout), dimension(:) :: b
-
607  real(real64), intent(out), target, optional, dimension(:) :: work
-
608  integer(int32), intent(out), optional :: olwork
-
609  class(errors), intent(inout), optional, target :: err
-
610 
-
611  ! Local Variables
-
612  integer(int32) :: m, n, k, flag, lwork, istat
-
613  real(real64), pointer, dimension(:) :: wptr
-
614  real(real64), allocatable, target, dimension(:) :: wrk
-
615  class(errors), pointer :: errmgr
-
616  type(errors), target :: deferr
-
617  character(len = 128) :: errmsg
-
618 
-
619  ! Initialization
-
620  m = size(a, 1)
-
621  n = size(a, 2)
-
622  k = min(m, n)
-
623  if (present(err)) then
-
624  errmgr => err
-
625  else
-
626  errmgr => deferr
-
627  end if
-
628 
-
629  ! Input Check
-
630  flag = 0
-
631  if (m < n) then
-
632  flag = 1
-
633  else if (size(tau) /= k) then
-
634  flag = 2
-
635  else if (size(b) /= m) then
-
636  flag = 3
-
637  end if
-
638  if (flag /= 0) then
-
639  ! ERROR: One of the input arrays is not sized correctly
-
640  write(errmsg, '(AI0A)') "Input number ", flag, &
-
641  " is not sized correctly."
-
642  call errmgr%report_error("solve_qr_no_pivot_vec", trim(errmsg), &
-
643  la_array_size_error)
-
644  return
-
645  end if
-
646 
-
647  ! Workspace Query
-
648  call mult_qr(.true., a, tau, b, olwork = lwork)
-
649  if (present(olwork)) then
-
650  olwork = lwork
-
651  return
-
652  end if
-
653 
-
654  ! Local Memory Allocation
-
655  if (present(work)) then
-
656  if (size(work) < lwork) then
-
657  ! ERROR: WORK not sized correctly
-
658  call errmgr%report_error("solve_qr_no_pivot_vec", &
-
659  "Incorrectly sized input array WORK, argument 4.", &
-
660  la_array_size_error)
-
661  return
-
662  end if
-
663  wptr => work(1:lwork)
-
664  else
-
665  allocate(wrk(lwork), stat = istat)
-
666  if (istat /= 0) then
-
667  ! ERROR: Out of memory
-
668  call errmgr%report_error("solve_qr_no_pivot_vec", &
-
669  "Insufficient memory available.", &
-
670  la_out_of_memory_error)
-
671  return
-
672  end if
-
673  wptr => wrk
-
674  end if
-
675 
-
676  ! Compute Q**T * B, and store in B
-
677  call mult_qr(.true., a, tau, b, work = wptr)
-
678 
-
679  ! Solve the triangular system: A(1:N,1:N)*X = B(1:N)
-
680  call solve_triangular_system(.true., .false., .true., a(1:n,1:n), b)
-
681  end subroutine
-
682 
-
683 ! ------------------------------------------------------------------------------
-
684  module subroutine solve_qr_no_pivot_vec_cmplx(a, tau, b, work, olwork, err)
-
685  ! Arguments
-
686  complex(real64), intent(inout), dimension(:,:) :: a
-
687  complex(real64), intent(in), dimension(:) :: tau
-
688  complex(real64), intent(inout), dimension(:) :: b
-
689  complex(real64), intent(out), target, optional, dimension(:) :: work
-
690  integer(int32), intent(out), optional :: olwork
-
691  class(errors), intent(inout), optional, target :: err
-
692 
-
693  ! Local Variables
-
694  integer(int32) :: m, n, k, flag, lwork, istat
-
695  complex(real64), pointer, dimension(:) :: wptr
-
696  complex(real64), allocatable, target, dimension(:) :: wrk
-
697  class(errors), pointer :: errmgr
-
698  type(errors), target :: deferr
-
699  character(len = 128) :: errmsg
-
700 
-
701  ! Initialization
-
702  m = size(a, 1)
-
703  n = size(a, 2)
-
704  k = min(m, n)
-
705  if (present(err)) then
-
706  errmgr => err
-
707  else
-
708  errmgr => deferr
-
709  end if
-
710 
-
711  ! Input Check
-
712  flag = 0
-
713  if (m < n) then
-
714  flag = 1
-
715  else if (size(tau) /= k) then
-
716  flag = 2
-
717  else if (size(b) /= m) then
-
718  flag = 3
-
719  end if
-
720  if (flag /= 0) then
-
721  ! ERROR: One of the input arrays is not sized correctly
-
722  write(errmsg, '(AI0A)') "Input number ", flag, &
-
723  " is not sized correctly."
-
724  call errmgr%report_error("solve_qr_no_pivot_vec_cmplx", &
-
725  trim(errmsg), la_array_size_error)
-
726  return
-
727  end if
-
728 
-
729  ! Workspace Query
-
730  call mult_qr(.true., a, tau, b, olwork = lwork)
-
731  if (present(olwork)) then
-
732  olwork = lwork
-
733  return
-
734  end if
-
735 
-
736  ! Local Memory Allocation
-
737  if (present(work)) then
-
738  if (size(work) < lwork) then
-
739  ! ERROR: WORK not sized correctly
-
740  call errmgr%report_error("solve_qr_no_pivot_vec_cmplx", &
-
741  "Incorrectly sized input array WORK, argument 4.", &
-
742  la_array_size_error)
-
743  return
-
744  end if
-
745  wptr => work(1:lwork)
-
746  else
-
747  allocate(wrk(lwork), stat = istat)
-
748  if (istat /= 0) then
-
749  ! ERROR: Out of memory
-
750  call errmgr%report_error("solve_qr_no_pivot_vec_cmplx", &
-
751  "Insufficient memory available.", &
-
752  la_out_of_memory_error)
-
753  return
-
754  end if
-
755  wptr => wrk
-
756  end if
-
757 
-
758  ! Compute Q**T * B, and store in B
-
759  call mult_qr(.true., a, tau, b, work = wptr)
-
760 
-
761  ! Solve the triangular system: A(1:N,1:N)*X = B(1:N)
-
762  call solve_triangular_system(.true., .false., .true., a(1:n,1:n), b)
-
763  end subroutine
-
764 
-
765 ! ------------------------------------------------------------------------------
-
766  module subroutine solve_qr_pivot_mtx(a, tau, jpvt, b, work, olwork, err)
-
767  ! Arguments
-
768  real(real64), intent(inout), dimension(:,:) :: a
-
769  real(real64), intent(in), dimension(:) :: tau
-
770  integer(int32), intent(in), dimension(:) :: jpvt
-
771  real(real64), intent(inout), dimension(:,:) :: b
-
772  real(real64), intent(out), target, optional, dimension(:) :: work
-
773  integer(int32), intent(out), optional :: olwork
-
774  class(errors), intent(inout), optional, target :: err
-
775 
-
776  ! Parameters
-
777  integer(int32), parameter :: imin = 2
-
778  integer(int32), parameter :: imax = 1
-
779  real(real64), parameter :: zero = 0.0d0
-
780  real(real64), parameter :: one = 1.0d0
-
781 
-
782  ! Local Variables
-
783  integer(int32) :: i, j, m, n, mn, nrhs, lwork, ismin, ismax, &
-
784  rnk, maxmn, flag, istat, lwork1, lwork2, lwork3
-
785  real(real64) :: rcond, smax, smin, smaxpr, sminpr, s1, c1, s2, c2
-
786  real(real64), pointer, dimension(:) :: wptr, w, tau2
-
787  real(real64), allocatable, target, dimension(:) :: wrk
-
788  class(errors), pointer :: errmgr
-
789  type(errors), target :: deferr
-
790  character(len = 128) :: errmsg
-
791 
-
792  ! Initialization
-
793  m = size(a, 1)
-
794  n = size(a, 2)
-
795  mn = min(m, n)
-
796  maxmn = max(m, n)
-
797  nrhs = size(b, 2)
-
798  ismin = mn + 1
-
799  ismax = 2 * mn + 1
-
800  rcond = epsilon(rcond)
-
801  if (present(err)) then
-
802  errmgr => err
-
803  else
-
804  errmgr => deferr
-
805  end if
-
806 
-
807  ! Input Check
-
808  flag = 0
-
809  if (size(tau) /= mn) then
-
810  flag = 2
-
811  else if (size(jpvt) /= n) then
-
812  flag = 3
-
813  else if (size(b, 1) /= maxmn) then
-
814  flag = 4
-
815  end if
-
816  if (flag /= 0) then
-
817  ! ERROR: One of the input arrays is not sized correctly
-
818  write(errmsg, '(AI0A)') "Input number ", flag, &
-
819  " is not sized correctly."
-
820  call errmgr%report_error("solve_qr_pivot_mtx", trim(errmsg), &
-
821  la_array_size_error)
-
822  return
-
823  end if
-
824 
-
825  ! Workspace Query
-
826  call rz_factor(a(1:mn,:), a(1:mn,1), olwork = lwork1)
-
827  call mult_qr(.true., .true., a, tau, b(1:m,:), olwork = lwork2)
-
828  call mult_rz(.true., .true., n, a(1:mn,:), a(1:mn,1), b(1:n,:), &
-
829  olwork = lwork3)
-
830  lwork = max(lwork1, lwork2, lwork3, 2 * mn + 1) + mn
-
831  if (present(olwork)) then
-
832  olwork = lwork
-
833  return
-
834  end if
-
835 
-
836  ! Local Memory Allocation
-
837  if (present(work)) then
-
838  if (size(work) < lwork) then
-
839  ! ERROR: WORK not sized correctly
-
840  call errmgr%report_error("solve_qr_no_pivot_mtx", &
-
841  "Incorrectly sized input array WORK, argument 5.", &
-
842  la_array_size_error)
-
843  return
-
844  end if
-
845  wptr => work(1:lwork)
-
846  else
-
847  allocate(wrk(lwork), stat = istat)
-
848  if (istat /= 0) then
-
849  ! ERROR: Out of memory
-
850  call errmgr%report_error("solve_qr_pivot_mtx", &
-
851  "Insufficient memory available.", &
-
852  la_out_of_memory_error)
-
853  return
-
854  end if
-
855  wptr => wrk
-
856  end if
-
857 
-
858  ! Determine the rank of R11 using an incremental condition estimation
-
859  wptr(ismin) = one
-
860  wptr(ismax) = one
-
861  smax = abs(a(1,1))
-
862  smin = smax
-
863  if (abs(a(1,1)) == zero) then
-
864  rnk = 0
-
865  b(1:maxmn,:) = zero
-
866  return
-
867  else
-
868  rnk = 1
-
869  end if
-
870  do
-
871  if (rnk < mn) then
-
872  i = rnk + 1
-
873  call dlaic1(imin, rnk, wptr(ismin:ismin+rnk-1), smin, &
-
874  a(1:rnk-1,i), a(i,i), sminpr, s1, c1)
-
875  call dlaic1(imax, rnk, wptr(ismax:ismax+rnk-1), smax, &
-
876  a(1:rnk-1,i), a(i,i), smaxpr, s2, c2)
-
877  if (smaxpr * rcond <= sminpr) then
-
878  do i = 1, rnk
-
879  wptr(ismin+i-1) = s1 * wptr(ismin+i-1)
-
880  wptr(ismax+i-1) = s2 * wptr(ismax+i-1)
-
881  end do
-
882  wptr(ismin+rnk) = c1
-
883  wptr(ismax+rnk) = c2
-
884  smin = sminpr
-
885  smax = smaxpr
-
886  rnk = rnk + 1
-
887  cycle
-
888  end if
-
889  end if
-
890  exit
-
891  end do
-
892 
-
893  ! Partition R = [R11 R12]
-
894  ! [ 0 R22]
-
895  tau2 => wptr(1:rnk)
-
896  w => wptr(rnk+1:lwork)
-
897  if (rnk < n) call rz_factor(a(1:rnk,:), tau2, w)
-
898 
-
899  ! Compute B(1:m,1:NRHS) = Q**T * B(1:M,1:NRHS)
-
900  call mult_qr(.true., .true., a, tau, b(1:m,:), w)
-
901 
-
902  ! Solve the triangular system T11 * B(1:rnk,1:nrhs) = B(1:rnk,1:nrhs)
-
903  call solve_triangular_system(.true., .true., .false., .true., one, &
-
904  a(1:rnk,1:rnk), b(1:rnk,:))
-
905  if (n > rnk) b(rnk+1:n,:) = zero
-
906 
-
907  ! Compute B(1:n,1:nrhs) = Y**T * B(1:n,1:nrhs)
-
908  if (rnk < n) then
-
909  call mult_rz(.true., .true., n - rnk, a(1:rnk,:), tau2, b(1:n,:), w)
-
910  end if
-
911 
-
912  ! Apply the pivoting: B(1:N,1:NRHS) = P * B(1:N,1:NRHS)
-
913  do j = 1, nrhs
-
914  do i = 1, n
-
915  wptr(jpvt(i)) = b(i,j)
-
916  end do
-
917  b(:,j) = wptr(1:n)
-
918  end do
-
919  end subroutine
-
920 
-
921 ! ------------------------------------------------------------------------------
-
922  module subroutine solve_qr_pivot_mtx_cmplx(a, tau, jpvt, b, work, olwork, err)
-
923  ! Arguments
-
924  complex(real64), intent(inout), dimension(:,:) :: a
-
925  complex(real64), intent(in), dimension(:) :: tau
-
926  integer(int32), intent(in), dimension(:) :: jpvt
-
927  complex(real64), intent(inout), dimension(:,:) :: b
-
928  complex(real64), intent(out), target, optional, dimension(:) :: work
-
929  integer(int32), intent(out), optional :: olwork
-
930  class(errors), intent(inout), optional, target :: err
-
931 
-
932  ! Parameters
-
933  integer(int32), parameter :: imin = 2
-
934  integer(int32), parameter :: imax = 1
-
935  complex(real64), parameter :: zero = (0.0d0, 0.0d0)
-
936  complex(real64), parameter :: one = (1.0d0, 0.0d0)
-
937 
-
938  ! Local Variables
-
939  integer(int32) :: i, j, m, n, mn, nrhs, lwork, ismin, ismax, &
-
940  rnk, maxmn, flag, istat, lwork1, lwork2, lwork3
-
941  real(real64) :: rcond, smax, smin, smaxpr, sminpr
-
942  complex(real64) :: s1, c1, s2, c2
-
943  complex(real64), pointer, dimension(:) :: wptr, w, tau2
-
944  complex(real64), allocatable, target, dimension(:) :: wrk
-
945  class(errors), pointer :: errmgr
-
946  type(errors), target :: deferr
-
947  character(len = 128) :: errmsg
-
948 
-
949  ! Initialization
-
950  m = size(a, 1)
-
951  n = size(a, 2)
-
952  mn = min(m, n)
-
953  maxmn = max(m, n)
-
954  nrhs = size(b, 2)
-
955  ismin = mn + 1
-
956  ismax = 2 * mn + 1
-
957  rcond = epsilon(rcond)
-
958  if (present(err)) then
-
959  errmgr => err
-
960  else
-
961  errmgr => deferr
-
962  end if
-
963 
-
964  ! Input Check
-
965  flag = 0
-
966  if (size(tau) /= mn) then
-
967  flag = 2
-
968  else if (size(jpvt) /= n) then
-
969  flag = 3
-
970  else if (size(b, 1) /= maxmn) then
-
971  flag = 4
-
972  end if
-
973  if (flag /= 0) then
-
974  ! ERROR: One of the input arrays is not sized correctly
-
975  write(errmsg, '(AI0A)') "Input number ", flag, &
-
976  " is not sized correctly."
-
977  call errmgr%report_error("solve_qr_pivot_mtx_cmplx", &
-
978  trim(errmsg), la_array_size_error)
-
979  return
-
980  end if
-
981 
-
982  ! Workspace Query
-
983  call rz_factor(a(1:mn,:), a(1:mn,1), olwork = lwork1)
-
984  call mult_qr(.true., .true., a, tau, b(1:m,:), olwork = lwork2)
-
985  call mult_rz(.true., .true., n, a(1:mn,:), a(1:mn,1), b(1:n,:), &
-
986  olwork = lwork3)
-
987  lwork = max(lwork1, lwork2, lwork3, 2 * mn + 1) + mn
-
988  if (present(olwork)) then
-
989  olwork = lwork
-
990  return
-
991  end if
-
992 
-
993  ! Local Memory Allocation
-
994  if (present(work)) then
-
995  if (size(work) < lwork) then
-
996  ! ERROR: WORK not sized correctly
-
997  call errmgr%report_error("solve_qr_no_pivot_mtx_cmplx", &
-
998  "Incorrectly sized input array WORK, argument 5.", &
-
999  la_array_size_error)
-
1000  return
-
1001  end if
-
1002  wptr => work(1:lwork)
-
1003  else
-
1004  allocate(wrk(lwork), stat = istat)
-
1005  if (istat /= 0) then
-
1006  ! ERROR: Out of memory
-
1007  call errmgr%report_error("solve_qr_pivot_mtx_cmplx", &
-
1008  "Insufficient memory available.", &
-
1009  la_out_of_memory_error)
-
1010  return
-
1011  end if
-
1012  wptr => wrk
-
1013  end if
-
1014 
-
1015  ! Determine the rank of R11 using an incremental condition estimation
-
1016  wptr(ismin) = one
-
1017  wptr(ismax) = one
-
1018  smax = abs(a(1,1))
-
1019  smin = smax
-
1020  if (abs(a(1,1)) == zero) then
-
1021  rnk = 0
-
1022  b(1:maxmn,:) = zero
-
1023  return
-
1024  else
-
1025  rnk = 1
-
1026  end if
-
1027  do
-
1028  if (rnk < mn) then
-
1029  i = rnk + 1
-
1030  call zlaic1(imin, rnk, wptr(ismin:ismin+rnk-1), smin, &
-
1031  a(1:rnk-1,i), a(i,i), sminpr, s1, c1)
-
1032  call zlaic1(imax, rnk, wptr(ismax:ismax+rnk-1), smax, &
-
1033  a(1:rnk-1,i), a(i,i), smaxpr, s2, c2)
-
1034  if (smaxpr * rcond <= sminpr) then
-
1035  do i = 1, rnk
-
1036  wptr(ismin+i-1) = s1 * wptr(ismin+i-1)
-
1037  wptr(ismax+i-1) = s2 * wptr(ismax+i-1)
-
1038  end do
-
1039  wptr(ismin+rnk) = c1
-
1040  wptr(ismax+rnk) = c2
-
1041  smin = sminpr
-
1042  smax = smaxpr
-
1043  rnk = rnk + 1
-
1044  cycle
-
1045  end if
-
1046  end if
-
1047  exit
-
1048  end do
-
1049 
-
1050  ! Partition R = [R11 R12]
-
1051  ! [ 0 R22]
-
1052  tau2 => wptr(1:rnk)
-
1053  w => wptr(rnk+1:lwork)
-
1054  if (rnk < n) call rz_factor(a(1:rnk,:), tau2, w)
-
1055 
-
1056  ! Compute B(1:m,1:NRHS) = Q**T * B(1:M,1:NRHS)
-
1057  call mult_qr(.true., .true., a, tau, b(1:m,:), w)
-
1058 
-
1059  ! Solve the triangular system T11 * B(1:rnk,1:nrhs) = B(1:rnk,1:nrhs)
-
1060  call solve_triangular_system(.true., .true., .false., .true., one, &
-
1061  a(1:rnk,1:rnk), b(1:rnk,:))
-
1062  if (n > rnk) b(rnk+1:n,:) = zero
-
1063 
-
1064  ! Compute B(1:n,1:nrhs) = Y**T * B(1:n,1:nrhs)
-
1065  if (rnk < n) then
-
1066  call mult_rz(.true., .true., n - rnk, a(1:rnk,:), tau2, b(1:n,:), w)
-
1067  end if
-
1068 
-
1069  ! Apply the pivoting: B(1:N,1:NRHS) = P * B(1:N,1:NRHS)
-
1070  do j = 1, nrhs
-
1071  do i = 1, n
-
1072  wptr(jpvt(i)) = b(i,j)
-
1073  end do
-
1074  b(:,j) = wptr(1:n)
-
1075  end do
-
1076  end subroutine
-
1077 
-
1078 ! ------------------------------------------------------------------------------
-
1079  module subroutine solve_qr_pivot_vec(a, tau, jpvt, b, work, olwork, err)
-
1080  ! Arguments
-
1081  real(real64), intent(inout), dimension(:,:) :: a
-
1082  real(real64), intent(in), dimension(:) :: tau
-
1083  integer(int32), intent(in), dimension(:) :: jpvt
-
1084  real(real64), intent(inout), dimension(:) :: b
-
1085  real(real64), intent(out), target, optional, dimension(:) :: work
-
1086  integer(int32), intent(out), optional :: olwork
-
1087  class(errors), intent(inout), optional, target :: err
-
1088 
-
1089  ! Parameters
-
1090  integer(int32), parameter :: imin = 2
-
1091  integer(int32), parameter :: imax = 1
-
1092  real(real64), parameter :: zero = 0.0d0
-
1093  real(real64), parameter :: one = 1.0d0
-
1094 
-
1095  ! Local Variables
-
1096  integer(int32) :: i, m, n, mn, lwork, ismin, ismax, rnk, maxmn, flag, &
-
1097  istat, lwork1, lwork2
-
1098  real(real64) :: rcond, smax, smin, smaxpr, sminpr, s1, c1, s2, c2
-
1099  real(real64), pointer, dimension(:) :: wptr, w, tau2
-
1100  real(real64), allocatable, target, dimension(:) :: wrk
-
1101  class(errors), pointer :: errmgr
-
1102  type(errors), target :: deferr
-
1103  character(len = 128) :: errmsg
-
1104 
-
1105  ! Initialization
-
1106  m = size(a, 1)
-
1107  n = size(a, 2)
-
1108  mn = min(m, n)
-
1109  maxmn = max(m, n)
-
1110  ismin = mn + 1
-
1111  ismax = 2 * mn + 1
-
1112  rcond = epsilon(rcond)
-
1113  if (present(err)) then
-
1114  errmgr => err
-
1115  else
-
1116  errmgr => deferr
-
1117  end if
-
1118 
-
1119  ! Input Check
-
1120  flag = 0
-
1121  if (size(tau) /= mn) then
-
1122  flag = 2
-
1123  else if (size(jpvt) /= n) then
-
1124  flag = 3
-
1125  else if (size(b) /= maxmn) then
-
1126  flag = 4
-
1127  end if
-
1128  if (flag /= 0) then
-
1129  ! ERROR: One of the input arrays is not sized correctly
-
1130  write(errmsg, '(AI0A)') "Input number ", flag, &
-
1131  " is not sized correctly."
-
1132  call errmgr%report_error("solve_qr_pivot_vec", trim(errmsg), &
-
1133  la_array_size_error)
-
1134  return
-
1135  end if
-
1136 
-
1137  ! Workspace Query
-
1138  call rz_factor(a(1:mn,:), a(1:mn,1), olwork = lwork1)
-
1139  call mult_rz(.true., n, a(1:mn,:), a(1:mn,1), b(1:n), olwork = lwork2)
-
1140  lwork = max(lwork1, lwork2, 2 * mn + 1) + mn
-
1141  if (present(olwork)) then
-
1142  olwork = lwork
-
1143  return
-
1144  end if
-
1145 
-
1146  ! Local Memory Allocation
-
1147  if (present(work)) then
-
1148  if (size(work) < lwork) then
-
1149  ! ERROR: WORK not sized correctly
-
1150  call errmgr%report_error("solve_qr_no_pivot_mtx", &
-
1151  "Incorrectly sized input array WORK, argument 5.", &
-
1152  la_array_size_error)
-
1153  return
-
1154  end if
-
1155  wptr => work(1:lwork)
-
1156  else
-
1157  allocate(wrk(lwork), stat = istat)
-
1158  if (istat /= 0) then
-
1159  ! ERROR: Out of memory
-
1160  call errmgr%report_error("solve_qr_pivot_vec", &
-
1161  "Insufficient memory available.", &
-
1162  la_out_of_memory_error)
-
1163  return
-
1164  end if
-
1165  wptr => wrk
-
1166  end if
-
1167 
-
1168  ! Determine the rank of R11 using an incremental condition estimation
-
1169  wptr(ismin) = one
-
1170  wptr(ismax) = one
-
1171  smax = abs(a(1,1))
-
1172  smin = smax
-
1173  if (abs(a(1,1)) == zero) then
-
1174  rnk = 0
-
1175  b(maxmn) = zero
-
1176  return
-
1177  else
-
1178  rnk = 1
-
1179  end if
-
1180  do
-
1181  if (rnk < mn) then
-
1182  i = rnk + 1
-
1183  call dlaic1(imin, rnk, wptr(ismin:ismin+rnk-1), smin, &
-
1184  a(1:rnk-1,i), a(i,i), sminpr, s1, c1)
-
1185  call dlaic1(imax, rnk, wptr(ismax:ismax+rnk-1), smax, &
-
1186  a(1:rnk-1,i), a(i,i), smaxpr, s2, c2)
-
1187  if (smaxpr * rcond <= sminpr) then
-
1188  do i = 1, rnk
-
1189  wptr(ismin+i-1) = s1 * wptr(ismin+i-1)
-
1190  wptr(ismax+i-1) = s2 * wptr(ismax+i-1)
-
1191  end do
-
1192  wptr(ismin+rnk) = c1
-
1193  wptr(ismax+rnk) = c2
-
1194  smin = sminpr
-
1195  smax = smaxpr
-
1196  rnk = rnk + 1
-
1197  cycle
-
1198  end if
-
1199  end if
-
1200  exit
-
1201  end do
-
1202 
-
1203  ! Partition R = [R11 R12]
-
1204  ! [ 0 R22]
-
1205  tau2 => wptr(1:rnk)
-
1206  w => wptr(rnk+1:lwork)
-
1207  if (rnk < n) call rz_factor(a(1:rnk,:), tau2, w)
-
1208 
-
1209  ! Compute B(1:m,1:NRHS) = Q**T * B(1:M,1:NRHS)
-
1210  call mult_qr(.true., a, tau, b(1:m))
-
1211 
-
1212  ! Solve the triangular system T11 * B(1:rnk) = B(1:rnk)
-
1213  call solve_triangular_system(.true., .false., .true., a(1:rnk,1:rnk), &
-
1214  b(1:rnk))
-
1215  if (n > rnk) b(rnk+1:n) = zero
-
1216 
-
1217  ! Compute B(1:n) = Y**T * B(1:n)
-
1218  if (rnk < n) then
-
1219  call mult_rz(.true., n - rnk, a(1:rnk,:), tau2, b(1:n), w)
-
1220  end if
-
1221 
-
1222  ! Apply the pivoting: B(1:N) = P * B(1:N)
-
1223  do i = 1, n
-
1224  wptr(jpvt(i)) = b(i)
-
1225  end do
-
1226  b = wptr(1:n)
-
1227  end subroutine
-
1228 
-
1229 ! ------------------------------------------------------------------------------
-
1230  module subroutine solve_qr_pivot_vec_cmplx(a, tau, jpvt, b, work, olwork, err)
-
1231  ! Arguments
-
1232  complex(real64), intent(inout), dimension(:,:) :: a
-
1233  complex(real64), intent(in), dimension(:) :: tau
-
1234  integer(int32), intent(in), dimension(:) :: jpvt
-
1235  complex(real64), intent(inout), dimension(:) :: b
-
1236  complex(real64), intent(out), target, optional, dimension(:) :: work
-
1237  integer(int32), intent(out), optional :: olwork
-
1238  class(errors), intent(inout), optional, target :: err
-
1239 
-
1240  ! Parameters
-
1241  integer(int32), parameter :: imin = 2
-
1242  integer(int32), parameter :: imax = 1
-
1243  complex(real64), parameter :: zero = (0.0d0, 0.0d0)
-
1244  complex(real64), parameter :: one = (1.0d0, 0.0d0)
-
1245 
-
1246  ! Local Variables
-
1247  integer(int32) :: i, m, n, mn, lwork, ismin, ismax, rnk, maxmn, flag, &
-
1248  istat, lwork1, lwork2
-
1249  real(real64) :: rcond, smax, smin, smaxpr, sminpr
-
1250  complex(real64) :: s1, c1, s2, c2
-
1251  complex(real64), pointer, dimension(:) :: wptr, w, tau2
-
1252  complex(real64), allocatable, target, dimension(:) :: wrk
-
1253  class(errors), pointer :: errmgr
-
1254  type(errors), target :: deferr
-
1255  character(len = 128) :: errmsg
-
1256 
-
1257  ! Initialization
-
1258  m = size(a, 1)
-
1259  n = size(a, 2)
-
1260  mn = min(m, n)
-
1261  maxmn = max(m, n)
-
1262  ismin = mn + 1
-
1263  ismax = 2 * mn + 1
-
1264  rcond = epsilon(rcond)
-
1265  if (present(err)) then
-
1266  errmgr => err
-
1267  else
-
1268  errmgr => deferr
-
1269  end if
-
1270 
-
1271  ! Input Check
-
1272  flag = 0
-
1273  if (size(tau) /= mn) then
-
1274  flag = 2
-
1275  else if (size(jpvt) /= n) then
-
1276  flag = 3
-
1277  else if (size(b) /= maxmn) then
-
1278  flag = 4
-
1279  end if
-
1280  if (flag /= 0) then
-
1281  ! ERROR: One of the input arrays is not sized correctly
-
1282  write(errmsg, '(AI0A)') "Input number ", flag, &
-
1283  " is not sized correctly."
-
1284  call errmgr%report_error("solve_qr_pivot_vec_cmplx", trim(errmsg), &
-
1285  la_array_size_error)
-
1286  return
-
1287  end if
-
1288 
-
1289  ! Workspace Query
-
1290  call rz_factor(a(1:mn,:), a(1:mn,1), olwork = lwork1)
-
1291  call mult_rz(.true., n, a(1:mn,:), a(1:mn,1), b(1:n), olwork = lwork2)
-
1292  lwork = max(lwork1, lwork2, 2 * mn + 1) + mn
-
1293  if (present(olwork)) then
-
1294  olwork = lwork
-
1295  return
-
1296  end if
-
1297 
-
1298  ! Local Memory Allocation
-
1299  if (present(work)) then
-
1300  if (size(work) < lwork) then
-
1301  ! ERROR: WORK not sized correctly
-
1302  call errmgr%report_error("solve_qr_no_pivot_mtx_cmplx", &
-
1303  "Incorrectly sized input array WORK, argument 5.", &
-
1304  la_array_size_error)
-
1305  return
-
1306  end if
-
1307  wptr => work(1:lwork)
-
1308  else
-
1309  allocate(wrk(lwork), stat = istat)
-
1310  if (istat /= 0) then
-
1311  ! ERROR: Out of memory
-
1312  call errmgr%report_error("solve_qr_pivot_vec_cmplx", &
-
1313  "Insufficient memory available.", &
-
1314  la_out_of_memory_error)
-
1315  return
-
1316  end if
-
1317  wptr => wrk
-
1318  end if
-
1319 
-
1320  ! Determine the rank of R11 using an incremental condition estimation
-
1321  wptr(ismin) = one
-
1322  wptr(ismax) = one
-
1323  smax = abs(a(1,1))
-
1324  smin = smax
-
1325  if (abs(a(1,1)) == zero) then
-
1326  rnk = 0
-
1327  b(maxmn) = zero
-
1328  return
-
1329  else
-
1330  rnk = 1
-
1331  end if
-
1332  do
-
1333  if (rnk < mn) then
-
1334  i = rnk + 1
-
1335  call zlaic1(imin, rnk, wptr(ismin:ismin+rnk-1), smin, &
-
1336  a(1:rnk-1,i), a(i,i), sminpr, s1, c1)
-
1337  call zlaic1(imax, rnk, wptr(ismax:ismax+rnk-1), smax, &
-
1338  a(1:rnk-1,i), a(i,i), smaxpr, s2, c2)
-
1339  if (smaxpr * rcond <= sminpr) then
-
1340  do i = 1, rnk
-
1341  wptr(ismin+i-1) = s1 * wptr(ismin+i-1)
-
1342  wptr(ismax+i-1) = s2 * wptr(ismax+i-1)
-
1343  end do
-
1344  wptr(ismin+rnk) = c1
-
1345  wptr(ismax+rnk) = c2
-
1346  smin = sminpr
-
1347  smax = smaxpr
-
1348  rnk = rnk + 1
-
1349  cycle
-
1350  end if
-
1351  end if
-
1352  exit
-
1353  end do
-
1354 
-
1355  ! Partition R = [R11 R12]
-
1356  ! [ 0 R22]
-
1357  tau2 => wptr(1:rnk)
-
1358  w => wptr(rnk+1:lwork)
-
1359  if (rnk < n) call rz_factor(a(1:rnk,:), tau2, w)
-
1360 
-
1361  ! Compute B(1:m,1:NRHS) = Q**T * B(1:M,1:NRHS)
-
1362  call mult_qr(.true., a, tau, b(1:m))
-
1363 
-
1364  ! Solve the triangular system T11 * B(1:rnk) = B(1:rnk)
-
1365  call solve_triangular_system(.true., .false., .true., a(1:rnk,1:rnk), &
-
1366  b(1:rnk))
-
1367  if (n > rnk) b(rnk+1:n) = zero
-
1368 
-
1369  ! Compute B(1:n) = Y**T * B(1:n)
-
1370  if (rnk < n) then
-
1371  call mult_rz(.true., n - rnk, a(1:rnk,:), tau2, b(1:n), w)
-
1372  end if
-
1373 
-
1374  ! Apply the pivoting: B(1:N) = P * B(1:N)
-
1375  do i = 1, n
-
1376  wptr(jpvt(i)) = b(i)
-
1377  end do
-
1378  b = wptr(1:n)
-
1379  end subroutine
-
1380 
-
1381 ! ******************************************************************************
-
1382 ! CHOLESKY SOLVE
-
1383 ! ------------------------------------------------------------------------------
-
1384  module subroutine solve_cholesky_mtx(upper, a, b, err)
-
1385  ! Arguments
-
1386  logical, intent(in) :: upper
-
1387  real(real64), intent(in), dimension(:,:) :: a
-
1388  real(real64), intent(inout), dimension(:,:) :: b
-
1389  class(errors), intent(inout), optional, target :: err
-
1390 
-
1391  ! Local Variables
-
1392  character :: uplo
-
1393  integer(int32) :: n, nrhs, flag
-
1394  class(errors), pointer :: errmgr
-
1395  type(errors), target :: deferr
-
1396  character(len = 128) :: errmsg
-
1397 
-
1398  ! Initialization
-
1399  n = size(a, 1)
-
1400  nrhs = size(b, 2)
-
1401  if (upper) then
-
1402  uplo = 'U'
-
1403  else
-
1404  uplo = 'L'
-
1405  end if
-
1406  if (present(err)) then
-
1407  errmgr => err
-
1408  else
-
1409  errmgr => deferr
-
1410  end if
-
1411 
-
1412  ! Input Check
-
1413  flag = 0
-
1414  if (size(a, 2) /= n) then
-
1415  flag = 2
-
1416  else if (size(b, 1) /= n) then
-
1417  flag = 3
-
1418  end if
-
1419  if (flag /= 0) then
-
1420  write(errmsg, '(AI0A)') "Input number ", flag, &
-
1421  " is not sized correctly."
-
1422  call errmgr%report_error("solve_cholesky_mtx", trim(errmsg), &
-
1423  la_array_size_error)
-
1424  return
-
1425  end if
-
1426 
-
1427  ! Process
-
1428  call dpotrs(uplo, n, nrhs, a, n, b, n, flag)
-
1429  end subroutine
-
1430 
-
1431 ! ------------------------------------------------------------------------------
-
1432  module subroutine solve_cholesky_mtx_cmplx(upper, a, b, err)
-
1433  ! Arguments
-
1434  logical, intent(in) :: upper
-
1435  complex(real64), intent(in), dimension(:,:) :: a
-
1436  complex(real64), intent(inout), dimension(:,:) :: b
-
1437  class(errors), intent(inout), optional, target :: err
-
1438 
-
1439  ! Local Variables
-
1440  character :: uplo
-
1441  integer(int32) :: n, nrhs, flag
-
1442  class(errors), pointer :: errmgr
-
1443  type(errors), target :: deferr
-
1444  character(len = 128) :: errmsg
-
1445 
-
1446  ! Initialization
-
1447  n = size(a, 1)
-
1448  nrhs = size(b, 2)
-
1449  if (upper) then
-
1450  uplo = 'U'
-
1451  else
-
1452  uplo = 'L'
-
1453  end if
-
1454  if (present(err)) then
-
1455  errmgr => err
-
1456  else
-
1457  errmgr => deferr
-
1458  end if
-
1459 
-
1460  ! Input Check
-
1461  flag = 0
-
1462  if (size(a, 2) /= n) then
-
1463  flag = 2
-
1464  else if (size(b, 1) /= n) then
-
1465  flag = 3
-
1466  end if
-
1467  if (flag /= 0) then
-
1468  write(errmsg, '(AI0A)') "Input number ", flag, &
-
1469  " is not sized correctly."
-
1470  call errmgr%report_error("solve_cholesky_mtx_cmplx", trim(errmsg), &
-
1471  la_array_size_error)
-
1472  return
-
1473  end if
-
1474 
-
1475  ! Process
-
1476  call zpotrs(uplo, n, nrhs, a, n, b, n, flag)
-
1477  end subroutine
-
1478 
-
1479 ! ------------------------------------------------------------------------------
-
1480  module subroutine solve_cholesky_vec(upper, a, b, err)
-
1481  ! Arguments
-
1482  logical, intent(in) :: upper
-
1483  real(real64), intent(in), dimension(:,:) :: a
-
1484  real(real64), intent(inout), dimension(:) :: b
-
1485  class(errors), intent(inout), optional, target :: err
-
1486 
-
1487  ! Local Variables
-
1488  character :: uplo
-
1489  integer(int32) :: n, flag
-
1490  class(errors), pointer :: errmgr
-
1491  type(errors), target :: deferr
-
1492  character(len = 128) :: errmsg
-
1493 
-
1494  ! Initialization
-
1495  n = size(a, 1)
-
1496  if (upper) then
-
1497  uplo = 'U'
-
1498  else
-
1499  uplo = 'L'
-
1500  end if
-
1501  if (present(err)) then
-
1502  errmgr => err
-
1503  else
-
1504  errmgr => deferr
-
1505  end if
-
1506 
-
1507  ! Input Check
-
1508  flag = 0
-
1509  if (size(a, 2) /= n) then
-
1510  flag = 2
-
1511  else if (size(b) /= n) then
-
1512  flag = 3
-
1513  end if
-
1514  if (flag /= 0) then
-
1515  write(errmsg, '(AI0A)') "Input number ", flag, &
-
1516  " is not sized correctly."
-
1517  call errmgr%report_error("solve_cholesky_vec", trim(errmsg), &
-
1518  la_array_size_error)
-
1519  return
-
1520  end if
-
1521 
-
1522  ! Process
-
1523  call dpotrs(uplo, n, 1, a, n, b, n, flag)
-
1524  end subroutine
-
1525 
-
1526 ! ------------------------------------------------------------------------------
-
1527  module subroutine solve_cholesky_vec_cmplx(upper, a, b, err)
-
1528  ! Arguments
-
1529  logical, intent(in) :: upper
-
1530  complex(real64), intent(in), dimension(:,:) :: a
-
1531  complex(real64), intent(inout), dimension(:) :: b
-
1532  class(errors), intent(inout), optional, target :: err
-
1533 
-
1534  ! Local Variables
-
1535  character :: uplo
-
1536  integer(int32) :: n, flag
-
1537  class(errors), pointer :: errmgr
-
1538  type(errors), target :: deferr
-
1539  character(len = 128) :: errmsg
-
1540 
-
1541  ! Initialization
-
1542  n = size(a, 1)
-
1543  if (upper) then
-
1544  uplo = 'U'
-
1545  else
-
1546  uplo = 'L'
-
1547  end if
-
1548  if (present(err)) then
-
1549  errmgr => err
-
1550  else
-
1551  errmgr => deferr
-
1552  end if
-
1553 
-
1554  ! Input Check
-
1555  flag = 0
-
1556  if (size(a, 2) /= n) then
-
1557  flag = 2
-
1558  else if (size(b) /= n) then
-
1559  flag = 3
-
1560  end if
-
1561  if (flag /= 0) then
-
1562  write(errmsg, '(AI0A)') "Input number ", flag, &
-
1563  " is not sized correctly."
-
1564  call errmgr%report_error("solve_cholesky_vec_cmplx", trim(errmsg), &
-
1565  la_array_size_error)
-
1566  return
-
1567  end if
-
1568 
-
1569  ! Process
-
1570  call zpotrs(uplo, n, 1, a, n, b, n, flag)
-
1571  end subroutine
-
1572 
-
1573 ! ******************************************************************************
-
1574 ! MATRIX INVERSION ROUTINES
-
1575 ! ------------------------------------------------------------------------------
-
1576  module subroutine mtx_inverse_dbl(a, iwork, work, olwork, err)
-
1577  ! Arguments
-
1578  real(real64), intent(inout), dimension(:,:) :: a
-
1579  integer(int32), intent(out), target, optional, dimension(:) :: iwork
-
1580  real(real64), intent(out), target, optional, dimension(:) :: work
-
1581  integer(int32), intent(out), optional :: olwork
-
1582  class(errors), intent(inout), optional, target :: err
-
1583 
-
1584  ! Local Variables
-
1585  integer(int32) :: n, liwork, lwork, istat, flag
-
1586  integer(int32), pointer, dimension(:) :: iptr
-
1587  integer(int32), allocatable, target, dimension(:) :: iwrk
-
1588  real(real64), pointer, dimension(:) :: wptr
-
1589  real(real64), allocatable, target, dimension(:) :: wrk
-
1590  real(real64), dimension(1) :: temp
-
1591  class(errors), pointer :: errmgr
-
1592  type(errors), target :: deferr
-
1593 
-
1594  ! Initialization
-
1595  n = size(a, 1)
-
1596  liwork = n
-
1597  if (present(err)) then
-
1598  errmgr => err
-
1599  else
-
1600  errmgr => deferr
-
1601  end if
-
1602 
-
1603  ! Input Check
-
1604  if (size(a, 2) /= n) then
-
1605  call errmgr%report_error("mtx_inverse", &
-
1606  "The matrix must be squre to invert.", la_array_size_error)
-
1607  return
-
1608  end if
-
1609 
-
1610  ! Workspace Query
-
1611  call dgetri(n, a, n, istat, temp, -1, flag)
-
1612  lwork = int(temp(1), int32)
-
1613  if (present(olwork)) then
-
1614  olwork = lwork
-
1615  return
-
1616  end if
-
1617 
-
1618  ! Workspace Allocation
-
1619  if (present(work)) then
-
1620  if (size(work) < lwork) then
-
1621  ! ERROR: WORK not sized correctly
-
1622  call errmgr%report_error("mtx_inverse_dbl", &
-
1623  "Incorrectly sized input array WORK, argument 3.", &
-
1624  la_array_size_error)
-
1625  return
-
1626  end if
-
1627  wptr => work(1:lwork)
-
1628  else
-
1629  allocate(wrk(lwork), stat = istat)
-
1630  if (istat /= 0) then
-
1631  ! ERROR: Out of memory
-
1632  call errmgr%report_error("mtx_inverse_dbl", &
-
1633  "Insufficient memory available.", &
-
1634  la_out_of_memory_error)
-
1635  return
-
1636  end if
-
1637  wptr => wrk
-
1638  end if
-
1639 
-
1640  ! Integer Workspace Allocation
-
1641  if (present(iwork)) then
-
1642  if (size(iwork) < liwork) then
-
1643  ! ERROR: IWORK not sized correctly
-
1644  call errmgr%report_error("mtx_inverse_dbl", &
-
1645  "Incorrectly sized input array IWORK, argument 2.", &
-
1646  la_array_size_error)
-
1647  return
-
1648  end if
-
1649  iptr => iwork(1:liwork)
-
1650  else
-
1651  allocate(iwrk(liwork), stat = istat)
-
1652  if (istat /= 0) then
-
1653  ! ERROR: Out of memory
-
1654  call errmgr%report_error("mtx_inverse_dbl", &
-
1655  "Insufficient memory available.", &
-
1656  la_out_of_memory_error)
-
1657  return
-
1658  end if
-
1659  iptr => iwrk
-
1660  end if
-
1661 
-
1662  ! Compute the LU factorization of A
-
1663  call dgetrf(n, n, a, n, iptr, flag)
-
1664 
-
1665  ! Compute the inverse of the LU factored matrix
-
1666  call dgetri(n, a, n, iptr, wptr, lwork, flag)
-
1667 
-
1668  ! Check for a singular matrix
-
1669  if (flag > 0) then
-
1670  call errmgr%report_error("mtx_inverse_dbl", &
-
1671  "The matrix is singular; therefore, the inverse could " // &
-
1672  "not be computed.", la_singular_matrix_error)
-
1673  end if
-
1674  end subroutine
-
1675 
-
1676 ! ------------------------------------------------------------------------------
-
1677  module subroutine mtx_inverse_cmplx(a, iwork, work, olwork, err)
-
1678  ! Arguments
-
1679  complex(real64), intent(inout), dimension(:,:) :: a
-
1680  integer(int32), intent(out), target, optional, dimension(:) :: iwork
-
1681  complex(real64), intent(out), target, optional, dimension(:) :: work
-
1682  integer(int32), intent(out), optional :: olwork
-
1683  class(errors), intent(inout), optional, target :: err
-
1684 
-
1685  ! Local Variables
-
1686  integer(int32) :: n, liwork, lwork, istat, flag
-
1687  integer(int32), pointer, dimension(:) :: iptr
-
1688  integer(int32), allocatable, target, dimension(:) :: iwrk
-
1689  complex(real64), pointer, dimension(:) :: wptr
-
1690  complex(real64), allocatable, target, dimension(:) :: wrk
-
1691  complex(real64), dimension(1) :: temp
-
1692  class(errors), pointer :: errmgr
-
1693  type(errors), target :: deferr
-
1694 
-
1695  ! Initialization
-
1696  n = size(a, 1)
-
1697  liwork = n
-
1698  if (present(err)) then
-
1699  errmgr => err
-
1700  else
-
1701  errmgr => deferr
-
1702  end if
-
1703 
-
1704  ! Input Check
-
1705  if (size(a, 2) /= n) then
-
1706  call errmgr%report_error("mtx_inverse_cmplx", &
-
1707  "The matrix must be squre to invert.", la_array_size_error)
-
1708  return
-
1709  end if
-
1710 
-
1711  ! Workspace Query
-
1712  call zgetri(n, a, n, istat, temp, -1, flag)
-
1713  lwork = int(temp(1), int32)
-
1714  if (present(olwork)) then
-
1715  olwork = lwork
-
1716  return
-
1717  end if
-
1718 
-
1719  ! Workspace Allocation
-
1720  if (present(work)) then
-
1721  if (size(work) < lwork) then
-
1722  ! ERROR: WORK not sized correctly
-
1723  call errmgr%report_error("mtx_inverse_cmplx", &
-
1724  "Incorrectly sized input array WORK, argument 3.", &
-
1725  la_array_size_error)
-
1726  return
-
1727  end if
-
1728  wptr => work(1:lwork)
-
1729  else
-
1730  allocate(wrk(lwork), stat = istat)
-
1731  if (istat /= 0) then
-
1732  ! ERROR: Out of memory
-
1733  call errmgr%report_error("mtx_inverse_cmplx", &
-
1734  "Insufficient memory available.", &
-
1735  la_out_of_memory_error)
-
1736  return
-
1737  end if
-
1738  wptr => wrk
-
1739  end if
-
1740 
-
1741  ! Integer Workspace Allocation
-
1742  if (present(iwork)) then
-
1743  if (size(iwork) < liwork) then
-
1744  ! ERROR: IWORK not sized correctly
-
1745  call errmgr%report_error("mtx_inverse_cmplx", &
-
1746  "Incorrectly sized input array IWORK, argument 2.", &
-
1747  la_array_size_error)
-
1748  return
-
1749  end if
-
1750  iptr => iwork(1:liwork)
-
1751  else
-
1752  allocate(iwrk(liwork), stat = istat)
-
1753  if (istat /= 0) then
-
1754  ! ERROR: Out of memory
-
1755  call errmgr%report_error("mtx_inverse_cmplx", &
-
1756  "Insufficient memory available.", &
-
1757  la_out_of_memory_error)
-
1758  return
-
1759  end if
-
1760  iptr => iwrk
-
1761  end if
-
1762 
-
1763  ! Compute the LU factorization of A
-
1764  call zgetrf(n, n, a, n, iptr, flag)
-
1765 
-
1766  ! Compute the inverse of the LU factored matrix
-
1767  call zgetri(n, a, n, iptr, wptr, lwork, flag)
-
1768 
-
1769  ! Check for a singular matrix
-
1770  if (flag > 0) then
-
1771  call errmgr%report_error("mtx_inverse_cmplx", &
-
1772  "The matrix is singular; therefore, the inverse could " // &
-
1773  "not be computed.", la_singular_matrix_error)
-
1774  end if
-
1775  end subroutine
-
1776 
-
1777 ! ------------------------------------------------------------------------------
-
1778  module subroutine mtx_pinverse_dbl(a, ainv, tol, work, olwork, err)
-
1779  ! Arguments
-
1780  real(real64), intent(inout), dimension(:,:) :: a
-
1781  real(real64), intent(out), dimension(:,:) :: ainv
-
1782  real(real64), intent(in), optional :: tol
-
1783  real(real64), intent(out), target, dimension(:), optional :: work
-
1784  integer(int32), intent(out), optional :: olwork
-
1785  class(errors), intent(inout), optional, target :: err
-
1786 
-
1787  ! External Function Interfaces
-
1788  interface
-
1789  function dlamch(cmach) result(x)
-
1790  use, intrinsic :: iso_fortran_env, only : real64
-
1791  character, intent(in) :: cmach
-
1792  real(real64) :: x
-
1793  end function
-
1794  end interface
-
1795 
-
1796  ! Parameters
-
1797  real(real64), parameter :: zero = 0.0d0
-
1798  real(real64), parameter :: one = 1.0d0
-
1799 
-
1800  ! Local Variables
-
1801  integer(int32) :: i, m, n, mn, lwork, istat, flag, i1, i2a, i2b, i3a, &
-
1802  i3b, i4
-
1803  real(real64), pointer, dimension(:) :: s, wptr, w
-
1804  real(real64), pointer, dimension(:,:) :: u, vt
-
1805  real(real64), allocatable, target, dimension(:) :: wrk
-
1806  real(real64), dimension(1) :: temp
-
1807  real(real64) :: t, tref, tolcheck
-
1808  class(errors), pointer :: errmgr
-
1809  type(errors), target :: deferr
-
1810  character(len = 128) :: errmsg
-
1811 
-
1812  ! Initialization
-
1813  m = size(a, 1)
-
1814  n = size(a, 2)
-
1815  mn = min(m, n)
-
1816  i1 = m * mn
-
1817  i2a = i1 + 1
-
1818  i2b = i2a + n * n - 1
-
1819  i3a = i2b + 1
-
1820  i3b = i3a + mn - 1
-
1821  i4 = i3b + 1
-
1822  tolcheck = dlamch('s')
-
1823  if (present(err)) then
-
1824  errmgr => err
-
1825  else
-
1826  errmgr => deferr
-
1827  end if
-
1828 
-
1829  ! Input Check
-
1830  if (size(ainv, 1) /= n .or. size(ainv, 2) /= m) then
-
1831  write(errmsg, '(AI0AI0A)') &
-
1832  "The output matrix AINV is not sized appropriately. " // &
-
1833  "It is expected to be ", n, "-by-", m, "."
-
1834  call errmgr%report_error("mtx_pinverse", errmsg, &
-
1835  la_array_size_error)
-
1836  return
-
1837  end if
-
1838 
-
1839  ! Workspace Query
-
1840  call dgesvd('S', 'A', m, n, a, m, a(1:mn,:), a, m, a, n, temp, -1, flag)
-
1841  lwork = int(temp(1), int32)
-
1842  lwork = lwork + m * mn + n * n + mn
-
1843  if (present(olwork)) then
-
1844  olwork = lwork
-
1845  return
-
1846  end if
-
1847 
-
1848  ! Local Memory Allocation
-
1849  if (present(work)) then
-
1850  if (size(work) < lwork) then
-
1851  ! ERROR: WORK not sized correctly
-
1852  call errmgr%report_error("mtx_pinverse", &
-
1853  "Incorrectly sized input array WORK, argument 4.", &
-
1854  la_array_size_error)
-
1855  return
-
1856  end if
-
1857  wptr => work(1:lwork)
-
1858  else
-
1859  allocate(wrk(lwork), stat = istat)
-
1860  if (istat /= 0) then
-
1861  ! ERROR: Out of memory
-
1862  call errmgr%report_error("mtx_pinverse", &
-
1863  "Insufficient memory available.", &
-
1864  la_out_of_memory_error)
-
1865  return
-
1866  end if
-
1867  wptr => wrk
-
1868  end if
-
1869  u(1:m,1:mn) => wptr(1:i1)
-
1870  vt(1:n,1:n) => wptr(i2a:i2b)
-
1871  s => wptr(i3a:i3b)
-
1872  w => wptr(i4:lwork)
-
1873 
-
1874  ! Compute the SVD of A
-
1875  call dgesvd('S', 'A', m, n, a, m, s, u, m, vt, n, w, size(w), flag)
-
1876 
-
1877  ! Check for convergence
-
1878  if (flag > 0) then
-
1879  write(errmsg, '(I0A)') flag, " superdiagonals could not " // &
-
1880  "converge to zero as part of the QR iteration process."
-
1881  call errmgr%report_warning("mtx_pinverse", errmsg, &
-
1882  la_convergence_error)
-
1883  return
-
1884  end if
-
1885 
-
1886  ! Determine the threshold tolerance for the singular values such that
-
1887  ! singular values less than the threshold result in zero when inverted.
-
1888  tref = max(m, n) * epsilon(t) * s(1)
-
1889  if (present(tol)) then
-
1890  t = tol
-
1891  else
-
1892  t = tref
-
1893  end if
-
1894  !if (t < safe_denom(t)) then
-
1895  if (t < tolcheck) then
-
1896  ! The supplied tolerance is too small, simply fall back to the
-
1897  ! default, but issue a warning to the user
-
1898  t = tref
-
1899  ! call errmgr%report_warning("pinverse_1", "The supplied tolerance was " // &
-
1900  ! "smaller than a value that would result in an overflow " // &
-
1901  ! "condition, or is negative; therefore, the tolerance has " // &
-
1902  ! "been reset to its default value.")
-
1903  end if
-
1904 
-
1905  ! Compute the pseudoinverse such that pinv(A) = V * inv(S) * U**T by
-
1906  ! first computing V * inv(S) (result is N-by-M), and store in the first
-
1907  ! MN rows of VT in a transposed manner.
-
1908  do i = 1, mn
-
1909  ! Apply 1 / S(I) to VT(I,:)
-
1910  if (s(i) < t) then
-
1911  vt(i,:) = zero
-
1912  else
-
1913  call recip_mult_array(s(i), vt(i,1:n))
-
1914  end if
-
1915  end do
-
1916 
-
1917  ! Compute (VT**T * inv(S)) * U**T
-
1918  call mtx_mult(.true., .true., one, vt(1:mn,:), u, zero, ainv)
-
1919  end subroutine
-
1920 
-
1921 ! ------------------------------------------------------------------------------
-
1922  module subroutine mtx_pinverse_cmplx(a, ainv, tol, work, olwork, rwork, err)
-
1923  ! Arguments
-
1924  complex(real64), intent(inout), dimension(:,:) :: a
-
1925  complex(real64), intent(out), dimension(:,:) :: ainv
-
1926  real(real64), intent(in), optional :: tol
-
1927  complex(real64), intent(out), target, dimension(:), optional :: work
-
1928  integer(int32), intent(out), optional :: olwork
-
1929  real(real64), intent(out), target, dimension(:), optional :: rwork
-
1930  class(errors), intent(inout), optional, target :: err
-
1931 
-
1932  ! External Function Interfaces
-
1933  interface
-
1934  function dlamch(cmach) result(x)
-
1935  use, intrinsic :: iso_fortran_env, only : real64
-
1936  character, intent(in) :: cmach
-
1937  real(real64) :: x
-
1938  end function
-
1939  end interface
-
1940 
-
1941  ! Parameters
-
1942  complex(real64), parameter :: zero = (0.0d0, 0.0d0)
-
1943  complex(real64), parameter :: one = (1.0d0, 0.0d0)
-
1944 
-
1945  ! Local Variables
-
1946  integer(int32) :: i, m, n, mn, lwork, istat, flag, i1, i2a, i2b, i3, &
-
1947  lrwork, j, k
-
1948  real(real64), pointer, dimension(:) :: s, rwptr, rw
-
1949  real(real64), allocatable, target, dimension(:) :: rwrk
-
1950  complex(real64), pointer, dimension(:) :: wptr, w
-
1951  complex(real64), pointer, dimension(:,:) :: u, vt
-
1952  complex(real64), allocatable, target, dimension(:) :: wrk
-
1953  complex(real64) :: temp(1), val
-
1954  real(real64) :: t, tref, tolcheck, rtemp(1)
-
1955  class(errors), pointer :: errmgr
-
1956  type(errors), target :: deferr
-
1957  character(len = 128) :: errmsg
-
1958 
-
1959  ! Initialization
-
1960  m = size(a, 1)
-
1961  n = size(a, 2)
-
1962  mn = min(m, n)
-
1963  lrwork = 6 * mn
-
1964  i1 = m * mn
-
1965  i2a = i1 + 1
-
1966  i2b = i2a + n * n - 1
-
1967  i3 = i2b + 1
-
1968  tolcheck = dlamch('s')
-
1969  if (present(err)) then
-
1970  errmgr => err
-
1971  else
-
1972  errmgr => deferr
-
1973  end if
-
1974 
-
1975  ! Input Check
-
1976  if (size(ainv, 1) /= n .or. size(ainv, 2) /= m) then
-
1977  write(errmsg, '(AI0AI0A)') &
-
1978  "The output matrix AINV is not sized appropriately. " // &
-
1979  "It is expected to be ", n, "-by-", m, "."
-
1980  call errmgr%report_error("mtx_pinverse_cmplx", errmsg, &
-
1981  la_array_size_error)
-
1982  return
-
1983  end if
-
1984 
-
1985  ! Workspace Query
-
1986  call zgesvd('S', 'A', m, n, a, m, a(1:mn,:), a, m, a, n, temp, -1, &
-
1987  rtemp, flag)
-
1988  lwork = int(temp(1), int32)
-
1989  lwork = lwork + m * mn + n * n
-
1990  if (present(olwork)) then
-
1991  olwork = lwork
-
1992  return
-
1993  end if
-
1994 
-
1995  ! Local Memory Allocation
-
1996  if (present(work)) then
-
1997  if (size(work) < lwork) then
-
1998  ! ERROR: WORK not sized correctly
-
1999  call errmgr%report_error("mtx_pinverse_cmplx", &
-
2000  "Incorrectly sized input array WORK, argument 4.", &
-
2001  la_array_size_error)
-
2002  return
-
2003  end if
-
2004  wptr => work(1:lwork)
-
2005  else
-
2006  allocate(wrk(lwork), stat = istat)
-
2007  if (istat /= 0) then
-
2008  ! ERROR: Out of memory
-
2009  call errmgr%report_error("mtx_pinverse_cmplx", &
-
2010  "Insufficient memory available.", &
-
2011  la_out_of_memory_error)
-
2012  return
-
2013  end if
-
2014  wptr => wrk
-
2015  end if
-
2016 
-
2017  if (present(rwork)) then
-
2018  if (size(rwork) < lrwork) then
-
2019  ! ERROR: WORK not sized correctly
-
2020  call errmgr%report_error("mtx_pinverse_cmplx", &
-
2021  "Incorrectly sized input array RWORK, argument 6.", &
-
2022  la_array_size_error)
-
2023  return
-
2024  end if
-
2025  rwptr => rwork(1:lrwork)
-
2026  else
-
2027  allocate(rwrk(lrwork), stat = istat)
-
2028  if (istat /= 0) then
-
2029  ! ERROR: Out of memory
-
2030  call errmgr%report_error("mtx_pinverse_cmplx", &
-
2031  "Insufficient memory available.", &
-
2032  la_out_of_memory_error)
-
2033  return
-
2034  end if
-
2035  rwptr => rwrk
-
2036  end if
-
2037  u(1:m,1:mn) => wptr(1:i1)
-
2038  vt(1:n,1:n) => wptr(i2a:i2b)
-
2039  w => wptr(i3:lwork)
-
2040  s => rwptr(1:mn)
-
2041  rw => rwptr(mn+1:lrwork)
-
2042 
-
2043  ! Compute the SVD of A
-
2044  call zgesvd('S', 'A', m, n, a, m, s, u, m, vt, n, w, size(w), rw, flag)
-
2045 
-
2046  ! Check for convergence
-
2047  if (flag > 0) then
-
2048  write(errmsg, '(I0A)') flag, " superdiagonals could not " // &
-
2049  "converge to zero as part of the QR iteration process."
-
2050  call errmgr%report_warning("mtx_pinverse_cmplx", errmsg, &
-
2051  la_convergence_error)
-
2052  return
-
2053  end if
-
2054 
-
2055  ! Determine the threshold tolerance for the singular values such that
-
2056  ! singular values less than the threshold result in zero when inverted.
-
2057  tref = max(m, n) * epsilon(t) * s(1)
-
2058  if (present(tol)) then
-
2059  t = tol
-
2060  else
-
2061  t = tref
-
2062  end if
-
2063  !if (t < safe_denom(t)) then
-
2064  if (t < tolcheck) then
-
2065  ! The supplied tolerance is too small, simply fall back to the
-
2066  ! default, but issue a warning to the user
-
2067  t = tref
-
2068  ! call errmgr%report_warning("pinverse_1", "The supplied tolerance was " // &
-
2069  ! "smaller than a value that would result in an overflow " // &
-
2070  ! "condition, or is negative; therefore, the tolerance has " // &
-
2071  ! "been reset to its default value.")
-
2072  end if
-
2073 
-
2074  ! Compute the pseudoinverse such that pinv(A) = V * inv(S) * U**T by
-
2075  ! first computing V * inv(S) (result is N-by-M), and store in the first
-
2076  ! MN rows of VT in a transposed manner.
-
2077  do i = 1, mn
-
2078  ! Apply 1 / S(I) to VT(I,:)
-
2079  if (s(i) < t) then
-
2080  vt(i,:) = zero
-
2081  else
-
2082  ! call recip_mult_array(s(i), vt(i,1:n))
-
2083  vt(i,1:n) = conjg(vt(i,1:n)) / s(i)
-
2084  end if
-
2085  end do
-
2086 
-
2087  ! Compute (VT**T * inv(S)) * U**H
-
2088  ! ainv = n-by-m
-
2089  ! vt is n-by-n
-
2090  ! u is m-by-mn such that u**H = mn-by-m
-
2091  ! Compute ainv = vt**T * u**H
-
2092  do j = 1, m
-
2093  do i = 1, n
-
2094  val = zero
-
2095  do k = 1, mn
-
2096  val = val + vt(k,i) * conjg(u(j,k))
-
2097  end do
-
2098  ainv(i,j) = val
-
2099  end do
-
2100  end do
-
2101  end subroutine
-
2102 
-
2103 ! ******************************************************************************
-
2104 ! LEAST SQUARES SOLUTION ROUTINES
-
2105 ! ------------------------------------------------------------------------------
-
2106  module subroutine solve_least_squares_mtx(a, b, work, olwork, err)
-
2107  ! Arguments
-
2108  real(real64), intent(inout), dimension(:,:) :: a, b
-
2109  real(real64), intent(out), target, optional, dimension(:) :: work
-
2110  integer(int32), intent(out), optional :: olwork
-
2111  class(errors), intent(inout), optional, target :: err
-
2112 
-
2113  ! Local Variables
-
2114  integer(int32) :: m, n, maxmn, nrhs, lwork, istat, flag
-
2115  real(real64), pointer, dimension(:) :: wptr
-
2116  real(real64), allocatable, target, dimension(:) :: wrk
-
2117  real(real64), dimension(1) :: temp
-
2118  class(errors), pointer :: errmgr
-
2119  type(errors), target :: deferr
-
2120 
-
2121  ! Initialization
-
2122  m = size(a, 1)
-
2123  n = size(a, 2)
-
2124  maxmn = max(m, n)
-
2125  nrhs = size(b, 2)
-
2126  if (present(err)) then
-
2127  errmgr => err
-
2128  else
-
2129  errmgr => deferr
-
2130  end if
-
2131 
-
2132  ! Input Check
-
2133  if (size(b, 1) /= maxmn) then
-
2134  call errmgr%report_error("solve_least_squares_mtx", &
-
2135  "Input 2 is not sized correctly.", la_array_size_error)
-
2136  return
-
2137  end if
-
2138 
-
2139  ! Workspace Query
-
2140  call dgels('N', m, n, nrhs, a, m, b, maxmn, temp, -1, flag)
-
2141  lwork = int(temp(1), int32)
-
2142  if (present(olwork)) then
-
2143  olwork = lwork
-
2144  return
-
2145  end if
-
2146 
-
2147  ! Local Memory Allocation
-
2148  if (present(work)) then
-
2149  if (size(work) < lwork) then
-
2150  ! ERROR: WORK not sized correctly
-
2151  call errmgr%report_error("solve_least_squares_mtx", &
-
2152  "Incorrectly sized input array WORK, argument 3.", &
-
2153  la_array_size_error)
-
2154  return
-
2155  end if
-
2156  wptr => work(1:lwork)
-
2157  else
-
2158  allocate(wrk(lwork), stat = istat)
-
2159  if (istat /= 0) then
-
2160  ! ERROR: Out of memory
-
2161  call errmgr%report_error("solve_least_squares_mtx", &
-
2162  "Insufficient memory available.", &
-
2163  la_out_of_memory_error)
-
2164  return
-
2165  end if
-
2166  wptr => wrk
-
2167  end if
-
2168 
-
2169  ! Process
-
2170  call dgels('N', m, n, nrhs, a, m, b, maxmn, wptr, lwork, flag)
-
2171  if (flag > 0) then
-
2172  call errmgr%report_error("solve_least_squares_mtx", &
-
2173  "The supplied matrix is not of full rank; therefore, " // &
-
2174  "the solution could not be computed via this routine. " // &
-
2175  "Try a routine that utilizes column pivoting.", &
-
2176  la_invalid_operation_error)
-
2177  end if
-
2178  end subroutine
-
2179 
-
2180 ! ------------------------------------------------------------------------------
-
2181  module subroutine solve_least_squares_mtx_cmplx(a, b, work, olwork, err)
-
2182  ! Arguments
-
2183  complex(real64), intent(inout), dimension(:,:) :: a, b
-
2184  complex(real64), intent(out), target, optional, dimension(:) :: work
-
2185  integer(int32), intent(out), optional :: olwork
-
2186  class(errors), intent(inout), optional, target :: err
-
2187 
-
2188  ! Local Variables
-
2189  integer(int32) :: m, n, maxmn, nrhs, lwork, istat, flag
-
2190  complex(real64), pointer, dimension(:) :: wptr
-
2191  complex(real64), allocatable, target, dimension(:) :: wrk
-
2192  complex(real64), dimension(1) :: temp
-
2193  class(errors), pointer :: errmgr
-
2194  type(errors), target :: deferr
-
2195 
-
2196  ! Initialization
-
2197  m = size(a, 1)
-
2198  n = size(a, 2)
-
2199  maxmn = max(m, n)
-
2200  nrhs = size(b, 2)
-
2201  if (present(err)) then
-
2202  errmgr => err
-
2203  else
-
2204  errmgr => deferr
-
2205  end if
-
2206 
-
2207  ! Input Check
-
2208  if (size(b, 1) /= maxmn) then
-
2209  call errmgr%report_error("solve_least_squares_mtx_cmplx", &
-
2210  "Input 2 is not sized correctly.", la_array_size_error)
-
2211  return
-
2212  end if
-
2213 
-
2214  ! Workspace Query
-
2215  call zgels('N', m, n, nrhs, a, m, b, maxmn, temp, -1, flag)
-
2216  lwork = int(temp(1), int32)
-
2217  if (present(olwork)) then
-
2218  olwork = lwork
-
2219  return
-
2220  end if
-
2221 
-
2222  ! Local Memory Allocation
-
2223  if (present(work)) then
-
2224  if (size(work) < lwork) then
-
2225  ! ERROR: WORK not sized correctly
-
2226  call errmgr%report_error("solve_least_squares_mtx_cmplx", &
-
2227  "Incorrectly sized input array WORK, argument 3.", &
-
2228  la_array_size_error)
-
2229  return
-
2230  end if
-
2231  wptr => work(1:lwork)
-
2232  else
-
2233  allocate(wrk(lwork), stat = istat)
-
2234  if (istat /= 0) then
-
2235  ! ERROR: Out of memory
-
2236  call errmgr%report_error("solve_least_squares_mtx_cmplx", &
-
2237  "Insufficient memory available.", &
-
2238  la_out_of_memory_error)
-
2239  return
-
2240  end if
-
2241  wptr => wrk
-
2242  end if
-
2243 
-
2244  ! Process
-
2245  call zgels('N', m, n, nrhs, a, m, b, maxmn, wptr, lwork, flag)
-
2246  if (flag > 0) then
-
2247  call errmgr%report_error("solve_least_squares_mtx_cmplx", &
-
2248  "The supplied matrix is not of full rank; therefore, " // &
-
2249  "the solution could not be computed via this routine. " // &
-
2250  "Try a routine that utilizes column pivoting.", &
-
2251  la_invalid_operation_error)
-
2252  end if
-
2253  end subroutine
-
2254 
-
2255 ! ------------------------------------------------------------------------------
-
2256  module subroutine solve_least_squares_vec(a, b, work, olwork, err)
-
2257  ! Arguments
-
2258  real(real64), intent(inout), dimension(:,:) :: a
-
2259  real(real64), intent(inout), dimension(:) :: b
-
2260  real(real64), intent(out), target, optional, dimension(:) :: work
-
2261  integer(int32), intent(out), optional :: olwork
-
2262  class(errors), intent(inout), optional, target :: err
-
2263 
-
2264  ! Local Variables
-
2265  integer(int32) :: m, n, maxmn, lwork, istat, flag
-
2266  real(real64), pointer, dimension(:) :: wptr
-
2267  real(real64), allocatable, target, dimension(:) :: wrk
-
2268  real(real64), dimension(1) :: temp
-
2269  class(errors), pointer :: errmgr
-
2270  type(errors), target :: deferr
-
2271 
-
2272  ! Initialization
-
2273  m = size(a, 1)
-
2274  n = size(a, 2)
-
2275  maxmn = max(m, n)
-
2276  if (present(err)) then
-
2277  errmgr => err
-
2278  else
-
2279  errmgr => deferr
-
2280  end if
-
2281 
-
2282  ! Input Check
-
2283  if (size(b) /= maxmn) then
-
2284  call errmgr%report_error("solve_least_squares_vec", &
-
2285  "Input 2 is not sized correctly.", la_array_size_error)
-
2286  return
-
2287  end if
-
2288 
-
2289  ! Workspace Query
-
2290  call dgels('N', m, n, 1, a, m, b, maxmn, temp, -1, flag)
-
2291  lwork = int(temp(1), int32)
-
2292  if (present(olwork)) then
-
2293  olwork = lwork
-
2294  return
-
2295  end if
-
2296 
-
2297  ! Local Memory Allocation
-
2298  if (present(work)) then
-
2299  if (size(work) < lwork) then
-
2300  ! ERROR: WORK not sized correctly
-
2301  call errmgr%report_error("solve_least_squares_vec", &
-
2302  "Incorrectly sized input array WORK, argument 3.", &
-
2303  la_array_size_error)
-
2304  return
-
2305  end if
-
2306  wptr => work(1:lwork)
-
2307  else
-
2308  allocate(wrk(lwork), stat = istat)
-
2309  if (istat /= 0) then
-
2310  ! ERROR: Out of memory
-
2311  call errmgr%report_error("solve_least_squares_vec", &
-
2312  "Insufficient memory available.", &
-
2313  la_out_of_memory_error)
-
2314  return
-
2315  end if
-
2316  wptr => wrk
-
2317  end if
-
2318 
-
2319  ! Process
-
2320  call dgels('N', m, n, 1, a, m, b, maxmn, wptr, lwork, flag)
-
2321  if (flag > 0) then
-
2322  call errmgr%report_error("solve_least_squares_mtx", &
-
2323  "The supplied matrix is not of full rank; therefore, " // &
-
2324  "the solution could not be computed via this routine. " // &
-
2325  "Try a routine that utilizes column pivoting.", &
-
2326  la_invalid_operation_error)
-
2327  end if
-
2328  end subroutine
-
2329 
-
2330 ! ------------------------------------------------------------------------------
-
2331  module subroutine solve_least_squares_vec_cmplx(a, b, work, olwork, err)
-
2332  ! Arguments
-
2333  complex(real64), intent(inout), dimension(:,:) :: a
-
2334  complex(real64), intent(inout), dimension(:) :: b
-
2335  complex(real64), intent(out), target, optional, dimension(:) :: work
-
2336  integer(int32), intent(out), optional :: olwork
-
2337  class(errors), intent(inout), optional, target :: err
-
2338 
-
2339  ! Local Variables
-
2340  integer(int32) :: m, n, maxmn, lwork, istat, flag
-
2341  complex(real64), pointer, dimension(:) :: wptr
-
2342  complex(real64), allocatable, target, dimension(:) :: wrk
-
2343  complex(real64), dimension(1) :: temp
-
2344  class(errors), pointer :: errmgr
-
2345  type(errors), target :: deferr
-
2346 
-
2347  ! Initialization
-
2348  m = size(a, 1)
-
2349  n = size(a, 2)
-
2350  maxmn = max(m, n)
-
2351  if (present(err)) then
-
2352  errmgr => err
-
2353  else
-
2354  errmgr => deferr
-
2355  end if
-
2356 
-
2357  ! Input Check
-
2358  if (size(b) /= maxmn) then
-
2359  call errmgr%report_error("solve_least_squares_vec_cmplx", &
-
2360  "Input 2 is not sized correctly.", la_array_size_error)
-
2361  return
-
2362  end if
-
2363 
-
2364  ! Workspace Query
-
2365  call zgels('N', m, n, 1, a, m, b, maxmn, temp, -1, flag)
-
2366  lwork = int(temp(1), int32)
-
2367  if (present(olwork)) then
-
2368  olwork = lwork
-
2369  return
-
2370  end if
-
2371 
-
2372  ! Local Memory Allocation
-
2373  if (present(work)) then
-
2374  if (size(work) < lwork) then
-
2375  ! ERROR: WORK not sized correctly
-
2376  call errmgr%report_error("solve_least_squares_vec_cmplx", &
-
2377  "Incorrectly sized input array WORK, argument 3.", &
-
2378  la_array_size_error)
-
2379  return
-
2380  end if
-
2381  wptr => work(1:lwork)
-
2382  else
-
2383  allocate(wrk(lwork), stat = istat)
-
2384  if (istat /= 0) then
-
2385  ! ERROR: Out of memory
-
2386  call errmgr%report_error("solve_least_squares_vec_cmplx", &
-
2387  "Insufficient memory available.", &
-
2388  la_out_of_memory_error)
-
2389  return
-
2390  end if
-
2391  wptr => wrk
-
2392  end if
-
2393 
-
2394  ! Process
-
2395  call zgels('N', m, n, 1, a, m, b, maxmn, wptr, lwork, flag)
-
2396  if (flag > 0) then
-
2397  call errmgr%report_error("solve_least_squares_mtx_cmplx", &
-
2398  "The supplied matrix is not of full rank; therefore, " // &
-
2399  "the solution could not be computed via this routine. " // &
-
2400  "Try a routine that utilizes column pivoting.", &
-
2401  la_invalid_operation_error)
-
2402  end if
-
2403  end subroutine
-
2404 
-
2405 ! ------------------------------------------------------------------------------
-
2406  module subroutine solve_least_squares_mtx_pvt(a, b, ipvt, arnk, work, olwork, err)
-
2407  ! Arguments
-
2408  real(real64), intent(inout), dimension(:,:) :: a, b
-
2409  integer(int32), intent(inout), target, optional, dimension(:) :: ipvt
-
2410  integer(int32), intent(out), optional :: arnk
-
2411  real(real64), intent(out), target, optional, dimension(:) :: work
-
2412  integer(int32), intent(out), optional :: olwork
-
2413  class(errors), intent(inout), optional, target :: err
-
2414 
-
2415  ! Local Variables
-
2416  integer(int32) :: m, n, maxmn, nrhs, lwork, istat, flag, rnk
-
2417  real(real64), pointer, dimension(:) :: wptr
-
2418  real(real64), allocatable, target, dimension(:) :: wrk
-
2419  integer(int32), allocatable, target, dimension(:) :: iwrk
-
2420  integer(int32), pointer, dimension(:) :: iptr
-
2421  real(real64), dimension(1) :: temp
-
2422  integer(int32), dimension(1) :: itemp
-
2423  real(real64) :: rc
-
2424  class(errors), pointer :: errmgr
-
2425  type(errors), target :: deferr
-
2426  character(len = 128) :: errmsg
-
2427 
-
2428  ! Initialization
-
2429  m = size(a, 1)
-
2430  n = size(a, 2)
-
2431  maxmn = max(m, n)
-
2432  nrhs = size(b, 2)
-
2433  rc = epsilon(rc)
-
2434  if (present(arnk)) arnk = 0
-
2435  if (present(err)) then
-
2436  errmgr => err
-
2437  else
-
2438  errmgr => deferr
-
2439  end if
-
2440 
-
2441  ! Input Check
-
2442  flag = 0
-
2443  if (size(b, 1) /= maxmn) then
-
2444  flag = 2
-
2445  end if
-
2446  if (flag /= 0) then
-
2447  write(errmsg, '(AI0A)') "Input number ", flag, &
-
2448  " is not sized correctly."
-
2449  call errmgr%report_error("solve_least_squares_mtx_pvt", &
-
2450  trim(errmsg), la_array_size_error)
-
2451  return
-
2452  end if
-
2453 
-
2454  ! Workspace Query
-
2455  call dgelsy(m, n, nrhs, a, m, b, maxmn, itemp, rc, rnk, temp, -1, flag)
-
2456  lwork = int(temp(1), int32)
-
2457  if (present(olwork)) then
-
2458  olwork = lwork
-
2459  return
-
2460  end if
-
2461 
-
2462  ! Local Memory Allocation
-
2463  if (present(ipvt)) then
-
2464  if (size(ipvt) < n) then
-
2465  ! ERROR: IPVT is not big enough
-
2466  call errmgr%report_error("solve_least_squares_mtx_pvt", &
-
2467  "Incorrectly sized pivot array, argument 3.", &
-
2468  la_array_size_error)
-
2469  return
-
2470  end if
-
2471  iptr => ipvt(1:n)
-
2472  else
-
2473  allocate(iwrk(n), stat = istat)
-
2474  if (istat /= 0) then
-
2475  ! ERROR: Out of memory
-
2476  call errmgr%report_error("solve_least_squares_mtx_pvt", &
-
2477  "Insufficient memory available.", &
-
2478  la_out_of_memory_error)
-
2479  return
-
2480  end if
-
2481  iptr => iwrk
-
2482  iptr = 0
-
2483  end if
-
2484 
-
2485  if (present(work)) then
-
2486  if (size(work) < lwork) then
-
2487  ! ERROR: WORK not sized correctly
-
2488  call errmgr%report_error("solve_least_squares_mtx_pvt", &
-
2489  "Incorrectly sized input array WORK, argument 5.", &
-
2490  la_array_size_error)
-
2491  return
-
2492  end if
-
2493  wptr => work(1:lwork)
-
2494  else
-
2495  allocate(wrk(lwork), stat = istat)
-
2496  if (istat /= 0) then
-
2497  ! ERROR: Out of memory
-
2498  call errmgr%report_error("solve_least_squares_mtx_pvt", &
-
2499  "Insufficient memory available.", &
-
2500  la_out_of_memory_error)
-
2501  return
-
2502  end if
-
2503  wptr => wrk
-
2504  end if
-
2505 
-
2506  ! Process
-
2507  call dgelsy(m, n, nrhs, a, m, b, maxmn, iptr, rc, rnk, wptr, lwork, &
-
2508  flag)
-
2509  if (present(arnk)) arnk = rnk
-
2510  end subroutine
-
2511 
-
2512 ! ------------------------------------------------------------------------------
-
2513  module subroutine solve_least_squares_mtx_pvt_cmplx(a, b, ipvt, arnk, &
-
2514  work, olwork, rwork, err)
-
2515  ! Arguments
-
2516  complex(real64), intent(inout), dimension(:,:) :: a, b
-
2517  integer(int32), intent(inout), target, optional, dimension(:) :: ipvt
-
2518  integer(int32), intent(out), optional :: arnk
-
2519  complex(real64), intent(out), target, optional, dimension(:) :: work
-
2520  integer(int32), intent(out), optional :: olwork
-
2521  real(real64), intent(out), target, optional, dimension(:) :: rwork
-
2522  class(errors), intent(inout), optional, target :: err
-
2523 
-
2524  ! Local Variables
-
2525  integer(int32) :: m, n, maxmn, nrhs, lwork, istat, flag, rnk, lrwork
-
2526  complex(real64), pointer, dimension(:) :: wptr
-
2527  complex(real64), allocatable, target, dimension(:) :: wrk
-
2528  real(real64), pointer, dimension(:) :: rwptr
-
2529  real(real64), allocatable, target, dimension(:) :: rwrk
-
2530  integer(int32), allocatable, target, dimension(:) :: iwrk
-
2531  integer(int32), pointer, dimension(:) :: iptr
-
2532  complex(real64), dimension(1) :: temp
-
2533  real(real64), dimension(1) :: rtemp
-
2534  integer(int32), dimension(1) :: itemp
-
2535  real(real64) :: rc
-
2536  class(errors), pointer :: errmgr
-
2537  type(errors), target :: deferr
-
2538  character(len = 128) :: errmsg
-
2539 
-
2540  ! Initialization
-
2541  m = size(a, 1)
-
2542  n = size(a, 2)
-
2543  maxmn = max(m, n)
-
2544  nrhs = size(b, 2)
-
2545  lrwork = 2 * n
-
2546  rc = epsilon(rc)
-
2547  if (present(arnk)) arnk = 0
-
2548  if (present(err)) then
-
2549  errmgr => err
-
2550  else
-
2551  errmgr => deferr
-
2552  end if
-
2553 
-
2554  ! Input Check
-
2555  flag = 0
-
2556  if (size(b, 1) /= maxmn) then
-
2557  flag = 2
-
2558  end if
-
2559  if (flag /= 0) then
-
2560  write(errmsg, '(AI0A)') "Input number ", flag, &
-
2561  " is not sized correctly."
-
2562  call errmgr%report_error("solve_least_squares_mtx_pvt_cmplx", &
-
2563  trim(errmsg), la_array_size_error)
-
2564  return
-
2565  end if
-
2566 
-
2567  ! Workspace Query
-
2568  call zgelsy(m, n, nrhs, a, m, b, maxmn, itemp, rc, rnk, temp, -1, &
-
2569  rtemp, flag)
-
2570  lwork = int(temp(1), int32)
-
2571  if (present(olwork)) then
-
2572  olwork = lwork
-
2573  return
-
2574  end if
-
2575 
-
2576  ! Local Memory Allocation
-
2577  if (present(ipvt)) then
-
2578  if (size(ipvt) < n) then
-
2579  ! ERROR: IPVT is not big enough
-
2580  call errmgr%report_error("solve_least_squares_mtx_pvt", &
-
2581  "Incorrectly sized pivot array, argument 3.", &
-
2582  la_array_size_error)
-
2583  return
-
2584  end if
-
2585  iptr => ipvt(1:n)
-
2586  else
-
2587  allocate(iwrk(n), stat = istat)
-
2588  if (istat /= 0) then
-
2589  ! ERROR: Out of memory
-
2590  call errmgr%report_error("solve_least_squares_mtx_pvt", &
-
2591  "Insufficient memory available.", &
-
2592  la_out_of_memory_error)
-
2593  return
-
2594  end if
-
2595  iptr => iwrk
-
2596  iptr = 0
-
2597  end if
-
2598 
-
2599  if (present(work)) then
-
2600  if (size(work) < lwork) then
-
2601  ! ERROR: WORK not sized correctly
-
2602  call errmgr%report_error("solve_least_squares_mtx_pvt", &
-
2603  "Incorrectly sized input array WORK, argument 5.", &
-
2604  la_array_size_error)
-
2605  return
-
2606  end if
-
2607  wptr => work(1:lwork)
-
2608  else
-
2609  allocate(wrk(lwork), stat = istat)
-
2610  if (istat /= 0) then
-
2611  ! ERROR: Out of memory
-
2612  call errmgr%report_error("solve_least_squares_mtx_pvt", &
-
2613  "Insufficient memory available.", &
-
2614  la_out_of_memory_error)
-
2615  return
-
2616  end if
-
2617  wptr => wrk
-
2618  end if
-
2619 
-
2620  if (present(rwork)) then
-
2621  if (size(rwork) < lrwork) then
-
2622  ! ERROR: RWORK not sized correctly
-
2623  call errmgr%report_error("solve_least_squares_mtx_pvt_cmplx", &
-
2624  "Incorrectly sized input array RWORK, argument 7.", &
-
2625  la_array_size_error)
-
2626  return
-
2627  end if
-
2628  rwptr => rwork(1:lrwork)
-
2629  else
-
2630  allocate(rwrk(lrwork), stat = istat)
-
2631  if (istat /= 0) then
-
2632  ! ERROR: Out of memory
-
2633  call errmgr%report_error("solve_least_squares_mtx_pvt_cmplx", &
-
2634  "Insufficient memory available.", &
-
2635  la_out_of_memory_error)
-
2636  return
-
2637  end if
-
2638  rwptr => rwrk
-
2639  end if
-
2640 
-
2641  ! Process
-
2642  call zgelsy(m, n, nrhs, a, m, b, maxmn, iptr, rc, rnk, wptr, lwork, &
-
2643  rwptr, flag)
-
2644  if (present(arnk)) arnk = rnk
-
2645  end subroutine
-
2646 
-
2647 ! ------------------------------------------------------------------------------
-
2648  module subroutine solve_least_squares_vec_pvt(a, b, ipvt, arnk, work, olwork, err)
-
2649  ! Arguments
-
2650  real(real64), intent(inout), dimension(:,:) :: a
-
2651  real(real64), intent(inout), dimension(:) :: b
-
2652  integer(int32), intent(inout), target, optional, dimension(:) :: ipvt
-
2653  integer(int32), intent(out), optional :: arnk
-
2654  real(real64), intent(out), target, optional, dimension(:) :: work
-
2655  integer(int32), intent(out), optional :: olwork
-
2656  class(errors), intent(inout), optional, target :: err
-
2657 
-
2658  ! Local Variables
-
2659  integer(int32) :: m, n, maxmn, lwork, istat, flag, rnk
-
2660  real(real64), pointer, dimension(:) :: wptr
-
2661  real(real64), allocatable, target, dimension(:) :: wrk
-
2662  integer(int32), allocatable, target, dimension(:) :: iwrk
-
2663  integer(int32), pointer, dimension(:) :: iptr
-
2664  real(real64), dimension(1) :: temp
-
2665  integer(int32), dimension(1) :: itemp
-
2666  real(real64) :: rc
-
2667  class(errors), pointer :: errmgr
-
2668  type(errors), target :: deferr
-
2669  character(len = 128) :: errmsg
-
2670 
-
2671  ! Initialization
-
2672  m = size(a, 1)
-
2673  n = size(a, 2)
-
2674  maxmn = max(m, n)
-
2675  rc = epsilon(rc)
-
2676  if (present(arnk)) arnk = 0
-
2677  if (present(err)) then
-
2678  errmgr => err
-
2679  else
-
2680  errmgr => deferr
-
2681  end if
-
2682 
-
2683  ! Input Check
-
2684  flag = 0
-
2685  if (size(b, 1) /= maxmn) then
-
2686  flag = 2
-
2687  end if
-
2688  if (flag /= 0) then
-
2689  write(errmsg, '(AI0A)') "Input number ", flag, &
-
2690  " is not sized correctly."
-
2691  call errmgr%report_error("solve_least_squares_vec_pvt", &
-
2692  trim(errmsg), la_array_size_error)
-
2693  return
-
2694  end if
-
2695 
-
2696  ! Workspace Query
-
2697  call dgelsy(m, n, 1, a, m, b, maxmn, itemp, rc, rnk, temp, -1, flag)
-
2698  lwork = int(temp(1), int32)
-
2699  if (present(olwork)) then
-
2700  olwork = lwork
-
2701  return
-
2702  end if
-
2703 
-
2704  ! Local Memory Allocation
-
2705  if (present(ipvt)) then
-
2706  if (size(ipvt) < n) then
-
2707  ! ERROR: IPVT is not big enough
-
2708  call errmgr%report_error("solve_least_squares_mtx_pvt", &
-
2709  "Incorrectly sized pivot array, argument 3.", &
-
2710  la_array_size_error)
-
2711  return
-
2712  end if
-
2713  iptr => ipvt(1:n)
-
2714  else
-
2715  allocate(iwrk(n), stat = istat)
-
2716  if (istat /= 0) then
-
2717  ! ERROR: Out of memory
-
2718  call errmgr%report_error("solve_least_squares_mtx_pvt", &
-
2719  "Insufficient memory available.", &
-
2720  la_out_of_memory_error)
-
2721  return
-
2722  end if
-
2723  iptr => iwrk
-
2724  iptr = 0
-
2725  end if
-
2726 
-
2727  if (present(work)) then
-
2728  if (size(work) < lwork) then
-
2729  ! ERROR: WORK not sized correctly
-
2730  call errmgr%report_error("solve_least_squares_vec_pvt", &
-
2731  "Incorrectly sized input array WORK, argument 5.", &
-
2732  la_array_size_error)
-
2733  return
-
2734  end if
-
2735  wptr => work(1:lwork)
-
2736  else
-
2737  allocate(wrk(lwork), stat = istat)
-
2738  if (istat /= 0) then
-
2739  ! ERROR: Out of memory
-
2740  call errmgr%report_error("solve_least_squares_vec_pvt", &
-
2741  "Insufficient memory available.", &
-
2742  la_out_of_memory_error)
-
2743  return
-
2744  end if
-
2745  wptr => wrk
-
2746  end if
-
2747 
-
2748  ! Process
-
2749  call dgelsy(m, n, 1, a, m, b, maxmn, iptr, rc, rnk, wptr, lwork, flag)
-
2750  if (present(arnk)) arnk = rnk
-
2751  end subroutine
-
2752 
-
2753 ! ------------------------------------------------------------------------------
-
2754  module subroutine solve_least_squares_vec_pvt_cmplx(a, b, ipvt, arnk, &
-
2755  work, olwork, rwork, err)
-
2756  ! Arguments
-
2757  complex(real64), intent(inout), dimension(:,:) :: a
-
2758  complex(real64), intent(inout), dimension(:) :: b
-
2759  integer(int32), intent(inout), target, optional, dimension(:) :: ipvt
-
2760  integer(int32), intent(out), optional :: arnk
-
2761  complex(real64), intent(out), target, optional, dimension(:) :: work
-
2762  integer(int32), intent(out), optional :: olwork
-
2763  real(real64), intent(out), target, optional, dimension(:) :: rwork
-
2764  class(errors), intent(inout), optional, target :: err
-
2765 
-
2766  ! Local Variables
-
2767  integer(int32) :: m, n, maxmn, lwork, istat, flag, rnk
-
2768  complex(real64), pointer, dimension(:) :: wptr
-
2769  complex(real64), allocatable, target, dimension(:) :: wrk
-
2770  real(real64), pointer, dimension(:) :: rwptr
-
2771  real(real64), allocatable, target, dimension(:) :: rwrk
-
2772  integer(int32), allocatable, target, dimension(:) :: iwrk
-
2773  integer(int32), pointer, dimension(:) :: iptr
-
2774  complex(real64), dimension(1) :: temp
-
2775  real(real64), dimension(1) :: rtemp
-
2776  integer(int32), dimension(1) :: itemp
-
2777  real(real64) :: rc
-
2778  class(errors), pointer :: errmgr
-
2779  type(errors), target :: deferr
-
2780  character(len = 128) :: errmsg
-
2781 
-
2782  ! Initialization
-
2783  m = size(a, 1)
-
2784  n = size(a, 2)
-
2785  maxmn = max(m, n)
-
2786  lrwork = 2 * n
-
2787  rc = epsilon(rc)
-
2788  if (present(arnk)) arnk = 0
-
2789  if (present(err)) then
-
2790  errmgr => err
-
2791  else
-
2792  errmgr => deferr
-
2793  end if
-
2794 
-
2795  ! Input Check
-
2796  flag = 0
-
2797  if (size(b, 1) /= maxmn) then
-
2798  flag = 2
-
2799  end if
-
2800  if (flag /= 0) then
-
2801  write(errmsg, '(AI0A)') "Input number ", flag, &
-
2802  " is not sized correctly."
-
2803  call errmgr%report_error("solve_least_squares_vec_pvt_cmplx", &
-
2804  trim(errmsg), la_array_size_error)
-
2805  return
-
2806  end if
-
2807 
-
2808  ! Workspace Query
-
2809  call zgelsy(m, n, 1, a, m, b, maxmn, itemp, rc, rnk, temp, -1, rtemp, &
-
2810  flag)
-
2811  lwork = int(temp(1), int32)
-
2812  if (present(olwork)) then
-
2813  olwork = lwork
-
2814  return
-
2815  end if
-
2816 
-
2817  ! Local Memory Allocation
-
2818  if (present(ipvt)) then
-
2819  if (size(ipvt) < n) then
-
2820  ! ERROR: IPVT is not big enough
-
2821  call errmgr%report_error("solve_least_squares_mtx_pvt", &
-
2822  "Incorrectly sized pivot array, argument 3.", &
-
2823  la_array_size_error)
-
2824  return
-
2825  end if
-
2826  iptr => ipvt(1:n)
-
2827  else
-
2828  allocate(iwrk(n), stat = istat)
-
2829  if (istat /= 0) then
-
2830  ! ERROR: Out of memory
-
2831  call errmgr%report_error("solve_least_squares_mtx_pvt", &
-
2832  "Insufficient memory available.", &
-
2833  la_out_of_memory_error)
-
2834  return
-
2835  end if
-
2836  iptr => iwrk
-
2837  iptr = 0
-
2838  end if
-
2839 
-
2840  if (present(work)) then
-
2841  if (size(work) < lwork) then
-
2842  ! ERROR: WORK not sized correctly
-
2843  call errmgr%report_error("solve_least_squares_vec_pvt_cmplx", &
-
2844  "Incorrectly sized input array WORK, argument 5.", &
-
2845  la_array_size_error)
-
2846  return
-
2847  end if
-
2848  wptr => work(1:lwork)
-
2849  else
-
2850  allocate(wrk(lwork), stat = istat)
-
2851  if (istat /= 0) then
-
2852  ! ERROR: Out of memory
-
2853  call errmgr%report_error("solve_least_squares_vec_pvt_cmplx", &
-
2854  "Insufficient memory available.", &
-
2855  la_out_of_memory_error)
-
2856  return
-
2857  end if
-
2858  wptr => wrk
-
2859  end if
-
2860 
-
2861  if (present(rwork)) then
-
2862  if (size(rwork) < lrwork) then
-
2863  ! ERROR: WORK not sized correctly
-
2864  call errmgr%report_error("solve_least_squares_vec_pvt_cmplx", &
-
2865  "Incorrectly sized input array RWORK, argument 7.", &
-
2866  la_array_size_error)
-
2867  return
-
2868  end if
-
2869  rwptr => rwork(1:lrwork)
-
2870  else
-
2871  allocate(rwrk(lrwork), stat = istat)
-
2872  if (istat /= 0) then
-
2873  ! ERROR: Out of memory
-
2874  call errmgr%report_error("solve_least_squares_vec_pvt_cmplx", &
-
2875  "Insufficient memory available.", &
-
2876  la_out_of_memory_error)
-
2877  return
-
2878  end if
-
2879  rwptr => rwrk
-
2880  end if
-
2881 
-
2882  ! Process
-
2883  call zgelsy(m, n, 1, a, m, b, maxmn, iptr, rc, rnk, wptr, lwork, &
-
2884  rwptr, flag)
-
2885  if (present(arnk)) arnk = rnk
-
2886  end subroutine
-
2887 
-
2888 ! ------------------------------------------------------------------------------
-
2889  module subroutine solve_least_squares_mtx_svd(a, b, s, arnk, work, olwork, err)
-
2890  ! Arguments
-
2891  real(real64), intent(inout), dimension(:,:) :: a, b
-
2892  integer(int32), intent(out), optional :: arnk
-
2893  real(real64), intent(out), target, optional, dimension(:) :: work, s
-
2894  integer(int32), intent(out), optional :: olwork
-
2895  class(errors), intent(inout), optional, target :: err
-
2896 
-
2897  ! Local Variables
-
2898  integer(int32) :: m, n, nrhs, mn, maxmn, istat, flag, lwork, rnk
-
2899  real(real64), pointer, dimension(:) :: wptr, sptr
-
2900  real(real64), allocatable, target, dimension(:) :: wrk, sing
-
2901  real(real64), dimension(1) :: temp
-
2902  real(real64) :: rcond
-
2903  class(errors), pointer :: errmgr
-
2904  type(errors), target :: deferr
-
2905  character(len = 128) :: errmsg
-
2906 
-
2907  ! Initialization
-
2908  m = size(a, 1)
-
2909  n = size(a, 2)
-
2910  nrhs = size(b, 2)
-
2911  mn = min(m, n)
-
2912  maxmn = max(m, n)
-
2913  rcond = epsilon(rcond)
-
2914  if (present(arnk)) arnk = 0
-
2915  if (present(err)) then
-
2916  errmgr => err
-
2917  else
-
2918  errmgr => deferr
-
2919  end if
-
2920 
-
2921  ! Input Check
-
2922  flag = 0
-
2923  if (size(b, 1) /= maxmn) then
-
2924  flag = 2
-
2925  end if
-
2926  if (flag /= 0) then
-
2927  ! ERROR: One of the input arrays is not sized correctly
-
2928  write(errmsg, '(AI0A)') "Input number ", flag, &
-
2929  " is not sized correctly."
-
2930  call errmgr%report_error("solve_least_squares_mtx_svd", &
-
2931  trim(errmsg), la_array_size_error)
-
2932  return
-
2933  end if
-
2934 
-
2935  ! Workspace Query
-
2936  call dgelss(m, n, nrhs, a, m, b, maxmn, temp, rcond, rnk, temp, -1, &
-
2937  flag)
-
2938  lwork = int(temp(1), int32)
-
2939  if (present(olwork)) then
-
2940  olwork = lwork
-
2941  return
-
2942  end if
-
2943 
-
2944  ! Local Memory Allocation
-
2945  if (present(s)) then
-
2946  if (size(s) < mn) then
-
2947  ! ERROR: S not sized correctly
-
2948  call errmgr%report_error("solve_least_squares_mtx_svd", &
-
2949  "Incorrectly sized input array S, argument 3.", &
-
2950  la_array_size_error)
-
2951  return
-
2952  end if
-
2953  sptr => s(1:mn)
-
2954  else
-
2955  allocate(sing(mn), stat = istat)
-
2956  if (istat /= 0) then
-
2957  ! ERROR: Out of memory
-
2958  call errmgr%report_error("solve_least_squares_mtx_svd", &
-
2959  "Insufficient memory available.", &
-
2960  la_out_of_memory_error)
-
2961  return
-
2962  end if
-
2963  sptr => sing
-
2964  end if
-
2965 
-
2966  if (present(work)) then
-
2967  if (size(work) < lwork) then
-
2968  ! ERROR: WORK not sized correctly
-
2969  call errmgr%report_error("solve_least_squares_mtx_svd", &
-
2970  "Incorrectly sized input array WORK, argument 5.", &
-
2971  la_array_size_error)
-
2972  return
-
2973  end if
-
2974  wptr => work(1:lwork)
-
2975  else
-
2976  allocate(wrk(lwork), stat = istat)
-
2977  if (istat /= 0) then
-
2978  ! ERROR: Out of memory
-
2979  call errmgr%report_error("solve_least_squares_mtx_svd", &
-
2980  "Insufficient memory available.", &
-
2981  la_out_of_memory_error)
-
2982  return
-
2983  end if
-
2984  wptr => wrk
-
2985  end if
-
2986 
-
2987  ! Process
-
2988  call dgelss(m, n, nrhs, a, m, b, maxmn, sptr, rcond, rnk, wptr, lwork, &
-
2989  flag)
-
2990  if (present(arnk)) arnk = rnk
-
2991  if (flag > 0) then
-
2992  write(errmsg, '(I0A)') flag, " superdiagonals could not " // &
-
2993  "converge to zero as part of the QR iteration process."
-
2994  call errmgr%report_warning("solve_least_squares_mtx_svd", errmsg, &
-
2995  la_convergence_error)
-
2996  end if
-
2997  end subroutine
-
2998 
-
2999 ! ------------------------------------------------------------------------------
-
3000  module subroutine solve_least_squares_mtx_svd_cmplx(a, b, s, arnk, work, &
-
3001  olwork, rwork, err)
-
3002  ! Arguments
-
3003  complex(real64), intent(inout), dimension(:,:) :: a, b
-
3004  integer(int32), intent(out), optional :: arnk
-
3005  complex(real64), intent(out), target, optional, dimension(:) :: work
-
3006  real(real64), intent(out), target, optional, dimension(:) :: s, rwork
-
3007  integer(int32), intent(out), optional :: olwork
-
3008  class(errors), intent(inout), optional, target :: err
-
3009 
-
3010  ! Local Variables
-
3011  integer(int32) :: m, n, nrhs, mn, maxmn, istat, flag, lwork, rnk, lrwork
-
3012  complex(real64), pointer, dimension(:) :: wptr
-
3013  complex(real64), allocatable, target, dimension(:) :: wrk
-
3014  real(real64), pointer, dimension(:) :: rwptr, sptr
-
3015  real(real64), allocatable, target, dimension(:) :: rwrk, sing
-
3016  complex(real64), dimension(1) :: temp
-
3017  real(real64), dimension(1) :: rtemp
-
3018  real(real64) :: rcond
-
3019  class(errors), pointer :: errmgr
-
3020  type(errors), target :: deferr
-
3021  character(len = 128) :: errmsg
-
3022 
-
3023  ! Initialization
-
3024  m = size(a, 1)
-
3025  n = size(a, 2)
-
3026  nrhs = size(b, 2)
-
3027  mn = min(m, n)
-
3028  lrwork = 5 * mn
-
3029  maxmn = max(m, n)
-
3030  rcond = epsilon(rcond)
-
3031  if (present(arnk)) arnk = 0
-
3032  if (present(err)) then
-
3033  errmgr => err
-
3034  else
-
3035  errmgr => deferr
-
3036  end if
-
3037 
-
3038  ! Input Check
-
3039  flag = 0
-
3040  if (size(b, 1) /= maxmn) then
-
3041  flag = 2
-
3042  end if
-
3043  if (flag /= 0) then
-
3044  ! ERROR: One of the input arrays is not sized correctly
-
3045  write(errmsg, '(AI0A)') "Input number ", flag, &
-
3046  " is not sized correctly."
-
3047  call errmgr%report_error("solve_least_squares_mtx_svd_cmplx", &
-
3048  trim(errmsg), la_array_size_error)
-
3049  return
-
3050  end if
-
3051 
-
3052  ! Workspace Query
-
3053  call zgelss(m, n, nrhs, a, m, b, maxmn, rtemp, rcond, rnk, temp, -1, &
-
3054  rtemp, flag)
-
3055  lwork = int(temp(1), int32)
-
3056  if (present(olwork)) then
-
3057  olwork = lwork
-
3058  return
-
3059  end if
-
3060 
-
3061  ! Local Memory Allocation
-
3062  if (present(s)) then
-
3063  if (size(s) < mn) then
-
3064  ! ERROR: S not sized correctly
-
3065  call errmgr%report_error("solve_least_squares_mtx_svd_cmplx", &
-
3066  "Incorrectly sized input array S, argument 3.", &
-
3067  la_array_size_error)
-
3068  return
-
3069  end if
-
3070  sptr => s(1:mn)
-
3071  else
-
3072  allocate(sing(mn), stat = istat)
-
3073  if (istat /= 0) then
-
3074  ! ERROR: Out of memory
-
3075  call errmgr%report_error("solve_least_squares_mtx_svd_cmplx", &
-
3076  "Insufficient memory available.", &
-
3077  la_out_of_memory_error)
-
3078  return
-
3079  end if
-
3080  sptr => sing
-
3081  end if
-
3082 
-
3083  if (present(work)) then
-
3084  if (size(work) < lwork) then
-
3085  ! ERROR: WORK not sized correctly
-
3086  call errmgr%report_error("solve_least_squares_mtx_svd_cmplx", &
-
3087  "Incorrectly sized input array WORK, argument 5.", &
-
3088  la_array_size_error)
-
3089  return
-
3090  end if
-
3091  wptr => work(1:lwork)
-
3092  else
-
3093  allocate(wrk(lwork), stat = istat)
-
3094  if (istat /= 0) then
-
3095  ! ERROR: Out of memory
-
3096  call errmgr%report_error("solve_least_squares_mtx_svd_cmplx", &
-
3097  "Insufficient memory available.", &
-
3098  la_out_of_memory_error)
-
3099  return
-
3100  end if
-
3101  wptr => wrk
-
3102  end if
-
3103 
-
3104  if (present(rwork)) then
-
3105  if (size(rwork) < lrwork) then
-
3106  ! ERROR: WORK not sized correctly
-
3107  call errmgr%report_error("solve_least_squares_mtx_svd_cmplx", &
-
3108  "Incorrectly sized input array RWORK, argument 7.", &
-
3109  la_array_size_error)
-
3110  return
-
3111  end if
-
3112  rwptr => rwork(1:lrwork)
-
3113  else
-
3114  allocate(rwrk(lrwork), stat = istat)
-
3115  if (istat /= 0) then
-
3116  ! ERROR: Out of memory
-
3117  call errmgr%report_error("solve_least_squares_mtx_svd_cmplx", &
-
3118  "Insufficient memory available.", &
-
3119  la_out_of_memory_error)
-
3120  return
-
3121  end if
-
3122  rwptr => rwrk
-
3123  end if
-
3124 
-
3125  ! Process
-
3126  call zgelss(m, n, nrhs, a, m, b, maxmn, sptr, rcond, rnk, wptr, lwork, &
-
3127  rwptr, flag)
-
3128  if (present(arnk)) arnk = rnk
-
3129  if (flag > 0) then
-
3130  write(errmsg, '(I0A)') flag, " superdiagonals could not " // &
-
3131  "converge to zero as part of the QR iteration process."
-
3132  call errmgr%report_warning("solve_least_squares_mtx_svd_cmplx", &
-
3133  errmsg, la_convergence_error)
-
3134  end if
-
3135  end subroutine
-
3136 
-
3137 ! ------------------------------------------------------------------------------
-
3138  module subroutine solve_least_squares_vec_svd(a, b, s, arnk, work, olwork, err)
-
3139  ! Arguments
-
3140  real(real64), intent(inout), dimension(:,:) :: a
-
3141  real(real64), intent(inout), dimension(:) :: b
-
3142  integer(int32), intent(out), optional :: arnk
-
3143  real(real64), intent(out), target, optional, dimension(:) :: work, s
-
3144  integer(int32), intent(out), optional :: olwork
-
3145  class(errors), intent(inout), optional, target :: err
-
3146 
-
3147  ! Local Variables
-
3148  integer(int32) :: m, n, mn, maxmn, istat, flag, lwork, rnk
-
3149  real(real64), pointer, dimension(:) :: wptr, sptr
-
3150  real(real64), allocatable, target, dimension(:) :: wrk, sing
-
3151  real(real64), dimension(1) :: temp
-
3152  real(real64) :: rcond
-
3153  class(errors), pointer :: errmgr
-
3154  type(errors), target :: deferr
-
3155  character(len = 128) :: errmsg
-
3156 
-
3157  ! Initialization
-
3158  m = size(a, 1)
-
3159  n = size(a, 2)
-
3160  mn = min(m, n)
-
3161  maxmn = max(m, n)
-
3162  rcond = epsilon(rcond)
-
3163  if (present(arnk)) arnk = 0
-
3164  if (present(err)) then
-
3165  errmgr => err
-
3166  else
-
3167  errmgr => deferr
-
3168  end if
-
3169 
-
3170  ! Input Check
-
3171  flag = 0
-
3172  if (size(b) /= maxmn) then
-
3173  flag = 2
-
3174  end if
-
3175  if (flag /= 0) then
-
3176  ! ERROR: One of the input arrays is not sized correctly
-
3177  write(errmsg, '(AI0A)') "Input number ", flag, &
-
3178  " is not sized correctly."
-
3179  call errmgr%report_error("solve_least_squares_vec_svd", &
-
3180  trim(errmsg), la_array_size_error)
-
3181  return
-
3182  end if
-
3183 
-
3184  ! Workspace Query
-
3185  call dgelss(m, n, 1, a, m, b, maxmn, temp, rcond, rnk, temp, -1, flag)
-
3186  lwork = int(temp(1), int32)
-
3187  if (present(olwork)) then
-
3188  olwork = lwork
-
3189  return
-
3190  end if
-
3191 
-
3192  ! Local Memory Allocation
-
3193  if (present(s)) then
-
3194  if (size(s) < mn) then
-
3195  ! ERROR: S not sized correctly
-
3196  call errmgr%report_error("solve_least_squares_vec_svd", &
-
3197  "Incorrectly sized input array S, argument 3.", &
-
3198  la_array_size_error)
-
3199  return
-
3200  end if
-
3201  sptr => s(1:mn)
-
3202  else
-
3203  allocate(sing(mn), stat = istat)
-
3204  if (istat /= 0) then
-
3205  ! ERROR: Out of memory
-
3206  call errmgr%report_error("solve_least_squares_vec_svd", &
-
3207  "Insufficient memory available.", &
-
3208  la_out_of_memory_error)
-
3209  return
-
3210  end if
-
3211  sptr => sing
-
3212  end if
-
3213 
-
3214  if (present(work)) then
-
3215  if (size(work) < lwork) then
-
3216  ! ERROR: WORK not sized correctly
-
3217  call errmgr%report_error("solve_least_squares_vec_svd", &
-
3218  "Incorrectly sized input array WORK, argument 5.", &
-
3219  la_array_size_error)
-
3220  return
-
3221  end if
-
3222  wptr => work(1:lwork)
-
3223  else
-
3224  allocate(wrk(lwork), stat = istat)
-
3225  if (istat /= 0) then
-
3226  ! ERROR: Out of memory
-
3227  call errmgr%report_error("solve_least_squares_vec_svd", &
-
3228  "Insufficient memory available.", &
-
3229  la_out_of_memory_error)
-
3230  return
-
3231  end if
-
3232  wptr => wrk
-
3233  end if
-
3234 
-
3235  ! Process
-
3236  call dgelss(m, n, 1, a, m, b, maxmn, sptr, rcond, rnk, wptr, lwork, &
-
3237  flag)
-
3238  if (present(arnk)) arnk = rnk
-
3239  if (flag > 0) then
-
3240  write(errmsg, '(I0A)') flag, " superdiagonals could not " // &
-
3241  "converge to zero as part of the QR iteration process."
-
3242  call errmgr%report_warning("solve_least_squares_vec_svd", errmsg, &
-
3243  la_convergence_error)
-
3244  end if
-
3245  end subroutine
-
3246 
-
3247 ! ------------------------------------------------------------------------------
-
3248  module subroutine solve_least_squares_vec_svd_cmplx(a, b, s, arnk, work, &
-
3249  olwork, rwork, err)
-
3250  ! Arguments
-
3251  complex(real64), intent(inout), dimension(:,:) :: a
-
3252  complex(real64), intent(inout), dimension(:) :: b
-
3253  integer(int32), intent(out), optional :: arnk
-
3254  complex(real64), intent(out), target, optional, dimension(:) :: work
-
3255  real(real64), intent(out), target, optional, dimension(:) :: rwork, s
-
3256  integer(int32), intent(out), optional :: olwork
-
3257  class(errors), intent(inout), optional, target :: err
-
3258 
-
3259  ! Local Variables
-
3260  integer(int32) :: m, n, mn, maxmn, istat, flag, lwork, rnk, lrwork
-
3261  real(real64), pointer, dimension(:) :: rwptr, sptr
-
3262  real(real64), allocatable, target, dimension(:) :: rwrk, sing
-
3263  complex(real64), pointer, dimension(:) :: wptr
-
3264  complex(real64), allocatable, target, dimension(:) :: wrk
-
3265  complex(real64), dimension(1) :: temp
-
3266  real(real64), dimension(1) :: rtemp
-
3267  real(real64) :: rcond
-
3268  class(errors), pointer :: errmgr
-
3269  type(errors), target :: deferr
-
3270  character(len = 128) :: errmsg
-
3271 
-
3272  ! Initialization
-
3273  m = size(a, 1)
-
3274  n = size(a, 2)
-
3275  mn = min(m, n)
-
3276  lrwork = 5 * mn
-
3277  maxmn = max(m, n)
-
3278  rcond = epsilon(rcond)
-
3279  if (present(arnk)) arnk = 0
-
3280  if (present(err)) then
-
3281  errmgr => err
-
3282  else
-
3283  errmgr => deferr
-
3284  end if
-
3285 
-
3286  ! Input Check
-
3287  flag = 0
-
3288  if (size(b) /= maxmn) then
-
3289  flag = 2
-
3290  end if
-
3291  if (flag /= 0) then
-
3292  ! ERROR: One of the input arrays is not sized correctly
-
3293  write(errmsg, '(AI0A)') "Input number ", flag, &
-
3294  " is not sized correctly."
-
3295  call errmgr%report_error("solve_least_squares_vec_svd_cmplx", &
-
3296  trim(errmsg), la_array_size_error)
-
3297  return
-
3298  end if
-
3299 
-
3300  ! Workspace Query
-
3301  call zgelss(m, n, 1, a, m, b, maxmn, rtemp, rcond, rnk, temp, -1, &
-
3302  rtemp, flag)
-
3303  lwork = int(temp(1), int32)
-
3304  if (present(olwork)) then
-
3305  olwork = lwork
-
3306  return
-
3307  end if
-
3308 
-
3309  ! Local Memory Allocation
-
3310  if (present(s)) then
-
3311  if (size(s) < mn) then
-
3312  ! ERROR: S not sized correctly
-
3313  call errmgr%report_error("solve_least_squares_vec_svd_cmplx", &
-
3314  "Incorrectly sized input array S, argument 3.", &
-
3315  la_array_size_error)
-
3316  return
-
3317  end if
-
3318  sptr => s(1:mn)
-
3319  else
-
3320  allocate(sing(mn), stat = istat)
-
3321  if (istat /= 0) then
-
3322  ! ERROR: Out of memory
-
3323  call errmgr%report_error("solve_least_squares_vec_svd_cmplx", &
-
3324  "Insufficient memory available.", &
-
3325  la_out_of_memory_error)
-
3326  return
-
3327  end if
-
3328  sptr => sing
-
3329  end if
-
3330 
-
3331  if (present(work)) then
-
3332  if (size(work) < lwork) then
-
3333  ! ERROR: WORK not sized correctly
-
3334  call errmgr%report_error("solve_least_squares_vec_svd_cmplx", &
-
3335  "Incorrectly sized input array WORK, argument 5.", &
-
3336  la_array_size_error)
-
3337  return
-
3338  end if
-
3339  wptr => work(1:lwork)
-
3340  else
-
3341  allocate(wrk(lwork), stat = istat)
-
3342  if (istat /= 0) then
-
3343  ! ERROR: Out of memory
-
3344  call errmgr%report_error("solve_least_squares_vec_svd_cmplx", &
-
3345  "Insufficient memory available.", &
-
3346  la_out_of_memory_error)
-
3347  return
-
3348  end if
-
3349  wptr => wrk
-
3350  end if
-
3351 
-
3352  if (present(rwork)) then
-
3353  if (size(rwork) < lrwork) then
-
3354  ! ERROR: WORK not sized correctly
-
3355  call errmgr%report_error("solve_least_squares_vec_svd_cmplx", &
-
3356  "Incorrectly sized input array RWORK, argument 7.", &
-
3357  la_array_size_error)
-
3358  return
-
3359  end if
-
3360  rwptr => rwork(1:lrwork)
-
3361  else
-
3362  allocate(rwrk(lrwork), stat = istat)
-
3363  if (istat /= 0) then
-
3364  ! ERROR: Out of memory
-
3365  call errmgr%report_error("solve_least_squares_vec_svd_cmplx", &
-
3366  "Insufficient memory available.", &
-
3367  la_out_of_memory_error)
-
3368  return
-
3369  end if
-
3370  rwptr => rwrk
-
3371  end if
-
3372 
-
3373  ! Process
-
3374  call zgelss(m, n, 1, a, m, b, maxmn, sptr, rcond, rnk, wptr, lwork, &
-
3375  rwptr, flag)
-
3376  if (present(arnk)) arnk = rnk
-
3377  if (flag > 0) then
-
3378  write(errmsg, '(I0A)') flag, " superdiagonals could not " // &
-
3379  "converge to zero as part of the QR iteration process."
-
3380  call errmgr%report_warning("solve_least_squares_vec_svd_cmplx", &
-
3381  errmsg, la_convergence_error)
-
3382  end if
-
3383  end subroutine
-
3384 
-
3385 end submodule
+
1! linalg_solve.f90
+
2
+
7submodule(linalg_core) linalg_solve
+
8contains
+
9! ******************************************************************************
+
10! TRIANGULAR MATRIX SOLUTION ROUTINES
+
11! ------------------------------------------------------------------------------
+
12 module subroutine solve_tri_mtx(lside, upper, trans, nounit, alpha, a, b, err)
+
13 ! Arguments
+
14 logical, intent(in) :: lside, upper, trans, nounit
+
15 real(real64), intent(in) :: alpha
+
16 real(real64), intent(in), dimension(:,:) :: a
+
17 real(real64), intent(inout), dimension(:,:) :: b
+
18 class(errors), intent(inout), optional, target :: err
+
19
+
20 ! Parameters
+
21 character :: side, uplo, transa, diag
+
22
+
23 ! Local Variables
+
24 integer(int32) :: m, n, nrowa
+
25 class(errors), pointer :: errmgr
+
26 type(errors), target :: deferr
+
27
+
28 ! Initialization
+
29 m = size(b, 1)
+
30 n = size(b, 2)
+
31 if (lside) then
+
32 nrowa = m
+
33 side = 'L'
+
34 else
+
35 nrowa = n
+
36 side = 'R'
+
37 end if
+
38 if (upper) then
+
39 uplo = 'U'
+
40 else
+
41 uplo = 'L'
+
42 end if
+
43 if (trans) then
+
44 transa = 'T'
+
45 else
+
46 transa = 'N'
+
47 end if
+
48 if (nounit) then
+
49 diag = 'N'
+
50 else
+
51 diag = 'U'
+
52 end if
+
53 if (present(err)) then
+
54 errmgr => err
+
55 else
+
56 errmgr => deferr
+
57 end if
+
58
+
59 ! Input Check - matrix A must be square
+
60 if (size(a, 1) /= nrowa .or. size(a, 2) /= nrowa) then
+
61 ! ERROR: A must be square
+
62 call errmgr%report_error("solve_tri_mtx", &
+
63 "The input matrix must be square.", la_array_size_error)
+
64 return
+
65 end if
+
66
+
67 ! Call DTRSM
+
68 call dtrsm(side, uplo, transa, diag, m, n, alpha, a, nrowa, b, m)
+
69 end subroutine
+
70
+
71! ------------------------------------------------------------------------------
+
72 module subroutine solve_tri_mtx_cmplx(lside, upper, trans, nounit, alpha, a, b, err)
+
73 ! Arguments
+
74 logical, intent(in) :: lside, upper, trans, nounit
+
75 complex(real64), intent(in) :: alpha
+
76 complex(real64), intent(in), dimension(:,:) :: a
+
77 complex(real64), intent(inout), dimension(:,:) :: b
+
78 class(errors), intent(inout), optional, target :: err
+
79
+
80 ! Parameters
+
81 character :: side, uplo, transa, diag
+
82
+
83 ! Local Variables
+
84 integer(int32) :: m, n, nrowa
+
85 class(errors), pointer :: errmgr
+
86 type(errors), target :: deferr
+
87
+
88 ! Initialization
+
89 m = size(b, 1)
+
90 n = size(b, 2)
+
91 if (lside) then
+
92 nrowa = m
+
93 side = 'L'
+
94 else
+
95 nrowa = n
+
96 side = 'R'
+
97 end if
+
98 if (upper) then
+
99 uplo = 'U'
+
100 else
+
101 uplo = 'L'
+
102 end if
+
103 if (trans) then
+
104 transa = 'C'
+
105 else
+
106 transa = 'N'
+
107 end if
+
108 if (nounit) then
+
109 diag = 'N'
+
110 else
+
111 diag = 'U'
+
112 end if
+
113 if (present(err)) then
+
114 errmgr => err
+
115 else
+
116 errmgr => deferr
+
117 end if
+
118
+
119 ! Input Check - matrix A must be square
+
120 if (size(a, 1) /= nrowa .or. size(a, 2) /= nrowa) then
+
121 ! ERROR: A must be square
+
122 call errmgr%report_error("solve_tri_mtx_cmplx", &
+
123 "The input matrix must be square.", la_array_size_error)
+
124 return
+
125 end if
+
126
+
127 ! Call ZTRSM
+
128 call ztrsm(side, uplo, transa, diag, m, n, alpha, a, nrowa, b, m)
+
129 end subroutine
+
130
+
131! ------------------------------------------------------------------------------
+
132 module subroutine solve_tri_vec(upper, trans, nounit, a, x, err)
+
133 ! Arguments
+
134 logical, intent(in) :: upper, trans, nounit
+
135 real(real64), intent(in), dimension(:,:) :: a
+
136 real(real64), intent(inout), dimension(:) :: x
+
137 class(errors), intent(inout), optional, target :: err
+
138
+
139 ! Parameters
+
140 real(real64), parameter :: zero = 0.0d0
+
141
+
142 ! Local Variables
+
143 character :: uplo, t, diag
+
144 integer(int32) :: n
+
145 class(errors), pointer :: errmgr
+
146 type(errors), target :: deferr
+
147
+
148 ! Initialization
+
149 n = size(a, 1)
+
150 if (upper) then
+
151 uplo = 'U'
+
152 else
+
153 uplo = 'L'
+
154 end if
+
155 if (trans) then
+
156 t = 'T'
+
157 else
+
158 t = 'N'
+
159 end if
+
160 if (nounit) then
+
161 diag = 'N'
+
162 else
+
163 diag = 'U'
+
164 end if
+
165 if (present(err)) then
+
166 errmgr => err
+
167 else
+
168 errmgr => deferr
+
169 end if
+
170
+
171 ! Input Check
+
172 if (size(a, 2) /= n) then
+
173 ! ERROR: A must be square
+
174 call errmgr%report_error("solve_tri_vec", &
+
175 "The input matrix must be square.", la_array_size_error)
+
176 return
+
177 else if (size(x) /= n) then
+
178 ! ERROR: Inner matrix dimensions must agree
+
179 call errmgr%report_error("solve_tri_vec", &
+
180 "The inner matrix dimensions must be equal.", &
+
181 la_array_size_error)
+
182 return
+
183 end if
+
184
+
185 ! Call DTRSV
+
186 call dtrsv(uplo, t, diag, n, a, n, x, 1)
+
187 end subroutine
+
188
+
189! ------------------------------------------------------------------------------
+
190 module subroutine solve_tri_vec_cmplx(upper, trans, nounit, a, x, err)
+
191 ! Arguments
+
192 logical, intent(in) :: upper, trans, nounit
+
193 complex(real64), intent(in), dimension(:,:) :: a
+
194 complex(real64), intent(inout), dimension(:) :: x
+
195 class(errors), intent(inout), optional, target :: err
+
196
+
197 ! Parameters
+
198 real(real64), parameter :: zero = 0.0d0
+
199
+
200 ! Local Variables
+
201 character :: uplo, t, diag
+
202 integer(int32) :: n
+
203 class(errors), pointer :: errmgr
+
204 type(errors), target :: deferr
+
205
+
206 ! Initialization
+
207 n = size(a, 1)
+
208 if (upper) then
+
209 uplo = 'U'
+
210 else
+
211 uplo = 'L'
+
212 end if
+
213 if (trans) then
+
214 t = 'C'
+
215 else
+
216 t = 'N'
+
217 end if
+
218 if (nounit) then
+
219 diag = 'N'
+
220 else
+
221 diag = 'U'
+
222 end if
+
223 if (present(err)) then
+
224 errmgr => err
+
225 else
+
226 errmgr => deferr
+
227 end if
+
228
+
229 ! Input Check
+
230 if (size(a, 2) /= n) then
+
231 ! ERROR: A must be square
+
232 call errmgr%report_error("solve_tri_vec_cmplx", &
+
233 "The input matrix must be square.", la_array_size_error)
+
234 return
+
235 else if (size(x) /= n) then
+
236 ! ERROR: Inner matrix dimensions must agree
+
237 call errmgr%report_error("solve_tri_vec_cmplx", &
+
238 "The inner matrix dimensions must be equal.", &
+
239 la_array_size_error)
+
240 return
+
241 end if
+
242
+
243 ! Call ZTRSV
+
244 call ztrsv(uplo, t, diag, n, a, n, x, 1)
+
245 end subroutine
+
246
+
247! ******************************************************************************
+
248! LU SOLUTION
+
249! ------------------------------------------------------------------------------
+
250 module subroutine solve_lu_mtx(a, ipvt, b, err)
+
251 ! Arguments
+
252 real(real64), intent(in), dimension(:,:) :: a
+
253 integer(int32), intent(in), dimension(:) :: ipvt
+
254 real(real64), intent(inout), dimension(:,:) :: b
+
255 class(errors), intent(inout), optional, target :: err
+
256
+
257 ! Local Variables
+
258 integer(int32) :: n, nrhs, flag
+
259 class(errors), pointer :: errmgr
+
260 type(errors), target :: deferr
+
261 character(len = 128) :: errmsg
+
262
+
263 ! Initialization
+
264 n = size(a, 1)
+
265 nrhs = size(b, 2)
+
266 if (present(err)) then
+
267 errmgr => err
+
268 else
+
269 errmgr => deferr
+
270 end if
+
271
+
272 ! Input Check
+
273 flag = 0
+
274 if (size(a, 2) /= n) then
+
275 flag = 1
+
276 else if (size(ipvt) /= n) then
+
277 flag = 2
+
278 else if (size(b, 1) /= n) then
+
279 flag = 3
+
280 end if
+
281 if (flag /= 0) then
+
282 ! One of the input arrays is not sized correctly
+
283 write(errmsg, '(AI0A)') "Input number ", flag, &
+
284 " is not sized correctly."
+
285 call errmgr%report_error("solve_lu_mtx", trim(errmsg), &
+
286 la_array_size_error)
+
287 return
+
288 end if
+
289
+
290 ! Call DGETRS
+
291 call dgetrs("N", n, nrhs, a, n, ipvt, b, n, flag)
+
292 end subroutine
+
293
+
294! ------------------------------------------------------------------------------
+
295 module subroutine solve_lu_mtx_cmplx(a, ipvt, b, err)
+
296 ! Arguments
+
297 complex(real64), intent(in), dimension(:,:) :: a
+
298 integer(int32), intent(in), dimension(:) :: ipvt
+
299 complex(real64), intent(inout), dimension(:,:) :: b
+
300 class(errors), intent(inout), optional, target :: err
+
301
+
302 ! Local Variables
+
303 integer(int32) :: n, nrhs, flag
+
304 class(errors), pointer :: errmgr
+
305 type(errors), target :: deferr
+
306 character(len = 128) :: errmsg
+
307
+
308 ! Initialization
+
309 n = size(a, 1)
+
310 nrhs = size(b, 2)
+
311 if (present(err)) then
+
312 errmgr => err
+
313 else
+
314 errmgr => deferr
+
315 end if
+
316
+
317 ! Input Check
+
318 flag = 0
+
319 if (size(a, 2) /= n) then
+
320 flag = 1
+
321 else if (size(ipvt) /= n) then
+
322 flag = 2
+
323 else if (size(b, 1) /= n) then
+
324 flag = 3
+
325 end if
+
326 if (flag /= 0) then
+
327 ! One of the input arrays is not sized correctly
+
328 write(errmsg, '(AI0A)') "Input number ", flag, &
+
329 " is not sized correctly."
+
330 call errmgr%report_error("solve_lu_mtx_cmplx", trim(errmsg), &
+
331 la_array_size_error)
+
332 return
+
333 end if
+
334
+
335 ! Call ZGETRS
+
336 call zgetrs("N", n, nrhs, a, n, ipvt, b, n, flag)
+
337 end subroutine
+
338
+
339! ------------------------------------------------------------------------------
+
340 module subroutine solve_lu_vec(a, ipvt, b, err)
+
341 ! Arguments
+
342 real(real64), intent(in), dimension(:,:) :: a
+
343 integer(int32), intent(in), dimension(:) :: ipvt
+
344 real(real64), intent(inout), dimension(:) :: b
+
345 class(errors), intent(inout), optional, target :: err
+
346
+
347 ! Local Variables
+
348 integer(int32) :: n, flag
+
349 class(errors), pointer :: errmgr
+
350 type(errors), target :: deferr
+
351 character(len = 128) :: errmsg
+
352
+
353 ! Initialization
+
354 n = size(a, 1)
+
355 if (present(err)) then
+
356 errmgr => err
+
357 else
+
358 errmgr => deferr
+
359 end if
+
360
+
361 ! Input Check
+
362 flag = 0
+
363 if (size(a, 2) /= n) then
+
364 flag = 1
+
365 else if (size(ipvt) /= n) then
+
366 flag = 2
+
367 else if (size(b) /= n) then
+
368 flag = 3
+
369 end if
+
370 if (flag /= 0) then
+
371 ! One of the input arrays is not sized correctly
+
372 write(errmsg, '(AI0A)') "Input number ", flag, &
+
373 " is not sized correctly."
+
374 call errmgr%report_error("solve_lu_vec", trim(errmsg), &
+
375 la_array_size_error)
+
376 return
+
377 end if
+
378
+
379 ! Call DGETRS
+
380 call dgetrs("N", n, 1, a, n, ipvt, b, n, flag)
+
381 end subroutine
+
382
+
383! ------------------------------------------------------------------------------
+
384 module subroutine solve_lu_vec_cmplx(a, ipvt, b, err)
+
385 ! Arguments
+
386 complex(real64), intent(in), dimension(:,:) :: a
+
387 integer(int32), intent(in), dimension(:) :: ipvt
+
388 complex(real64), intent(inout), dimension(:) :: b
+
389 class(errors), intent(inout), optional, target :: err
+
390
+
391 ! Local Variables
+
392 integer(int32) :: n, flag
+
393 class(errors), pointer :: errmgr
+
394 type(errors), target :: deferr
+
395 character(len = 128) :: errmsg
+
396
+
397 ! Initialization
+
398 n = size(a, 1)
+
399 if (present(err)) then
+
400 errmgr => err
+
401 else
+
402 errmgr => deferr
+
403 end if
+
404
+
405 ! Input Check
+
406 flag = 0
+
407 if (size(a, 2) /= n) then
+
408 flag = 1
+
409 else if (size(ipvt) /= n) then
+
410 flag = 2
+
411 else if (size(b) /= n) then
+
412 flag = 3
+
413 end if
+
414 if (flag /= 0) then
+
415 ! One of the input arrays is not sized correctly
+
416 write(errmsg, '(AI0A)') "Input number ", flag, &
+
417 " is not sized correctly."
+
418 call errmgr%report_error("solve_lu_vec_cmplx", trim(errmsg), &
+
419 la_array_size_error)
+
420 return
+
421 end if
+
422
+
423 ! Call ZGETRS
+
424 call zgetrs("N", n, 1, a, n, ipvt, b, n, flag)
+
425 end subroutine
+
426
+
427! ******************************************************************************
+
428! QR SOLUTION
+
429! ------------------------------------------------------------------------------
+
430 module subroutine solve_qr_no_pivot_mtx(a, tau, b, work, olwork, err)
+
431 ! Arguments
+
432 real(real64), intent(inout), dimension(:,:) :: a, b
+
433 real(real64), intent(in), dimension(:) :: tau
+
434 real(real64), intent(out), target, optional, dimension(:) :: work
+
435 integer(int32), intent(out), optional :: olwork
+
436 class(errors), intent(inout), optional, target :: err
+
437
+
438 ! Parameters
+
439 real(real64), parameter :: one = 1.0d0
+
440
+
441 ! Local Variables
+
442 integer(int32) :: m, n, nrhs, k, lwork, flag, istat
+
443 real(real64), pointer, dimension(:) :: wptr
+
444 real(real64), allocatable, target, dimension(:) :: wrk
+
445 class(errors), pointer :: errmgr
+
446 type(errors), target :: deferr
+
447 character(len = 128) :: errmsg
+
448
+
449 ! Initialization
+
450 m = size(a, 1)
+
451 n = size(a, 2)
+
452 nrhs = size(b, 2)
+
453 k = min(m, n)
+
454 if (present(err)) then
+
455 errmgr => err
+
456 else
+
457 errmgr => deferr
+
458 end if
+
459
+
460 ! Input Check
+
461 flag = 0
+
462 if (m < n) then
+
463 flag = 1
+
464 else if (size(tau) /= k) then
+
465 flag = 2
+
466 else if (size(b, 1) /= m) then
+
467 flag = 3
+
468 end if
+
469 if (flag /= 0) then
+
470 ! ERROR: One of the input arrays is not sized correctly
+
471 write(errmsg, '(AI0A)') "Input number ", flag, &
+
472 " is not sized correctly."
+
473 call errmgr%report_error("solve_qr_no_pivot_mtx", trim(errmsg), &
+
474 la_array_size_error)
+
475 return
+
476 end if
+
477
+
478 ! Workspace Query
+
479 call mult_qr(.true., .true., a, tau, b, olwork = lwork)
+
480 if (present(olwork)) then
+
481 olwork = lwork
+
482 return
+
483 end if
+
484
+
485 ! Local Memory Allocation
+
486 if (present(work)) then
+
487 if (size(work) < lwork) then
+
488 ! ERROR: WORK not sized correctly
+
489 call errmgr%report_error("solve_qr_no_pivot_mtx", &
+
490 "Incorrectly sized input array WORK, argument 4.", &
+
491 la_array_size_error)
+
492 return
+
493 end if
+
494 wptr => work(1:lwork)
+
495 else
+
496 allocate(wrk(lwork), stat = istat)
+
497 if (istat /= 0) then
+
498 ! ERROR: Out of memory
+
499 call errmgr%report_error("solve_qr_no_pivot_mtx", &
+
500 "Insufficient memory available.", &
+
501 la_out_of_memory_error)
+
502 return
+
503 end if
+
504 wptr => wrk
+
505 end if
+
506
+
507 ! Compute Q**T * B, and store in B
+
508 call mult_qr(.true., .true., a, tau, b, wptr)
+
509
+
510 ! Solve the triangular system: A(1:N,1:N)*X = B(1:N,:)
+
511 call solve_triangular_system(.true., .true., .false., .true., one, &
+
512 a(1:n,1:n), b(1:n,:))
+
513 end subroutine
+
514
+
515! ------------------------------------------------------------------------------
+
516 module subroutine solve_qr_no_pivot_mtx_cmplx(a, tau, b, work, olwork, err)
+
517 ! Arguments
+
518 complex(real64), intent(inout), dimension(:,:) :: a, b
+
519 complex(real64), intent(in), dimension(:) :: tau
+
520 complex(real64), intent(out), target, optional, dimension(:) :: work
+
521 integer(int32), intent(out), optional :: olwork
+
522 class(errors), intent(inout), optional, target :: err
+
523
+
524 ! Parameters
+
525 complex(real64), parameter :: one = (1.0d0, 0.0d0)
+
526
+
527 ! Local Variables
+
528 integer(int32) :: m, n, nrhs, k, lwork, flag, istat
+
529 complex(real64), pointer, dimension(:) :: wptr
+
530 complex(real64), allocatable, target, dimension(:) :: wrk
+
531 class(errors), pointer :: errmgr
+
532 type(errors), target :: deferr
+
533 character(len = 128) :: errmsg
+
534
+
535 ! Initialization
+
536 m = size(a, 1)
+
537 n = size(a, 2)
+
538 nrhs = size(b, 2)
+
539 k = min(m, n)
+
540 if (present(err)) then
+
541 errmgr => err
+
542 else
+
543 errmgr => deferr
+
544 end if
+
545
+
546 ! Input Check
+
547 flag = 0
+
548 if (m < n) then
+
549 flag = 1
+
550 else if (size(tau) /= k) then
+
551 flag = 2
+
552 else if (size(b, 1) /= m) then
+
553 flag = 3
+
554 end if
+
555 if (flag /= 0) then
+
556 ! ERROR: One of the input arrays is not sized correctly
+
557 write(errmsg, '(AI0A)') "Input number ", flag, &
+
558 " is not sized correctly."
+
559 call errmgr%report_error("solve_qr_no_pivot_mtx_cmplx", &
+
560 trim(errmsg), la_array_size_error)
+
561 return
+
562 end if
+
563
+
564 ! Workspace Query
+
565 call mult_qr(.true., .true., a, tau, b, olwork = lwork)
+
566 if (present(olwork)) then
+
567 olwork = lwork
+
568 return
+
569 end if
+
570
+
571 ! Local Memory Allocation
+
572 if (present(work)) then
+
573 if (size(work) < lwork) then
+
574 ! ERROR: WORK not sized correctly
+
575 call errmgr%report_error("solve_qr_no_pivot_mtx_cmplx", &
+
576 "Incorrectly sized input array WORK, argument 4.", &
+
577 la_array_size_error)
+
578 return
+
579 end if
+
580 wptr => work(1:lwork)
+
581 else
+
582 allocate(wrk(lwork), stat = istat)
+
583 if (istat /= 0) then
+
584 ! ERROR: Out of memory
+
585 call errmgr%report_error("solve_qr_no_pivot_mtx_cmplx", &
+
586 "Insufficient memory available.", &
+
587 la_out_of_memory_error)
+
588 return
+
589 end if
+
590 wptr => wrk
+
591 end if
+
592
+
593 ! Compute Q**T * B, and store in B
+
594 call mult_qr(.true., .true., a, tau, b, wptr)
+
595
+
596 ! Solve the triangular system: A(1:N,1:N)*X = B(1:N,:)
+
597 call solve_triangular_system(.true., .true., .false., .true., one, &
+
598 a(1:n,1:n), b(1:n,:))
+
599 end subroutine
+
600
+
601! ------------------------------------------------------------------------------
+
602 module subroutine solve_qr_no_pivot_vec(a, tau, b, work, olwork, err)
+
603 ! Arguments
+
604 real(real64), intent(inout), dimension(:,:) :: a
+
605 real(real64), intent(in), dimension(:) :: tau
+
606 real(real64), intent(inout), dimension(:) :: b
+
607 real(real64), intent(out), target, optional, dimension(:) :: work
+
608 integer(int32), intent(out), optional :: olwork
+
609 class(errors), intent(inout), optional, target :: err
+
610
+
611 ! Local Variables
+
612 integer(int32) :: m, n, k, flag, lwork, istat
+
613 real(real64), pointer, dimension(:) :: wptr
+
614 real(real64), allocatable, target, dimension(:) :: wrk
+
615 class(errors), pointer :: errmgr
+
616 type(errors), target :: deferr
+
617 character(len = 128) :: errmsg
+
618
+
619 ! Initialization
+
620 m = size(a, 1)
+
621 n = size(a, 2)
+
622 k = min(m, n)
+
623 if (present(err)) then
+
624 errmgr => err
+
625 else
+
626 errmgr => deferr
+
627 end if
+
628
+
629 ! Input Check
+
630 flag = 0
+
631 if (m < n) then
+
632 flag = 1
+
633 else if (size(tau) /= k) then
+
634 flag = 2
+
635 else if (size(b) /= m) then
+
636 flag = 3
+
637 end if
+
638 if (flag /= 0) then
+
639 ! ERROR: One of the input arrays is not sized correctly
+
640 write(errmsg, '(AI0A)') "Input number ", flag, &
+
641 " is not sized correctly."
+
642 call errmgr%report_error("solve_qr_no_pivot_vec", trim(errmsg), &
+
643 la_array_size_error)
+
644 return
+
645 end if
+
646
+
647 ! Workspace Query
+
648 call mult_qr(.true., a, tau, b, olwork = lwork)
+
649 if (present(olwork)) then
+
650 olwork = lwork
+
651 return
+
652 end if
+
653
+
654 ! Local Memory Allocation
+
655 if (present(work)) then
+
656 if (size(work) < lwork) then
+
657 ! ERROR: WORK not sized correctly
+
658 call errmgr%report_error("solve_qr_no_pivot_vec", &
+
659 "Incorrectly sized input array WORK, argument 4.", &
+
660 la_array_size_error)
+
661 return
+
662 end if
+
663 wptr => work(1:lwork)
+
664 else
+
665 allocate(wrk(lwork), stat = istat)
+
666 if (istat /= 0) then
+
667 ! ERROR: Out of memory
+
668 call errmgr%report_error("solve_qr_no_pivot_vec", &
+
669 "Insufficient memory available.", &
+
670 la_out_of_memory_error)
+
671 return
+
672 end if
+
673 wptr => wrk
+
674 end if
+
675
+
676 ! Compute Q**T * B, and store in B
+
677 call mult_qr(.true., a, tau, b, work = wptr)
+
678
+
679 ! Solve the triangular system: A(1:N,1:N)*X = B(1:N)
+
680 call solve_triangular_system(.true., .false., .true., a(1:n,1:n), b)
+
681 end subroutine
+
682
+
683! ------------------------------------------------------------------------------
+
684 module subroutine solve_qr_no_pivot_vec_cmplx(a, tau, b, work, olwork, err)
+
685 ! Arguments
+
686 complex(real64), intent(inout), dimension(:,:) :: a
+
687 complex(real64), intent(in), dimension(:) :: tau
+
688 complex(real64), intent(inout), dimension(:) :: b
+
689 complex(real64), intent(out), target, optional, dimension(:) :: work
+
690 integer(int32), intent(out), optional :: olwork
+
691 class(errors), intent(inout), optional, target :: err
+
692
+
693 ! Local Variables
+
694 integer(int32) :: m, n, k, flag, lwork, istat
+
695 complex(real64), pointer, dimension(:) :: wptr
+
696 complex(real64), allocatable, target, dimension(:) :: wrk
+
697 class(errors), pointer :: errmgr
+
698 type(errors), target :: deferr
+
699 character(len = 128) :: errmsg
+
700
+
701 ! Initialization
+
702 m = size(a, 1)
+
703 n = size(a, 2)
+
704 k = min(m, n)
+
705 if (present(err)) then
+
706 errmgr => err
+
707 else
+
708 errmgr => deferr
+
709 end if
+
710
+
711 ! Input Check
+
712 flag = 0
+
713 if (m < n) then
+
714 flag = 1
+
715 else if (size(tau) /= k) then
+
716 flag = 2
+
717 else if (size(b) /= m) then
+
718 flag = 3
+
719 end if
+
720 if (flag /= 0) then
+
721 ! ERROR: One of the input arrays is not sized correctly
+
722 write(errmsg, '(AI0A)') "Input number ", flag, &
+
723 " is not sized correctly."
+
724 call errmgr%report_error("solve_qr_no_pivot_vec_cmplx", &
+
725 trim(errmsg), la_array_size_error)
+
726 return
+
727 end if
+
728
+
729 ! Workspace Query
+
730 call mult_qr(.true., a, tau, b, olwork = lwork)
+
731 if (present(olwork)) then
+
732 olwork = lwork
+
733 return
+
734 end if
+
735
+
736 ! Local Memory Allocation
+
737 if (present(work)) then
+
738 if (size(work) < lwork) then
+
739 ! ERROR: WORK not sized correctly
+
740 call errmgr%report_error("solve_qr_no_pivot_vec_cmplx", &
+
741 "Incorrectly sized input array WORK, argument 4.", &
+
742 la_array_size_error)
+
743 return
+
744 end if
+
745 wptr => work(1:lwork)
+
746 else
+
747 allocate(wrk(lwork), stat = istat)
+
748 if (istat /= 0) then
+
749 ! ERROR: Out of memory
+
750 call errmgr%report_error("solve_qr_no_pivot_vec_cmplx", &
+
751 "Insufficient memory available.", &
+
752 la_out_of_memory_error)
+
753 return
+
754 end if
+
755 wptr => wrk
+
756 end if
+
757
+
758 ! Compute Q**T * B, and store in B
+
759 call mult_qr(.true., a, tau, b, work = wptr)
+
760
+
761 ! Solve the triangular system: A(1:N,1:N)*X = B(1:N)
+
762 call solve_triangular_system(.true., .false., .true., a(1:n,1:n), b)
+
763 end subroutine
+
764
+
765! ------------------------------------------------------------------------------
+
766 module subroutine solve_qr_pivot_mtx(a, tau, jpvt, b, work, olwork, err)
+
767 ! Arguments
+
768 real(real64), intent(inout), dimension(:,:) :: a
+
769 real(real64), intent(in), dimension(:) :: tau
+
770 integer(int32), intent(in), dimension(:) :: jpvt
+
771 real(real64), intent(inout), dimension(:,:) :: b
+
772 real(real64), intent(out), target, optional, dimension(:) :: work
+
773 integer(int32), intent(out), optional :: olwork
+
774 class(errors), intent(inout), optional, target :: err
+
775
+
776 ! Parameters
+
777 integer(int32), parameter :: imin = 2
+
778 integer(int32), parameter :: imax = 1
+
779 real(real64), parameter :: zero = 0.0d0
+
780 real(real64), parameter :: one = 1.0d0
+
781
+
782 ! Local Variables
+
783 integer(int32) :: i, j, m, n, mn, nrhs, lwork, ismin, ismax, &
+
784 rnk, maxmn, flag, istat, lwork1, lwork2, lwork3
+
785 real(real64) :: rcond, smax, smin, smaxpr, sminpr, s1, c1, s2, c2
+
786 real(real64), pointer, dimension(:) :: wptr, w, tau2
+
787 real(real64), allocatable, target, dimension(:) :: wrk
+
788 class(errors), pointer :: errmgr
+
789 type(errors), target :: deferr
+
790 character(len = 128) :: errmsg
+
791
+
792 ! Initialization
+
793 m = size(a, 1)
+
794 n = size(a, 2)
+
795 mn = min(m, n)
+
796 maxmn = max(m, n)
+
797 nrhs = size(b, 2)
+
798 ismin = mn + 1
+
799 ismax = 2 * mn + 1
+
800 rcond = epsilon(rcond)
+
801 if (present(err)) then
+
802 errmgr => err
+
803 else
+
804 errmgr => deferr
+
805 end if
+
806
+
807 ! Input Check
+
808 flag = 0
+
809 if (size(tau) /= mn) then
+
810 flag = 2
+
811 else if (size(jpvt) /= n) then
+
812 flag = 3
+
813 else if (size(b, 1) /= maxmn) then
+
814 flag = 4
+
815 end if
+
816 if (flag /= 0) then
+
817 ! ERROR: One of the input arrays is not sized correctly
+
818 write(errmsg, '(AI0A)') "Input number ", flag, &
+
819 " is not sized correctly."
+
820 call errmgr%report_error("solve_qr_pivot_mtx", trim(errmsg), &
+
821 la_array_size_error)
+
822 return
+
823 end if
+
824
+
825 ! Workspace Query
+
826 call rz_factor(a(1:mn,:), a(1:mn,1), olwork = lwork1)
+
827 call mult_qr(.true., .true., a, tau, b(1:m,:), olwork = lwork2)
+
828 call mult_rz(.true., .true., n, a(1:mn,:), a(1:mn,1), b(1:n,:), &
+
829 olwork = lwork3)
+
830 lwork = max(lwork1, lwork2, lwork3, 2 * mn + 1) + mn
+
831 if (present(olwork)) then
+
832 olwork = lwork
+
833 return
+
834 end if
+
835
+
836 ! Local Memory Allocation
+
837 if (present(work)) then
+
838 if (size(work) < lwork) then
+
839 ! ERROR: WORK not sized correctly
+
840 call errmgr%report_error("solve_qr_no_pivot_mtx", &
+
841 "Incorrectly sized input array WORK, argument 5.", &
+
842 la_array_size_error)
+
843 return
+
844 end if
+
845 wptr => work(1:lwork)
+
846 else
+
847 allocate(wrk(lwork), stat = istat)
+
848 if (istat /= 0) then
+
849 ! ERROR: Out of memory
+
850 call errmgr%report_error("solve_qr_pivot_mtx", &
+
851 "Insufficient memory available.", &
+
852 la_out_of_memory_error)
+
853 return
+
854 end if
+
855 wptr => wrk
+
856 end if
+
857
+
858 ! Determine the rank of R11 using an incremental condition estimation
+
859 wptr(ismin) = one
+
860 wptr(ismax) = one
+
861 smax = abs(a(1,1))
+
862 smin = smax
+
863 if (abs(a(1,1)) == zero) then
+
864 rnk = 0
+
865 b(1:maxmn,:) = zero
+
866 return
+
867 else
+
868 rnk = 1
+
869 end if
+
870 do
+
871 if (rnk < mn) then
+
872 i = rnk + 1
+
873 call dlaic1(imin, rnk, wptr(ismin:ismin+rnk-1), smin, &
+
874 a(1:rnk-1,i), a(i,i), sminpr, s1, c1)
+
875 call dlaic1(imax, rnk, wptr(ismax:ismax+rnk-1), smax, &
+
876 a(1:rnk-1,i), a(i,i), smaxpr, s2, c2)
+
877 if (smaxpr * rcond <= sminpr) then
+
878 do i = 1, rnk
+
879 wptr(ismin+i-1) = s1 * wptr(ismin+i-1)
+
880 wptr(ismax+i-1) = s2 * wptr(ismax+i-1)
+
881 end do
+
882 wptr(ismin+rnk) = c1
+
883 wptr(ismax+rnk) = c2
+
884 smin = sminpr
+
885 smax = smaxpr
+
886 rnk = rnk + 1
+
887 cycle
+
888 end if
+
889 end if
+
890 exit
+
891 end do
+
892
+
893 ! Partition R = [R11 R12]
+
894 ! [ 0 R22]
+
895 tau2 => wptr(1:rnk)
+
896 w => wptr(rnk+1:lwork)
+
897 if (rnk < n) call rz_factor(a(1:rnk,:), tau2, w)
+
898
+
899 ! Compute B(1:m,1:NRHS) = Q**T * B(1:M,1:NRHS)
+
900 call mult_qr(.true., .true., a, tau, b(1:m,:), w)
+
901
+
902 ! Solve the triangular system T11 * B(1:rnk,1:nrhs) = B(1:rnk,1:nrhs)
+
903 call solve_triangular_system(.true., .true., .false., .true., one, &
+
904 a(1:rnk,1:rnk), b(1:rnk,:))
+
905 if (n > rnk) b(rnk+1:n,:) = zero
+
906
+
907 ! Compute B(1:n,1:nrhs) = Y**T * B(1:n,1:nrhs)
+
908 if (rnk < n) then
+
909 call mult_rz(.true., .true., n - rnk, a(1:rnk,:), tau2, b(1:n,:), w)
+
910 end if
+
911
+
912 ! Apply the pivoting: B(1:N,1:NRHS) = P * B(1:N,1:NRHS)
+
913 do j = 1, nrhs
+
914 do i = 1, n
+
915 wptr(jpvt(i)) = b(i,j)
+
916 end do
+
917 b(:,j) = wptr(1:n)
+
918 end do
+
919 end subroutine
+
920
+
921! ------------------------------------------------------------------------------
+
922 module subroutine solve_qr_pivot_mtx_cmplx(a, tau, jpvt, b, work, olwork, err)
+
923 ! Arguments
+
924 complex(real64), intent(inout), dimension(:,:) :: a
+
925 complex(real64), intent(in), dimension(:) :: tau
+
926 integer(int32), intent(in), dimension(:) :: jpvt
+
927 complex(real64), intent(inout), dimension(:,:) :: b
+
928 complex(real64), intent(out), target, optional, dimension(:) :: work
+
929 integer(int32), intent(out), optional :: olwork
+
930 class(errors), intent(inout), optional, target :: err
+
931
+
932 ! Parameters
+
933 integer(int32), parameter :: imin = 2
+
934 integer(int32), parameter :: imax = 1
+
935 complex(real64), parameter :: zero = (0.0d0, 0.0d0)
+
936 complex(real64), parameter :: one = (1.0d0, 0.0d0)
+
937
+
938 ! Local Variables
+
939 integer(int32) :: i, j, m, n, mn, nrhs, lwork, ismin, ismax, &
+
940 rnk, maxmn, flag, istat, lwork1, lwork2, lwork3
+
941 real(real64) :: rcond, smax, smin, smaxpr, sminpr
+
942 complex(real64) :: s1, c1, s2, c2
+
943 complex(real64), pointer, dimension(:) :: wptr, w, tau2
+
944 complex(real64), allocatable, target, dimension(:) :: wrk
+
945 class(errors), pointer :: errmgr
+
946 type(errors), target :: deferr
+
947 character(len = 128) :: errmsg
+
948
+
949 ! Initialization
+
950 m = size(a, 1)
+
951 n = size(a, 2)
+
952 mn = min(m, n)
+
953 maxmn = max(m, n)
+
954 nrhs = size(b, 2)
+
955 ismin = mn + 1
+
956 ismax = 2 * mn + 1
+
957 rcond = epsilon(rcond)
+
958 if (present(err)) then
+
959 errmgr => err
+
960 else
+
961 errmgr => deferr
+
962 end if
+
963
+
964 ! Input Check
+
965 flag = 0
+
966 if (size(tau) /= mn) then
+
967 flag = 2
+
968 else if (size(jpvt) /= n) then
+
969 flag = 3
+
970 else if (size(b, 1) /= maxmn) then
+
971 flag = 4
+
972 end if
+
973 if (flag /= 0) then
+
974 ! ERROR: One of the input arrays is not sized correctly
+
975 write(errmsg, '(AI0A)') "Input number ", flag, &
+
976 " is not sized correctly."
+
977 call errmgr%report_error("solve_qr_pivot_mtx_cmplx", &
+
978 trim(errmsg), la_array_size_error)
+
979 return
+
980 end if
+
981
+
982 ! Workspace Query
+
983 call rz_factor(a(1:mn,:), a(1:mn,1), olwork = lwork1)
+
984 call mult_qr(.true., .true., a, tau, b(1:m,:), olwork = lwork2)
+
985 call mult_rz(.true., .true., n, a(1:mn,:), a(1:mn,1), b(1:n,:), &
+
986 olwork = lwork3)
+
987 lwork = max(lwork1, lwork2, lwork3, 2 * mn + 1) + mn
+
988 if (present(olwork)) then
+
989 olwork = lwork
+
990 return
+
991 end if
+
992
+
993 ! Local Memory Allocation
+
994 if (present(work)) then
+
995 if (size(work) < lwork) then
+
996 ! ERROR: WORK not sized correctly
+
997 call errmgr%report_error("solve_qr_no_pivot_mtx_cmplx", &
+
998 "Incorrectly sized input array WORK, argument 5.", &
+
999 la_array_size_error)
+
1000 return
+
1001 end if
+
1002 wptr => work(1:lwork)
+
1003 else
+
1004 allocate(wrk(lwork), stat = istat)
+
1005 if (istat /= 0) then
+
1006 ! ERROR: Out of memory
+
1007 call errmgr%report_error("solve_qr_pivot_mtx_cmplx", &
+
1008 "Insufficient memory available.", &
+
1009 la_out_of_memory_error)
+
1010 return
+
1011 end if
+
1012 wptr => wrk
+
1013 end if
+
1014
+
1015 ! Determine the rank of R11 using an incremental condition estimation
+
1016 wptr(ismin) = one
+
1017 wptr(ismax) = one
+
1018 smax = abs(a(1,1))
+
1019 smin = smax
+
1020 if (abs(a(1,1)) == zero) then
+
1021 rnk = 0
+
1022 b(1:maxmn,:) = zero
+
1023 return
+
1024 else
+
1025 rnk = 1
+
1026 end if
+
1027 do
+
1028 if (rnk < mn) then
+
1029 i = rnk + 1
+
1030 call zlaic1(imin, rnk, wptr(ismin:ismin+rnk-1), smin, &
+
1031 a(1:rnk-1,i), a(i,i), sminpr, s1, c1)
+
1032 call zlaic1(imax, rnk, wptr(ismax:ismax+rnk-1), smax, &
+
1033 a(1:rnk-1,i), a(i,i), smaxpr, s2, c2)
+
1034 if (smaxpr * rcond <= sminpr) then
+
1035 do i = 1, rnk
+
1036 wptr(ismin+i-1) = s1 * wptr(ismin+i-1)
+
1037 wptr(ismax+i-1) = s2 * wptr(ismax+i-1)
+
1038 end do
+
1039 wptr(ismin+rnk) = c1
+
1040 wptr(ismax+rnk) = c2
+
1041 smin = sminpr
+
1042 smax = smaxpr
+
1043 rnk = rnk + 1
+
1044 cycle
+
1045 end if
+
1046 end if
+
1047 exit
+
1048 end do
+
1049
+
1050 ! Partition R = [R11 R12]
+
1051 ! [ 0 R22]
+
1052 tau2 => wptr(1:rnk)
+
1053 w => wptr(rnk+1:lwork)
+
1054 if (rnk < n) call rz_factor(a(1:rnk,:), tau2, w)
+
1055
+
1056 ! Compute B(1:m,1:NRHS) = Q**T * B(1:M,1:NRHS)
+
1057 call mult_qr(.true., .true., a, tau, b(1:m,:), w)
+
1058
+
1059 ! Solve the triangular system T11 * B(1:rnk,1:nrhs) = B(1:rnk,1:nrhs)
+
1060 call solve_triangular_system(.true., .true., .false., .true., one, &
+
1061 a(1:rnk,1:rnk), b(1:rnk,:))
+
1062 if (n > rnk) b(rnk+1:n,:) = zero
+
1063
+
1064 ! Compute B(1:n,1:nrhs) = Y**T * B(1:n,1:nrhs)
+
1065 if (rnk < n) then
+
1066 call mult_rz(.true., .true., n - rnk, a(1:rnk,:), tau2, b(1:n,:), w)
+
1067 end if
+
1068
+
1069 ! Apply the pivoting: B(1:N,1:NRHS) = P * B(1:N,1:NRHS)
+
1070 do j = 1, nrhs
+
1071 do i = 1, n
+
1072 wptr(jpvt(i)) = b(i,j)
+
1073 end do
+
1074 b(:,j) = wptr(1:n)
+
1075 end do
+
1076 end subroutine
+
1077
+
1078! ------------------------------------------------------------------------------
+
1079 module subroutine solve_qr_pivot_vec(a, tau, jpvt, b, work, olwork, err)
+
1080 ! Arguments
+
1081 real(real64), intent(inout), dimension(:,:) :: a
+
1082 real(real64), intent(in), dimension(:) :: tau
+
1083 integer(int32), intent(in), dimension(:) :: jpvt
+
1084 real(real64), intent(inout), dimension(:) :: b
+
1085 real(real64), intent(out), target, optional, dimension(:) :: work
+
1086 integer(int32), intent(out), optional :: olwork
+
1087 class(errors), intent(inout), optional, target :: err
+
1088
+
1089 ! Parameters
+
1090 integer(int32), parameter :: imin = 2
+
1091 integer(int32), parameter :: imax = 1
+
1092 real(real64), parameter :: zero = 0.0d0
+
1093 real(real64), parameter :: one = 1.0d0
+
1094
+
1095 ! Local Variables
+
1096 integer(int32) :: i, m, n, mn, lwork, ismin, ismax, rnk, maxmn, flag, &
+
1097 istat, lwork1, lwork2
+
1098 real(real64) :: rcond, smax, smin, smaxpr, sminpr, s1, c1, s2, c2
+
1099 real(real64), pointer, dimension(:) :: wptr, w, tau2
+
1100 real(real64), allocatable, target, dimension(:) :: wrk
+
1101 class(errors), pointer :: errmgr
+
1102 type(errors), target :: deferr
+
1103 character(len = 128) :: errmsg
+
1104
+
1105 ! Initialization
+
1106 m = size(a, 1)
+
1107 n = size(a, 2)
+
1108 mn = min(m, n)
+
1109 maxmn = max(m, n)
+
1110 ismin = mn + 1
+
1111 ismax = 2 * mn + 1
+
1112 rcond = epsilon(rcond)
+
1113 if (present(err)) then
+
1114 errmgr => err
+
1115 else
+
1116 errmgr => deferr
+
1117 end if
+
1118
+
1119 ! Input Check
+
1120 flag = 0
+
1121 if (size(tau) /= mn) then
+
1122 flag = 2
+
1123 else if (size(jpvt) /= n) then
+
1124 flag = 3
+
1125 else if (size(b) /= maxmn) then
+
1126 flag = 4
+
1127 end if
+
1128 if (flag /= 0) then
+
1129 ! ERROR: One of the input arrays is not sized correctly
+
1130 write(errmsg, '(AI0A)') "Input number ", flag, &
+
1131 " is not sized correctly."
+
1132 call errmgr%report_error("solve_qr_pivot_vec", trim(errmsg), &
+
1133 la_array_size_error)
+
1134 return
+
1135 end if
+
1136
+
1137 ! Workspace Query
+
1138 call rz_factor(a(1:mn,:), a(1:mn,1), olwork = lwork1)
+
1139 call mult_rz(.true., n, a(1:mn,:), a(1:mn,1), b(1:n), olwork = lwork2)
+
1140 lwork = max(lwork1, lwork2, 2 * mn + 1) + mn
+
1141 if (present(olwork)) then
+
1142 olwork = lwork
+
1143 return
+
1144 end if
+
1145
+
1146 ! Local Memory Allocation
+
1147 if (present(work)) then
+
1148 if (size(work) < lwork) then
+
1149 ! ERROR: WORK not sized correctly
+
1150 call errmgr%report_error("solve_qr_no_pivot_mtx", &
+
1151 "Incorrectly sized input array WORK, argument 5.", &
+
1152 la_array_size_error)
+
1153 return
+
1154 end if
+
1155 wptr => work(1:lwork)
+
1156 else
+
1157 allocate(wrk(lwork), stat = istat)
+
1158 if (istat /= 0) then
+
1159 ! ERROR: Out of memory
+
1160 call errmgr%report_error("solve_qr_pivot_vec", &
+
1161 "Insufficient memory available.", &
+
1162 la_out_of_memory_error)
+
1163 return
+
1164 end if
+
1165 wptr => wrk
+
1166 end if
+
1167
+
1168 ! Determine the rank of R11 using an incremental condition estimation
+
1169 wptr(ismin) = one
+
1170 wptr(ismax) = one
+
1171 smax = abs(a(1,1))
+
1172 smin = smax
+
1173 if (abs(a(1,1)) == zero) then
+
1174 rnk = 0
+
1175 b(maxmn) = zero
+
1176 return
+
1177 else
+
1178 rnk = 1
+
1179 end if
+
1180 do
+
1181 if (rnk < mn) then
+
1182 i = rnk + 1
+
1183 call dlaic1(imin, rnk, wptr(ismin:ismin+rnk-1), smin, &
+
1184 a(1:rnk-1,i), a(i,i), sminpr, s1, c1)
+
1185 call dlaic1(imax, rnk, wptr(ismax:ismax+rnk-1), smax, &
+
1186 a(1:rnk-1,i), a(i,i), smaxpr, s2, c2)
+
1187 if (smaxpr * rcond <= sminpr) then
+
1188 do i = 1, rnk
+
1189 wptr(ismin+i-1) = s1 * wptr(ismin+i-1)
+
1190 wptr(ismax+i-1) = s2 * wptr(ismax+i-1)
+
1191 end do
+
1192 wptr(ismin+rnk) = c1
+
1193 wptr(ismax+rnk) = c2
+
1194 smin = sminpr
+
1195 smax = smaxpr
+
1196 rnk = rnk + 1
+
1197 cycle
+
1198 end if
+
1199 end if
+
1200 exit
+
1201 end do
+
1202
+
1203 ! Partition R = [R11 R12]
+
1204 ! [ 0 R22]
+
1205 tau2 => wptr(1:rnk)
+
1206 w => wptr(rnk+1:lwork)
+
1207 if (rnk < n) call rz_factor(a(1:rnk,:), tau2, w)
+
1208
+
1209 ! Compute B(1:m,1:NRHS) = Q**T * B(1:M,1:NRHS)
+
1210 call mult_qr(.true., a, tau, b(1:m))
+
1211
+
1212 ! Solve the triangular system T11 * B(1:rnk) = B(1:rnk)
+
1213 call solve_triangular_system(.true., .false., .true., a(1:rnk,1:rnk), &
+
1214 b(1:rnk))
+
1215 if (n > rnk) b(rnk+1:n) = zero
+
1216
+
1217 ! Compute B(1:n) = Y**T * B(1:n)
+
1218 if (rnk < n) then
+
1219 call mult_rz(.true., n - rnk, a(1:rnk,:), tau2, b(1:n), w)
+
1220 end if
+
1221
+
1222 ! Apply the pivoting: B(1:N) = P * B(1:N)
+
1223 do i = 1, n
+
1224 wptr(jpvt(i)) = b(i)
+
1225 end do
+
1226 b = wptr(1:n)
+
1227 end subroutine
+
1228
+
1229! ------------------------------------------------------------------------------
+
1230 module subroutine solve_qr_pivot_vec_cmplx(a, tau, jpvt, b, work, olwork, err)
+
1231 ! Arguments
+
1232 complex(real64), intent(inout), dimension(:,:) :: a
+
1233 complex(real64), intent(in), dimension(:) :: tau
+
1234 integer(int32), intent(in), dimension(:) :: jpvt
+
1235 complex(real64), intent(inout), dimension(:) :: b
+
1236 complex(real64), intent(out), target, optional, dimension(:) :: work
+
1237 integer(int32), intent(out), optional :: olwork
+
1238 class(errors), intent(inout), optional, target :: err
+
1239
+
1240 ! Parameters
+
1241 integer(int32), parameter :: imin = 2
+
1242 integer(int32), parameter :: imax = 1
+
1243 complex(real64), parameter :: zero = (0.0d0, 0.0d0)
+
1244 complex(real64), parameter :: one = (1.0d0, 0.0d0)
+
1245
+
1246 ! Local Variables
+
1247 integer(int32) :: i, m, n, mn, lwork, ismin, ismax, rnk, maxmn, flag, &
+
1248 istat, lwork1, lwork2
+
1249 real(real64) :: rcond, smax, smin, smaxpr, sminpr
+
1250 complex(real64) :: s1, c1, s2, c2
+
1251 complex(real64), pointer, dimension(:) :: wptr, w, tau2
+
1252 complex(real64), allocatable, target, dimension(:) :: wrk
+
1253 class(errors), pointer :: errmgr
+
1254 type(errors), target :: deferr
+
1255 character(len = 128) :: errmsg
+
1256
+
1257 ! Initialization
+
1258 m = size(a, 1)
+
1259 n = size(a, 2)
+
1260 mn = min(m, n)
+
1261 maxmn = max(m, n)
+
1262 ismin = mn + 1
+
1263 ismax = 2 * mn + 1
+
1264 rcond = epsilon(rcond)
+
1265 if (present(err)) then
+
1266 errmgr => err
+
1267 else
+
1268 errmgr => deferr
+
1269 end if
+
1270
+
1271 ! Input Check
+
1272 flag = 0
+
1273 if (size(tau) /= mn) then
+
1274 flag = 2
+
1275 else if (size(jpvt) /= n) then
+
1276 flag = 3
+
1277 else if (size(b) /= maxmn) then
+
1278 flag = 4
+
1279 end if
+
1280 if (flag /= 0) then
+
1281 ! ERROR: One of the input arrays is not sized correctly
+
1282 write(errmsg, '(AI0A)') "Input number ", flag, &
+
1283 " is not sized correctly."
+
1284 call errmgr%report_error("solve_qr_pivot_vec_cmplx", trim(errmsg), &
+
1285 la_array_size_error)
+
1286 return
+
1287 end if
+
1288
+
1289 ! Workspace Query
+
1290 call rz_factor(a(1:mn,:), a(1:mn,1), olwork = lwork1)
+
1291 call mult_rz(.true., n, a(1:mn,:), a(1:mn,1), b(1:n), olwork = lwork2)
+
1292 lwork = max(lwork1, lwork2, 2 * mn + 1) + mn
+
1293 if (present(olwork)) then
+
1294 olwork = lwork
+
1295 return
+
1296 end if
+
1297
+
1298 ! Local Memory Allocation
+
1299 if (present(work)) then
+
1300 if (size(work) < lwork) then
+
1301 ! ERROR: WORK not sized correctly
+
1302 call errmgr%report_error("solve_qr_no_pivot_mtx_cmplx", &
+
1303 "Incorrectly sized input array WORK, argument 5.", &
+
1304 la_array_size_error)
+
1305 return
+
1306 end if
+
1307 wptr => work(1:lwork)
+
1308 else
+
1309 allocate(wrk(lwork), stat = istat)
+
1310 if (istat /= 0) then
+
1311 ! ERROR: Out of memory
+
1312 call errmgr%report_error("solve_qr_pivot_vec_cmplx", &
+
1313 "Insufficient memory available.", &
+
1314 la_out_of_memory_error)
+
1315 return
+
1316 end if
+
1317 wptr => wrk
+
1318 end if
+
1319
+
1320 ! Determine the rank of R11 using an incremental condition estimation
+
1321 wptr(ismin) = one
+
1322 wptr(ismax) = one
+
1323 smax = abs(a(1,1))
+
1324 smin = smax
+
1325 if (abs(a(1,1)) == zero) then
+
1326 rnk = 0
+
1327 b(maxmn) = zero
+
1328 return
+
1329 else
+
1330 rnk = 1
+
1331 end if
+
1332 do
+
1333 if (rnk < mn) then
+
1334 i = rnk + 1
+
1335 call zlaic1(imin, rnk, wptr(ismin:ismin+rnk-1), smin, &
+
1336 a(1:rnk-1,i), a(i,i), sminpr, s1, c1)
+
1337 call zlaic1(imax, rnk, wptr(ismax:ismax+rnk-1), smax, &
+
1338 a(1:rnk-1,i), a(i,i), smaxpr, s2, c2)
+
1339 if (smaxpr * rcond <= sminpr) then
+
1340 do i = 1, rnk
+
1341 wptr(ismin+i-1) = s1 * wptr(ismin+i-1)
+
1342 wptr(ismax+i-1) = s2 * wptr(ismax+i-1)
+
1343 end do
+
1344 wptr(ismin+rnk) = c1
+
1345 wptr(ismax+rnk) = c2
+
1346 smin = sminpr
+
1347 smax = smaxpr
+
1348 rnk = rnk + 1
+
1349 cycle
+
1350 end if
+
1351 end if
+
1352 exit
+
1353 end do
+
1354
+
1355 ! Partition R = [R11 R12]
+
1356 ! [ 0 R22]
+
1357 tau2 => wptr(1:rnk)
+
1358 w => wptr(rnk+1:lwork)
+
1359 if (rnk < n) call rz_factor(a(1:rnk,:), tau2, w)
+
1360
+
1361 ! Compute B(1:m,1:NRHS) = Q**T * B(1:M,1:NRHS)
+
1362 call mult_qr(.true., a, tau, b(1:m))
+
1363
+
1364 ! Solve the triangular system T11 * B(1:rnk) = B(1:rnk)
+
1365 call solve_triangular_system(.true., .false., .true., a(1:rnk,1:rnk), &
+
1366 b(1:rnk))
+
1367 if (n > rnk) b(rnk+1:n) = zero
+
1368
+
1369 ! Compute B(1:n) = Y**T * B(1:n)
+
1370 if (rnk < n) then
+
1371 call mult_rz(.true., n - rnk, a(1:rnk,:), tau2, b(1:n), w)
+
1372 end if
+
1373
+
1374 ! Apply the pivoting: B(1:N) = P * B(1:N)
+
1375 do i = 1, n
+
1376 wptr(jpvt(i)) = b(i)
+
1377 end do
+
1378 b = wptr(1:n)
+
1379 end subroutine
+
1380
+
1381! ******************************************************************************
+
1382! CHOLESKY SOLVE
+
1383! ------------------------------------------------------------------------------
+
1384 module subroutine solve_cholesky_mtx(upper, a, b, err)
+
1385 ! Arguments
+
1386 logical, intent(in) :: upper
+
1387 real(real64), intent(in), dimension(:,:) :: a
+
1388 real(real64), intent(inout), dimension(:,:) :: b
+
1389 class(errors), intent(inout), optional, target :: err
+
1390
+
1391 ! Local Variables
+
1392 character :: uplo
+
1393 integer(int32) :: n, nrhs, flag
+
1394 class(errors), pointer :: errmgr
+
1395 type(errors), target :: deferr
+
1396 character(len = 128) :: errmsg
+
1397
+
1398 ! Initialization
+
1399 n = size(a, 1)
+
1400 nrhs = size(b, 2)
+
1401 if (upper) then
+
1402 uplo = 'U'
+
1403 else
+
1404 uplo = 'L'
+
1405 end if
+
1406 if (present(err)) then
+
1407 errmgr => err
+
1408 else
+
1409 errmgr => deferr
+
1410 end if
+
1411
+
1412 ! Input Check
+
1413 flag = 0
+
1414 if (size(a, 2) /= n) then
+
1415 flag = 2
+
1416 else if (size(b, 1) /= n) then
+
1417 flag = 3
+
1418 end if
+
1419 if (flag /= 0) then
+
1420 write(errmsg, '(AI0A)') "Input number ", flag, &
+
1421 " is not sized correctly."
+
1422 call errmgr%report_error("solve_cholesky_mtx", trim(errmsg), &
+
1423 la_array_size_error)
+
1424 return
+
1425 end if
+
1426
+
1427 ! Process
+
1428 call dpotrs(uplo, n, nrhs, a, n, b, n, flag)
+
1429 end subroutine
+
1430
+
1431! ------------------------------------------------------------------------------
+
1432 module subroutine solve_cholesky_mtx_cmplx(upper, a, b, err)
+
1433 ! Arguments
+
1434 logical, intent(in) :: upper
+
1435 complex(real64), intent(in), dimension(:,:) :: a
+
1436 complex(real64), intent(inout), dimension(:,:) :: b
+
1437 class(errors), intent(inout), optional, target :: err
+
1438
+
1439 ! Local Variables
+
1440 character :: uplo
+
1441 integer(int32) :: n, nrhs, flag
+
1442 class(errors), pointer :: errmgr
+
1443 type(errors), target :: deferr
+
1444 character(len = 128) :: errmsg
+
1445
+
1446 ! Initialization
+
1447 n = size(a, 1)
+
1448 nrhs = size(b, 2)
+
1449 if (upper) then
+
1450 uplo = 'U'
+
1451 else
+
1452 uplo = 'L'
+
1453 end if
+
1454 if (present(err)) then
+
1455 errmgr => err
+
1456 else
+
1457 errmgr => deferr
+
1458 end if
+
1459
+
1460 ! Input Check
+
1461 flag = 0
+
1462 if (size(a, 2) /= n) then
+
1463 flag = 2
+
1464 else if (size(b, 1) /= n) then
+
1465 flag = 3
+
1466 end if
+
1467 if (flag /= 0) then
+
1468 write(errmsg, '(AI0A)') "Input number ", flag, &
+
1469 " is not sized correctly."
+
1470 call errmgr%report_error("solve_cholesky_mtx_cmplx", trim(errmsg), &
+
1471 la_array_size_error)
+
1472 return
+
1473 end if
+
1474
+
1475 ! Process
+
1476 call zpotrs(uplo, n, nrhs, a, n, b, n, flag)
+
1477 end subroutine
+
1478
+
1479! ------------------------------------------------------------------------------
+
1480 module subroutine solve_cholesky_vec(upper, a, b, err)
+
1481 ! Arguments
+
1482 logical, intent(in) :: upper
+
1483 real(real64), intent(in), dimension(:,:) :: a
+
1484 real(real64), intent(inout), dimension(:) :: b
+
1485 class(errors), intent(inout), optional, target :: err
+
1486
+
1487 ! Local Variables
+
1488 character :: uplo
+
1489 integer(int32) :: n, flag
+
1490 class(errors), pointer :: errmgr
+
1491 type(errors), target :: deferr
+
1492 character(len = 128) :: errmsg
+
1493
+
1494 ! Initialization
+
1495 n = size(a, 1)
+
1496 if (upper) then
+
1497 uplo = 'U'
+
1498 else
+
1499 uplo = 'L'
+
1500 end if
+
1501 if (present(err)) then
+
1502 errmgr => err
+
1503 else
+
1504 errmgr => deferr
+
1505 end if
+
1506
+
1507 ! Input Check
+
1508 flag = 0
+
1509 if (size(a, 2) /= n) then
+
1510 flag = 2
+
1511 else if (size(b) /= n) then
+
1512 flag = 3
+
1513 end if
+
1514 if (flag /= 0) then
+
1515 write(errmsg, '(AI0A)') "Input number ", flag, &
+
1516 " is not sized correctly."
+
1517 call errmgr%report_error("solve_cholesky_vec", trim(errmsg), &
+
1518 la_array_size_error)
+
1519 return
+
1520 end if
+
1521
+
1522 ! Process
+
1523 call dpotrs(uplo, n, 1, a, n, b, n, flag)
+
1524 end subroutine
+
1525
+
1526! ------------------------------------------------------------------------------
+
1527 module subroutine solve_cholesky_vec_cmplx(upper, a, b, err)
+
1528 ! Arguments
+
1529 logical, intent(in) :: upper
+
1530 complex(real64), intent(in), dimension(:,:) :: a
+
1531 complex(real64), intent(inout), dimension(:) :: b
+
1532 class(errors), intent(inout), optional, target :: err
+
1533
+
1534 ! Local Variables
+
1535 character :: uplo
+
1536 integer(int32) :: n, flag
+
1537 class(errors), pointer :: errmgr
+
1538 type(errors), target :: deferr
+
1539 character(len = 128) :: errmsg
+
1540
+
1541 ! Initialization
+
1542 n = size(a, 1)
+
1543 if (upper) then
+
1544 uplo = 'U'
+
1545 else
+
1546 uplo = 'L'
+
1547 end if
+
1548 if (present(err)) then
+
1549 errmgr => err
+
1550 else
+
1551 errmgr => deferr
+
1552 end if
+
1553
+
1554 ! Input Check
+
1555 flag = 0
+
1556 if (size(a, 2) /= n) then
+
1557 flag = 2
+
1558 else if (size(b) /= n) then
+
1559 flag = 3
+
1560 end if
+
1561 if (flag /= 0) then
+
1562 write(errmsg, '(AI0A)') "Input number ", flag, &
+
1563 " is not sized correctly."
+
1564 call errmgr%report_error("solve_cholesky_vec_cmplx", trim(errmsg), &
+
1565 la_array_size_error)
+
1566 return
+
1567 end if
+
1568
+
1569 ! Process
+
1570 call zpotrs(uplo, n, 1, a, n, b, n, flag)
+
1571 end subroutine
+
1572
+
1573! ******************************************************************************
+
1574! MATRIX INVERSION ROUTINES
+
1575! ------------------------------------------------------------------------------
+
1576 module subroutine mtx_inverse_dbl(a, iwork, work, olwork, err)
+
1577 ! Arguments
+
1578 real(real64), intent(inout), dimension(:,:) :: a
+
1579 integer(int32), intent(out), target, optional, dimension(:) :: iwork
+
1580 real(real64), intent(out), target, optional, dimension(:) :: work
+
1581 integer(int32), intent(out), optional :: olwork
+
1582 class(errors), intent(inout), optional, target :: err
+
1583
+
1584 ! Local Variables
+
1585 integer(int32) :: n, liwork, lwork, istat, flag
+
1586 integer(int32), pointer, dimension(:) :: iptr
+
1587 integer(int32), allocatable, target, dimension(:) :: iwrk
+
1588 real(real64), pointer, dimension(:) :: wptr
+
1589 real(real64), allocatable, target, dimension(:) :: wrk
+
1590 real(real64), dimension(1) :: temp
+
1591 class(errors), pointer :: errmgr
+
1592 type(errors), target :: deferr
+
1593
+
1594 ! Initialization
+
1595 n = size(a, 1)
+
1596 liwork = n
+
1597 if (present(err)) then
+
1598 errmgr => err
+
1599 else
+
1600 errmgr => deferr
+
1601 end if
+
1602
+
1603 ! Input Check
+
1604 if (size(a, 2) /= n) then
+
1605 call errmgr%report_error("mtx_inverse", &
+
1606 "The matrix must be squre to invert.", la_array_size_error)
+
1607 return
+
1608 end if
+
1609
+
1610 ! Workspace Query
+
1611 call dgetri(n, a, n, istat, temp, -1, flag)
+
1612 lwork = int(temp(1), int32)
+
1613 if (present(olwork)) then
+
1614 olwork = lwork
+
1615 return
+
1616 end if
+
1617
+
1618 ! Workspace Allocation
+
1619 if (present(work)) then
+
1620 if (size(work) < lwork) then
+
1621 ! ERROR: WORK not sized correctly
+
1622 call errmgr%report_error("mtx_inverse_dbl", &
+
1623 "Incorrectly sized input array WORK, argument 3.", &
+
1624 la_array_size_error)
+
1625 return
+
1626 end if
+
1627 wptr => work(1:lwork)
+
1628 else
+
1629 allocate(wrk(lwork), stat = istat)
+
1630 if (istat /= 0) then
+
1631 ! ERROR: Out of memory
+
1632 call errmgr%report_error("mtx_inverse_dbl", &
+
1633 "Insufficient memory available.", &
+
1634 la_out_of_memory_error)
+
1635 return
+
1636 end if
+
1637 wptr => wrk
+
1638 end if
+
1639
+
1640 ! Integer Workspace Allocation
+
1641 if (present(iwork)) then
+
1642 if (size(iwork) < liwork) then
+
1643 ! ERROR: IWORK not sized correctly
+
1644 call errmgr%report_error("mtx_inverse_dbl", &
+
1645 "Incorrectly sized input array IWORK, argument 2.", &
+
1646 la_array_size_error)
+
1647 return
+
1648 end if
+
1649 iptr => iwork(1:liwork)
+
1650 else
+
1651 allocate(iwrk(liwork), stat = istat)
+
1652 if (istat /= 0) then
+
1653 ! ERROR: Out of memory
+
1654 call errmgr%report_error("mtx_inverse_dbl", &
+
1655 "Insufficient memory available.", &
+
1656 la_out_of_memory_error)
+
1657 return
+
1658 end if
+
1659 iptr => iwrk
+
1660 end if
+
1661
+
1662 ! Compute the LU factorization of A
+
1663 call dgetrf(n, n, a, n, iptr, flag)
+
1664
+
1665 ! Compute the inverse of the LU factored matrix
+
1666 call dgetri(n, a, n, iptr, wptr, lwork, flag)
+
1667
+
1668 ! Check for a singular matrix
+
1669 if (flag > 0) then
+
1670 call errmgr%report_error("mtx_inverse_dbl", &
+
1671 "The matrix is singular; therefore, the inverse could " // &
+
1672 "not be computed.", la_singular_matrix_error)
+
1673 end if
+
1674 end subroutine
+
1675
+
1676! ------------------------------------------------------------------------------
+
1677 module subroutine mtx_inverse_cmplx(a, iwork, work, olwork, err)
+
1678 ! Arguments
+
1679 complex(real64), intent(inout), dimension(:,:) :: a
+
1680 integer(int32), intent(out), target, optional, dimension(:) :: iwork
+
1681 complex(real64), intent(out), target, optional, dimension(:) :: work
+
1682 integer(int32), intent(out), optional :: olwork
+
1683 class(errors), intent(inout), optional, target :: err
+
1684
+
1685 ! Local Variables
+
1686 integer(int32) :: n, liwork, lwork, istat, flag
+
1687 integer(int32), pointer, dimension(:) :: iptr
+
1688 integer(int32), allocatable, target, dimension(:) :: iwrk
+
1689 complex(real64), pointer, dimension(:) :: wptr
+
1690 complex(real64), allocatable, target, dimension(:) :: wrk
+
1691 complex(real64), dimension(1) :: temp
+
1692 class(errors), pointer :: errmgr
+
1693 type(errors), target :: deferr
+
1694
+
1695 ! Initialization
+
1696 n = size(a, 1)
+
1697 liwork = n
+
1698 if (present(err)) then
+
1699 errmgr => err
+
1700 else
+
1701 errmgr => deferr
+
1702 end if
+
1703
+
1704 ! Input Check
+
1705 if (size(a, 2) /= n) then
+
1706 call errmgr%report_error("mtx_inverse_cmplx", &
+
1707 "The matrix must be squre to invert.", la_array_size_error)
+
1708 return
+
1709 end if
+
1710
+
1711 ! Workspace Query
+
1712 call zgetri(n, a, n, istat, temp, -1, flag)
+
1713 lwork = int(temp(1), int32)
+
1714 if (present(olwork)) then
+
1715 olwork = lwork
+
1716 return
+
1717 end if
+
1718
+
1719 ! Workspace Allocation
+
1720 if (present(work)) then
+
1721 if (size(work) < lwork) then
+
1722 ! ERROR: WORK not sized correctly
+
1723 call errmgr%report_error("mtx_inverse_cmplx", &
+
1724 "Incorrectly sized input array WORK, argument 3.", &
+
1725 la_array_size_error)
+
1726 return
+
1727 end if
+
1728 wptr => work(1:lwork)
+
1729 else
+
1730 allocate(wrk(lwork), stat = istat)
+
1731 if (istat /= 0) then
+
1732 ! ERROR: Out of memory
+
1733 call errmgr%report_error("mtx_inverse_cmplx", &
+
1734 "Insufficient memory available.", &
+
1735 la_out_of_memory_error)
+
1736 return
+
1737 end if
+
1738 wptr => wrk
+
1739 end if
+
1740
+
1741 ! Integer Workspace Allocation
+
1742 if (present(iwork)) then
+
1743 if (size(iwork) < liwork) then
+
1744 ! ERROR: IWORK not sized correctly
+
1745 call errmgr%report_error("mtx_inverse_cmplx", &
+
1746 "Incorrectly sized input array IWORK, argument 2.", &
+
1747 la_array_size_error)
+
1748 return
+
1749 end if
+
1750 iptr => iwork(1:liwork)
+
1751 else
+
1752 allocate(iwrk(liwork), stat = istat)
+
1753 if (istat /= 0) then
+
1754 ! ERROR: Out of memory
+
1755 call errmgr%report_error("mtx_inverse_cmplx", &
+
1756 "Insufficient memory available.", &
+
1757 la_out_of_memory_error)
+
1758 return
+
1759 end if
+
1760 iptr => iwrk
+
1761 end if
+
1762
+
1763 ! Compute the LU factorization of A
+
1764 call zgetrf(n, n, a, n, iptr, flag)
+
1765
+
1766 ! Compute the inverse of the LU factored matrix
+
1767 call zgetri(n, a, n, iptr, wptr, lwork, flag)
+
1768
+
1769 ! Check for a singular matrix
+
1770 if (flag > 0) then
+
1771 call errmgr%report_error("mtx_inverse_cmplx", &
+
1772 "The matrix is singular; therefore, the inverse could " // &
+
1773 "not be computed.", la_singular_matrix_error)
+
1774 end if
+
1775 end subroutine
+
1776
+
1777! ------------------------------------------------------------------------------
+
1778 module subroutine mtx_pinverse_dbl(a, ainv, tol, work, olwork, err)
+
1779 ! Arguments
+
1780 real(real64), intent(inout), dimension(:,:) :: a
+
1781 real(real64), intent(out), dimension(:,:) :: ainv
+
1782 real(real64), intent(in), optional :: tol
+
1783 real(real64), intent(out), target, dimension(:), optional :: work
+
1784 integer(int32), intent(out), optional :: olwork
+
1785 class(errors), intent(inout), optional, target :: err
+
1786
+
1787 ! External Function Interfaces
+
1788 interface
+
1789 function dlamch(cmach) result(x)
+
1790 use, intrinsic :: iso_fortran_env, only : real64
+
1791 character, intent(in) :: cmach
+
1792 real(real64) :: x
+
1793 end function
+
1794 end interface
+
1795
+
1796 ! Parameters
+
1797 real(real64), parameter :: zero = 0.0d0
+
1798 real(real64), parameter :: one = 1.0d0
+
1799
+
1800 ! Local Variables
+
1801 integer(int32) :: i, m, n, mn, lwork, istat, flag, i1, i2a, i2b, i3a, &
+
1802 i3b, i4
+
1803 real(real64), pointer, dimension(:) :: s, wptr, w
+
1804 real(real64), pointer, dimension(:,:) :: u, vt
+
1805 real(real64), allocatable, target, dimension(:) :: wrk
+
1806 real(real64), dimension(1) :: temp
+
1807 real(real64) :: t, tref, tolcheck
+
1808 class(errors), pointer :: errmgr
+
1809 type(errors), target :: deferr
+
1810 character(len = 128) :: errmsg
+
1811
+
1812 ! Initialization
+
1813 m = size(a, 1)
+
1814 n = size(a, 2)
+
1815 mn = min(m, n)
+
1816 i1 = m * mn
+
1817 i2a = i1 + 1
+
1818 i2b = i2a + n * n - 1
+
1819 i3a = i2b + 1
+
1820 i3b = i3a + mn - 1
+
1821 i4 = i3b + 1
+
1822 tolcheck = dlamch('s')
+
1823 if (present(err)) then
+
1824 errmgr => err
+
1825 else
+
1826 errmgr => deferr
+
1827 end if
+
1828
+
1829 ! Input Check
+
1830 if (size(ainv, 1) /= n .or. size(ainv, 2) /= m) then
+
1831 write(errmsg, '(AI0AI0A)') &
+
1832 "The output matrix AINV is not sized appropriately. " // &
+
1833 "It is expected to be ", n, "-by-", m, "."
+
1834 call errmgr%report_error("mtx_pinverse", errmsg, &
+
1835 la_array_size_error)
+
1836 return
+
1837 end if
+
1838
+
1839 ! Workspace Query
+
1840 call dgesvd('S', 'A', m, n, a, m, a(1:mn,:), a, m, a, n, temp, -1, flag)
+
1841 lwork = int(temp(1), int32)
+
1842 lwork = lwork + m * mn + n * n + mn
+
1843 if (present(olwork)) then
+
1844 olwork = lwork
+
1845 return
+
1846 end if
+
1847
+
1848 ! Local Memory Allocation
+
1849 if (present(work)) then
+
1850 if (size(work) < lwork) then
+
1851 ! ERROR: WORK not sized correctly
+
1852 call errmgr%report_error("mtx_pinverse", &
+
1853 "Incorrectly sized input array WORK, argument 4.", &
+
1854 la_array_size_error)
+
1855 return
+
1856 end if
+
1857 wptr => work(1:lwork)
+
1858 else
+
1859 allocate(wrk(lwork), stat = istat)
+
1860 if (istat /= 0) then
+
1861 ! ERROR: Out of memory
+
1862 call errmgr%report_error("mtx_pinverse", &
+
1863 "Insufficient memory available.", &
+
1864 la_out_of_memory_error)
+
1865 return
+
1866 end if
+
1867 wptr => wrk
+
1868 end if
+
1869 u(1:m,1:mn) => wptr(1:i1)
+
1870 vt(1:n,1:n) => wptr(i2a:i2b)
+
1871 s => wptr(i3a:i3b)
+
1872 w => wptr(i4:lwork)
+
1873
+
1874 ! Compute the SVD of A
+
1875 call dgesvd('S', 'A', m, n, a, m, s, u, m, vt, n, w, size(w), flag)
+
1876
+
1877 ! Check for convergence
+
1878 if (flag > 0) then
+
1879 write(errmsg, '(I0A)') flag, " superdiagonals could not " // &
+
1880 "converge to zero as part of the QR iteration process."
+
1881 call errmgr%report_warning("mtx_pinverse", errmsg, &
+
1882 la_convergence_error)
+
1883 return
+
1884 end if
+
1885
+
1886 ! Determine the threshold tolerance for the singular values such that
+
1887 ! singular values less than the threshold result in zero when inverted.
+
1888 tref = max(m, n) * epsilon(t) * s(1)
+
1889 if (present(tol)) then
+
1890 t = tol
+
1891 else
+
1892 t = tref
+
1893 end if
+
1894 !if (t < safe_denom(t)) then
+
1895 if (t < tolcheck) then
+
1896 ! The supplied tolerance is too small, simply fall back to the
+
1897 ! default, but issue a warning to the user
+
1898 t = tref
+
1899 ! call errmgr%report_warning("pinverse_1", "The supplied tolerance was " // &
+
1900 ! "smaller than a value that would result in an overflow " // &
+
1901 ! "condition, or is negative; therefore, the tolerance has " // &
+
1902 ! "been reset to its default value.")
+
1903 end if
+
1904
+
1905 ! Compute the pseudoinverse such that pinv(A) = V * inv(S) * U**T by
+
1906 ! first computing V * inv(S) (result is N-by-M), and store in the first
+
1907 ! MN rows of VT in a transposed manner.
+
1908 do i = 1, mn
+
1909 ! Apply 1 / S(I) to VT(I,:)
+
1910 if (s(i) < t) then
+
1911 vt(i,:) = zero
+
1912 else
+
1913 call recip_mult_array(s(i), vt(i,1:n))
+
1914 end if
+
1915 end do
+
1916
+
1917 ! Compute (VT**T * inv(S)) * U**T
+
1918 call mtx_mult(.true., .true., one, vt(1:mn,:), u, zero, ainv)
+
1919 end subroutine
+
1920
+
1921! ------------------------------------------------------------------------------
+
1922 module subroutine mtx_pinverse_cmplx(a, ainv, tol, work, olwork, rwork, err)
+
1923 ! Arguments
+
1924 complex(real64), intent(inout), dimension(:,:) :: a
+
1925 complex(real64), intent(out), dimension(:,:) :: ainv
+
1926 real(real64), intent(in), optional :: tol
+
1927 complex(real64), intent(out), target, dimension(:), optional :: work
+
1928 integer(int32), intent(out), optional :: olwork
+
1929 real(real64), intent(out), target, dimension(:), optional :: rwork
+
1930 class(errors), intent(inout), optional, target :: err
+
1931
+
1932 ! External Function Interfaces
+
1933 interface
+
1934 function dlamch(cmach) result(x)
+
1935 use, intrinsic :: iso_fortran_env, only : real64
+
1936 character, intent(in) :: cmach
+
1937 real(real64) :: x
+
1938 end function
+
1939 end interface
+
1940
+
1941 ! Parameters
+
1942 complex(real64), parameter :: zero = (0.0d0, 0.0d0)
+
1943 complex(real64), parameter :: one = (1.0d0, 0.0d0)
+
1944
+
1945 ! Local Variables
+
1946 integer(int32) :: i, m, n, mn, lwork, istat, flag, i1, i2a, i2b, i3, &
+
1947 lrwork, j, k
+
1948 real(real64), pointer, dimension(:) :: s, rwptr, rw
+
1949 real(real64), allocatable, target, dimension(:) :: rwrk
+
1950 complex(real64), pointer, dimension(:) :: wptr, w
+
1951 complex(real64), pointer, dimension(:,:) :: u, vt
+
1952 complex(real64), allocatable, target, dimension(:) :: wrk
+
1953 complex(real64) :: temp(1), val
+
1954 real(real64) :: t, tref, tolcheck, rtemp(1)
+
1955 class(errors), pointer :: errmgr
+
1956 type(errors), target :: deferr
+
1957 character(len = 128) :: errmsg
+
1958
+
1959 ! Initialization
+
1960 m = size(a, 1)
+
1961 n = size(a, 2)
+
1962 mn = min(m, n)
+
1963 lrwork = 6 * mn
+
1964 i1 = m * mn
+
1965 i2a = i1 + 1
+
1966 i2b = i2a + n * n - 1
+
1967 i3 = i2b + 1
+
1968 tolcheck = dlamch('s')
+
1969 if (present(err)) then
+
1970 errmgr => err
+
1971 else
+
1972 errmgr => deferr
+
1973 end if
+
1974
+
1975 ! Input Check
+
1976 if (size(ainv, 1) /= n .or. size(ainv, 2) /= m) then
+
1977 write(errmsg, '(AI0AI0A)') &
+
1978 "The output matrix AINV is not sized appropriately. " // &
+
1979 "It is expected to be ", n, "-by-", m, "."
+
1980 call errmgr%report_error("mtx_pinverse_cmplx", errmsg, &
+
1981 la_array_size_error)
+
1982 return
+
1983 end if
+
1984
+
1985 ! Workspace Query
+
1986 call zgesvd('S', 'A', m, n, a, m, a(1:mn,:), a, m, a, n, temp, -1, &
+
1987 rtemp, flag)
+
1988 lwork = int(temp(1), int32)
+
1989 lwork = lwork + m * mn + n * n
+
1990 if (present(olwork)) then
+
1991 olwork = lwork
+
1992 return
+
1993 end if
+
1994
+
1995 ! Local Memory Allocation
+
1996 if (present(work)) then
+
1997 if (size(work) < lwork) then
+
1998 ! ERROR: WORK not sized correctly
+
1999 call errmgr%report_error("mtx_pinverse_cmplx", &
+
2000 "Incorrectly sized input array WORK, argument 4.", &
+
2001 la_array_size_error)
+
2002 return
+
2003 end if
+
2004 wptr => work(1:lwork)
+
2005 else
+
2006 allocate(wrk(lwork), stat = istat)
+
2007 if (istat /= 0) then
+
2008 ! ERROR: Out of memory
+
2009 call errmgr%report_error("mtx_pinverse_cmplx", &
+
2010 "Insufficient memory available.", &
+
2011 la_out_of_memory_error)
+
2012 return
+
2013 end if
+
2014 wptr => wrk
+
2015 end if
+
2016
+
2017 if (present(rwork)) then
+
2018 if (size(rwork) < lrwork) then
+
2019 ! ERROR: WORK not sized correctly
+
2020 call errmgr%report_error("mtx_pinverse_cmplx", &
+
2021 "Incorrectly sized input array RWORK, argument 6.", &
+
2022 la_array_size_error)
+
2023 return
+
2024 end if
+
2025 rwptr => rwork(1:lrwork)
+
2026 else
+
2027 allocate(rwrk(lrwork), stat = istat)
+
2028 if (istat /= 0) then
+
2029 ! ERROR: Out of memory
+
2030 call errmgr%report_error("mtx_pinverse_cmplx", &
+
2031 "Insufficient memory available.", &
+
2032 la_out_of_memory_error)
+
2033 return
+
2034 end if
+
2035 rwptr => rwrk
+
2036 end if
+
2037 u(1:m,1:mn) => wptr(1:i1)
+
2038 vt(1:n,1:n) => wptr(i2a:i2b)
+
2039 w => wptr(i3:lwork)
+
2040 s => rwptr(1:mn)
+
2041 rw => rwptr(mn+1:lrwork)
+
2042
+
2043 ! Compute the SVD of A
+
2044 call zgesvd('S', 'A', m, n, a, m, s, u, m, vt, n, w, size(w), rw, flag)
+
2045
+
2046 ! Check for convergence
+
2047 if (flag > 0) then
+
2048 write(errmsg, '(I0A)') flag, " superdiagonals could not " // &
+
2049 "converge to zero as part of the QR iteration process."
+
2050 call errmgr%report_warning("mtx_pinverse_cmplx", errmsg, &
+
2051 la_convergence_error)
+
2052 return
+
2053 end if
+
2054
+
2055 ! Determine the threshold tolerance for the singular values such that
+
2056 ! singular values less than the threshold result in zero when inverted.
+
2057 tref = max(m, n) * epsilon(t) * s(1)
+
2058 if (present(tol)) then
+
2059 t = tol
+
2060 else
+
2061 t = tref
+
2062 end if
+
2063 !if (t < safe_denom(t)) then
+
2064 if (t < tolcheck) then
+
2065 ! The supplied tolerance is too small, simply fall back to the
+
2066 ! default, but issue a warning to the user
+
2067 t = tref
+
2068 ! call errmgr%report_warning("pinverse_1", "The supplied tolerance was " // &
+
2069 ! "smaller than a value that would result in an overflow " // &
+
2070 ! "condition, or is negative; therefore, the tolerance has " // &
+
2071 ! "been reset to its default value.")
+
2072 end if
+
2073
+
2074 ! Compute the pseudoinverse such that pinv(A) = V * inv(S) * U**T by
+
2075 ! first computing V * inv(S) (result is N-by-M), and store in the first
+
2076 ! MN rows of VT in a transposed manner.
+
2077 do i = 1, mn
+
2078 ! Apply 1 / S(I) to VT(I,:)
+
2079 if (s(i) < t) then
+
2080 vt(i,:) = zero
+
2081 else
+
2082 ! call recip_mult_array(s(i), vt(i,1:n))
+
2083 vt(i,1:n) = conjg(vt(i,1:n)) / s(i)
+
2084 end if
+
2085 end do
+
2086
+
2087 ! Compute (VT**T * inv(S)) * U**H
+
2088 ! ainv = n-by-m
+
2089 ! vt is n-by-n
+
2090 ! u is m-by-mn such that u**H = mn-by-m
+
2091 ! Compute ainv = vt**T * u**H
+
2092 do j = 1, m
+
2093 do i = 1, n
+
2094 val = zero
+
2095 do k = 1, mn
+
2096 val = val + vt(k,i) * conjg(u(j,k))
+
2097 end do
+
2098 ainv(i,j) = val
+
2099 end do
+
2100 end do
+
2101 end subroutine
+
2102
+
2103! ******************************************************************************
+
2104! LEAST SQUARES SOLUTION ROUTINES
+
2105! ------------------------------------------------------------------------------
+
2106 module subroutine solve_least_squares_mtx(a, b, work, olwork, err)
+
2107 ! Arguments
+
2108 real(real64), intent(inout), dimension(:,:) :: a, b
+
2109 real(real64), intent(out), target, optional, dimension(:) :: work
+
2110 integer(int32), intent(out), optional :: olwork
+
2111 class(errors), intent(inout), optional, target :: err
+
2112
+
2113 ! Local Variables
+
2114 integer(int32) :: m, n, maxmn, nrhs, lwork, istat, flag
+
2115 real(real64), pointer, dimension(:) :: wptr
+
2116 real(real64), allocatable, target, dimension(:) :: wrk
+
2117 real(real64), dimension(1) :: temp
+
2118 class(errors), pointer :: errmgr
+
2119 type(errors), target :: deferr
+
2120
+
2121 ! Initialization
+
2122 m = size(a, 1)
+
2123 n = size(a, 2)
+
2124 maxmn = max(m, n)
+
2125 nrhs = size(b, 2)
+
2126 if (present(err)) then
+
2127 errmgr => err
+
2128 else
+
2129 errmgr => deferr
+
2130 end if
+
2131
+
2132 ! Input Check
+
2133 if (size(b, 1) /= maxmn) then
+
2134 call errmgr%report_error("solve_least_squares_mtx", &
+
2135 "Input 2 is not sized correctly.", la_array_size_error)
+
2136 return
+
2137 end if
+
2138
+
2139 ! Workspace Query
+
2140 call dgels('N', m, n, nrhs, a, m, b, maxmn, temp, -1, flag)
+
2141 lwork = int(temp(1), int32)
+
2142 if (present(olwork)) then
+
2143 olwork = lwork
+
2144 return
+
2145 end if
+
2146
+
2147 ! Local Memory Allocation
+
2148 if (present(work)) then
+
2149 if (size(work) < lwork) then
+
2150 ! ERROR: WORK not sized correctly
+
2151 call errmgr%report_error("solve_least_squares_mtx", &
+
2152 "Incorrectly sized input array WORK, argument 3.", &
+
2153 la_array_size_error)
+
2154 return
+
2155 end if
+
2156 wptr => work(1:lwork)
+
2157 else
+
2158 allocate(wrk(lwork), stat = istat)
+
2159 if (istat /= 0) then
+
2160 ! ERROR: Out of memory
+
2161 call errmgr%report_error("solve_least_squares_mtx", &
+
2162 "Insufficient memory available.", &
+
2163 la_out_of_memory_error)
+
2164 return
+
2165 end if
+
2166 wptr => wrk
+
2167 end if
+
2168
+
2169 ! Process
+
2170 call dgels('N', m, n, nrhs, a, m, b, maxmn, wptr, lwork, flag)
+
2171 if (flag > 0) then
+
2172 call errmgr%report_error("solve_least_squares_mtx", &
+
2173 "The supplied matrix is not of full rank; therefore, " // &
+
2174 "the solution could not be computed via this routine. " // &
+
2175 "Try a routine that utilizes column pivoting.", &
+
2176 la_invalid_operation_error)
+
2177 end if
+
2178 end subroutine
+
2179
+
2180! ------------------------------------------------------------------------------
+
2181 module subroutine solve_least_squares_mtx_cmplx(a, b, work, olwork, err)
+
2182 ! Arguments
+
2183 complex(real64), intent(inout), dimension(:,:) :: a, b
+
2184 complex(real64), intent(out), target, optional, dimension(:) :: work
+
2185 integer(int32), intent(out), optional :: olwork
+
2186 class(errors), intent(inout), optional, target :: err
+
2187
+
2188 ! Local Variables
+
2189 integer(int32) :: m, n, maxmn, nrhs, lwork, istat, flag
+
2190 complex(real64), pointer, dimension(:) :: wptr
+
2191 complex(real64), allocatable, target, dimension(:) :: wrk
+
2192 complex(real64), dimension(1) :: temp
+
2193 class(errors), pointer :: errmgr
+
2194 type(errors), target :: deferr
+
2195
+
2196 ! Initialization
+
2197 m = size(a, 1)
+
2198 n = size(a, 2)
+
2199 maxmn = max(m, n)
+
2200 nrhs = size(b, 2)
+
2201 if (present(err)) then
+
2202 errmgr => err
+
2203 else
+
2204 errmgr => deferr
+
2205 end if
+
2206
+
2207 ! Input Check
+
2208 if (size(b, 1) /= maxmn) then
+
2209 call errmgr%report_error("solve_least_squares_mtx_cmplx", &
+
2210 "Input 2 is not sized correctly.", la_array_size_error)
+
2211 return
+
2212 end if
+
2213
+
2214 ! Workspace Query
+
2215 call zgels('N', m, n, nrhs, a, m, b, maxmn, temp, -1, flag)
+
2216 lwork = int(temp(1), int32)
+
2217 if (present(olwork)) then
+
2218 olwork = lwork
+
2219 return
+
2220 end if
+
2221
+
2222 ! Local Memory Allocation
+
2223 if (present(work)) then
+
2224 if (size(work) < lwork) then
+
2225 ! ERROR: WORK not sized correctly
+
2226 call errmgr%report_error("solve_least_squares_mtx_cmplx", &
+
2227 "Incorrectly sized input array WORK, argument 3.", &
+
2228 la_array_size_error)
+
2229 return
+
2230 end if
+
2231 wptr => work(1:lwork)
+
2232 else
+
2233 allocate(wrk(lwork), stat = istat)
+
2234 if (istat /= 0) then
+
2235 ! ERROR: Out of memory
+
2236 call errmgr%report_error("solve_least_squares_mtx_cmplx", &
+
2237 "Insufficient memory available.", &
+
2238 la_out_of_memory_error)
+
2239 return
+
2240 end if
+
2241 wptr => wrk
+
2242 end if
+
2243
+
2244 ! Process
+
2245 call zgels('N', m, n, nrhs, a, m, b, maxmn, wptr, lwork, flag)
+
2246 if (flag > 0) then
+
2247 call errmgr%report_error("solve_least_squares_mtx_cmplx", &
+
2248 "The supplied matrix is not of full rank; therefore, " // &
+
2249 "the solution could not be computed via this routine. " // &
+
2250 "Try a routine that utilizes column pivoting.", &
+
2251 la_invalid_operation_error)
+
2252 end if
+
2253 end subroutine
+
2254
+
2255! ------------------------------------------------------------------------------
+
2256 module subroutine solve_least_squares_vec(a, b, work, olwork, err)
+
2257 ! Arguments
+
2258 real(real64), intent(inout), dimension(:,:) :: a
+
2259 real(real64), intent(inout), dimension(:) :: b
+
2260 real(real64), intent(out), target, optional, dimension(:) :: work
+
2261 integer(int32), intent(out), optional :: olwork
+
2262 class(errors), intent(inout), optional, target :: err
+
2263
+
2264 ! Local Variables
+
2265 integer(int32) :: m, n, maxmn, lwork, istat, flag
+
2266 real(real64), pointer, dimension(:) :: wptr
+
2267 real(real64), allocatable, target, dimension(:) :: wrk
+
2268 real(real64), dimension(1) :: temp
+
2269 class(errors), pointer :: errmgr
+
2270 type(errors), target :: deferr
+
2271
+
2272 ! Initialization
+
2273 m = size(a, 1)
+
2274 n = size(a, 2)
+
2275 maxmn = max(m, n)
+
2276 if (present(err)) then
+
2277 errmgr => err
+
2278 else
+
2279 errmgr => deferr
+
2280 end if
+
2281
+
2282 ! Input Check
+
2283 if (size(b) /= maxmn) then
+
2284 call errmgr%report_error("solve_least_squares_vec", &
+
2285 "Input 2 is not sized correctly.", la_array_size_error)
+
2286 return
+
2287 end if
+
2288
+
2289 ! Workspace Query
+
2290 call dgels('N', m, n, 1, a, m, b, maxmn, temp, -1, flag)
+
2291 lwork = int(temp(1), int32)
+
2292 if (present(olwork)) then
+
2293 olwork = lwork
+
2294 return
+
2295 end if
+
2296
+
2297 ! Local Memory Allocation
+
2298 if (present(work)) then
+
2299 if (size(work) < lwork) then
+
2300 ! ERROR: WORK not sized correctly
+
2301 call errmgr%report_error("solve_least_squares_vec", &
+
2302 "Incorrectly sized input array WORK, argument 3.", &
+
2303 la_array_size_error)
+
2304 return
+
2305 end if
+
2306 wptr => work(1:lwork)
+
2307 else
+
2308 allocate(wrk(lwork), stat = istat)
+
2309 if (istat /= 0) then
+
2310 ! ERROR: Out of memory
+
2311 call errmgr%report_error("solve_least_squares_vec", &
+
2312 "Insufficient memory available.", &
+
2313 la_out_of_memory_error)
+
2314 return
+
2315 end if
+
2316 wptr => wrk
+
2317 end if
+
2318
+
2319 ! Process
+
2320 call dgels('N', m, n, 1, a, m, b, maxmn, wptr, lwork, flag)
+
2321 if (flag > 0) then
+
2322 call errmgr%report_error("solve_least_squares_mtx", &
+
2323 "The supplied matrix is not of full rank; therefore, " // &
+
2324 "the solution could not be computed via this routine. " // &
+
2325 "Try a routine that utilizes column pivoting.", &
+
2326 la_invalid_operation_error)
+
2327 end if
+
2328 end subroutine
+
2329
+
2330! ------------------------------------------------------------------------------
+
2331 module subroutine solve_least_squares_vec_cmplx(a, b, work, olwork, err)
+
2332 ! Arguments
+
2333 complex(real64), intent(inout), dimension(:,:) :: a
+
2334 complex(real64), intent(inout), dimension(:) :: b
+
2335 complex(real64), intent(out), target, optional, dimension(:) :: work
+
2336 integer(int32), intent(out), optional :: olwork
+
2337 class(errors), intent(inout), optional, target :: err
+
2338
+
2339 ! Local Variables
+
2340 integer(int32) :: m, n, maxmn, lwork, istat, flag
+
2341 complex(real64), pointer, dimension(:) :: wptr
+
2342 complex(real64), allocatable, target, dimension(:) :: wrk
+
2343 complex(real64), dimension(1) :: temp
+
2344 class(errors), pointer :: errmgr
+
2345 type(errors), target :: deferr
+
2346
+
2347 ! Initialization
+
2348 m = size(a, 1)
+
2349 n = size(a, 2)
+
2350 maxmn = max(m, n)
+
2351 if (present(err)) then
+
2352 errmgr => err
+
2353 else
+
2354 errmgr => deferr
+
2355 end if
+
2356
+
2357 ! Input Check
+
2358 if (size(b) /= maxmn) then
+
2359 call errmgr%report_error("solve_least_squares_vec_cmplx", &
+
2360 "Input 2 is not sized correctly.", la_array_size_error)
+
2361 return
+
2362 end if
+
2363
+
2364 ! Workspace Query
+
2365 call zgels('N', m, n, 1, a, m, b, maxmn, temp, -1, flag)
+
2366 lwork = int(temp(1), int32)
+
2367 if (present(olwork)) then
+
2368 olwork = lwork
+
2369 return
+
2370 end if
+
2371
+
2372 ! Local Memory Allocation
+
2373 if (present(work)) then
+
2374 if (size(work) < lwork) then
+
2375 ! ERROR: WORK not sized correctly
+
2376 call errmgr%report_error("solve_least_squares_vec_cmplx", &
+
2377 "Incorrectly sized input array WORK, argument 3.", &
+
2378 la_array_size_error)
+
2379 return
+
2380 end if
+
2381 wptr => work(1:lwork)
+
2382 else
+
2383 allocate(wrk(lwork), stat = istat)
+
2384 if (istat /= 0) then
+
2385 ! ERROR: Out of memory
+
2386 call errmgr%report_error("solve_least_squares_vec_cmplx", &
+
2387 "Insufficient memory available.", &
+
2388 la_out_of_memory_error)
+
2389 return
+
2390 end if
+
2391 wptr => wrk
+
2392 end if
+
2393
+
2394 ! Process
+
2395 call zgels('N', m, n, 1, a, m, b, maxmn, wptr, lwork, flag)
+
2396 if (flag > 0) then
+
2397 call errmgr%report_error("solve_least_squares_mtx_cmplx", &
+
2398 "The supplied matrix is not of full rank; therefore, " // &
+
2399 "the solution could not be computed via this routine. " // &
+
2400 "Try a routine that utilizes column pivoting.", &
+
2401 la_invalid_operation_error)
+
2402 end if
+
2403 end subroutine
+
2404
+
2405! ------------------------------------------------------------------------------
+
2406 module subroutine solve_least_squares_mtx_pvt(a, b, ipvt, arnk, work, olwork, err)
+
2407 ! Arguments
+
2408 real(real64), intent(inout), dimension(:,:) :: a, b
+
2409 integer(int32), intent(inout), target, optional, dimension(:) :: ipvt
+
2410 integer(int32), intent(out), optional :: arnk
+
2411 real(real64), intent(out), target, optional, dimension(:) :: work
+
2412 integer(int32), intent(out), optional :: olwork
+
2413 class(errors), intent(inout), optional, target :: err
+
2414
+
2415 ! Local Variables
+
2416 integer(int32) :: m, n, maxmn, nrhs, lwork, istat, flag, rnk
+
2417 real(real64), pointer, dimension(:) :: wptr
+
2418 real(real64), allocatable, target, dimension(:) :: wrk
+
2419 integer(int32), allocatable, target, dimension(:) :: iwrk
+
2420 integer(int32), pointer, dimension(:) :: iptr
+
2421 real(real64), dimension(1) :: temp
+
2422 integer(int32), dimension(1) :: itemp
+
2423 real(real64) :: rc
+
2424 class(errors), pointer :: errmgr
+
2425 type(errors), target :: deferr
+
2426 character(len = 128) :: errmsg
+
2427
+
2428 ! Initialization
+
2429 m = size(a, 1)
+
2430 n = size(a, 2)
+
2431 maxmn = max(m, n)
+
2432 nrhs = size(b, 2)
+
2433 rc = epsilon(rc)
+
2434 if (present(arnk)) arnk = 0
+
2435 if (present(err)) then
+
2436 errmgr => err
+
2437 else
+
2438 errmgr => deferr
+
2439 end if
+
2440
+
2441 ! Input Check
+
2442 flag = 0
+
2443 if (size(b, 1) /= maxmn) then
+
2444 flag = 2
+
2445 end if
+
2446 if (flag /= 0) then
+
2447 write(errmsg, '(AI0A)') "Input number ", flag, &
+
2448 " is not sized correctly."
+
2449 call errmgr%report_error("solve_least_squares_mtx_pvt", &
+
2450 trim(errmsg), la_array_size_error)
+
2451 return
+
2452 end if
+
2453
+
2454 ! Workspace Query
+
2455 call dgelsy(m, n, nrhs, a, m, b, maxmn, itemp, rc, rnk, temp, -1, flag)
+
2456 lwork = int(temp(1), int32)
+
2457 if (present(olwork)) then
+
2458 olwork = lwork
+
2459 return
+
2460 end if
+
2461
+
2462 ! Local Memory Allocation
+
2463 if (present(ipvt)) then
+
2464 if (size(ipvt) < n) then
+
2465 ! ERROR: IPVT is not big enough
+
2466 call errmgr%report_error("solve_least_squares_mtx_pvt", &
+
2467 "Incorrectly sized pivot array, argument 3.", &
+
2468 la_array_size_error)
+
2469 return
+
2470 end if
+
2471 iptr => ipvt(1:n)
+
2472 else
+
2473 allocate(iwrk(n), stat = istat)
+
2474 if (istat /= 0) then
+
2475 ! ERROR: Out of memory
+
2476 call errmgr%report_error("solve_least_squares_mtx_pvt", &
+
2477 "Insufficient memory available.", &
+
2478 la_out_of_memory_error)
+
2479 return
+
2480 end if
+
2481 iptr => iwrk
+
2482 iptr = 0
+
2483 end if
+
2484
+
2485 if (present(work)) then
+
2486 if (size(work) < lwork) then
+
2487 ! ERROR: WORK not sized correctly
+
2488 call errmgr%report_error("solve_least_squares_mtx_pvt", &
+
2489 "Incorrectly sized input array WORK, argument 5.", &
+
2490 la_array_size_error)
+
2491 return
+
2492 end if
+
2493 wptr => work(1:lwork)
+
2494 else
+
2495 allocate(wrk(lwork), stat = istat)
+
2496 if (istat /= 0) then
+
2497 ! ERROR: Out of memory
+
2498 call errmgr%report_error("solve_least_squares_mtx_pvt", &
+
2499 "Insufficient memory available.", &
+
2500 la_out_of_memory_error)
+
2501 return
+
2502 end if
+
2503 wptr => wrk
+
2504 end if
+
2505
+
2506 ! Process
+
2507 call dgelsy(m, n, nrhs, a, m, b, maxmn, iptr, rc, rnk, wptr, lwork, &
+
2508 flag)
+
2509 if (present(arnk)) arnk = rnk
+
2510 end subroutine
+
2511
+
2512! ------------------------------------------------------------------------------
+
2513 module subroutine solve_least_squares_mtx_pvt_cmplx(a, b, ipvt, arnk, &
+
2514 work, olwork, rwork, err)
+
2515 ! Arguments
+
2516 complex(real64), intent(inout), dimension(:,:) :: a, b
+
2517 integer(int32), intent(inout), target, optional, dimension(:) :: ipvt
+
2518 integer(int32), intent(out), optional :: arnk
+
2519 complex(real64), intent(out), target, optional, dimension(:) :: work
+
2520 integer(int32), intent(out), optional :: olwork
+
2521 real(real64), intent(out), target, optional, dimension(:) :: rwork
+
2522 class(errors), intent(inout), optional, target :: err
+
2523
+
2524 ! Local Variables
+
2525 integer(int32) :: m, n, maxmn, nrhs, lwork, istat, flag, rnk, lrwork
+
2526 complex(real64), pointer, dimension(:) :: wptr
+
2527 complex(real64), allocatable, target, dimension(:) :: wrk
+
2528 real(real64), pointer, dimension(:) :: rwptr
+
2529 real(real64), allocatable, target, dimension(:) :: rwrk
+
2530 integer(int32), allocatable, target, dimension(:) :: iwrk
+
2531 integer(int32), pointer, dimension(:) :: iptr
+
2532 complex(real64), dimension(1) :: temp
+
2533 real(real64), dimension(1) :: rtemp
+
2534 integer(int32), dimension(1) :: itemp
+
2535 real(real64) :: rc
+
2536 class(errors), pointer :: errmgr
+
2537 type(errors), target :: deferr
+
2538 character(len = 128) :: errmsg
+
2539
+
2540 ! Initialization
+
2541 m = size(a, 1)
+
2542 n = size(a, 2)
+
2543 maxmn = max(m, n)
+
2544 nrhs = size(b, 2)
+
2545 lrwork = 2 * n
+
2546 rc = epsilon(rc)
+
2547 if (present(arnk)) arnk = 0
+
2548 if (present(err)) then
+
2549 errmgr => err
+
2550 else
+
2551 errmgr => deferr
+
2552 end if
+
2553
+
2554 ! Input Check
+
2555 flag = 0
+
2556 if (size(b, 1) /= maxmn) then
+
2557 flag = 2
+
2558 end if
+
2559 if (flag /= 0) then
+
2560 write(errmsg, '(AI0A)') "Input number ", flag, &
+
2561 " is not sized correctly."
+
2562 call errmgr%report_error("solve_least_squares_mtx_pvt_cmplx", &
+
2563 trim(errmsg), la_array_size_error)
+
2564 return
+
2565 end if
+
2566
+
2567 ! Workspace Query
+
2568 call zgelsy(m, n, nrhs, a, m, b, maxmn, itemp, rc, rnk, temp, -1, &
+
2569 rtemp, flag)
+
2570 lwork = int(temp(1), int32)
+
2571 if (present(olwork)) then
+
2572 olwork = lwork
+
2573 return
+
2574 end if
+
2575
+
2576 ! Local Memory Allocation
+
2577 if (present(ipvt)) then
+
2578 if (size(ipvt) < n) then
+
2579 ! ERROR: IPVT is not big enough
+
2580 call errmgr%report_error("solve_least_squares_mtx_pvt", &
+
2581 "Incorrectly sized pivot array, argument 3.", &
+
2582 la_array_size_error)
+
2583 return
+
2584 end if
+
2585 iptr => ipvt(1:n)
+
2586 else
+
2587 allocate(iwrk(n), stat = istat)
+
2588 if (istat /= 0) then
+
2589 ! ERROR: Out of memory
+
2590 call errmgr%report_error("solve_least_squares_mtx_pvt", &
+
2591 "Insufficient memory available.", &
+
2592 la_out_of_memory_error)
+
2593 return
+
2594 end if
+
2595 iptr => iwrk
+
2596 iptr = 0
+
2597 end if
+
2598
+
2599 if (present(work)) then
+
2600 if (size(work) < lwork) then
+
2601 ! ERROR: WORK not sized correctly
+
2602 call errmgr%report_error("solve_least_squares_mtx_pvt", &
+
2603 "Incorrectly sized input array WORK, argument 5.", &
+
2604 la_array_size_error)
+
2605 return
+
2606 end if
+
2607 wptr => work(1:lwork)
+
2608 else
+
2609 allocate(wrk(lwork), stat = istat)
+
2610 if (istat /= 0) then
+
2611 ! ERROR: Out of memory
+
2612 call errmgr%report_error("solve_least_squares_mtx_pvt", &
+
2613 "Insufficient memory available.", &
+
2614 la_out_of_memory_error)
+
2615 return
+
2616 end if
+
2617 wptr => wrk
+
2618 end if
+
2619
+
2620 if (present(rwork)) then
+
2621 if (size(rwork) < lrwork) then
+
2622 ! ERROR: RWORK not sized correctly
+
2623 call errmgr%report_error("solve_least_squares_mtx_pvt_cmplx", &
+
2624 "Incorrectly sized input array RWORK, argument 7.", &
+
2625 la_array_size_error)
+
2626 return
+
2627 end if
+
2628 rwptr => rwork(1:lrwork)
+
2629 else
+
2630 allocate(rwrk(lrwork), stat = istat)
+
2631 if (istat /= 0) then
+
2632 ! ERROR: Out of memory
+
2633 call errmgr%report_error("solve_least_squares_mtx_pvt_cmplx", &
+
2634 "Insufficient memory available.", &
+
2635 la_out_of_memory_error)
+
2636 return
+
2637 end if
+
2638 rwptr => rwrk
+
2639 end if
+
2640
+
2641 ! Process
+
2642 call zgelsy(m, n, nrhs, a, m, b, maxmn, iptr, rc, rnk, wptr, lwork, &
+
2643 rwptr, flag)
+
2644 if (present(arnk)) arnk = rnk
+
2645 end subroutine
+
2646
+
2647! ------------------------------------------------------------------------------
+
2648 module subroutine solve_least_squares_vec_pvt(a, b, ipvt, arnk, work, olwork, err)
+
2649 ! Arguments
+
2650 real(real64), intent(inout), dimension(:,:) :: a
+
2651 real(real64), intent(inout), dimension(:) :: b
+
2652 integer(int32), intent(inout), target, optional, dimension(:) :: ipvt
+
2653 integer(int32), intent(out), optional :: arnk
+
2654 real(real64), intent(out), target, optional, dimension(:) :: work
+
2655 integer(int32), intent(out), optional :: olwork
+
2656 class(errors), intent(inout), optional, target :: err
+
2657
+
2658 ! Local Variables
+
2659 integer(int32) :: m, n, maxmn, lwork, istat, flag, rnk
+
2660 real(real64), pointer, dimension(:) :: wptr
+
2661 real(real64), allocatable, target, dimension(:) :: wrk
+
2662 integer(int32), allocatable, target, dimension(:) :: iwrk
+
2663 integer(int32), pointer, dimension(:) :: iptr
+
2664 real(real64), dimension(1) :: temp
+
2665 integer(int32), dimension(1) :: itemp
+
2666 real(real64) :: rc
+
2667 class(errors), pointer :: errmgr
+
2668 type(errors), target :: deferr
+
2669 character(len = 128) :: errmsg
+
2670
+
2671 ! Initialization
+
2672 m = size(a, 1)
+
2673 n = size(a, 2)
+
2674 maxmn = max(m, n)
+
2675 rc = epsilon(rc)
+
2676 if (present(arnk)) arnk = 0
+
2677 if (present(err)) then
+
2678 errmgr => err
+
2679 else
+
2680 errmgr => deferr
+
2681 end if
+
2682
+
2683 ! Input Check
+
2684 flag = 0
+
2685 if (size(b, 1) /= maxmn) then
+
2686 flag = 2
+
2687 end if
+
2688 if (flag /= 0) then
+
2689 write(errmsg, '(AI0A)') "Input number ", flag, &
+
2690 " is not sized correctly."
+
2691 call errmgr%report_error("solve_least_squares_vec_pvt", &
+
2692 trim(errmsg), la_array_size_error)
+
2693 return
+
2694 end if
+
2695
+
2696 ! Workspace Query
+
2697 call dgelsy(m, n, 1, a, m, b, maxmn, itemp, rc, rnk, temp, -1, flag)
+
2698 lwork = int(temp(1), int32)
+
2699 if (present(olwork)) then
+
2700 olwork = lwork
+
2701 return
+
2702 end if
+
2703
+
2704 ! Local Memory Allocation
+
2705 if (present(ipvt)) then
+
2706 if (size(ipvt) < n) then
+
2707 ! ERROR: IPVT is not big enough
+
2708 call errmgr%report_error("solve_least_squares_mtx_pvt", &
+
2709 "Incorrectly sized pivot array, argument 3.", &
+
2710 la_array_size_error)
+
2711 return
+
2712 end if
+
2713 iptr => ipvt(1:n)
+
2714 else
+
2715 allocate(iwrk(n), stat = istat)
+
2716 if (istat /= 0) then
+
2717 ! ERROR: Out of memory
+
2718 call errmgr%report_error("solve_least_squares_mtx_pvt", &
+
2719 "Insufficient memory available.", &
+
2720 la_out_of_memory_error)
+
2721 return
+
2722 end if
+
2723 iptr => iwrk
+
2724 iptr = 0
+
2725 end if
+
2726
+
2727 if (present(work)) then
+
2728 if (size(work) < lwork) then
+
2729 ! ERROR: WORK not sized correctly
+
2730 call errmgr%report_error("solve_least_squares_vec_pvt", &
+
2731 "Incorrectly sized input array WORK, argument 5.", &
+
2732 la_array_size_error)
+
2733 return
+
2734 end if
+
2735 wptr => work(1:lwork)
+
2736 else
+
2737 allocate(wrk(lwork), stat = istat)
+
2738 if (istat /= 0) then
+
2739 ! ERROR: Out of memory
+
2740 call errmgr%report_error("solve_least_squares_vec_pvt", &
+
2741 "Insufficient memory available.", &
+
2742 la_out_of_memory_error)
+
2743 return
+
2744 end if
+
2745 wptr => wrk
+
2746 end if
+
2747
+
2748 ! Process
+
2749 call dgelsy(m, n, 1, a, m, b, maxmn, iptr, rc, rnk, wptr, lwork, flag)
+
2750 if (present(arnk)) arnk = rnk
+
2751 end subroutine
+
2752
+
2753! ------------------------------------------------------------------------------
+
2754 module subroutine solve_least_squares_vec_pvt_cmplx(a, b, ipvt, arnk, &
+
2755 work, olwork, rwork, err)
+
2756 ! Arguments
+
2757 complex(real64), intent(inout), dimension(:,:) :: a
+
2758 complex(real64), intent(inout), dimension(:) :: b
+
2759 integer(int32), intent(inout), target, optional, dimension(:) :: ipvt
+
2760 integer(int32), intent(out), optional :: arnk
+
2761 complex(real64), intent(out), target, optional, dimension(:) :: work
+
2762 integer(int32), intent(out), optional :: olwork
+
2763 real(real64), intent(out), target, optional, dimension(:) :: rwork
+
2764 class(errors), intent(inout), optional, target :: err
+
2765
+
2766 ! Local Variables
+
2767 integer(int32) :: m, n, maxmn, lwork, istat, flag, rnk
+
2768 complex(real64), pointer, dimension(:) :: wptr
+
2769 complex(real64), allocatable, target, dimension(:) :: wrk
+
2770 real(real64), pointer, dimension(:) :: rwptr
+
2771 real(real64), allocatable, target, dimension(:) :: rwrk
+
2772 integer(int32), allocatable, target, dimension(:) :: iwrk
+
2773 integer(int32), pointer, dimension(:) :: iptr
+
2774 complex(real64), dimension(1) :: temp
+
2775 real(real64), dimension(1) :: rtemp
+
2776 integer(int32), dimension(1) :: itemp
+
2777 real(real64) :: rc
+
2778 class(errors), pointer :: errmgr
+
2779 type(errors), target :: deferr
+
2780 character(len = 128) :: errmsg
+
2781
+
2782 ! Initialization
+
2783 m = size(a, 1)
+
2784 n = size(a, 2)
+
2785 maxmn = max(m, n)
+
2786 lrwork = 2 * n
+
2787 rc = epsilon(rc)
+
2788 if (present(arnk)) arnk = 0
+
2789 if (present(err)) then
+
2790 errmgr => err
+
2791 else
+
2792 errmgr => deferr
+
2793 end if
+
2794
+
2795 ! Input Check
+
2796 flag = 0
+
2797 if (size(b, 1) /= maxmn) then
+
2798 flag = 2
+
2799 end if
+
2800 if (flag /= 0) then
+
2801 write(errmsg, '(AI0A)') "Input number ", flag, &
+
2802 " is not sized correctly."
+
2803 call errmgr%report_error("solve_least_squares_vec_pvt_cmplx", &
+
2804 trim(errmsg), la_array_size_error)
+
2805 return
+
2806 end if
+
2807
+
2808 ! Workspace Query
+
2809 call zgelsy(m, n, 1, a, m, b, maxmn, itemp, rc, rnk, temp, -1, rtemp, &
+
2810 flag)
+
2811 lwork = int(temp(1), int32)
+
2812 if (present(olwork)) then
+
2813 olwork = lwork
+
2814 return
+
2815 end if
+
2816
+
2817 ! Local Memory Allocation
+
2818 if (present(ipvt)) then
+
2819 if (size(ipvt) < n) then
+
2820 ! ERROR: IPVT is not big enough
+
2821 call errmgr%report_error("solve_least_squares_mtx_pvt", &
+
2822 "Incorrectly sized pivot array, argument 3.", &
+
2823 la_array_size_error)
+
2824 return
+
2825 end if
+
2826 iptr => ipvt(1:n)
+
2827 else
+
2828 allocate(iwrk(n), stat = istat)
+
2829 if (istat /= 0) then
+
2830 ! ERROR: Out of memory
+
2831 call errmgr%report_error("solve_least_squares_mtx_pvt", &
+
2832 "Insufficient memory available.", &
+
2833 la_out_of_memory_error)
+
2834 return
+
2835 end if
+
2836 iptr => iwrk
+
2837 iptr = 0
+
2838 end if
+
2839
+
2840 if (present(work)) then
+
2841 if (size(work) < lwork) then
+
2842 ! ERROR: WORK not sized correctly
+
2843 call errmgr%report_error("solve_least_squares_vec_pvt_cmplx", &
+
2844 "Incorrectly sized input array WORK, argument 5.", &
+
2845 la_array_size_error)
+
2846 return
+
2847 end if
+
2848 wptr => work(1:lwork)
+
2849 else
+
2850 allocate(wrk(lwork), stat = istat)
+
2851 if (istat /= 0) then
+
2852 ! ERROR: Out of memory
+
2853 call errmgr%report_error("solve_least_squares_vec_pvt_cmplx", &
+
2854 "Insufficient memory available.", &
+
2855 la_out_of_memory_error)
+
2856 return
+
2857 end if
+
2858 wptr => wrk
+
2859 end if
+
2860
+
2861 if (present(rwork)) then
+
2862 if (size(rwork) < lrwork) then
+
2863 ! ERROR: WORK not sized correctly
+
2864 call errmgr%report_error("solve_least_squares_vec_pvt_cmplx", &
+
2865 "Incorrectly sized input array RWORK, argument 7.", &
+
2866 la_array_size_error)
+
2867 return
+
2868 end if
+
2869 rwptr => rwork(1:lrwork)
+
2870 else
+
2871 allocate(rwrk(lrwork), stat = istat)
+
2872 if (istat /= 0) then
+
2873 ! ERROR: Out of memory
+
2874 call errmgr%report_error("solve_least_squares_vec_pvt_cmplx", &
+
2875 "Insufficient memory available.", &
+
2876 la_out_of_memory_error)
+
2877 return
+
2878 end if
+
2879 rwptr => rwrk
+
2880 end if
+
2881
+
2882 ! Process
+
2883 call zgelsy(m, n, 1, a, m, b, maxmn, iptr, rc, rnk, wptr, lwork, &
+
2884 rwptr, flag)
+
2885 if (present(arnk)) arnk = rnk
+
2886 end subroutine
+
2887
+
2888! ------------------------------------------------------------------------------
+
2889 module subroutine solve_least_squares_mtx_svd(a, b, s, arnk, work, olwork, err)
+
2890 ! Arguments
+
2891 real(real64), intent(inout), dimension(:,:) :: a, b
+
2892 integer(int32), intent(out), optional :: arnk
+
2893 real(real64), intent(out), target, optional, dimension(:) :: work, s
+
2894 integer(int32), intent(out), optional :: olwork
+
2895 class(errors), intent(inout), optional, target :: err
+
2896
+
2897 ! Local Variables
+
2898 integer(int32) :: m, n, nrhs, mn, maxmn, istat, flag, lwork, rnk
+
2899 real(real64), pointer, dimension(:) :: wptr, sptr
+
2900 real(real64), allocatable, target, dimension(:) :: wrk, sing
+
2901 real(real64), dimension(1) :: temp
+
2902 real(real64) :: rcond
+
2903 class(errors), pointer :: errmgr
+
2904 type(errors), target :: deferr
+
2905 character(len = 128) :: errmsg
+
2906
+
2907 ! Initialization
+
2908 m = size(a, 1)
+
2909 n = size(a, 2)
+
2910 nrhs = size(b, 2)
+
2911 mn = min(m, n)
+
2912 maxmn = max(m, n)
+
2913 rcond = epsilon(rcond)
+
2914 if (present(arnk)) arnk = 0
+
2915 if (present(err)) then
+
2916 errmgr => err
+
2917 else
+
2918 errmgr => deferr
+
2919 end if
+
2920
+
2921 ! Input Check
+
2922 flag = 0
+
2923 if (size(b, 1) /= maxmn) then
+
2924 flag = 2
+
2925 end if
+
2926 if (flag /= 0) then
+
2927 ! ERROR: One of the input arrays is not sized correctly
+
2928 write(errmsg, '(AI0A)') "Input number ", flag, &
+
2929 " is not sized correctly."
+
2930 call errmgr%report_error("solve_least_squares_mtx_svd", &
+
2931 trim(errmsg), la_array_size_error)
+
2932 return
+
2933 end if
+
2934
+
2935 ! Workspace Query
+
2936 call dgelss(m, n, nrhs, a, m, b, maxmn, temp, rcond, rnk, temp, -1, &
+
2937 flag)
+
2938 lwork = int(temp(1), int32)
+
2939 if (present(olwork)) then
+
2940 olwork = lwork
+
2941 return
+
2942 end if
+
2943
+
2944 ! Local Memory Allocation
+
2945 if (present(s)) then
+
2946 if (size(s) < mn) then
+
2947 ! ERROR: S not sized correctly
+
2948 call errmgr%report_error("solve_least_squares_mtx_svd", &
+
2949 "Incorrectly sized input array S, argument 3.", &
+
2950 la_array_size_error)
+
2951 return
+
2952 end if
+
2953 sptr => s(1:mn)
+
2954 else
+
2955 allocate(sing(mn), stat = istat)
+
2956 if (istat /= 0) then
+
2957 ! ERROR: Out of memory
+
2958 call errmgr%report_error("solve_least_squares_mtx_svd", &
+
2959 "Insufficient memory available.", &
+
2960 la_out_of_memory_error)
+
2961 return
+
2962 end if
+
2963 sptr => sing
+
2964 end if
+
2965
+
2966 if (present(work)) then
+
2967 if (size(work) < lwork) then
+
2968 ! ERROR: WORK not sized correctly
+
2969 call errmgr%report_error("solve_least_squares_mtx_svd", &
+
2970 "Incorrectly sized input array WORK, argument 5.", &
+
2971 la_array_size_error)
+
2972 return
+
2973 end if
+
2974 wptr => work(1:lwork)
+
2975 else
+
2976 allocate(wrk(lwork), stat = istat)
+
2977 if (istat /= 0) then
+
2978 ! ERROR: Out of memory
+
2979 call errmgr%report_error("solve_least_squares_mtx_svd", &
+
2980 "Insufficient memory available.", &
+
2981 la_out_of_memory_error)
+
2982 return
+
2983 end if
+
2984 wptr => wrk
+
2985 end if
+
2986
+
2987 ! Process
+
2988 call dgelss(m, n, nrhs, a, m, b, maxmn, sptr, rcond, rnk, wptr, lwork, &
+
2989 flag)
+
2990 if (present(arnk)) arnk = rnk
+
2991 if (flag > 0) then
+
2992 write(errmsg, '(I0A)') flag, " superdiagonals could not " // &
+
2993 "converge to zero as part of the QR iteration process."
+
2994 call errmgr%report_warning("solve_least_squares_mtx_svd", errmsg, &
+
2995 la_convergence_error)
+
2996 end if
+
2997 end subroutine
+
2998
+
2999! ------------------------------------------------------------------------------
+
3000 module subroutine solve_least_squares_mtx_svd_cmplx(a, b, s, arnk, work, &
+
3001 olwork, rwork, err)
+
3002 ! Arguments
+
3003 complex(real64), intent(inout), dimension(:,:) :: a, b
+
3004 integer(int32), intent(out), optional :: arnk
+
3005 complex(real64), intent(out), target, optional, dimension(:) :: work
+
3006 real(real64), intent(out), target, optional, dimension(:) :: s, rwork
+
3007 integer(int32), intent(out), optional :: olwork
+
3008 class(errors), intent(inout), optional, target :: err
+
3009
+
3010 ! Local Variables
+
3011 integer(int32) :: m, n, nrhs, mn, maxmn, istat, flag, lwork, rnk, lrwork
+
3012 complex(real64), pointer, dimension(:) :: wptr
+
3013 complex(real64), allocatable, target, dimension(:) :: wrk
+
3014 real(real64), pointer, dimension(:) :: rwptr, sptr
+
3015 real(real64), allocatable, target, dimension(:) :: rwrk, sing
+
3016 complex(real64), dimension(1) :: temp
+
3017 real(real64), dimension(1) :: rtemp
+
3018 real(real64) :: rcond
+
3019 class(errors), pointer :: errmgr
+
3020 type(errors), target :: deferr
+
3021 character(len = 128) :: errmsg
+
3022
+
3023 ! Initialization
+
3024 m = size(a, 1)
+
3025 n = size(a, 2)
+
3026 nrhs = size(b, 2)
+
3027 mn = min(m, n)
+
3028 lrwork = 5 * mn
+
3029 maxmn = max(m, n)
+
3030 rcond = epsilon(rcond)
+
3031 if (present(arnk)) arnk = 0
+
3032 if (present(err)) then
+
3033 errmgr => err
+
3034 else
+
3035 errmgr => deferr
+
3036 end if
+
3037
+
3038 ! Input Check
+
3039 flag = 0
+
3040 if (size(b, 1) /= maxmn) then
+
3041 flag = 2
+
3042 end if
+
3043 if (flag /= 0) then
+
3044 ! ERROR: One of the input arrays is not sized correctly
+
3045 write(errmsg, '(AI0A)') "Input number ", flag, &
+
3046 " is not sized correctly."
+
3047 call errmgr%report_error("solve_least_squares_mtx_svd_cmplx", &
+
3048 trim(errmsg), la_array_size_error)
+
3049 return
+
3050 end if
+
3051
+
3052 ! Workspace Query
+
3053 call zgelss(m, n, nrhs, a, m, b, maxmn, rtemp, rcond, rnk, temp, -1, &
+
3054 rtemp, flag)
+
3055 lwork = int(temp(1), int32)
+
3056 if (present(olwork)) then
+
3057 olwork = lwork
+
3058 return
+
3059 end if
+
3060
+
3061 ! Local Memory Allocation
+
3062 if (present(s)) then
+
3063 if (size(s) < mn) then
+
3064 ! ERROR: S not sized correctly
+
3065 call errmgr%report_error("solve_least_squares_mtx_svd_cmplx", &
+
3066 "Incorrectly sized input array S, argument 3.", &
+
3067 la_array_size_error)
+
3068 return
+
3069 end if
+
3070 sptr => s(1:mn)
+
3071 else
+
3072 allocate(sing(mn), stat = istat)
+
3073 if (istat /= 0) then
+
3074 ! ERROR: Out of memory
+
3075 call errmgr%report_error("solve_least_squares_mtx_svd_cmplx", &
+
3076 "Insufficient memory available.", &
+
3077 la_out_of_memory_error)
+
3078 return
+
3079 end if
+
3080 sptr => sing
+
3081 end if
+
3082
+
3083 if (present(work)) then
+
3084 if (size(work) < lwork) then
+
3085 ! ERROR: WORK not sized correctly
+
3086 call errmgr%report_error("solve_least_squares_mtx_svd_cmplx", &
+
3087 "Incorrectly sized input array WORK, argument 5.", &
+
3088 la_array_size_error)
+
3089 return
+
3090 end if
+
3091 wptr => work(1:lwork)
+
3092 else
+
3093 allocate(wrk(lwork), stat = istat)
+
3094 if (istat /= 0) then
+
3095 ! ERROR: Out of memory
+
3096 call errmgr%report_error("solve_least_squares_mtx_svd_cmplx", &
+
3097 "Insufficient memory available.", &
+
3098 la_out_of_memory_error)
+
3099 return
+
3100 end if
+
3101 wptr => wrk
+
3102 end if
+
3103
+
3104 if (present(rwork)) then
+
3105 if (size(rwork) < lrwork) then
+
3106 ! ERROR: WORK not sized correctly
+
3107 call errmgr%report_error("solve_least_squares_mtx_svd_cmplx", &
+
3108 "Incorrectly sized input array RWORK, argument 7.", &
+
3109 la_array_size_error)
+
3110 return
+
3111 end if
+
3112 rwptr => rwork(1:lrwork)
+
3113 else
+
3114 allocate(rwrk(lrwork), stat = istat)
+
3115 if (istat /= 0) then
+
3116 ! ERROR: Out of memory
+
3117 call errmgr%report_error("solve_least_squares_mtx_svd_cmplx", &
+
3118 "Insufficient memory available.", &
+
3119 la_out_of_memory_error)
+
3120 return
+
3121 end if
+
3122 rwptr => rwrk
+
3123 end if
+
3124
+
3125 ! Process
+
3126 call zgelss(m, n, nrhs, a, m, b, maxmn, sptr, rcond, rnk, wptr, lwork, &
+
3127 rwptr, flag)
+
3128 if (present(arnk)) arnk = rnk
+
3129 if (flag > 0) then
+
3130 write(errmsg, '(I0A)') flag, " superdiagonals could not " // &
+
3131 "converge to zero as part of the QR iteration process."
+
3132 call errmgr%report_warning("solve_least_squares_mtx_svd_cmplx", &
+
3133 errmsg, la_convergence_error)
+
3134 end if
+
3135 end subroutine
+
3136
+
3137! ------------------------------------------------------------------------------
+
3138 module subroutine solve_least_squares_vec_svd(a, b, s, arnk, work, olwork, err)
+
3139 ! Arguments
+
3140 real(real64), intent(inout), dimension(:,:) :: a
+
3141 real(real64), intent(inout), dimension(:) :: b
+
3142 integer(int32), intent(out), optional :: arnk
+
3143 real(real64), intent(out), target, optional, dimension(:) :: work, s
+
3144 integer(int32), intent(out), optional :: olwork
+
3145 class(errors), intent(inout), optional, target :: err
+
3146
+
3147 ! Local Variables
+
3148 integer(int32) :: m, n, mn, maxmn, istat, flag, lwork, rnk
+
3149 real(real64), pointer, dimension(:) :: wptr, sptr
+
3150 real(real64), allocatable, target, dimension(:) :: wrk, sing
+
3151 real(real64), dimension(1) :: temp
+
3152 real(real64) :: rcond
+
3153 class(errors), pointer :: errmgr
+
3154 type(errors), target :: deferr
+
3155 character(len = 128) :: errmsg
+
3156
+
3157 ! Initialization
+
3158 m = size(a, 1)
+
3159 n = size(a, 2)
+
3160 mn = min(m, n)
+
3161 maxmn = max(m, n)
+
3162 rcond = epsilon(rcond)
+
3163 if (present(arnk)) arnk = 0
+
3164 if (present(err)) then
+
3165 errmgr => err
+
3166 else
+
3167 errmgr => deferr
+
3168 end if
+
3169
+
3170 ! Input Check
+
3171 flag = 0
+
3172 if (size(b) /= maxmn) then
+
3173 flag = 2
+
3174 end if
+
3175 if (flag /= 0) then
+
3176 ! ERROR: One of the input arrays is not sized correctly
+
3177 write(errmsg, '(AI0A)') "Input number ", flag, &
+
3178 " is not sized correctly."
+
3179 call errmgr%report_error("solve_least_squares_vec_svd", &
+
3180 trim(errmsg), la_array_size_error)
+
3181 return
+
3182 end if
+
3183
+
3184 ! Workspace Query
+
3185 call dgelss(m, n, 1, a, m, b, maxmn, temp, rcond, rnk, temp, -1, flag)
+
3186 lwork = int(temp(1), int32)
+
3187 if (present(olwork)) then
+
3188 olwork = lwork
+
3189 return
+
3190 end if
+
3191
+
3192 ! Local Memory Allocation
+
3193 if (present(s)) then
+
3194 if (size(s) < mn) then
+
3195 ! ERROR: S not sized correctly
+
3196 call errmgr%report_error("solve_least_squares_vec_svd", &
+
3197 "Incorrectly sized input array S, argument 3.", &
+
3198 la_array_size_error)
+
3199 return
+
3200 end if
+
3201 sptr => s(1:mn)
+
3202 else
+
3203 allocate(sing(mn), stat = istat)
+
3204 if (istat /= 0) then
+
3205 ! ERROR: Out of memory
+
3206 call errmgr%report_error("solve_least_squares_vec_svd", &
+
3207 "Insufficient memory available.", &
+
3208 la_out_of_memory_error)
+
3209 return
+
3210 end if
+
3211 sptr => sing
+
3212 end if
+
3213
+
3214 if (present(work)) then
+
3215 if (size(work) < lwork) then
+
3216 ! ERROR: WORK not sized correctly
+
3217 call errmgr%report_error("solve_least_squares_vec_svd", &
+
3218 "Incorrectly sized input array WORK, argument 5.", &
+
3219 la_array_size_error)
+
3220 return
+
3221 end if
+
3222 wptr => work(1:lwork)
+
3223 else
+
3224 allocate(wrk(lwork), stat = istat)
+
3225 if (istat /= 0) then
+
3226 ! ERROR: Out of memory
+
3227 call errmgr%report_error("solve_least_squares_vec_svd", &
+
3228 "Insufficient memory available.", &
+
3229 la_out_of_memory_error)
+
3230 return
+
3231 end if
+
3232 wptr => wrk
+
3233 end if
+
3234
+
3235 ! Process
+
3236 call dgelss(m, n, 1, a, m, b, maxmn, sptr, rcond, rnk, wptr, lwork, &
+
3237 flag)
+
3238 if (present(arnk)) arnk = rnk
+
3239 if (flag > 0) then
+
3240 write(errmsg, '(I0A)') flag, " superdiagonals could not " // &
+
3241 "converge to zero as part of the QR iteration process."
+
3242 call errmgr%report_warning("solve_least_squares_vec_svd", errmsg, &
+
3243 la_convergence_error)
+
3244 end if
+
3245 end subroutine
+
3246
+
3247! ------------------------------------------------------------------------------
+
3248 module subroutine solve_least_squares_vec_svd_cmplx(a, b, s, arnk, work, &
+
3249 olwork, rwork, err)
+
3250 ! Arguments
+
3251 complex(real64), intent(inout), dimension(:,:) :: a
+
3252 complex(real64), intent(inout), dimension(:) :: b
+
3253 integer(int32), intent(out), optional :: arnk
+
3254 complex(real64), intent(out), target, optional, dimension(:) :: work
+
3255 real(real64), intent(out), target, optional, dimension(:) :: rwork, s
+
3256 integer(int32), intent(out), optional :: olwork
+
3257 class(errors), intent(inout), optional, target :: err
+
3258
+
3259 ! Local Variables
+
3260 integer(int32) :: m, n, mn, maxmn, istat, flag, lwork, rnk, lrwork
+
3261 real(real64), pointer, dimension(:) :: rwptr, sptr
+
3262 real(real64), allocatable, target, dimension(:) :: rwrk, sing
+
3263 complex(real64), pointer, dimension(:) :: wptr
+
3264 complex(real64), allocatable, target, dimension(:) :: wrk
+
3265 complex(real64), dimension(1) :: temp
+
3266 real(real64), dimension(1) :: rtemp
+
3267 real(real64) :: rcond
+
3268 class(errors), pointer :: errmgr
+
3269 type(errors), target :: deferr
+
3270 character(len = 128) :: errmsg
+
3271
+
3272 ! Initialization
+
3273 m = size(a, 1)
+
3274 n = size(a, 2)
+
3275 mn = min(m, n)
+
3276 lrwork = 5 * mn
+
3277 maxmn = max(m, n)
+
3278 rcond = epsilon(rcond)
+
3279 if (present(arnk)) arnk = 0
+
3280 if (present(err)) then
+
3281 errmgr => err
+
3282 else
+
3283 errmgr => deferr
+
3284 end if
+
3285
+
3286 ! Input Check
+
3287 flag = 0
+
3288 if (size(b) /= maxmn) then
+
3289 flag = 2
+
3290 end if
+
3291 if (flag /= 0) then
+
3292 ! ERROR: One of the input arrays is not sized correctly
+
3293 write(errmsg, '(AI0A)') "Input number ", flag, &
+
3294 " is not sized correctly."
+
3295 call errmgr%report_error("solve_least_squares_vec_svd_cmplx", &
+
3296 trim(errmsg), la_array_size_error)
+
3297 return
+
3298 end if
+
3299
+
3300 ! Workspace Query
+
3301 call zgelss(m, n, 1, a, m, b, maxmn, rtemp, rcond, rnk, temp, -1, &
+
3302 rtemp, flag)
+
3303 lwork = int(temp(1), int32)
+
3304 if (present(olwork)) then
+
3305 olwork = lwork
+
3306 return
+
3307 end if
+
3308
+
3309 ! Local Memory Allocation
+
3310 if (present(s)) then
+
3311 if (size(s) < mn) then
+
3312 ! ERROR: S not sized correctly
+
3313 call errmgr%report_error("solve_least_squares_vec_svd_cmplx", &
+
3314 "Incorrectly sized input array S, argument 3.", &
+
3315 la_array_size_error)
+
3316 return
+
3317 end if
+
3318 sptr => s(1:mn)
+
3319 else
+
3320 allocate(sing(mn), stat = istat)
+
3321 if (istat /= 0) then
+
3322 ! ERROR: Out of memory
+
3323 call errmgr%report_error("solve_least_squares_vec_svd_cmplx", &
+
3324 "Insufficient memory available.", &
+
3325 la_out_of_memory_error)
+
3326 return
+
3327 end if
+
3328 sptr => sing
+
3329 end if
+
3330
+
3331 if (present(work)) then
+
3332 if (size(work) < lwork) then
+
3333 ! ERROR: WORK not sized correctly
+
3334 call errmgr%report_error("solve_least_squares_vec_svd_cmplx", &
+
3335 "Incorrectly sized input array WORK, argument 5.", &
+
3336 la_array_size_error)
+
3337 return
+
3338 end if
+
3339 wptr => work(1:lwork)
+
3340 else
+
3341 allocate(wrk(lwork), stat = istat)
+
3342 if (istat /= 0) then
+
3343 ! ERROR: Out of memory
+
3344 call errmgr%report_error("solve_least_squares_vec_svd_cmplx", &
+
3345 "Insufficient memory available.", &
+
3346 la_out_of_memory_error)
+
3347 return
+
3348 end if
+
3349 wptr => wrk
+
3350 end if
+
3351
+
3352 if (present(rwork)) then
+
3353 if (size(rwork) < lrwork) then
+
3354 ! ERROR: WORK not sized correctly
+
3355 call errmgr%report_error("solve_least_squares_vec_svd_cmplx", &
+
3356 "Incorrectly sized input array RWORK, argument 7.", &
+
3357 la_array_size_error)
+
3358 return
+
3359 end if
+
3360 rwptr => rwork(1:lrwork)
+
3361 else
+
3362 allocate(rwrk(lrwork), stat = istat)
+
3363 if (istat /= 0) then
+
3364 ! ERROR: Out of memory
+
3365 call errmgr%report_error("solve_least_squares_vec_svd_cmplx", &
+
3366 "Insufficient memory available.", &
+
3367 la_out_of_memory_error)
+
3368 return
+
3369 end if
+
3370 rwptr => rwrk
+
3371 end if
+
3372
+
3373 ! Process
+
3374 call zgelss(m, n, 1, a, m, b, maxmn, sptr, rcond, rnk, wptr, lwork, &
+
3375 rwptr, flag)
+
3376 if (present(arnk)) arnk = rnk
+
3377 if (flag > 0) then
+
3378 write(errmsg, '(I0A)') flag, " superdiagonals could not " // &
+
3379 "converge to zero as part of the QR iteration process."
+
3380 call errmgr%report_warning("solve_least_squares_vec_svd_cmplx", &
+
3381 errmsg, la_convergence_error)
+
3382 end if
+
3383 end subroutine
+
3384
+
3385end submodule
+
Provides a set of common linear algebra routines.
Definition: linalg_core.f90:15
-
Provides a set of common linear algebra routines.
Definition: linalg_core.f90:15
diff --git a/doc/html/linalg__sorting_8f90_source.html b/doc/html/linalg__sorting_8f90_source.html index 8525ae59..33ac5257 100644 --- a/doc/html/linalg__sorting_8f90_source.html +++ b/doc/html/linalg__sorting_8f90_source.html @@ -1,11 +1,11 @@ - + - - + + -linalg: C:/Users/jchri/Documents/github/linalg/src/linalg_sorting.f90 Source File +linalg: D:/Code/linalg/src/linalg_sorting.f90 Source File @@ -13,13 +13,16 @@ - + + @@ -27,10 +30,9 @@
- - + @@ -39,21 +41,22 @@
-
linalg -  1.6.0 +
+
linalg 1.6.1
A linear algebra library that provides a user-friendly interface to several BLAS and LAPACK routines.
- + +/* @license-end */ +
@@ -67,8 +70,8 @@
@@ -81,569 +84,573 @@
- +
+
+
+
+
Loading...
+
Searching...
+
No Matches
+
+
+
-
-
linalg_sorting.f90
+
linalg_sorting.f90
-
1 ! linalg_sorting.f90
-
2 
-
7 submodule(linalg_core) linalg_sorting
-
8 contains
-
9 ! ******************************************************************************
-
10 ! SORTING ROUTINES
-
11 ! ------------------------------------------------------------------------------
-
12  module subroutine sort_dbl_array(x, ascend)
-
13  ! Arguments
-
14  real(real64), intent(inout), dimension(:) :: x
-
15  logical, intent(in), optional :: ascend
-
16 
-
17  ! Local Variables
-
18  character :: id
-
19  integer(int32) :: n, info
-
20 
-
21  ! Initialization
-
22  if (present(ascend)) then
-
23  if (ascend) then
-
24  id = 'I'
-
25  else
-
26  id = 'D'
-
27  end if
-
28  else
-
29  id = 'I'
-
30  end if
-
31  n = size(x)
-
32 
-
33  ! Process
-
34  call dlasrt(id, n, x, info)
-
35  end subroutine
-
36 
-
37 ! ------------------------------------------------------------------------------
-
38  module subroutine sort_dbl_array_ind(x, ind, ascend, err)
-
39  ! Arguments
-
40  real(real64), intent(inout), dimension(:) :: x
-
41  integer(int32), intent(inout), dimension(:) :: ind
-
42  logical, intent(in), optional :: ascend
-
43  class(errors), intent(inout), optional, target :: err
-
44 
-
45  ! Local Variables
-
46  class(errors), pointer :: errmgr
-
47  type(errors), target :: deferr
-
48  character(len = 128) :: errmsg
-
49  integer(int32) :: n
-
50  logical :: dir
-
51 
-
52  ! Initialization
-
53  n = size(x)
-
54  if (present(err)) then
-
55  errmgr => err
-
56  else
-
57  errmgr => deferr
-
58  end if
-
59  if (present(ascend)) then
-
60  dir = ascend
-
61  else
-
62  dir = .true. ! Ascend == true
-
63  end if
-
64 
-
65  ! Input Check
-
66  if (size(ind) /= n) then
-
67  write(errmsg, "(AI0AI0A)") &
-
68  "Expected the tracking array to be of size ", n, &
-
69  ", but found an array of size ", size(ind), "."
-
70  call errmgr%report_error("sort_dbl_array_ind", trim(errmsg), &
-
71  la_array_size_error)
-
72  return
-
73  end if
-
74  if (n <= 1) return
-
75 
-
76  ! Process
-
77  call qsort_dbl_ind(dir, x, ind)
-
78  end subroutine
-
79 
-
80 ! ------------------------------------------------------------------------------
-
81  module subroutine sort_cmplx_array(x, ascend)
-
82  ! Arguments
-
83  complex(real64), intent(inout), dimension(:) :: x
-
84  logical, intent(in), optional :: ascend
-
85 
-
86  ! Local Variables
-
87  logical :: dir
-
88 
-
89  ! Initialization
-
90  if (present(ascend)) then
-
91  dir = ascend
-
92  else
-
93  dir = .true.
-
94  end if
-
95 
-
96  ! Process
-
97  call qsort_cmplx(dir, x)
-
98  end subroutine
-
99 
-
100 ! ------------------------------------------------------------------------------
-
101  module subroutine sort_cmplx_array_ind(x, ind, ascend, err)
-
102  ! Arguments
-
103  complex(real64), intent(inout), dimension(:) :: x
-
104  integer(int32), intent(inout), dimension(:) :: ind
-
105  logical, intent(in), optional :: ascend
-
106  class(errors), intent(inout), optional, target :: err
-
107 
-
108  ! Local Variables
-
109  class(errors), pointer :: errmgr
-
110  type(errors), target :: deferr
-
111  character(len = 128) :: errmsg
-
112  integer(int32) :: n
-
113  logical :: dir
-
114 
-
115  ! Initialization
-
116  n = size(x)
-
117  if (present(err)) then
-
118  errmgr => err
-
119  else
-
120  errmgr => deferr
-
121  end if
-
122  if (present(ascend)) then
-
123  dir = ascend
-
124  else
-
125  dir = .true. ! Ascend == true
-
126  end if
-
127 
-
128  ! Input Check
-
129  if (size(ind) /= n) then
-
130  write(errmsg, "(AI0AI0A)") &
-
131  "Expected the tracking array to be of size ", n, &
-
132  ", but found an array of size ", size(ind), "."
-
133  call errmgr%report_error("sort_cmplx_array_ind", trim(errmsg), &
-
134  la_array_size_error)
-
135  return
-
136  end if
-
137  if (n <= 1) return
-
138 
-
139  ! Process
-
140  call qsort_cmplx_ind(dir, x, ind)
-
141  end subroutine
-
142 
-
143 ! ------------------------------------------------------------------------------
-
144  module subroutine sort_eigen_cmplx(vals, vecs, ascend, err)
-
145  ! Arguments
-
146  complex(real64), intent(inout), dimension(:) :: vals
-
147  complex(real64), intent(inout), dimension(:,:) :: vecs
-
148  logical, intent(in), optional :: ascend
-
149  class(errors), intent(inout), optional, target :: err
-
150 
-
151  ! Local Variables
-
152  class(errors), pointer :: errmgr
-
153  type(errors), target :: deferr
-
154  character(len = 128) :: errmsg
-
155  integer(int32) :: i, n, flag
-
156  logical :: dir
-
157  integer(int32), allocatable, dimension(:) :: ind
-
158 
-
159  ! Initialization
-
160  if (present(err)) then
-
161  errmgr => err
-
162  else
-
163  errmgr => deferr
-
164  end if
-
165  if (present(ascend)) then
-
166  dir = ascend
-
167  else
-
168  dir = .true. ! Ascend == true
-
169  end if
-
170 
-
171  ! Ensure the eigenvector matrix is sized appropriately
-
172  n = size(vals)
-
173  if (size(vecs, 1) /= n .or. size(vecs, 2) /= n) then
-
174  ! ARRAY SIZE ERROR
-
175  write(errmsg, '(AI0AI0AI0AI0A)') &
-
176  "Expected the eigenvector matrix to be of size ", n, &
-
177  "-by-", n, ", but found a matrix of size ", size(vecs, 1), &
-
178  "-by-", size(vecs, 2), "."
-
179  call errmgr%report_error("sort_eigen_cmplx", trim(errmsg), &
-
180  la_array_size_error)
-
181  end if
-
182 
-
183  ! Allocate memory for the tracking array
-
184  allocate(ind(n), stat = flag)
-
185  if (flag /= 0) then
-
186  call errmgr%report_error("sort_eigen_cmplx", &
-
187  "Insufficient memory available.", la_out_of_memory_error)
-
188  return
-
189  end if
-
190  do i = 1, n
-
191  ind(i) = i
-
192  end do
-
193 
-
194  ! Sort
-
195  call qsort_cmplx_ind(dir, vals, ind)
-
196 
-
197  ! Shift the eigenvectors around to keep them associated with the
-
198  ! appropriate eigenvalue
-
199  vecs = vecs(:,ind)
-
200  end subroutine
-
201 
-
202 ! ------------------------------------------------------------------------------
-
203  module subroutine sort_eigen_dbl(vals, vecs, ascend, err)
-
204  ! Arguments
-
205  real(real64), intent(inout), dimension(:) :: vals
-
206  real(real64), intent(inout), dimension(:,:) :: vecs
-
207  logical, intent(in), optional :: ascend
-
208  class(errors), intent(inout), optional, target :: err
-
209 
-
210  ! Local Variables
-
211  class(errors), pointer :: errmgr
-
212  type(errors), target :: deferr
-
213  character(len = 128) :: errmsg
-
214  integer(int32) :: i, n, flag
-
215  logical :: dir
-
216  integer(int32), allocatable, dimension(:) :: ind
-
217 
-
218  ! Initialization
-
219  if (present(err)) then
-
220  errmgr => err
-
221  else
-
222  errmgr => deferr
-
223  end if
-
224  if (present(ascend)) then
-
225  dir = ascend
-
226  else
-
227  dir = .true. ! Ascend == true
-
228  end if
-
229 
-
230  ! Ensure the eigenvector matrix is sized appropriately
-
231  n = size(vals)
-
232  if (size(vecs, 1) /= n .or. size(vecs, 2) /= n) then
-
233  ! ARRAY SIZE ERROR
-
234  write(errmsg, '(AI0AI0AI0AI0A)') &
-
235  "Expected the eigenvector matrix to be of size ", n, &
-
236  "-by-", n, ", but found a matrix of size ", size(vecs, 1), &
-
237  "-by-", size(vecs, 2), "."
-
238  call errmgr%report_error("sort_eigen_dbl", trim(errmsg), &
-
239  la_array_size_error)
-
240  end if
-
241 
-
242  ! Allocate memory for the tracking array
-
243  allocate(ind(n), stat = flag)
-
244  if (flag /= 0) then
-
245  call errmgr%report_error("sort_eigen_dbl", &
-
246  "Insufficient memory available.", la_out_of_memory_error)
-
247  return
-
248  end if
-
249  do i = 1, n
-
250  ind(i) = i
-
251  end do
-
252 
-
253  ! Sort
-
254  call qsort_dbl_ind(dir, vals, ind)
-
255 
-
256  ! Shift the eigenvectors around to keep them associated with the
-
257  ! appropriate eigenvalue
-
258  vecs = vecs(:,ind)
-
259  end subroutine
-
260 
-
261 ! ******************************************************************************
-
262 ! PRIVATE HELPER ROUTINES
-
263 ! ------------------------------------------------------------------------------
-
277  recursive subroutine qsort_dbl_ind(ascend, x, ind)
-
278  ! Arguments
-
279  logical, intent(in) :: ascend
-
280  real(real64), intent(inout), dimension(:) :: x
-
281  integer(int32), intent(inout), dimension(:) :: ind
-
282 
-
283  ! Local Variables
-
284  integer(int32) :: iq
-
285 
-
286  ! Process
-
287  if (size(x) > 1) then
-
288  call dbl_partition_ind(ascend, x, ind, iq)
-
289  call qsort_dbl_ind(ascend, x(:iq-1), ind(:iq-1))
-
290  call qsort_dbl_ind(ascend, x(iq:), ind(iq:))
-
291  end if
-
292  end subroutine
-
293 
-
294 ! ------------------------------------------------------------------------------
-
310  subroutine dbl_partition_ind(ascend, x, ind, marker)
-
311  ! Arguments
-
312  logical, intent(in) :: ascend
-
313  real(real64), intent(inout), dimension(:) :: x
-
314  integer(int32), intent(inout), dimension(:) :: ind
-
315  integer(int32), intent(out) :: marker
-
316 
-
317  ! Local Variables
-
318  integer(int32) :: i, j, itemp
-
319  real(real64) :: temp, pivot
-
320 
-
321  ! Process
-
322  pivot = x(1)
-
323  i = 0
-
324  j = size(x) + 1
-
325  if (ascend) then
-
326  ! Ascending Sort
-
327  do
-
328  j = j - 1
-
329  do
-
330  if (x(j) <= pivot) exit
-
331  j = j - 1
-
332  end do
-
333  i = i + 1
-
334  do
-
335  if (x(i) >= pivot) exit
-
336  i = i + 1
-
337  end do
-
338  if (i < j) then
-
339  ! Exchage X(I) and X(J)
-
340  temp = x(i)
-
341  x(i) = x(j)
-
342  x(j) = temp
-
343 
-
344  itemp = ind(i)
-
345  ind(i) = ind(j)
-
346  ind(j) = itemp
-
347  else if (i == j) then
-
348  marker = i + 1
-
349  return
-
350  else
-
351  marker = i
-
352  return
-
353  end if
-
354  end do
-
355  else
-
356  ! Descending Sort
-
357  do
-
358  j = j - 1
-
359  do
-
360  if (x(j) >= pivot) exit
-
361  j = j - 1
-
362  end do
-
363  i = i + 1
-
364  do
-
365  if (x(i) <= pivot) exit
-
366  i = i + 1
-
367  end do
-
368  if (i < j) then
-
369  ! Exchage X(I) and X(J)
-
370  temp = x(i)
-
371  x(i) = x(j)
-
372  x(j) = temp
-
373 
-
374  itemp = ind(i)
-
375  ind(i) = ind(j)
-
376  ind(j) = itemp
-
377  else if (i == j) then
-
378  marker = i + 1
-
379  return
-
380  else
-
381  marker = i
-
382  return
-
383  end if
-
384  end do
-
385  end if
-
386  end subroutine
-
387 
-
388 ! ------------------------------------------------------------------------------
-
403  recursive subroutine qsort_cmplx(ascend, x)
-
404  ! Arguments
-
405  logical, intent(in) :: ascend
-
406  complex(real64), intent(inout), dimension(:) :: x
-
407 
-
408  ! Local Variables
-
409  integer(int32) :: iq
-
410 
-
411  ! Process
-
412  if (size(x) > 1) then
-
413  call cmplx_partition(ascend, x, iq)
-
414  call qsort_cmplx(ascend, x(:iq-1))
-
415  call qsort_cmplx(ascend, x(iq:))
-
416  end if
-
417  end subroutine
-
418 
-
419 ! ------------------------------------------------------------------------------
-
436  subroutine cmplx_partition(ascend, x, marker)
-
437  ! Arguments
-
438  logical, intent(in) :: ascend
-
439  complex(real64), intent(inout), dimension(:) :: x
-
440  integer(int32), intent(out) :: marker
-
441 
-
442  ! Local Variables
-
443  integer(int32) :: i, j
-
444  complex(real64) :: temp
-
445  real(real64) :: pivot
-
446 
-
447  ! Process
-
448  pivot = real(x(1), real64)
-
449  i = 0
-
450  j = size(x) + 1
-
451  if (ascend) then
-
452  ! Ascending Sort
-
453  do
-
454  j = j - 1
-
455  do
-
456  if (real(x(j), real64) <= pivot) exit
-
457  j = j - 1
-
458  end do
-
459  i = i + 1
-
460  do
-
461  if (real(x(i), real64) >= pivot) exit
-
462  i = i + 1
-
463  end do
-
464  if (i < j) then
-
465  ! Exchage X(I) and X(J)
-
466  temp = x(i)
-
467  x(i) = x(j)
-
468  x(j) = temp
-
469  else if (i == j) then
-
470  marker = i + 1
-
471  return
-
472  else
-
473  marker = i
-
474  return
-
475  end if
-
476  end do
-
477  else
-
478  ! Descending Sort
-
479  do
-
480  j = j - 1
-
481  do
-
482  if (real(x(j), real64) >= pivot) exit
-
483  j = j - 1
-
484  end do
-
485  i = i + 1
-
486  do
-
487  if (real(x(i), real64) <= pivot) exit
-
488  i = i + 1
-
489  end do
-
490  if (i < j) then
-
491  ! Exchage X(I) and X(J)
-
492  temp = x(i)
-
493  x(i) = x(j)
-
494  x(j) = temp
-
495  else if (i == j) then
-
496  marker = i + 1
-
497  return
-
498  else
-
499  marker = i
-
500  return
-
501  end if
-
502  end do
-
503  end if
-
504  end subroutine
-
505 
-
506 ! ------------------------------------------------------------------------------
-
524  recursive subroutine qsort_cmplx_ind(ascend, x, ind)
-
525  ! Arguments
-
526  logical, intent(in) :: ascend
-
527  complex(real64), intent(inout), dimension(:) :: x
-
528  integer(int32), intent(inout), dimension(:) :: ind
-
529 
-
530  ! Local Variables
-
531  integer(int32) :: iq
-
532 
-
533  ! Process
-
534  if (size(x) > 1) then
-
535  call cmplx_partition_ind(ascend, x, ind, iq)
-
536  call qsort_cmplx_ind(ascend, x(:iq-1), ind(:iq-1))
-
537  call qsort_cmplx_ind(ascend, x(iq:), ind(iq:))
-
538  end if
-
539  end subroutine
-
540 
-
541 ! ------------------------------------------------------------------------------
-
561  subroutine cmplx_partition_ind(ascend, x, ind, marker)
-
562  ! Arguments
-
563  logical, intent(in) :: ascend
-
564  complex(real64), intent(inout), dimension(:) :: x
-
565  integer(int32), intent(inout), dimension(:) :: ind
-
566  integer(int32), intent(out) :: marker
-
567 
-
568  ! Local Variables
-
569  integer(int32) :: i, j, itemp
-
570  complex(real64) :: temp
-
571  real(real64) :: pivot
-
572 
-
573  ! Process
-
574  pivot = real(x(1), real64)
-
575  i = 0
-
576  j = size(x) + 1
-
577  if (ascend) then
-
578  ! Ascending Sort
-
579  do
-
580  j = j - 1
-
581  do
-
582  if (real(x(j), real64) <= pivot) exit
-
583  j = j - 1
-
584  end do
-
585  i = i + 1
-
586  do
-
587  if (real(x(i), real64) >= pivot) exit
-
588  i = i + 1
-
589  end do
-
590  if (i < j) then
-
591  ! Exchage X(I) and X(J)
-
592  temp = x(i)
-
593  x(i) = x(j)
-
594  x(j) = temp
-
595 
-
596  itemp = ind(i)
-
597  ind(i) = ind(j)
-
598  ind(j) = itemp
-
599  else if (i == j) then
-
600  marker = i + 1
-
601  return
-
602  else
-
603  marker = i
-
604  return
-
605  end if
-
606  end do
-
607  else
-
608  ! Descending Sort
-
609  do
-
610  j = j - 1
-
611  do
-
612  if (real(x(j), real64) >= pivot) exit
-
613  j = j - 1
-
614  end do
-
615  i = i + 1
-
616  do
-
617  if (real(x(i), real64) <= pivot) exit
-
618  i = i + 1
-
619  end do
-
620  if (i < j) then
-
621  ! Exchage X(I) and X(J)
-
622  temp = x(i)
-
623  x(i) = x(j)
-
624  x(j) = temp
-
625 
-
626  itemp = ind(i)
-
627  ind(i) = ind(j)
-
628  ind(j) = itemp
-
629  else if (i == j) then
-
630  marker = i + 1
-
631  return
-
632  else
-
633  marker = i
-
634  return
-
635  end if
-
636  end do
-
637  end if
-
638  end subroutine
-
639 
-
640 ! ------------------------------------------------------------------------------
-
641 end submodule
+
1! linalg_sorting.f90
+
2
+
7submodule(linalg_core) linalg_sorting
+
8contains
+
9! ******************************************************************************
+
10! SORTING ROUTINES
+
11! ------------------------------------------------------------------------------
+
12 module subroutine sort_dbl_array(x, ascend)
+
13 ! Arguments
+
14 real(real64), intent(inout), dimension(:) :: x
+
15 logical, intent(in), optional :: ascend
+
16
+
17 ! Local Variables
+
18 character :: id
+
19 integer(int32) :: n, info
+
20
+
21 ! Initialization
+
22 if (present(ascend)) then
+
23 if (ascend) then
+
24 id = 'I'
+
25 else
+
26 id = 'D'
+
27 end if
+
28 else
+
29 id = 'I'
+
30 end if
+
31 n = size(x)
+
32
+
33 ! Process
+
34 call dlasrt(id, n, x, info)
+
35 end subroutine
+
36
+
37! ------------------------------------------------------------------------------
+
38 module subroutine sort_dbl_array_ind(x, ind, ascend, err)
+
39 ! Arguments
+
40 real(real64), intent(inout), dimension(:) :: x
+
41 integer(int32), intent(inout), dimension(:) :: ind
+
42 logical, intent(in), optional :: ascend
+
43 class(errors), intent(inout), optional, target :: err
+
44
+
45 ! Local Variables
+
46 class(errors), pointer :: errmgr
+
47 type(errors), target :: deferr
+
48 character(len = 128) :: errmsg
+
49 integer(int32) :: n
+
50 logical :: dir
+
51
+
52 ! Initialization
+
53 n = size(x)
+
54 if (present(err)) then
+
55 errmgr => err
+
56 else
+
57 errmgr => deferr
+
58 end if
+
59 if (present(ascend)) then
+
60 dir = ascend
+
61 else
+
62 dir = .true. ! Ascend == true
+
63 end if
+
64
+
65 ! Input Check
+
66 if (size(ind) /= n) then
+
67 write(errmsg, "(AI0AI0A)") &
+
68 "Expected the tracking array to be of size ", n, &
+
69 ", but found an array of size ", size(ind), "."
+
70 call errmgr%report_error("sort_dbl_array_ind", trim(errmsg), &
+
71 la_array_size_error)
+
72 return
+
73 end if
+
74 if (n <= 1) return
+
75
+
76 ! Process
+
77 call qsort_dbl_ind(dir, x, ind)
+
78 end subroutine
+
79
+
80! ------------------------------------------------------------------------------
+
81 module subroutine sort_cmplx_array(x, ascend)
+
82 ! Arguments
+
83 complex(real64), intent(inout), dimension(:) :: x
+
84 logical, intent(in), optional :: ascend
+
85
+
86 ! Local Variables
+
87 logical :: dir
+
88
+
89 ! Initialization
+
90 if (present(ascend)) then
+
91 dir = ascend
+
92 else
+
93 dir = .true.
+
94 end if
+
95
+
96 ! Process
+
97 call qsort_cmplx(dir, x)
+
98 end subroutine
+
99
+
100! ------------------------------------------------------------------------------
+
101 module subroutine sort_cmplx_array_ind(x, ind, ascend, err)
+
102 ! Arguments
+
103 complex(real64), intent(inout), dimension(:) :: x
+
104 integer(int32), intent(inout), dimension(:) :: ind
+
105 logical, intent(in), optional :: ascend
+
106 class(errors), intent(inout), optional, target :: err
+
107
+
108 ! Local Variables
+
109 class(errors), pointer :: errmgr
+
110 type(errors), target :: deferr
+
111 character(len = 128) :: errmsg
+
112 integer(int32) :: n
+
113 logical :: dir
+
114
+
115 ! Initialization
+
116 n = size(x)
+
117 if (present(err)) then
+
118 errmgr => err
+
119 else
+
120 errmgr => deferr
+
121 end if
+
122 if (present(ascend)) then
+
123 dir = ascend
+
124 else
+
125 dir = .true. ! Ascend == true
+
126 end if
+
127
+
128 ! Input Check
+
129 if (size(ind) /= n) then
+
130 write(errmsg, "(AI0AI0A)") &
+
131 "Expected the tracking array to be of size ", n, &
+
132 ", but found an array of size ", size(ind), "."
+
133 call errmgr%report_error("sort_cmplx_array_ind", trim(errmsg), &
+
134 la_array_size_error)
+
135 return
+
136 end if
+
137 if (n <= 1) return
+
138
+
139 ! Process
+
140 call qsort_cmplx_ind(dir, x, ind)
+
141 end subroutine
+
142
+
143! ------------------------------------------------------------------------------
+
144 module subroutine sort_eigen_cmplx(vals, vecs, ascend, err)
+
145 ! Arguments
+
146 complex(real64), intent(inout), dimension(:) :: vals
+
147 complex(real64), intent(inout), dimension(:,:) :: vecs
+
148 logical, intent(in), optional :: ascend
+
149 class(errors), intent(inout), optional, target :: err
+
150
+
151 ! Local Variables
+
152 class(errors), pointer :: errmgr
+
153 type(errors), target :: deferr
+
154 character(len = 128) :: errmsg
+
155 integer(int32) :: i, n, flag
+
156 logical :: dir
+
157 integer(int32), allocatable, dimension(:) :: ind
+
158
+
159 ! Initialization
+
160 if (present(err)) then
+
161 errmgr => err
+
162 else
+
163 errmgr => deferr
+
164 end if
+
165 if (present(ascend)) then
+
166 dir = ascend
+
167 else
+
168 dir = .true. ! Ascend == true
+
169 end if
+
170
+
171 ! Ensure the eigenvector matrix is sized appropriately
+
172 n = size(vals)
+
173 if (size(vecs, 1) /= n .or. size(vecs, 2) /= n) then
+
174 ! ARRAY SIZE ERROR
+
175 write(errmsg, '(AI0AI0AI0AI0A)') &
+
176 "Expected the eigenvector matrix to be of size ", n, &
+
177 "-by-", n, ", but found a matrix of size ", size(vecs, 1), &
+
178 "-by-", size(vecs, 2), "."
+
179 call errmgr%report_error("sort_eigen_cmplx", trim(errmsg), &
+
180 la_array_size_error)
+
181 end if
+
182
+
183 ! Allocate memory for the tracking array
+
184 allocate(ind(n), stat = flag)
+
185 if (flag /= 0) then
+
186 call errmgr%report_error("sort_eigen_cmplx", &
+
187 "Insufficient memory available.", la_out_of_memory_error)
+
188 return
+
189 end if
+
190 do i = 1, n
+
191 ind(i) = i
+
192 end do
+
193
+
194 ! Sort
+
195 call qsort_cmplx_ind(dir, vals, ind)
+
196
+
197 ! Shift the eigenvectors around to keep them associated with the
+
198 ! appropriate eigenvalue
+
199 vecs = vecs(:,ind)
+
200 end subroutine
+
201
+
202! ------------------------------------------------------------------------------
+
203 module subroutine sort_eigen_dbl(vals, vecs, ascend, err)
+
204 ! Arguments
+
205 real(real64), intent(inout), dimension(:) :: vals
+
206 real(real64), intent(inout), dimension(:,:) :: vecs
+
207 logical, intent(in), optional :: ascend
+
208 class(errors), intent(inout), optional, target :: err
+
209
+
210 ! Local Variables
+
211 class(errors), pointer :: errmgr
+
212 type(errors), target :: deferr
+
213 character(len = 128) :: errmsg
+
214 integer(int32) :: i, n, flag
+
215 logical :: dir
+
216 integer(int32), allocatable, dimension(:) :: ind
+
217
+
218 ! Initialization
+
219 if (present(err)) then
+
220 errmgr => err
+
221 else
+
222 errmgr => deferr
+
223 end if
+
224 if (present(ascend)) then
+
225 dir = ascend
+
226 else
+
227 dir = .true. ! Ascend == true
+
228 end if
+
229
+
230 ! Ensure the eigenvector matrix is sized appropriately
+
231 n = size(vals)
+
232 if (size(vecs, 1) /= n .or. size(vecs, 2) /= n) then
+
233 ! ARRAY SIZE ERROR
+
234 write(errmsg, '(AI0AI0AI0AI0A)') &
+
235 "Expected the eigenvector matrix to be of size ", n, &
+
236 "-by-", n, ", but found a matrix of size ", size(vecs, 1), &
+
237 "-by-", size(vecs, 2), "."
+
238 call errmgr%report_error("sort_eigen_dbl", trim(errmsg), &
+
239 la_array_size_error)
+
240 end if
+
241
+
242 ! Allocate memory for the tracking array
+
243 allocate(ind(n), stat = flag)
+
244 if (flag /= 0) then
+
245 call errmgr%report_error("sort_eigen_dbl", &
+
246 "Insufficient memory available.", la_out_of_memory_error)
+
247 return
+
248 end if
+
249 do i = 1, n
+
250 ind(i) = i
+
251 end do
+
252
+
253 ! Sort
+
254 call qsort_dbl_ind(dir, vals, ind)
+
255
+
256 ! Shift the eigenvectors around to keep them associated with the
+
257 ! appropriate eigenvalue
+
258 vecs = vecs(:,ind)
+
259 end subroutine
+
260
+
261! ******************************************************************************
+
262! PRIVATE HELPER ROUTINES
+
263! ------------------------------------------------------------------------------
+
277 recursive subroutine qsort_dbl_ind(ascend, x, ind)
+
278 ! Arguments
+
279 logical, intent(in) :: ascend
+
280 real(real64), intent(inout), dimension(:) :: x
+
281 integer(int32), intent(inout), dimension(:) :: ind
+
282
+
283 ! Local Variables
+
284 integer(int32) :: iq
+
285
+
286 ! Process
+
287 if (size(x) > 1) then
+
288 call dbl_partition_ind(ascend, x, ind, iq)
+
289 call qsort_dbl_ind(ascend, x(:iq-1), ind(:iq-1))
+
290 call qsort_dbl_ind(ascend, x(iq:), ind(iq:))
+
291 end if
+
292 end subroutine
+
293
+
294! ------------------------------------------------------------------------------
+
310 subroutine dbl_partition_ind(ascend, x, ind, marker)
+
311 ! Arguments
+
312 logical, intent(in) :: ascend
+
313 real(real64), intent(inout), dimension(:) :: x
+
314 integer(int32), intent(inout), dimension(:) :: ind
+
315 integer(int32), intent(out) :: marker
+
316
+
317 ! Local Variables
+
318 integer(int32) :: i, j, itemp
+
319 real(real64) :: temp, pivot
+
320
+
321 ! Process
+
322 pivot = x(1)
+
323 i = 0
+
324 j = size(x) + 1
+
325 if (ascend) then
+
326 ! Ascending Sort
+
327 do
+
328 j = j - 1
+
329 do
+
330 if (x(j) <= pivot) exit
+
331 j = j - 1
+
332 end do
+
333 i = i + 1
+
334 do
+
335 if (x(i) >= pivot) exit
+
336 i = i + 1
+
337 end do
+
338 if (i < j) then
+
339 ! Exchage X(I) and X(J)
+
340 temp = x(i)
+
341 x(i) = x(j)
+
342 x(j) = temp
+
343
+
344 itemp = ind(i)
+
345 ind(i) = ind(j)
+
346 ind(j) = itemp
+
347 else if (i == j) then
+
348 marker = i + 1
+
349 return
+
350 else
+
351 marker = i
+
352 return
+
353 end if
+
354 end do
+
355 else
+
356 ! Descending Sort
+
357 do
+
358 j = j - 1
+
359 do
+
360 if (x(j) >= pivot) exit
+
361 j = j - 1
+
362 end do
+
363 i = i + 1
+
364 do
+
365 if (x(i) <= pivot) exit
+
366 i = i + 1
+
367 end do
+
368 if (i < j) then
+
369 ! Exchage X(I) and X(J)
+
370 temp = x(i)
+
371 x(i) = x(j)
+
372 x(j) = temp
+
373
+
374 itemp = ind(i)
+
375 ind(i) = ind(j)
+
376 ind(j) = itemp
+
377 else if (i == j) then
+
378 marker = i + 1
+
379 return
+
380 else
+
381 marker = i
+
382 return
+
383 end if
+
384 end do
+
385 end if
+
386 end subroutine
+
387
+
388! ------------------------------------------------------------------------------
+
403 recursive subroutine qsort_cmplx(ascend, x)
+
404 ! Arguments
+
405 logical, intent(in) :: ascend
+
406 complex(real64), intent(inout), dimension(:) :: x
+
407
+
408 ! Local Variables
+
409 integer(int32) :: iq
+
410
+
411 ! Process
+
412 if (size(x) > 1) then
+
413 call cmplx_partition(ascend, x, iq)
+
414 call qsort_cmplx(ascend, x(:iq-1))
+
415 call qsort_cmplx(ascend, x(iq:))
+
416 end if
+
417 end subroutine
+
418
+
419! ------------------------------------------------------------------------------
+
436 subroutine cmplx_partition(ascend, x, marker)
+
437 ! Arguments
+
438 logical, intent(in) :: ascend
+
439 complex(real64), intent(inout), dimension(:) :: x
+
440 integer(int32), intent(out) :: marker
+
441
+
442 ! Local Variables
+
443 integer(int32) :: i, j
+
444 complex(real64) :: temp
+
445 real(real64) :: pivot
+
446
+
447 ! Process
+
448 pivot = real(x(1), real64)
+
449 i = 0
+
450 j = size(x) + 1
+
451 if (ascend) then
+
452 ! Ascending Sort
+
453 do
+
454 j = j - 1
+
455 do
+
456 if (real(x(j), real64) <= pivot) exit
+
457 j = j - 1
+
458 end do
+
459 i = i + 1
+
460 do
+
461 if (real(x(i), real64) >= pivot) exit
+
462 i = i + 1
+
463 end do
+
464 if (i < j) then
+
465 ! Exchage X(I) and X(J)
+
466 temp = x(i)
+
467 x(i) = x(j)
+
468 x(j) = temp
+
469 else if (i == j) then
+
470 marker = i + 1
+
471 return
+
472 else
+
473 marker = i
+
474 return
+
475 end if
+
476 end do
+
477 else
+
478 ! Descending Sort
+
479 do
+
480 j = j - 1
+
481 do
+
482 if (real(x(j), real64) >= pivot) exit
+
483 j = j - 1
+
484 end do
+
485 i = i + 1
+
486 do
+
487 if (real(x(i), real64) <= pivot) exit
+
488 i = i + 1
+
489 end do
+
490 if (i < j) then
+
491 ! Exchage X(I) and X(J)
+
492 temp = x(i)
+
493 x(i) = x(j)
+
494 x(j) = temp
+
495 else if (i == j) then
+
496 marker = i + 1
+
497 return
+
498 else
+
499 marker = i
+
500 return
+
501 end if
+
502 end do
+
503 end if
+
504 end subroutine
+
505
+
506! ------------------------------------------------------------------------------
+
524 recursive subroutine qsort_cmplx_ind(ascend, x, ind)
+
525 ! Arguments
+
526 logical, intent(in) :: ascend
+
527 complex(real64), intent(inout), dimension(:) :: x
+
528 integer(int32), intent(inout), dimension(:) :: ind
+
529
+
530 ! Local Variables
+
531 integer(int32) :: iq
+
532
+
533 ! Process
+
534 if (size(x) > 1) then
+
535 call cmplx_partition_ind(ascend, x, ind, iq)
+
536 call qsort_cmplx_ind(ascend, x(:iq-1), ind(:iq-1))
+
537 call qsort_cmplx_ind(ascend, x(iq:), ind(iq:))
+
538 end if
+
539 end subroutine
+
540
+
541! ------------------------------------------------------------------------------
+
561 subroutine cmplx_partition_ind(ascend, x, ind, marker)
+
562 ! Arguments
+
563 logical, intent(in) :: ascend
+
564 complex(real64), intent(inout), dimension(:) :: x
+
565 integer(int32), intent(inout), dimension(:) :: ind
+
566 integer(int32), intent(out) :: marker
+
567
+
568 ! Local Variables
+
569 integer(int32) :: i, j, itemp
+
570 complex(real64) :: temp
+
571 real(real64) :: pivot
+
572
+
573 ! Process
+
574 pivot = real(x(1), real64)
+
575 i = 0
+
576 j = size(x) + 1
+
577 if (ascend) then
+
578 ! Ascending Sort
+
579 do
+
580 j = j - 1
+
581 do
+
582 if (real(x(j), real64) <= pivot) exit
+
583 j = j - 1
+
584 end do
+
585 i = i + 1
+
586 do
+
587 if (real(x(i), real64) >= pivot) exit
+
588 i = i + 1
+
589 end do
+
590 if (i < j) then
+
591 ! Exchage X(I) and X(J)
+
592 temp = x(i)
+
593 x(i) = x(j)
+
594 x(j) = temp
+
595
+
596 itemp = ind(i)
+
597 ind(i) = ind(j)
+
598 ind(j) = itemp
+
599 else if (i == j) then
+
600 marker = i + 1
+
601 return
+
602 else
+
603 marker = i
+
604 return
+
605 end if
+
606 end do
+
607 else
+
608 ! Descending Sort
+
609 do
+
610 j = j - 1
+
611 do
+
612 if (real(x(j), real64) >= pivot) exit
+
613 j = j - 1
+
614 end do
+
615 i = i + 1
+
616 do
+
617 if (real(x(i), real64) <= pivot) exit
+
618 i = i + 1
+
619 end do
+
620 if (i < j) then
+
621 ! Exchage X(I) and X(J)
+
622 temp = x(i)
+
623 x(i) = x(j)
+
624 x(j) = temp
+
625
+
626 itemp = ind(i)
+
627 ind(i) = ind(j)
+
628 ind(j) = itemp
+
629 else if (i == j) then
+
630 marker = i + 1
+
631 return
+
632 else
+
633 marker = i
+
634 return
+
635 end if
+
636 end do
+
637 end if
+
638 end subroutine
+
639
+
640! ------------------------------------------------------------------------------
+
641end submodule
+
Provides a set of common linear algebra routines.
Definition: linalg_core.f90:15
-
Provides a set of common linear algebra routines.
Definition: linalg_core.f90:15
diff --git a/doc/html/menu.js b/doc/html/menu.js index 433c15b8..b0b26936 100644 --- a/doc/html/menu.js +++ b/doc/html/menu.js @@ -1,25 +1,26 @@ /* - @licstart The following is the entire license notice for the - JavaScript code in this file. + @licstart The following is the entire license notice for the JavaScript code in this file. - Copyright (C) 1997-2017 by Dimitri van Heesch + The MIT License (MIT) - This program is free software; you can redistribute it and/or modify - it under the terms of the GNU General Public License as published by - the Free Software Foundation; either version 2 of the License, or - (at your option) any later version. + Copyright (C) 1997-2020 by Dimitri van Heesch - This program is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. + Permission is hereby granted, free of charge, to any person obtaining a copy of this software + and associated documentation files (the "Software"), to deal in the Software without restriction, + including without limitation the rights to use, copy, modify, merge, publish, distribute, + sublicense, and/or sell copies of the Software, and to permit persons to whom the Software is + furnished to do so, subject to the following conditions: - You should have received a copy of the GNU General Public License along - with this program; if not, write to the Free Software Foundation, Inc., - 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. + The above copyright notice and this permission notice shall be included in all copies or + substantial portions of the Software. - @licend The above is the entire license notice - for the JavaScript code in this file + THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING + BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND + NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, + DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, + OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. + + @licend The above is the entire license notice for the JavaScript code in this file */ function initMenu(relPath,searchEnabled,serverSide,searchPage,search) { function makeTree(data,relPath) { @@ -27,7 +28,15 @@ function initMenu(relPath,searchEnabled,serverSide,searchPage,search) { if ('children' in data) { result+='
    '; for (var i in data.children) { - result+='
  • '+ + var url; + var link; + link = data.children[i].url; + if (link.substring(0,1)=='^') { + url = link.substring(1); + } else { + url = relPath+link; + } + result+='
  • '+ data.children[i].text+''+ makeTree(data.children[i],relPath)+'
  • '; } @@ -35,15 +44,92 @@ function initMenu(relPath,searchEnabled,serverSide,searchPage,search) { } return result; } - - $('#main-nav').append(makeTree(menudata,relPath)); - $('#main-nav').children(':first').addClass('sm sm-dox').attr('id','main-menu'); + var searchBoxHtml; if (searchEnabled) { if (serverSide) { - $('#main-menu').append('
  • '); + searchBoxHtml='
    '+ + '
    '+ + '
     '+ + ''+ + '
    '+ + '
    '+ + '
    '+ + '
    '; } else { - $('#main-menu').append('
  • '); + searchBoxHtml='
    '+ + ''+ + ' '+ + ''+ + ''+ + ''+ + ''+ + ''+ + '
    '; + } + } + + $('#main-nav').before('
    '+ + ''+ + ''+ + '
    '); + $('#main-nav').append(makeTree(menudata,relPath)); + $('#main-nav').children(':first').addClass('sm sm-dox').attr('id','main-menu'); + if (searchBoxHtml) { + $('#main-menu').append('
  • '); + } + var $mainMenuState = $('#main-menu-state'); + var prevWidth = 0; + if ($mainMenuState.length) { + function initResizableIfExists() { + if (typeof initResizable==='function') initResizable(); + } + // animate mobile menu + $mainMenuState.change(function(e) { + var $menu = $('#main-menu'); + var options = { duration: 250, step: initResizableIfExists }; + if (this.checked) { + options['complete'] = function() { $menu.css('display', 'block') }; + $menu.hide().slideDown(options); + } else { + options['complete'] = function() { $menu.css('display', 'none') }; + $menu.show().slideUp(options); + } + }); + // set default menu visibility + function resetState() { + var $menu = $('#main-menu'); + var $mainMenuState = $('#main-menu-state'); + var newWidth = $(window).outerWidth(); + if (newWidth!=prevWidth) { + if ($(window).outerWidth()<768) { + $mainMenuState.prop('checked',false); $menu.hide(); + $('#searchBoxPos1').html(searchBoxHtml); + $('#searchBoxPos2').hide(); + } else { + $menu.show(); + $('#searchBoxPos1').empty(); + $('#searchBoxPos2').html(searchBoxHtml); + $('#searchBoxPos2').show(); + } + if (typeof searchBox!=='undefined') { + searchBox.CloseResultsWindow(); + } + prevWidth = newWidth; + } } + $(window).ready(function() { resetState(); initResizableIfExists(); }); + $(window).resize(resetState); } $('#main-menu').smartmenus(); } diff --git a/doc/html/menudata.js b/doc/html/menudata.js index fd3f13f7..3be9094a 100644 --- a/doc/html/menudata.js +++ b/doc/html/menudata.js @@ -1,24 +1,26 @@ /* -@licstart The following is the entire license notice for the -JavaScript code in this file. + @licstart The following is the entire license notice for the JavaScript code in this file. -Copyright (C) 1997-2019 by Dimitri van Heesch + The MIT License (MIT) -This program is free software; you can redistribute it and/or modify -it under the terms of version 2 of the GNU General Public License as published by -the Free Software Foundation + Copyright (C) 1997-2020 by Dimitri van Heesch -This program is distributed in the hope that it will be useful, -but WITHOUT ANY WARRANTY; without even the implied warranty of -MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -GNU General Public License for more details. + Permission is hereby granted, free of charge, to any person obtaining a copy of this software + and associated documentation files (the "Software"), to deal in the Software without restriction, + including without limitation the rights to use, copy, modify, merge, publish, distribute, + sublicense, and/or sell copies of the Software, and to permit persons to whom the Software is + furnished to do so, subject to the following conditions: -You should have received a copy of the GNU General Public License along -with this program; if not, write to the Free Software Foundation, Inc., -51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. + The above copyright notice and this permission notice shall be included in all copies or + substantial portions of the Software. -@licend The above is the entire license notice -for the JavaScript code in this file + THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING + BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND + NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, + DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, + OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. + + @licend The above is the entire license notice for the JavaScript code in this file */ var menudata={children:[ {text:"Main Page",url:"index.html"}, @@ -41,16 +43,7 @@ var menudata={children:[ {text:"Data Types List",url:"annotated.html"}, {text:"Data Types",url:"classes.html"}, {text:"Data Fields",url:"functions.html",children:[ -{text:"All",url:"functions.html",children:[ -{text:"l",url:"functions.html#index_l"}, -{text:"m",url:"functions.html#index_m"}, -{text:"p",url:"functions.html#index_p"}, -{text:"q",url:"functions.html#index_q"}, -{text:"r",url:"functions.html#index_r"}, -{text:"s",url:"functions.html#index_s"}, -{text:"u",url:"functions.html#index_u"}, -{text:"v",url:"functions.html#index_v"}]}, -{text:"Functions/Subroutines",url:"functions_func.html"}, +{text:"All",url:"functions.html"}, {text:"Variables",url:"functions_vars.html"}]}]}, {text:"Files",url:"files.html",children:[ {text:"File List",url:"files.html"}]}]} diff --git a/doc/html/namespacelinalg__c__api.html b/doc/html/namespacelinalg__c__api.html index eca00237..0e1d1f36 100644 --- a/doc/html/namespacelinalg__c__api.html +++ b/doc/html/namespacelinalg__c__api.html @@ -1,9 +1,9 @@ - + - - + + linalg: linalg_c_api Module Reference @@ -13,13 +13,16 @@ - + + @@ -27,10 +30,9 @@
    - - + @@ -39,21 +41,22 @@
    -
    linalg -  1.6.0 +
    +
    linalg 1.6.1
    A linear algebra library that provides a user-friendly interface to several BLAS and LAPACK routines.
    - + +/* @license-end */ +
@@ -67,8 +70,8 @@
@@ -81,23 +84,29 @@
- +
+
+
+
+
Loading...
+
Searching...
+
No Matches
+
+
+
-
-
linalg_c_api Module Reference
+
linalg_c_api Module Reference

Provides a C-friendly API to the LINALG library. Notice, all C-API LINALG routines begin with the prefix "la_". More...

- @@ -120,6 +129,9 @@ + + + @@ -281,10 +293,10 @@

+

Functions/Subroutines

integer(c_int) function la_rank1_update (m, n, alpha, x, y, a, lda)
 Performs the rank-1 update to matrix A such that: A = alpha * X * Y**T + A, where A is an M-by-N matrix, alpha is a scalar, X is an M-element array, and N is an N-element array. More...
integer(c_int) function la_diag_mtx_mult (lside, transb, m, n, k, alpha, a, b, ldb, beta, c, ldc)
 Computes the matrix operation: C = alpha * A * op(B) + beta * C, or C = alpha * op(B) * A + beta * C. More...
 
integer(c_int) function la_diag_mtx_mult_mixed (lside, opb, m, n, k, alpha, a, b, ldb, beta, c, ldc)
 Computes the matrix operation: C = alpha * A * op(B) + beta * C, or C = alpha * op(B) * A + beta * C. More...
 
integer(c_int) function la_diag_mtx_mult_cmplx (lside, opb, m, n, k, alpha, a, b, ldb, beta, c, ldc)
 Computes the matrix operation: C = alpha * A * op(B) + beta * C, or C = alpha * op(B) * A + beta * C. More...
 
 

Detailed Description

-

Provides a C-friendly API to the LINALG library. Notice, all C-API LINALG routines begin with the prefix "la_".

+

Provides a C-friendly API to the LINALG library. Notice, all C-API LINALG routines begin with the prefix "la_".

Function/Subroutine Documentation

- -

◆ la_cholesky_factor()

+ +

◆ la_cholesky_factor()

@@ -338,12 +350,12 @@

Definition at line 1619 of file linalg_c_api.f90.

+

Definition at line 1705 of file linalg_c_api.f90.

- -

◆ la_cholesky_factor_cmplx()

+ +

◆ la_cholesky_factor_cmplx()

@@ -397,12 +409,12 @@

Definition at line 1663 of file linalg_c_api.f90.

+

Definition at line 1749 of file linalg_c_api.f90.

- -

◆ la_cholesky_rank1_downdate()

+ +

◆ la_cholesky_rank1_downdate()

@@ -457,12 +469,12 @@

Definition at line 1792 of file linalg_c_api.f90.

+

Definition at line 1878 of file linalg_c_api.f90.

- -

◆ la_cholesky_rank1_downdate_cmplx()

+ +

◆ la_cholesky_rank1_downdate_cmplx()

@@ -517,12 +529,12 @@

Definition at line 1836 of file linalg_c_api.f90.

+

Definition at line 1922 of file linalg_c_api.f90.

- -

◆ la_cholesky_rank1_update()

+ +

◆ la_cholesky_rank1_update()

@@ -576,12 +588,12 @@

Definition at line 1706 of file linalg_c_api.f90.

+

Definition at line 1792 of file linalg_c_api.f90.

- -

◆ la_cholesky_rank1_update_cmplx()

+ +

◆ la_cholesky_rank1_update_cmplx()

@@ -635,12 +647,12 @@

Definition at line 1748 of file linalg_c_api.f90.

+

Definition at line 1834 of file linalg_c_api.f90.

- -

◆ la_det()

+ +

◆ la_det()

@@ -694,12 +706,12 @@

Definition at line 580 of file linalg_c_api.f90.

+

Definition at line 667 of file linalg_c_api.f90.

- -

◆ la_det_cmplx()

+ +

◆ la_det_cmplx()

@@ -753,12 +765,12 @@

Definition at line 617 of file linalg_c_api.f90.

+

Definition at line 704 of file linalg_c_api.f90.

- -

◆ la_diag_mtx_mult()

+ +

◆ la_diag_mtx_mult()

@@ -874,12 +886,12 @@

Definition at line 342 of file linalg_c_api.f90.

+

Definition at line 340 of file linalg_c_api.f90.

- -

◆ la_diag_mtx_mult_cmplx()

+ +

◆ la_diag_mtx_mult_cmplx()

@@ -995,12 +1007,133 @@

Definition at line 432 of file linalg_c_api.f90.

+

Definition at line 517 of file linalg_c_api.f90.

- -

◆ la_eigen_asymm()

+ +

◆ la_diag_mtx_mult_mixed()

+ +
+
+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
integer(c_int) function linalg_c_api::la_diag_mtx_mult_mixed (logical(c_bool), intent(in), value lside,
integer(c_int), intent(in), value opb,
integer(c_int), intent(in), value m,
integer(c_int), intent(in), value n,
integer(c_int), intent(in), value k,
complex(c_double), intent(in), value alpha,
real(c_double), dimension(*), intent(in) a,
complex(c_double), dimension(ldb,*), intent(in) b,
integer(c_int), intent(in), value ldb,
complex(c_double), intent(in), value beta,
complex(c_double), dimension(ldc,*), intent(inout) c,
integer(c_int), intent(in), value ldc 
)
+
+ +

Computes the matrix operation: C = alpha * A * op(B) + beta * C, or C = alpha * op(B) * A + beta * C.

+
Parameters
+ + + + + + + + + + + + + +
lsideSet to true to apply matrix A from the left; else, set to false to apply matrix A from the left.
opbSet to TRANSPOSE to compute op(B) as a direct transpose of B, set to HERMITIAN_TRANSPOSE to compute op(B) as the Hermitian transpose of B, otherwise, set to NO_OPERATION to compute op(B) as B.
mThe number of rows in the matrix C.
nThe number of columns in the matrix C.
kThe inner dimension of the matrix product A * op(B).
alphaA scalar multiplier.
aA P-element array containing the diagonal elements of matrix A where P = MIN(m, k) if lside is true; else, P = MIN(n, k) if lside is false.
bThe LDB-by-TDB matrix B where (LDB = leading dimension of B, and TDB = trailing dimension of B):
    +
  • lside == true & trans == true: LDB = n, TDB = k
  • +
  • lside == true & trans == false: LDB = k, TDB = n
  • +
  • lside == false & trans == true: LDB = k, TDB = m
  • +
  • lside == false & trans == false: LDB = m, TDB = k
  • +
+
ldbThe leading dimension of matrix B.
betaA scalar multiplier.
cThe m by n matrix C.
ldcThe leading dimension of matrix C.
+
+
+
Returns
An error code. The following codes are possible.
    +
  • LA_NO_ERROR: No error occurred. Successful operation.
  • +
  • LA_INVALID_INPUT_ERROR: Occurs if ldb, or ldc are not correct.
  • +
  • LA_ARRAY_SIZE_ERROR: Occurs if any of the input array sizes are incorrect.
  • +
+
+ +

Definition at line 429 of file linalg_c_api.f90.

+ +
+
+ +

◆ la_eigen_asymm()

@@ -1075,12 +1208,12 @@

Definition at line 2806 of file linalg_c_api.f90.

+

Definition at line 2892 of file linalg_c_api.f90.

- -

◆ la_eigen_cmplx()

+ +

◆ la_eigen_cmplx()

@@ -1155,12 +1288,12 @@

Definition at line 2941 of file linalg_c_api.f90.

+

Definition at line 3027 of file linalg_c_api.f90.

- -

◆ la_eigen_gen()

+ +

◆ la_eigen_gen()

@@ -1256,12 +1389,12 @@

Definition at line 2879 of file linalg_c_api.f90.

+

Definition at line 2965 of file linalg_c_api.f90.

- -

◆ la_eigen_symm()

+ +

◆ la_eigen_symm()

@@ -1323,12 +1456,12 @@

Definition at line 2757 of file linalg_c_api.f90.

+

Definition at line 2843 of file linalg_c_api.f90.

- -

◆ la_form_lu()

+ +

◆ la_form_lu()

@@ -1409,12 +1542,12 @@

Definition at line 845 of file linalg_c_api.f90.

+

Definition at line 931 of file linalg_c_api.f90.

- -

◆ la_form_lu_cmplx()

+ +

◆ la_form_lu_cmplx()

@@ -1495,12 +1628,12 @@

Definition at line 885 of file linalg_c_api.f90.

+

Definition at line 971 of file linalg_c_api.f90.

- -

◆ la_form_qr()

+ +

◆ la_form_qr()

@@ -1582,12 +1715,12 @@

Definition at line 1137 of file linalg_c_api.f90.

+

Definition at line 1223 of file linalg_c_api.f90.

- -

◆ la_form_qr_cmplx()

+ +

◆ la_form_qr_cmplx()

@@ -1669,12 +1802,12 @@

Definition at line 1195 of file linalg_c_api.f90.

+

Definition at line 1281 of file linalg_c_api.f90.

- -

◆ la_form_qr_cmplx_pvt()

+ +

◆ la_form_qr_cmplx_pvt()

@@ -1777,12 +1910,12 @@

Definition at line 1325 of file linalg_c_api.f90.

+

Definition at line 1411 of file linalg_c_api.f90.

- -

◆ la_form_qr_pvt()

+ +

◆ la_form_qr_pvt()

@@ -1885,12 +2018,12 @@

Definition at line 1259 of file linalg_c_api.f90.

+

Definition at line 1345 of file linalg_c_api.f90.

- -

◆ la_inverse()

+ +

◆ la_inverse()

@@ -1937,12 +2070,12 @@

Definition at line 2585 of file linalg_c_api.f90.

+

Definition at line 2672 of file linalg_c_api.f90.

- -

◆ la_inverse_cmplx()

+ +

◆ la_inverse_cmplx()

@@ -1989,12 +2122,12 @@

Definition at line 2623 of file linalg_c_api.f90.

+

Definition at line 2709 of file linalg_c_api.f90.

- -

◆ la_lu_factor()

+ +

◆ la_lu_factor()

@@ -2055,12 +2188,12 @@

Definition at line 749 of file linalg_c_api.f90.

+

Definition at line 835 of file linalg_c_api.f90.

- -

◆ la_lu_factor_cmplx()

+ +

◆ la_lu_factor_cmplx()

@@ -2121,12 +2254,12 @@

Definition at line 796 of file linalg_c_api.f90.

+

Definition at line 882 of file linalg_c_api.f90.

- -

◆ la_mtx_mult()

+ +

◆ la_mtx_mult()

@@ -2242,12 +2375,12 @@

Definition at line 186 of file linalg_c_api.f90.

+

Definition at line 184 of file linalg_c_api.f90.

- -

◆ la_mtx_mult_cmplx()

+ +

◆ la_mtx_mult_cmplx()

@@ -2363,12 +2496,12 @@

Definition at line 257 of file linalg_c_api.f90.

+

Definition at line 255 of file linalg_c_api.f90.

- -

◆ la_mult_qr()

+ +

◆ la_mult_qr()

@@ -2464,12 +2597,12 @@

Definition at line 1388 of file linalg_c_api.f90.

+

Definition at line 1474 of file linalg_c_api.f90.

- -

◆ la_mult_qr_cmplx()

+ +

◆ la_mult_qr_cmplx()

@@ -2565,12 +2698,12 @@

Definition at line 1459 of file linalg_c_api.f90.

+

Definition at line 1545 of file linalg_c_api.f90.

- -

◆ la_pinverse()

+ +

◆ la_pinverse()

@@ -2636,12 +2769,12 @@

Definition at line 2665 of file linalg_c_api.f90.

+

Definition at line 2751 of file linalg_c_api.f90.

- -

◆ la_pinverse_cmplx()

+ +

◆ la_pinverse_cmplx()

@@ -2707,12 +2840,12 @@

Definition at line 2708 of file linalg_c_api.f90.

+

Definition at line 2794 of file linalg_c_api.f90.

- -

◆ la_qr_factor()

+ +

◆ la_qr_factor()

@@ -2773,12 +2906,12 @@

Definition at line 926 of file linalg_c_api.f90.

+

Definition at line 1012 of file linalg_c_api.f90.

- -

◆ la_qr_factor_cmplx()

+ +

◆ la_qr_factor_cmplx()

@@ -2839,12 +2972,12 @@

Definition at line 975 of file linalg_c_api.f90.

+

Definition at line 1061 of file linalg_c_api.f90.

- -

◆ la_qr_factor_cmplx_pvt()

+ +

◆ la_qr_factor_cmplx_pvt()

@@ -2912,12 +3045,12 @@

Definition at line 1082 of file linalg_c_api.f90.

+

Definition at line 1168 of file linalg_c_api.f90.

- -

◆ la_qr_factor_pvt()

+ +

◆ la_qr_factor_pvt()

@@ -2985,12 +3118,12 @@

Definition at line 1028 of file linalg_c_api.f90.

+

Definition at line 1114 of file linalg_c_api.f90.

- -

◆ la_qr_rank1_update()

+ +

◆ la_qr_rank1_update()

@@ -3072,12 +3205,12 @@

Definition at line 1524 of file linalg_c_api.f90.

+

Definition at line 1610 of file linalg_c_api.f90.

- -

◆ la_qr_rank1_update_cmplx()

+ +

◆ la_qr_rank1_update_cmplx()

@@ -3159,12 +3292,12 @@

Definition at line 1574 of file linalg_c_api.f90.

+

Definition at line 1660 of file linalg_c_api.f90.

- -

◆ la_rank()

+ +

◆ la_rank()

@@ -3226,12 +3359,12 @@

Definition at line 502 of file linalg_c_api.f90.

+

Definition at line 589 of file linalg_c_api.f90.

- -

◆ la_rank1_update()

+ +

◆ la_rank1_update()

@@ -3305,12 +3438,12 @@

Definition at line 32 of file linalg_c_api.f90.

+

Definition at line 30 of file linalg_c_api.f90.

- -

◆ la_rank1_update_cmplx()

+ +

◆ la_rank1_update_cmplx()

@@ -3384,12 +3517,12 @@

Definition at line 71 of file linalg_c_api.f90.

+

Definition at line 69 of file linalg_c_api.f90.

- -

◆ la_rank_cmplx()

+ +

◆ la_rank_cmplx()

@@ -3451,12 +3584,12 @@

Definition at line 543 of file linalg_c_api.f90.

+

Definition at line 629 of file linalg_c_api.f90.

- -

◆ la_solve_cholesky()

+ +

◆ la_solve_cholesky()

@@ -3530,12 +3663,12 @@

Definition at line 2405 of file linalg_c_api.f90.

+

Definition at line 2491 of file linalg_c_api.f90.

- -

◆ la_solve_cholesky_cmplx()

+ +

◆ la_solve_cholesky_cmplx()

@@ -3609,12 +3742,12 @@

Definition at line 2446 of file linalg_c_api.f90.

+

Definition at line 2532 of file linalg_c_api.f90.

- -

◆ la_solve_least_squares()

+ +

◆ la_solve_least_squares()

@@ -3690,12 +3823,12 @@

Definition at line 2494 of file linalg_c_api.f90.

+

Definition at line 2580 of file linalg_c_api.f90.

- -

◆ la_solve_least_squares_cmplx()

+ +

◆ la_solve_least_squares_cmplx()

@@ -3771,12 +3904,12 @@

Definition at line 2546 of file linalg_c_api.f90.

+

Definition at line 2632 of file linalg_c_api.f90.

- -

◆ la_solve_lu()

+ +

◆ la_solve_lu()

@@ -3850,12 +3983,12 @@

Definition at line 2115 of file linalg_c_api.f90.

+

Definition at line 2201 of file linalg_c_api.f90.

- -

◆ la_solve_lu_cmplx()

+ +

◆ la_solve_lu_cmplx()

@@ -3929,12 +4062,12 @@

Definition at line 2154 of file linalg_c_api.f90.

+

Definition at line 2240 of file linalg_c_api.f90.

- -

◆ la_solve_qr()

+ +

◆ la_solve_qr()

@@ -4016,12 +4149,12 @@

Definition at line 2200 of file linalg_c_api.f90.

+

Definition at line 2286 of file linalg_c_api.f90.

- -

◆ la_solve_qr_cmplx()

+ +

◆ la_solve_qr_cmplx()

@@ -4103,12 +4236,12 @@

Definition at line 2251 of file linalg_c_api.f90.

+

Definition at line 2337 of file linalg_c_api.f90.

- -

◆ la_solve_qr_cmplx_pvt()

+ +

◆ la_solve_qr_cmplx_pvt()

@@ -4197,12 +4330,12 @@

Definition at line 2356 of file linalg_c_api.f90.

+

Definition at line 2442 of file linalg_c_api.f90.

- -

◆ la_solve_qr_pvt()

+ +

◆ la_solve_qr_pvt()

@@ -4291,12 +4424,12 @@

Definition at line 2302 of file linalg_c_api.f90.

+

Definition at line 2388 of file linalg_c_api.f90.

- -

◆ la_solve_tri_mtx()

+ +

◆ la_solve_tri_mtx()

@@ -4398,12 +4531,12 @@

Definition at line 2004 of file linalg_c_api.f90.

+

Definition at line 2090 of file linalg_c_api.f90.

- -

◆ la_solve_tri_mtx_cmplx()

+ +

◆ la_solve_tri_mtx_cmplx()

@@ -4505,12 +4638,12 @@

Definition at line 2066 of file linalg_c_api.f90.

+

Definition at line 2151 of file linalg_c_api.f90.

- -

◆ la_sort_eigen()

+ +

◆ la_sort_eigen()

@@ -4571,12 +4704,12 @@

Definition at line 2998 of file linalg_c_api.f90.

+

Definition at line 3084 of file linalg_c_api.f90.

- -

◆ la_sort_eigen_cmplx()

+ +

◆ la_sort_eigen_cmplx()

@@ -4637,12 +4770,12 @@

Definition at line 3043 of file linalg_c_api.f90.

+

Definition at line 3129 of file linalg_c_api.f90.

- -

◆ la_svd()

+ +

◆ la_svd()

@@ -4732,12 +4865,12 @@

Definition at line 1890 of file linalg_c_api.f90.

+

Definition at line 1976 of file linalg_c_api.f90.

- -

◆ la_svd_cmplx()

+ +

◆ la_svd_cmplx()

@@ -4827,12 +4960,12 @@

Definition at line 1947 of file linalg_c_api.f90.

+

Definition at line 2033 of file linalg_c_api.f90.

- -

◆ la_trace()

+ +

◆ la_trace()

@@ -4892,12 +5025,12 @@

Definition at line 106 of file linalg_c_api.f90.

+

Definition at line 104 of file linalg_c_api.f90.

- -

◆ la_trace_cmplx()

+ +

◆ la_trace_cmplx()

@@ -4957,12 +5090,12 @@

Definition at line 140 of file linalg_c_api.f90.

+

Definition at line 138 of file linalg_c_api.f90.

- -

◆ la_tri_mtx_mult()

+ +

◆ la_tri_mtx_mult()

@@ -5043,12 +5176,12 @@

Definition at line 665 of file linalg_c_api.f90.

+

Definition at line 751 of file linalg_c_api.f90.

- -

◆ la_tri_mtx_mult_cmplx()

+ +

◆ la_tri_mtx_mult_cmplx()

@@ -5129,7 +5262,7 @@

Definition at line 710 of file linalg_c_api.f90.

+

Definition at line 796 of file linalg_c_api.f90.

@@ -5139,9 +5272,7 @@

diff --git a/doc/html/namespacelinalg__constants.html b/doc/html/namespacelinalg__constants.html index f97fb178..3a99825f 100644 --- a/doc/html/namespacelinalg__constants.html +++ b/doc/html/namespacelinalg__constants.html @@ -1,9 +1,9 @@ - + - - + + linalg: linalg_constants Module Reference @@ -13,13 +13,16 @@ - + + @@ -27,10 +30,9 @@
- - + @@ -39,21 +41,22 @@
-
linalg -  1.6.0 +
+
linalg 1.6.1
A linear algebra library that provides a user-friendly interface to several BLAS and LAPACK routines.
- + +/* @license-end */ +
@@ -67,8 +70,8 @@
@@ -81,80 +84,272 @@
- +
+
+
+
+
Loading...
+
Searching...
+
No Matches
+
+
+
-
-
linalg_constants Module Reference
+
linalg_constants Module Reference

Provides a set of constants and error flags for the library. More...

- - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + +

+

Variables

-integer(int32), parameter no_operation = 0
 Defines no operation should be performed on the matrix.
integer(int32), parameter no_operation = 0
 Defines no operation should be performed on the matrix. More...
 
-integer(int32), parameter transpose = 1
 Defines a transpose operation.
integer(int32), parameter transpose = 1
 Defines a transpose operation. More...
 
-integer(int32), parameter hermitian_transpose = 2
 Defines a Hermitian transpose operation for a complex-valued matrix.
integer(int32), parameter hermitian_transpose = 2
 Defines a Hermitian transpose operation for a complex-valued matrix. More...
 
-integer(int32), parameter la_no_error = 0
 A flag denoting no error condition.
integer(int32), parameter la_no_error = 0
 A flag denoting no error condition. More...
 
-integer(int32), parameter la_invalid_input_error = 101
 An error flag denoting an invalid input.
integer(int32), parameter la_invalid_input_error = 101
 An error flag denoting an invalid input. More...
 
-integer(int32), parameter la_array_size_error = 102
 An error flag denoting an improperly sized array.
integer(int32), parameter la_array_size_error = 102
 An error flag denoting an improperly sized array. More...
 
-integer(int32), parameter la_singular_matrix_error = 103
 An error flag denoting a singular matrix.
integer(int32), parameter la_singular_matrix_error = 103
 An error flag denoting a singular matrix. More...
 
-integer(int32), parameter la_matrix_format_error = 104
 An error flag denoting an issue with the matrix format.
integer(int32), parameter la_matrix_format_error = 104
 An error flag denoting an issue with the matrix format. More...
 
-integer(int32), parameter la_out_of_memory_error = 105
 An error flag denoting that there is insufficient memory available.
integer(int32), parameter la_out_of_memory_error = 105
 An error flag denoting that there is insufficient memory available. More...
 
-integer(int32), parameter la_convergence_error = 106
 An error flag denoting a convergence failure.
integer(int32), parameter la_convergence_error = 106
 An error flag denoting a convergence failure. More...
 
-integer(int32), parameter la_invalid_operation_error = 107
 An error resulting from an invalid operation.
integer(int32), parameter la_invalid_operation_error = 107
 An error resulting from an invalid operation. More...
 

Detailed Description

-

Provides a set of constants and error flags for the library.

-
+

Provides a set of constants and error flags for the library.

+

Variable Documentation

+ +

◆ hermitian_transpose

+ +
+
+ + + + +
integer(int32), parameter linalg_constants::hermitian_transpose = 2
+
+ +

Defines a Hermitian transpose operation for a complex-valued matrix.

+ +

Definition at line 16 of file linalg_constants.f90.

+ +
+
+ +

◆ la_array_size_error

+ +
+
+ + + + +
integer(int32), parameter linalg_constants::la_array_size_error = 102
+
+ +

An error flag denoting an improperly sized array.

+ +

Definition at line 26 of file linalg_constants.f90.

+ +
+
+ +

◆ la_convergence_error

+ +
+
+ + + + +
integer(int32), parameter linalg_constants::la_convergence_error = 106
+
+ +

An error flag denoting a convergence failure.

+ +

Definition at line 34 of file linalg_constants.f90.

+ +
+
+ +

◆ la_invalid_input_error

+ +
+
+ + + + +
integer(int32), parameter linalg_constants::la_invalid_input_error = 101
+
+ +

An error flag denoting an invalid input.

+ +

Definition at line 24 of file linalg_constants.f90.

+ +
+
+ +

◆ la_invalid_operation_error

+ +
+
+ + + + +
integer(int32), parameter linalg_constants::la_invalid_operation_error = 107
+
+ +

An error resulting from an invalid operation.

+ +

Definition at line 36 of file linalg_constants.f90.

+ +
+
+ +

◆ la_matrix_format_error

+ +
+
+ + + + +
integer(int32), parameter linalg_constants::la_matrix_format_error = 104
+
+ +

An error flag denoting an issue with the matrix format.

+ +

Definition at line 30 of file linalg_constants.f90.

+ +
+
+ +

◆ la_no_error

+ +
+
+ + + + +
integer(int32), parameter linalg_constants::la_no_error = 0
+
+ +

A flag denoting no error condition.

+ +

Definition at line 22 of file linalg_constants.f90.

+ +
+
+ +

◆ la_out_of_memory_error

+ +
+
+ + + + +
integer(int32), parameter linalg_constants::la_out_of_memory_error = 105
+
+ +

An error flag denoting that there is insufficient memory available.

+ +

Definition at line 32 of file linalg_constants.f90.

+ +
+
+ +

◆ la_singular_matrix_error

+ +
+
+ + + + +
integer(int32), parameter linalg_constants::la_singular_matrix_error = 103
+
+ +

An error flag denoting a singular matrix.

+ +

Definition at line 28 of file linalg_constants.f90.

+ +
+
+ +

◆ no_operation

+ +
+
+ + + + +
integer(int32), parameter linalg_constants::no_operation = 0
+
+ +

Defines no operation should be performed on the matrix.

+ +

Definition at line 12 of file linalg_constants.f90.

+ +
+
+ +

◆ transpose

+ +
+
+ + + + +
integer(int32), parameter linalg_constants::transpose = 1
+
+ +

Defines a transpose operation.

+ +

Definition at line 14 of file linalg_constants.f90.

+ +
+
+
diff --git a/doc/html/namespacelinalg__core.html b/doc/html/namespacelinalg__core.html index 1f5c9c83..0065f41b 100644 --- a/doc/html/namespacelinalg__core.html +++ b/doc/html/namespacelinalg__core.html @@ -1,9 +1,9 @@ - + - - + + linalg: linalg_core Module Reference @@ -13,13 +13,16 @@ - + + @@ -27,10 +30,9 @@
- - + @@ -39,21 +41,22 @@
-
linalg -  1.6.0 +
+
linalg 1.6.1
A linear algebra library that provides a user-friendly interface to several BLAS and LAPACK routines.
- + +/* @license-end */ +
@@ -67,8 +70,8 @@
@@ -81,23 +84,29 @@
- +
+
+
+
+
Loading...
+
Searching...
+
No Matches
+
+
+
-
-
linalg_core Module Reference
+
linalg_core Module Reference

Provides a set of common linear algebra routines. More...

- @@ -130,7 +139,7 @@ - + @@ -151,7 +160,7 @@ - + @@ -197,16 +206,14 @@

+

Data Types

interface  cholesky_factor
 Computes the Cholesky factorization of a symmetric, positive definite matrix. More...
 Computes the inverse of a square matrix. More...
 
interface  mtx_mult
 Performs the matrix operation: C = alpha * op(A) * op(B) + beta * C. More...
 Performs the matrix operation: \( C = \alpha op(A) op(B) + \beta C \). More...
 
interface  mtx_pinverse
 Computes the Moore-Penrose pseudo-inverse of a M-by-N matrix using the singular value decomposition of the matrix. More...
 Computes the rank 1 update to an M-by-N QR factored matrix A (M >= N) where A = Q * R, and A1 = A + U * V**T such that A1 = Q1 * R1. More...
 
interface  rank1_update
 Performs the rank-1 update to matrix A such that: A = alpha * X * Y**T + A, where A is an M-by-N matrix, alpha is a scalar, X is an M-element array, and N is an N-element array. In the event that Y is complex, Y**H is used instead of Y**T. More...
 Performs the rank-1 update to matrix A such that: \( A = \alpha X Y^T + A \), where \( A \) is an M-by-N matrix, \( \alpha \)is a scalar, \( X \) is an M-element array, and \( Y \) is an N-element array. In the event that \( Y \) is complex, \( Y^H \) is used instead of \( Y^T \). More...
 
interface  recip_mult_array
 Multiplies a vector by the reciprocal of a real scalar. More...
 

Detailed Description

-

Provides a set of common linear algebra routines.

+

Provides a set of common linear algebra routines.

diff --git a/doc/html/namespacelinalg__core.js b/doc/html/namespacelinalg__core.js index 4ad4b74a..f010d8ec 100644 --- a/doc/html/namespacelinalg__core.js +++ b/doc/html/namespacelinalg__core.js @@ -1,35 +1,35 @@ var namespacelinalg__core = [ - [ "cholesky_factor", "interfacelinalg__core_1_1cholesky__factor.html", "interfacelinalg__core_1_1cholesky__factor" ], - [ "cholesky_rank1_downdate", "interfacelinalg__core_1_1cholesky__rank1__downdate.html", "interfacelinalg__core_1_1cholesky__rank1__downdate" ], - [ "cholesky_rank1_update", "interfacelinalg__core_1_1cholesky__rank1__update.html", "interfacelinalg__core_1_1cholesky__rank1__update" ], - [ "det", "interfacelinalg__core_1_1det.html", "interfacelinalg__core_1_1det" ], - [ "diag_mtx_mult", "interfacelinalg__core_1_1diag__mtx__mult.html", "interfacelinalg__core_1_1diag__mtx__mult" ], - [ "eigen", "interfacelinalg__core_1_1eigen.html", "interfacelinalg__core_1_1eigen" ], - [ "form_lu", "interfacelinalg__core_1_1form__lu.html", "interfacelinalg__core_1_1form__lu" ], - [ "form_qr", "interfacelinalg__core_1_1form__qr.html", "interfacelinalg__core_1_1form__qr" ], - [ "lu_factor", "interfacelinalg__core_1_1lu__factor.html", "interfacelinalg__core_1_1lu__factor" ], - [ "mtx_inverse", "interfacelinalg__core_1_1mtx__inverse.html", "interfacelinalg__core_1_1mtx__inverse" ], - [ "mtx_mult", "interfacelinalg__core_1_1mtx__mult.html", "interfacelinalg__core_1_1mtx__mult" ], - [ "mtx_pinverse", "interfacelinalg__core_1_1mtx__pinverse.html", "interfacelinalg__core_1_1mtx__pinverse" ], - [ "mtx_rank", "interfacelinalg__core_1_1mtx__rank.html", "interfacelinalg__core_1_1mtx__rank" ], - [ "mult_qr", "interfacelinalg__core_1_1mult__qr.html", "interfacelinalg__core_1_1mult__qr" ], - [ "mult_rz", "interfacelinalg__core_1_1mult__rz.html", "interfacelinalg__core_1_1mult__rz" ], - [ "qr_factor", "interfacelinalg__core_1_1qr__factor.html", "interfacelinalg__core_1_1qr__factor" ], - [ "qr_rank1_update", "interfacelinalg__core_1_1qr__rank1__update.html", "interfacelinalg__core_1_1qr__rank1__update" ], - [ "rank1_update", "interfacelinalg__core_1_1rank1__update.html", "interfacelinalg__core_1_1rank1__update" ], - [ "recip_mult_array", "interfacelinalg__core_1_1recip__mult__array.html", "interfacelinalg__core_1_1recip__mult__array" ], - [ "rz_factor", "interfacelinalg__core_1_1rz__factor.html", "interfacelinalg__core_1_1rz__factor" ], - [ "solve_cholesky", "interfacelinalg__core_1_1solve__cholesky.html", "interfacelinalg__core_1_1solve__cholesky" ], - [ "solve_least_squares", "interfacelinalg__core_1_1solve__least__squares.html", "interfacelinalg__core_1_1solve__least__squares" ], - [ "solve_least_squares_full", "interfacelinalg__core_1_1solve__least__squares__full.html", "interfacelinalg__core_1_1solve__least__squares__full" ], - [ "solve_least_squares_svd", "interfacelinalg__core_1_1solve__least__squares__svd.html", "interfacelinalg__core_1_1solve__least__squares__svd" ], - [ "solve_lu", "interfacelinalg__core_1_1solve__lu.html", "interfacelinalg__core_1_1solve__lu" ], - [ "solve_qr", "interfacelinalg__core_1_1solve__qr.html", "interfacelinalg__core_1_1solve__qr" ], - [ "solve_triangular_system", "interfacelinalg__core_1_1solve__triangular__system.html", "interfacelinalg__core_1_1solve__triangular__system" ], - [ "sort", "interfacelinalg__core_1_1sort.html", "interfacelinalg__core_1_1sort" ], - [ "svd", "interfacelinalg__core_1_1svd.html", "interfacelinalg__core_1_1svd" ], - [ "swap", "interfacelinalg__core_1_1swap.html", "interfacelinalg__core_1_1swap" ], - [ "trace", "interfacelinalg__core_1_1trace.html", "interfacelinalg__core_1_1trace" ], - [ "tri_mtx_mult", "interfacelinalg__core_1_1tri__mtx__mult.html", "interfacelinalg__core_1_1tri__mtx__mult" ] + [ "cholesky_factor", "interfacelinalg__core_1_1cholesky__factor.html", null ], + [ "cholesky_rank1_downdate", "interfacelinalg__core_1_1cholesky__rank1__downdate.html", null ], + [ "cholesky_rank1_update", "interfacelinalg__core_1_1cholesky__rank1__update.html", null ], + [ "det", "interfacelinalg__core_1_1det.html", null ], + [ "diag_mtx_mult", "interfacelinalg__core_1_1diag__mtx__mult.html", null ], + [ "eigen", "interfacelinalg__core_1_1eigen.html", null ], + [ "form_lu", "interfacelinalg__core_1_1form__lu.html", null ], + [ "form_qr", "interfacelinalg__core_1_1form__qr.html", null ], + [ "lu_factor", "interfacelinalg__core_1_1lu__factor.html", null ], + [ "mtx_inverse", "interfacelinalg__core_1_1mtx__inverse.html", null ], + [ "mtx_mult", "interfacelinalg__core_1_1mtx__mult.html", null ], + [ "mtx_pinverse", "interfacelinalg__core_1_1mtx__pinverse.html", null ], + [ "mtx_rank", "interfacelinalg__core_1_1mtx__rank.html", null ], + [ "mult_qr", "interfacelinalg__core_1_1mult__qr.html", null ], + [ "mult_rz", "interfacelinalg__core_1_1mult__rz.html", null ], + [ "qr_factor", "interfacelinalg__core_1_1qr__factor.html", null ], + [ "qr_rank1_update", "interfacelinalg__core_1_1qr__rank1__update.html", null ], + [ "rank1_update", "interfacelinalg__core_1_1rank1__update.html", null ], + [ "recip_mult_array", "interfacelinalg__core_1_1recip__mult__array.html", null ], + [ "rz_factor", "interfacelinalg__core_1_1rz__factor.html", null ], + [ "solve_cholesky", "interfacelinalg__core_1_1solve__cholesky.html", null ], + [ "solve_least_squares", "interfacelinalg__core_1_1solve__least__squares.html", null ], + [ "solve_least_squares_full", "interfacelinalg__core_1_1solve__least__squares__full.html", null ], + [ "solve_least_squares_svd", "interfacelinalg__core_1_1solve__least__squares__svd.html", null ], + [ "solve_lu", "interfacelinalg__core_1_1solve__lu.html", null ], + [ "solve_qr", "interfacelinalg__core_1_1solve__qr.html", null ], + [ "solve_triangular_system", "interfacelinalg__core_1_1solve__triangular__system.html", null ], + [ "sort", "interfacelinalg__core_1_1sort.html", null ], + [ "svd", "interfacelinalg__core_1_1svd.html", null ], + [ "swap", "interfacelinalg__core_1_1swap.html", null ], + [ "trace", "interfacelinalg__core_1_1trace.html", null ], + [ "tri_mtx_mult", "interfacelinalg__core_1_1tri__mtx__mult.html", null ] ]; \ No newline at end of file diff --git a/doc/html/namespacelinalg__immutable.html b/doc/html/namespacelinalg__immutable.html index 9d0a79ca..0012003c 100644 --- a/doc/html/namespacelinalg__immutable.html +++ b/doc/html/namespacelinalg__immutable.html @@ -1,9 +1,9 @@ - + - - + + linalg: linalg_immutable Module Reference @@ -13,13 +13,16 @@ - + + @@ -27,10 +30,9 @@
- - + @@ -39,21 +41,22 @@
-
linalg -  1.6.0 +
+
linalg 1.6.1
A linear algebra library that provides a user-friendly interface to several BLAS and LAPACK routines.
- + +/* @license-end */ +
@@ -67,8 +70,8 @@
@@ -81,24 +84,30 @@
- +
+
+
+
+
Loading...
+
Searching...
+
No Matches
+
+
+
-
-
linalg_immutable Module Reference
+
linalg_immutable Module Reference

Provides an immutable interface to many of the core linear algebra routines in this library. The intent is to allow for ease of use in situations where memory allocation, or absolute speed are of lesser importance to code readability. More...

- @@ -143,62 +152,14 @@

+

Data Types

type  eigen_results
 Defines a container for the output of an Eigen analysis of a square matrix. More...
 Defines a container for the output of a singular value decomposition of a matrix. More...
 
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - @@ -223,46 +184,16 @@ - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

+

Functions/Subroutines

real(real64) function, dimension(size(a, 1), size(a, 2)), public mat_rank1_update (a, x, y)
 Performs the rank-1 update to matrix A such that: B = X * Y**T + A, where A is an M-by-N matrix, X is an M-element array, and N is an N-element array. More...
 
real(real64) function, dimension(size(a), size(b, 2)) mat_mult_diag_1 (a, b)
 Computes the matrix operation: C = A * B, where A is a diagonal matrix. More...
 
real(real64) function, dimension(size(a)) mat_mult_diag_2 (a, b)
 Computes the matrix operation: C = A * B, where A is a diagonal matrix. More...
 
real(real64) function, dimension(size(a, 1), size(b)) mat_mult_diag_3 (a, b)
 Computes the matrix operation: C = A * B, where B is a diagonal matrix. More...
 
complex(real64) function, dimension(size(a), size(b, 2)) mat_mult_diag_1_cmplx (a, b)
 Computes the matrix operation: C = A * B, where A is a diagonal matrix. More...
 
complex(real64) function, dimension(size(a)) mat_mult_diag_2_cmplx (a, b)
 Computes the matrix operation: C = A * B, where A is a diagonal matrix. More...
 
complex(real64) function, dimension(size(a, 1), size(b)) mat_mult_diag_3_cmplx (a, b)
 Computes the matrix operation: C = A * B, where B is a diagonal matrix. More...
 
real(real64) function, dimension(size(a, 1), size(b, 2)) mat_mult_upper_tri_1 (a, b)
 Computes the matrix operation C = A * B, where A is an upper triangular matrix. More...
 
real(real64) function, dimension(size(a, 1)) mat_mult_upper_tri_2 (a, b)
 Computes the matrix operation C = A * B, where A is an upper triangular matrix. More...
 
real(real64) function, dimension(size(a, 1), size(b, 2)) mat_mult_lower_tri_1 (a, b)
 Computes the matrix operation C = A * B, where A is a lower triangular matrix. More...
 
real(real64) function, dimension(size(a, 1)) mat_mult_lower_tri_2 (a, b)
 Computes the matrix operation C = A * B, where A is a lower triangular matrix. More...
 
complex(real64) function, dimension(size(a, 1), size(b, 2)) mat_mult_upper_tri_1_cmplx (a, b)
 Computes the matrix operation C = A * B, where A is an upper triangular matrix. More...
 
complex(real64) function, dimension(size(a, 1)) mat_mult_upper_tri_2_cmplx (a, b)
 Computes the matrix operation C = A * B, where A is an upper triangular matrix. More...
 
complex(real64) function, dimension(size(a, 1), size(b, 2)) mat_mult_lower_tri_1_cmplx (a, b)
 Computes the matrix operation C = A * B, where A is a lower triangular matrix. More...
 
complex(real64) function, dimension(size(a, 1)) mat_mult_lower_tri_2_cmplx (a, b)
 Computes the matrix operation C = A * B, where A is a lower triangular matrix. More...
 
real(real64) function, public mat_det (a)
 Computes the determinant of a square matrix. More...
 
type(lu_results) function mat_lu_dbl (a)
 Computes the LU factorization of a square matrix. Notice, partial row pivoting is utilized. More...
 
type(lu_results_cmplx) function mat_lu_cmplx (a)
 Computes the LU factorization of a square matrix. Notice, partial row pivoting is utilized. More...
 
type(qr_results) function, public mat_qr (a, pvt)
 Computes the QR factorization of an M-by-N matrix. column pivoting can be used by this routine. More...
 
real(real64) function, dimension(size(a, 2), size(a, 1)), public mat_pinverse (a)
 Computes the Moore-Penrose pseudo-inverse of a M-by-N matrix. More...
 
real(real64) function, dimension(size(b, 1), size(b, 2)) mat_solve_upper_tri_1 (a, b)
 Solves the upper triangular system A X = B, where A is an upper triangular matrix. More...
 
real(real64) function, dimension(size(b)) mat_solve_upper_tri_2 (a, b)
 Solves the upper triangular system A X = B, where A is an upper triangular matrix. More...
 
complex(real64) function, dimension(size(b, 1), size(b, 2)) mat_solve_upper_tri_1_cmplx (a, b)
 Solves the upper triangular system A X = B, where A is an upper triangular matrix. More...
 
complex(real64) function, dimension(size(b)) mat_solve_upper_tri_2_cmplx (a, b)
 Solves the upper triangular system A X = B, where A is an upper triangular matrix. More...
 
real(real64) function, dimension(size(b, 1), size(b, 2)) mat_solve_lower_tri_1 (a, b)
 Solves the lower triangular system A X = B, where A is a lower triangular matrix. More...
 
real(real64) function, dimension(size(b)) mat_solve_lower_tri_2 (a, b)
 Solves the lower triangular system A X = B, where A is a lower triangular matrix. More...
 
complex(real64) function, dimension(size(b, 1), size(b, 2)) mat_solve_lower_tri_1_cmplx (a, b)
 Solves the lower triangular system A X = B, where A is a lower triangular matrix. More...
 
complex(real64) function, dimension(size(b)) mat_solve_lower_tri_2_cmplx (a, b)
 Solves the lower triangular system A X = B, where A is a lower triangular matrix. More...
 
type(eigen_results) function mat_eigen_1 (a)
 Computes the eigenvalues and eigenvectors (right) of a general N-by-N matrix. More...
 
type(eigen_results) function mat_eigen_2 (a, b)
 Computes eigenvalues and eigenvectors (right) from the eigenvalue problem: A X = lambda B X. More...
 
pure real(real64) function, dimension(n, n), public identity (n)
 Creates an N-by-N identity matrix. More...
 

Detailed Description

-

Provides an immutable interface to many of the core linear algebra routines in this library. The intent is to allow for ease of use in situations where memory allocation, or absolute speed are of lesser importance to code readability.

+

Provides an immutable interface to many of the core linear algebra routines in this library. The intent is to allow for ease of use in situations where memory allocation, or absolute speed are of lesser importance to code readability.

Routines in this module do not provide an error handling interface. Any errors encountered will result in an error message printed to the prompt, the generation (or appending to) an error file, and termination of the program. Notice, warning situations will be handled similarily, but without termination of the program.

Function/Subroutine Documentation

- -

◆ identity()

+ +

◆ identity()

- -

◆ mat_cholesky()

+ +

◆ mat_cholesky()

@@ -325,12 +256,12 @@

Definition at line 716 of file linalg_immutable.f90.

+

Definition at line 715 of file linalg_immutable.f90.

- -

◆ mat_cholesky_rank1_downdate()

+ +

◆ mat_cholesky_rank1_downdate()

- -

◆ mat_cholesky_rank1_update()

+ +

◆ mat_cholesky_rank1_update()

- -

◆ mat_det()

+ +

◆ mat_det()

- -

◆ mat_eigen_1()

- -
-
- - - - - -
- - - - - - - - -
type(eigen_results) function linalg_immutable::mat_eigen_1 (real(real64), dimension(:,:), intent(in) a)
-
-private
-
- -

Computes the eigenvalues and eigenvectors (right) of a general N-by-N matrix.

-
Parameters
- - -
[in]aThe N-by-N matrix on which to operate.
-
-
-
Returns
The eigenvalues and eigenvectors of the matrix. The results are sorted into ascending order.
- -

Definition at line 960 of file linalg_immutable.f90.

- -
-
- -

◆ mat_eigen_2()

- -
-
- - - - - -
- - - - - - - - - - - - - - - - - - -
type(eigen_results) function linalg_immutable::mat_eigen_2 (real(real64), dimension(:,:), intent(in) a,
real(real64), dimension(:,:), intent(in) b 
)
-
-private
-
- -

Computes eigenvalues and eigenvectors (right) from the eigenvalue problem: A X = lambda B X.

-
Parameters
- - - -
[in]aThe N-by-N matrix A.
[in]bThe N-by-N matrix B.
-
-
-
Returns
The eigenvalues and eigenvectors. The results are sorted into ascending order.
- -

Definition at line 990 of file linalg_immutable.f90.

+

Definition at line 509 of file linalg_immutable.f90.

- -

◆ mat_inverse()

+ +

◆ mat_inverse()

- -

◆ mat_lu_cmplx()

- -
-
- - - - - -
- - - - - - - - -
type(lu_results_cmplx) function linalg_immutable::mat_lu_cmplx (complex(real64), dimension(:,:), intent(in) a)
-
-private
-
- -

Computes the LU factorization of a square matrix. Notice, partial row pivoting is utilized.

-
Parameters
- - -
[in]aThe N-by-N matrix to factor.
-
-
-
Returns
The L, U, and P matrices resulting from the factorization.
- -

Definition at line 559 of file linalg_immutable.f90.

+

Definition at line 780 of file linalg_immutable.f90.

- -

◆ mat_lu_dbl()

+ +

◆ mat_pinverse()

- - - - - -
- +
type(lu_results) function linalg_immutable::mat_lu_dbl real(real64) function, dimension(size(a, 2), size(a, 1)), public linalg_immutable::mat_pinverse ( real(real64), dimension(:,:), intent(in)  a)
-
-private
-

Computes the LU factorization of a square matrix. Notice, partial row pivoting is utilized.

+

Computes the Moore-Penrose pseudo-inverse of a M-by-N matrix.

Parameters
- +
[in]aThe N-by-N matrix to factor.
[in]aThe M-by-N matrix to invert.
-
Returns
The L, U, and P matrices resulting from the factorization.
+
Returns
The N-by-M inverted matrix.
-

Definition at line 529 of file linalg_immutable.f90.

+

Definition at line 795 of file linalg_immutable.f90.

- -

◆ mat_mult_diag_1()

+ +

◆ mat_qr()

- - - - +
- + - + - - + + @@ -653,143 +451,51 @@

-private -

-
real(real64) function, dimension(size(a), size(b, 2)) linalg_immutable::mat_mult_diag_1 type(qr_results) function, public linalg_immutable::mat_qr (real(real64), dimension(:), intent(in) real(real64), dimension(:,:), intent(in)  a,
real(real64), dimension(:,:), intent(in) b logical, intent(in), optional pvt 
- -

◆ mat_mult_diag_1_cmplx()

+ +

◆ mat_qr_rank1_update()

- - - - - -
- + - - + + - - - - - - - - -
complex(real64) function, dimension(size(a), size(b, 2)) linalg_immutable::mat_mult_diag_1_cmplx type(qr_results) function, public linalg_immutable::mat_qr_rank1_update (complex(real64), dimension(:), intent(in) a, real(real64), dimension(:,:), intent(in) q,
complex(real64), dimension(:,:), intent(in) b 
)
-
-private
-
- -

Computes the matrix operation: C = A * B, where A is a diagonal matrix.

-
Parameters
- - - -
[in]aThe M-element array containing the diagonal elements of the matrix A.
[in]bThe P-by-N matrix B where P is greater than or equal to M.
-
-
-
Returns
The resulting M-by-N matrix.
- -

Definition at line 293 of file linalg_immutable.f90.

- -
-
- -

◆ mat_mult_diag_2()

- -
-
- - - - - -
- - - - - - + + - - - - - - - -
real(real64) function, dimension(size(a)) linalg_immutable::mat_mult_diag_2 (real(real64), dimension(:), intent(in) a, real(real64), dimension(:,:), intent(in) r,
real(real64), dimension(:), intent(in) b 
)
-
-private
-
- -

Computes the matrix operation: C = A * B, where A is a diagonal matrix.

-
Parameters
- - - -
[in]aThe M-element array containing the diagonal elements of the matrix A.
[in]bThe P-element array B where P is greater than or equal to M.
-
-
-
Returns
The resulting M-element array.
- -

Definition at line 248 of file linalg_immutable.f90.

- -
-
- -

◆ mat_mult_diag_2_cmplx()

- -
-
- - - - @@ -139,6 +139,19 @@
subroutine diag_mtx_mult(logical lside, complex(real64) alpha, complex(real64) a(:), complex(real64) b(:,:), optional class(errors) err)
subroutine diag_mtx_mult(logical lside, complex(real64) alpha, real(real64) a(:), complex(real64) b(:,:), optional class(errors) err)
+
Parameters
+
- - - - - - + - - + + @@ -797,38 +503,32 @@

-private -

-
complex(real64) function, dimension(size(a)) linalg_immutable::mat_mult_diag_2_cmplx (complex(real64), dimension(:), intent(in) a, x,
complex(real64), dimension(:), intent(in) b real(real64), dimension(:), intent(in) y 
- -

◆ mat_mult_diag_3()

+ +

◆ mat_rank1_update()

- - - - - -
- + @@ -837,55 +537,13 @@

- - - - - - - -
real(real64) function, dimension(size(a, 1), size(b)) linalg_immutable::mat_mult_diag_3 real(real64) function, dimension(size(a, 1), size(a, 2)), public linalg_immutable::mat_rank1_update ( real(real64), dimension(:,:), intent(in)  a, real(real64), dimension(:), intent(in) b 
)
-
-private
-
- -

Computes the matrix operation: C = A * B, where B is a diagonal matrix.

-
Parameters
- - - -
[in]aThe M-by-N matrix A.
[in]bThe P-element array containing the diagonal matrix B where P is at least N.
-
-
-
Returns
The resulting M-by-P matrix.
- -

Definition at line 270 of file linalg_immutable.f90.

- -
-
- -

◆ mat_mult_diag_3_cmplx()

- -
-
- - - - + diff --git a/doc/html/interfacelinalg__core_1_1cholesky__factor.html b/doc/html/interfacelinalg__core_1_1cholesky__factor.html index e6bf814b..bd8fb746 100644 --- a/doc/html/interfacelinalg__core_1_1cholesky__factor.html +++ b/doc/html/interfacelinalg__core_1_1cholesky__factor.html @@ -157,9 +157,9 @@
print '(A)', "Cholesky Solution (Manual Approach): X = "
print '(F8.4)', (bu(i), i = 1, size(bu))
end program
-
Computes the Cholesky factorization of a symmetric, positive definite matrix.
-
Solves a system of Cholesky factored equations.
-
Solves a triangular system of equations.
+
Computes the Cholesky factorization of a symmetric, positive definite matrix.
+
Solves a system of Cholesky factored equations.
+
Solves a triangular system of equations.
Provides a set of common linear algebra routines.
Definition: linalg_core.f90:15
The above program produces the following output.
Cholesky Solution: X =
239.5833
@@ -171,7 +171,7 @@
10.3333
-

Definition at line 857 of file linalg_core.f90.

+

Definition at line 1084 of file linalg_core.f90.


The documentation for this interface was generated from the following file: diff --git a/doc/html/interfacelinalg__core_1_1cholesky__rank1__downdate.html b/doc/html/interfacelinalg__core_1_1cholesky__rank1__downdate.html index 368b18b2..9fe4aa05 100644 --- a/doc/html/interfacelinalg__core_1_1cholesky__rank1__downdate.html +++ b/doc/html/interfacelinalg__core_1_1cholesky__rank1__downdate.html @@ -154,8 +154,8 @@
print *, ad(i,:)
end do
end program
-
Computes the Cholesky factorization of a symmetric, positive definite matrix.
-
Computes the rank 1 downdate to a Cholesky factored matrix (upper triangular).
+
Computes the Cholesky factorization of a symmetric, positive definite matrix.
+
Computes the rank 1 downdate to a Cholesky factored matrix (upper triangular).
Performs the rank-1 update to matrix A such that: , where is an M-by-N matrix, is a scalar,...
Provides a set of common linear algebra routines.
Definition: linalg_core.f90:15
The above program produces the following output.
Downdating the Factored Form:
@@ -168,7 +168,7 @@
0.0000000000000000 0.0000000000000000 3.0000000000000000
-

Definition at line 998 of file linalg_core.f90.

+

Definition at line 1225 of file linalg_core.f90.


The documentation for this interface was generated from the following file: diff --git a/doc/html/interfacelinalg__core_1_1cholesky__rank1__update.html b/doc/html/interfacelinalg__core_1_1cholesky__rank1__update.html index 57511999..87910b5a 100644 --- a/doc/html/interfacelinalg__core_1_1cholesky__rank1__update.html +++ b/doc/html/interfacelinalg__core_1_1cholesky__rank1__update.html @@ -150,8 +150,8 @@
print *, au(i,:)
end do
end program
-
Computes the Cholesky factorization of a symmetric, positive definite matrix.
-
Computes the rank 1 update to a Cholesky factored matrix (upper triangular).
+
Computes the Cholesky factorization of a symmetric, positive definite matrix.
+
Computes the rank 1 update to a Cholesky factored matrix (upper triangular).
Performs the rank-1 update to matrix A such that: , where is an M-by-N matrix, is a scalar,...
Provides a set of common linear algebra routines.
Definition: linalg_core.f90:15
The above program produces the following output.
Updating the Factored Form:
@@ -164,7 +164,7 @@
0.0000000000000000 0.0000000000000000 6.6989384530323557
-

Definition at line 925 of file linalg_core.f90.

+

Definition at line 1152 of file linalg_core.f90.


The documentation for this interface was generated from the following file: diff --git a/doc/html/interfacelinalg__core_1_1det.html b/doc/html/interfacelinalg__core_1_1det.html index 05803a9f..e8ca8911 100644 --- a/doc/html/interfacelinalg__core_1_1det.html +++ b/doc/html/interfacelinalg__core_1_1det.html @@ -107,8 +107,24 @@ More...

Detailed Description

Computes the determinant of a square matrix.

+
Syntax
real(real64) function det(real(real64) a(:,:), optional integer(int32) iwork(:), optional class(errors) err)
+
complex(real64) function det(complex(real64) a(:,:), optional integer(int32) iwork(:), optional class(errors) err)
+
+
Parameters
+
- - - - - - + - - + + @@ -893,967 +551,25 @@

-private -

-
complex(real64) function, dimension(size(a, 1), size(b)) linalg_immutable::mat_mult_diag_3_cmplx (complex(real64), dimension(:,:), intent(in) a, x,
complex(real64), dimension(:), intent(in) b real(real64), dimension(:), intent(in) y 
- - -

◆ mat_mult_lower_tri_1()

- -
-
- - - - - -
- - - - - - - - - - - - - - - - - - -
real(real64) function, dimension(size(a, 1), size(b, 2)) linalg_immutable::mat_mult_lower_tri_1 (real(real64), dimension(:,:), intent(in) a,
real(real64), dimension(:,:), intent(in) b 
)
-
-private
-
- -

Computes the matrix operation C = A * B, where A is a lower triangular matrix.

-
Parameters
- - - + +
[in]aThe M-by-M triangular matrix A.
[in]bThe M-by-N matrix B.
[in]xThe M-element array X.
[in]yTHe N-element array Y.
Returns
The resulting M-by-N matrix.
-

Definition at line 404 of file linalg_immutable.f90.

- -
-
- -

◆ mat_mult_lower_tri_1_cmplx()

- -
-
- - - - - -
- - - - - - - - - - - - - - - - - - -
complex(real64) function, dimension(size(a, 1), size(b, 2)) linalg_immutable::mat_mult_lower_tri_1_cmplx (complex(real64), dimension(:,:), intent(in) a,
complex(real64), dimension(:,:), intent(in) b 
)
-
-private
-
- -

Computes the matrix operation C = A * B, where A is a lower triangular matrix.

-
Parameters
- - - -
[in]aThe M-by-M triangular matrix A.
[in]bThe M-by-N matrix B.
-
-
-
Returns
The resulting M-by-N matrix.
- -

Definition at line 476 of file linalg_immutable.f90.

- -
-
- -

◆ mat_mult_lower_tri_2()

- -
-
- - - - - -
- - - - - - - - - - - - - - - - - - -
real(real64) function, dimension(size(a, 1)) linalg_immutable::mat_mult_lower_tri_2 (real(real64), dimension(:,:), intent(in) a,
real(real64), dimension(:), intent(in) b 
)
-
-private
-
- -

Computes the matrix operation C = A * B, where A is a lower triangular matrix.

-
Parameters
- - - -
[in]aThe M-by-M triangular matrix A.
[in]bThe M-element array B.
-
-
-
Returns
The resulting M-element array.
- -

Definition at line 422 of file linalg_immutable.f90.

- -
-
- -

◆ mat_mult_lower_tri_2_cmplx()

- -
-
- - - - - -
- - - - - - - - - - - - - - - - - - -
complex(real64) function, dimension(size(a, 1)) linalg_immutable::mat_mult_lower_tri_2_cmplx (complex(real64), dimension(:,:), intent(in) a,
complex(real64), dimension(:), intent(in) b 
)
-
-private
-
- -

Computes the matrix operation C = A * B, where A is a lower triangular matrix.

-
Parameters
- - - -
[in]aThe M-by-M triangular matrix A.
[in]bThe M-element array B.
-
-
-
Returns
The resulting M-element array.
- -

Definition at line 494 of file linalg_immutable.f90.

- -
-
- -

◆ mat_mult_upper_tri_1()

- -
-
- - - - - -
- - - - - - - - - - - - - - - - - - -
real(real64) function, dimension(size(a, 1), size(b, 2)) linalg_immutable::mat_mult_upper_tri_1 (real(real64), dimension(:,:), intent(in) a,
real(real64), dimension(:,:), intent(in) b 
)
-
-private
-
- -

Computes the matrix operation C = A * B, where A is an upper triangular matrix.

-
Parameters
- - - -
[in]aThe M-by-M triangular matrix A.
[in]bThe M-by-N matrix B.
-
-
-
Returns
The resulting M-by-N matrix.
- -

Definition at line 368 of file linalg_immutable.f90.

- -
-
- -

◆ mat_mult_upper_tri_1_cmplx()

- -
-
- - - - - -
- - - - - - - - - - - - - - - - - - -
complex(real64) function, dimension(size(a, 1), size(b, 2)) linalg_immutable::mat_mult_upper_tri_1_cmplx (complex(real64), dimension(:,:), intent(in) a,
complex(real64), dimension(:,:), intent(in) b 
)
-
-private
-
- -

Computes the matrix operation C = A * B, where A is an upper triangular matrix.

-
Parameters
- - - -
[in]aThe M-by-M triangular matrix A.
[in]bThe M-by-N matrix B.
-
-
-
Returns
The resulting M-by-N matrix.
- -

Definition at line 440 of file linalg_immutable.f90.

- -
-
- -

◆ mat_mult_upper_tri_2()

- -
-
- - - - - -
- - - - - - - - - - - - - - - - - - -
real(real64) function, dimension(size(a, 1)) linalg_immutable::mat_mult_upper_tri_2 (real(real64), dimension(:,:), intent(in) a,
real(real64), dimension(:), intent(in) b 
)
-
-private
-
- -

Computes the matrix operation C = A * B, where A is an upper triangular matrix.

-
Parameters
- - - -
[in]aThe M-by-M triangular matrix A.
[in]bThe M-element array B.
-
-
-
Returns
The resulting M-element array.
- -

Definition at line 386 of file linalg_immutable.f90.

- -
-
- -

◆ mat_mult_upper_tri_2_cmplx()

- -
-
- - - - - -
- - - - - - - - - - - - - - - - - - -
complex(real64) function, dimension(size(a, 1)) linalg_immutable::mat_mult_upper_tri_2_cmplx (complex(real64), dimension(:,:), intent(in) a,
complex(real64), dimension(:), intent(in) b 
)
-
-private
-
- -

Computes the matrix operation C = A * B, where A is an upper triangular matrix.

-
Parameters
- - - -
[in]aThe M-by-M triangular matrix A.
[in]bThe M-element array B.
-
-
-
Returns
The resulting M-element array.
- -

Definition at line 458 of file linalg_immutable.f90.

- -
-
- -

◆ mat_pinverse()

- -
-
- - - - - - - - -
real(real64) function, dimension(size(a, 2), size(a, 1)), public linalg_immutable::mat_pinverse (real(real64), dimension(:,:), intent(in) a)
-
- -

Computes the Moore-Penrose pseudo-inverse of a M-by-N matrix.

-
Parameters
- - -
[in]aThe M-by-N matrix to invert.
-
-
-
Returns
The N-by-M inverted matrix.
- -

Definition at line 796 of file linalg_immutable.f90.

- -
-
- -

◆ mat_qr()

- -
-
- - - - - - - - - - - - - - - - - - -
type(qr_results) function, public linalg_immutable::mat_qr (real(real64), dimension(:,:), intent(in) a,
logical, intent(in), optional pvt 
)
-
- -

Computes the QR factorization of an M-by-N matrix. column pivoting can be used by this routine.

-
Parameters
- - - -
[in]aThe M-by-N matrix to factor.
[in]pvtAn optional value that, if supplied, can be used to turn on column pivoting. The default value is false, such that no column pivoting is utilized.
-
-
-
Returns
The Q, R, and optionally P matrices resulting from the factorization.
- -

Definition at line 593 of file linalg_immutable.f90.

- -
-
- -

◆ mat_qr_rank1_update()

- -
-
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
type(qr_results) function, public linalg_immutable::mat_qr_rank1_update (real(real64), dimension(:,:), intent(in) q,
real(real64), dimension(:,:), intent(in) r,
real(real64), dimension(:), intent(in) x,
real(real64), dimension(:), intent(in) y 
)
-
- -

Computes the rank-1 update of a QR-factored system.

-
Parameters
- - - - - -
[in]qThe M-by-M orthogonal matrix Q from the factorization of the original system.
[in]rThe M-by-N upper trapezoidal matrix R from the factorization of the original system.
[in]xThe M-element update vector.
[in]yThe N-element update vector.
-
-
-
Returns
The updated Q and R matrices.
- -

Definition at line 639 of file linalg_immutable.f90.

- -
-
- -

◆ mat_rank1_update()

- -
-
- - - - - - - - - - - - - - - - - - - - - - - - -
real(real64) function, dimension(size(a, 1), size(a, 2)), public linalg_immutable::mat_rank1_update (real(real64), dimension(:,:), intent(in) a,
real(real64), dimension(:), intent(in) x,
real(real64), dimension(:), intent(in) y 
)
-
- -

Performs the rank-1 update to matrix A such that: B = X * Y**T + A, where A is an M-by-N matrix, X is an M-element array, and N is an N-element array.

-
Parameters
- - - - -
[in]aThe M-by-N matrix A.
[in]xThe M-element array X.
[in]yTHe N-element array Y.
-
-
-
Returns
The resulting M-by-N matrix.
- -

Definition at line 206 of file linalg_immutable.f90.

- -
-
- -

◆ mat_solve_lower_tri_1()

- -
-
- - - - - -
- - - - - - - - - - - - - - - - - - -
real(real64) function, dimension(size(b, 1), size(b, 2)) linalg_immutable::mat_solve_lower_tri_1 (real(real64), dimension(:,:), intent(in) a,
real(real64), dimension(:,:), intent(in) b 
)
-
-private
-
- -

Solves the lower triangular system A X = B, where A is a lower triangular matrix.

-
Parameters
- - - -
[in]aThe M-by-M lower triangluar matrix A.
[in]bThe M-by-NRHS matrix B.
-
-
-
Returns
The M-by-NRHS solution matrix X.
- -

Definition at line 888 of file linalg_immutable.f90.

- -
-
- -

◆ mat_solve_lower_tri_1_cmplx()

- -
-
- - - - - -
- - - - - - - - - - - - - - - - - - -
complex(real64) function, dimension(size(b, 1), size(b, 2)) linalg_immutable::mat_solve_lower_tri_1_cmplx (complex(real64), dimension(:,:), intent(in) a,
complex(real64), dimension(:,:), intent(in) b 
)
-
-private
-
- -

Solves the lower triangular system A X = B, where A is a lower triangular matrix.

-
Parameters
- - - -
[in]aThe M-by-M lower triangluar matrix A.
[in]bThe M-by-NRHS matrix B.
-
-
-
Returns
The M-by-NRHS solution matrix X.
- -

Definition at line 924 of file linalg_immutable.f90.

- -
-
- -

◆ mat_solve_lower_tri_2()

- -
-
- - - - - -
- - - - - - - - - - - - - - - - - - -
real(real64) function, dimension(size(b)) linalg_immutable::mat_solve_lower_tri_2 (real(real64), dimension(:,:), intent(in) a,
real(real64), dimension(:), intent(in) b 
)
-
-private
-
- -

Solves the lower triangular system A X = B, where A is a lower triangular matrix.

-
Parameters
- - - -
[in]aThe M-by-M lower triangluar matrix A.
[in]bThe M-element array B.
-
-
-
Returns
The M-element solution array X.
- -

Definition at line 906 of file linalg_immutable.f90.

- -
-
- -

◆ mat_solve_lower_tri_2_cmplx()

- -
-
- - - - - -
- - - - - - - - - - - - - - - - - - -
complex(real64) function, dimension(size(b)) linalg_immutable::mat_solve_lower_tri_2_cmplx (complex(real64), dimension(:,:), intent(in) a,
complex(real64), dimension(:), intent(in) b 
)
-
-private
-
- -

Solves the lower triangular system A X = B, where A is a lower triangular matrix.

-
Parameters
- - - -
[in]aThe M-by-M lower triangluar matrix A.
[in]bThe M-element array B.
-
-
-
Returns
The M-element solution array X.
- -

Definition at line 942 of file linalg_immutable.f90.

- -
-
- -

◆ mat_solve_upper_tri_1()

- -
-
- - - - - -
- - - - - - - - - - - - - - - - - - -
real(real64) function, dimension(size(b, 1), size(b, 2)) linalg_immutable::mat_solve_upper_tri_1 (real(real64), dimension(:,:), intent(in) a,
real(real64), dimension(:,:), intent(in) b 
)
-
-private
-
- -

Solves the upper triangular system A X = B, where A is an upper triangular matrix.

-
Parameters
- - - -
[in]aThe M-by-M upper triangluar matrix A.
[in]bThe M-by-NRHS matrix B.
-
-
-
Returns
The M-by-NRHS solution matrix X.
- -

Definition at line 816 of file linalg_immutable.f90.

- -
-
- -

◆ mat_solve_upper_tri_1_cmplx()

- -
-
- - - - - -
- - - - - - - - - - - - - - - - - - -
complex(real64) function, dimension(size(b, 1), size(b, 2)) linalg_immutable::mat_solve_upper_tri_1_cmplx (complex(real64), dimension(:,:), intent(in) a,
complex(real64), dimension(:,:), intent(in) b 
)
-
-private
-
- -

Solves the upper triangular system A X = B, where A is an upper triangular matrix.

-
Parameters
- - - -
[in]aThe M-by-M upper triangluar matrix A.
[in]bThe M-by-NRHS matrix B.
-
-
-
Returns
The M-by-NRHS solution matrix X.
- -

Definition at line 852 of file linalg_immutable.f90.

- -
-
- -

◆ mat_solve_upper_tri_2()

- -
-
- - - - - -
- - - - - - - - - - - - - - - - - - -
real(real64) function, dimension(size(b)) linalg_immutable::mat_solve_upper_tri_2 (real(real64), dimension(:,:), intent(in) a,
real(real64), dimension(:), intent(in) b 
)
-
-private
-
- -

Solves the upper triangular system A X = B, where A is an upper triangular matrix.

-
Parameters
- - - -
[in]aThe M-by-M upper triangluar matrix A.
[in]bThe M-element array B.
-
-
-
Returns
The M-element solution array X.
- -

Definition at line 834 of file linalg_immutable.f90.

- -
-
- -

◆ mat_solve_upper_tri_2_cmplx()

- -
-
- - - - - -
- - - - - - - - - - - - - - - - - - -
complex(real64) function, dimension(size(b)) linalg_immutable::mat_solve_upper_tri_2_cmplx (complex(real64), dimension(:,:), intent(in) a,
complex(real64), dimension(:), intent(in) b 
)
-
-private
-
- -

Solves the upper triangular system A X = B, where A is an upper triangular matrix.

-
Parameters
- - - -
[in]aThe M-by-M upper triangluar matrix A.
[in]bThe M-element array B.
-
-
-
Returns
The M-element solution array X.
- -

Definition at line 870 of file linalg_immutable.f90.

+

Definition at line 205 of file linalg_immutable.f90.

- -

◆ mat_svd()

+ +

◆ mat_svd()

@@ -1887,9 +603,7 @@

diff --git a/doc/html/namespacelinalg__immutable.js b/doc/html/namespacelinalg__immutable.js index f8365d4f..06af1664 100644 --- a/doc/html/namespacelinalg__immutable.js +++ b/doc/html/namespacelinalg__immutable.js @@ -3,15 +3,26 @@ var namespacelinalg__immutable = [ "eigen_results", "structlinalg__immutable_1_1eigen__results.html", "structlinalg__immutable_1_1eigen__results" ], [ "lu_results", "structlinalg__immutable_1_1lu__results.html", "structlinalg__immutable_1_1lu__results" ], [ "lu_results_cmplx", "structlinalg__immutable_1_1lu__results__cmplx.html", "structlinalg__immutable_1_1lu__results__cmplx" ], - [ "mat_eigen", "interfacelinalg__immutable_1_1mat__eigen.html", "interfacelinalg__immutable_1_1mat__eigen" ], - [ "mat_lu", "interfacelinalg__immutable_1_1mat__lu.html", "interfacelinalg__immutable_1_1mat__lu" ], - [ "mat_mult_diag", "interfacelinalg__immutable_1_1mat__mult__diag.html", "interfacelinalg__immutable_1_1mat__mult__diag" ], - [ "mat_mult_lower_tri", "interfacelinalg__immutable_1_1mat__mult__lower__tri.html", "interfacelinalg__immutable_1_1mat__mult__lower__tri" ], - [ "mat_mult_upper_tri", "interfacelinalg__immutable_1_1mat__mult__upper__tri.html", "interfacelinalg__immutable_1_1mat__mult__upper__tri" ], - [ "mat_solve_lower_tri", "interfacelinalg__immutable_1_1mat__solve__lower__tri.html", "interfacelinalg__immutable_1_1mat__solve__lower__tri" ], - [ "mat_solve_upper_tri", "interfacelinalg__immutable_1_1mat__solve__upper__tri.html", "interfacelinalg__immutable_1_1mat__solve__upper__tri" ], + [ "mat_eigen", "interfacelinalg__immutable_1_1mat__eigen.html", null ], + [ "mat_lu", "interfacelinalg__immutable_1_1mat__lu.html", null ], + [ "mat_mult_diag", "interfacelinalg__immutable_1_1mat__mult__diag.html", null ], + [ "mat_mult_lower_tri", "interfacelinalg__immutable_1_1mat__mult__lower__tri.html", null ], + [ "mat_mult_upper_tri", "interfacelinalg__immutable_1_1mat__mult__upper__tri.html", null ], + [ "mat_solve_lower_tri", "interfacelinalg__immutable_1_1mat__solve__lower__tri.html", null ], + [ "mat_solve_upper_tri", "interfacelinalg__immutable_1_1mat__solve__upper__tri.html", null ], [ "qr_results", "structlinalg__immutable_1_1qr__results.html", "structlinalg__immutable_1_1qr__results" ], [ "qr_results_cmplx", "structlinalg__immutable_1_1qr__results__cmplx.html", "structlinalg__immutable_1_1qr__results__cmplx" ], [ "svd_results", "structlinalg__immutable_1_1svd__results.html", "structlinalg__immutable_1_1svd__results" ], - [ "svd_results_cmplx", "structlinalg__immutable_1_1svd__results__cmplx.html", "structlinalg__immutable_1_1svd__results__cmplx" ] + [ "svd_results_cmplx", "structlinalg__immutable_1_1svd__results__cmplx.html", "structlinalg__immutable_1_1svd__results__cmplx" ], + [ "identity", "namespacelinalg__immutable.html#aeb1f553973ae3e9b86cb30a1ca1f5700", null ], + [ "mat_cholesky", "namespacelinalg__immutable.html#a5876e7f21f20679fd6c0c84768061a30", null ], + [ "mat_cholesky_rank1_downdate", "namespacelinalg__immutable.html#afb844327cadfdd08580c94cb1668c2a8", null ], + [ "mat_cholesky_rank1_update", "namespacelinalg__immutable.html#a83eaeadc3a3cc5d81c46824174e5a90b", null ], + [ "mat_det", "namespacelinalg__immutable.html#ab7abd8e3fd4170b5b5dfad4448a651c9", null ], + [ "mat_inverse", "namespacelinalg__immutable.html#a98f5b4e5de682d686cb763ab60fcde7f", null ], + [ "mat_pinverse", "namespacelinalg__immutable.html#aaf39795f72fad79a38213893b850d793", null ], + [ "mat_qr", "namespacelinalg__immutable.html#a8f1ba0ce9f8fbece16a512145bbc197f", null ], + [ "mat_qr_rank1_update", "namespacelinalg__immutable.html#a4b09077ad1495833919bab84b144b297", null ], + [ "mat_rank1_update", "namespacelinalg__immutable.html#a9648fd41cc3ce8ec40f67236d274f9a8", null ], + [ "mat_svd", "namespacelinalg__immutable.html#a6236acadb527f7762e3e1c0ee3d9ca82", null ] ]; \ No newline at end of file diff --git a/doc/html/namespacemembers.html b/doc/html/namespacemembers.html index 61121263..83435f38 100644 --- a/doc/html/namespacemembers.html +++ b/doc/html/namespacemembers.html @@ -1,9 +1,9 @@ - + - - + + linalg: Module Members @@ -13,13 +13,16 @@ - + + @@ -27,10 +30,9 @@
- - + @@ -39,21 +41,22 @@
-
linalg -  1.6.0 +
+
linalg 1.6.1
A linear algebra library that provides a user-friendly interface to several BLAS and LAPACK routines.
- + +/* @license-end */ +
@@ -67,8 +70,8 @@
@@ -81,368 +84,132 @@
- +
+
+
+
+
Loading...
+
Searching...
+
No Matches
+
+
+
Here is a list of all documented module members with links to the modules they belong to:
-

- h -

diff --git a/doc/html/namespacemembers_func.html b/doc/html/namespacemembers_func.html index ef4d67a2..fdda7432 100644 --- a/doc/html/namespacemembers_func.html +++ b/doc/html/namespacemembers_func.html @@ -1,9 +1,9 @@ - + - - + + linalg: Module Members @@ -13,13 +13,16 @@ - + + @@ -27,10 +30,9 @@
- - + @@ -39,21 +41,22 @@
-
linalg -  1.6.0 +
+
linalg 1.6.1
A linear algebra library that provides a user-friendly interface to several BLAS and LAPACK routines.
- + +/* @license-end */ +
@@ -67,8 +70,8 @@
@@ -81,323 +84,109 @@
- +
+
+
+
+
Loading...
+
Searching...
+
No Matches
+
+
+
  -

- i -

diff --git a/doc/html/namespacemembers_vars.html b/doc/html/namespacemembers_vars.html index 7909c025..d4084d74 100644 --- a/doc/html/namespacemembers_vars.html +++ b/doc/html/namespacemembers_vars.html @@ -1,9 +1,9 @@ - + - - + + linalg: Module Members @@ -13,13 +13,16 @@ - + + @@ -27,10 +30,9 @@
- - + @@ -39,21 +41,22 @@
-
linalg -  1.6.0 +
+
linalg 1.6.1
A linear algebra library that provides a user-friendly interface to several BLAS and LAPACK routines.
- + +/* @license-end */ +
@@ -67,8 +70,8 @@
@@ -81,55 +84,38 @@
- +
+
+
+
+
Loading...
+
Searching...
+
No Matches
+
+
+
 
diff --git a/doc/html/namespaces.html b/doc/html/namespaces.html index 7939815d..c9685e12 100644 --- a/doc/html/namespaces.html +++ b/doc/html/namespaces.html @@ -1,9 +1,9 @@ - + - - + + linalg: Modules List @@ -13,13 +13,16 @@ - + + @@ -27,10 +30,9 @@
- - + @@ -39,21 +41,22 @@
-
linalg -  1.6.0 +
+
linalg 1.6.1
A linear algebra library that provides a user-friendly interface to several BLAS and LAPACK routines.
- + +/* @license-end */ +
@@ -67,8 +70,8 @@
@@ -81,22 +84,74 @@
- +
+
+
+
+
Loading...
+
Searching...
+
No Matches
+
+
+
-
-
Modules List
+
Modules List
Here is a list of all documented modules with brief descriptions:
- +
[detail level 12]
- - - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
 Nlinalg_c_apiProvides a C-friendly API to the LINALG library. Notice, all C-API LINALG routines begin with the prefix "la_"
 Nlinalg_constantsProvides a set of constants and error flags for the library
 Nlinalg_coreProvides a set of common linear algebra routines
 Nlinalg_immutableProvides an immutable interface to many of the core linear algebra routines in this library. The intent is to allow for ease of use in situations where memory allocation, or absolute speed are of lesser importance to code readability
 Nlinalg_constantsProvides a set of constants and error flags for the library
 Nlinalg_coreProvides a set of common linear algebra routines
 Ccholesky_factorComputes the Cholesky factorization of a symmetric, positive definite matrix
 Ccholesky_rank1_downdateComputes the rank 1 downdate to a Cholesky factored matrix (upper triangular)
 Ccholesky_rank1_updateComputes the rank 1 update to a Cholesky factored matrix (upper triangular)
 CdetComputes the determinant of a square matrix
 Cdiag_mtx_multMultiplies a diagonal matrix with another matrix or array
 CeigenComputes the eigenvalues, and optionally the eigenvectors, of a matrix
 Cform_luExtracts the L and U matrices from the condensed [L\U] storage format used by the lu_factor
 Cform_qrForms the full M-by-M orthogonal matrix Q from the elementary reflectors returned by the base QR factorization algorithm
 Clu_factorComputes the LU factorization of an M-by-N matrix
 Cmtx_inverseComputes the inverse of a square matrix
 Cmtx_multPerforms the matrix operation: \( C = \alpha op(A) op(B) + \beta C \)
 Cmtx_pinverseComputes the Moore-Penrose pseudo-inverse of a M-by-N matrix using the singular value decomposition of the matrix
 Cmtx_rankComputes the rank of a matrix
 Cmult_qrMultiplies a general matrix by the orthogonal matrix Q from a QR factorization
 Cmult_rzMultiplies a general matrix by the orthogonal matrix Z from an RZ factorization
 Cqr_factorComputes the QR factorization of an M-by-N matrix
 Cqr_rank1_updateComputes the rank 1 update to an M-by-N QR factored matrix A (M >= N) where A = Q * R, and A1 = A + U * V**T such that A1 = Q1 * R1
 Crank1_updatePerforms the rank-1 update to matrix A such that: \( A = \alpha X Y^T + A \), where \( A \) is an M-by-N matrix, \( \alpha \)is a scalar, \( X \) is an M-element array, and \( Y \) is an N-element array. In the event that \( Y \) is complex, \( Y^H \) is used instead of \( Y^T \)
 Crecip_mult_arrayMultiplies a vector by the reciprocal of a real scalar
 Crz_factorFactors an upper trapezoidal matrix by means of orthogonal transformations such that A = R * Z = (R 0) * Z. Z is an orthogonal matrix of dimension N-by-N, and R is an M-by-M upper triangular matrix
 Csolve_choleskySolves a system of Cholesky factored equations
 Csolve_least_squaresSolves the overdetermined or underdetermined system (A*X = B) of M equations of N unknowns
 Csolve_least_squares_fullSolves the overdetermined or underdetermined system (A*X = B) of M equations of N unknowns, but uses a full orthogonal factorization of the system
 Csolve_least_squares_svdSolves the overdetermined or underdetermined system (A*X = B) of M equations of N unknowns using a singular value decomposition of matrix A
 Csolve_luSolves a system of LU-factored equations
 Csolve_qrSolves a system of M QR-factored equations of N unknowns
 Csolve_triangular_systemSolves a triangular system of equations
 CsortSorts an array
 CsvdComputes the singular value decomposition of a matrix A. The SVD is defined as: A = U * S * V**T, where U is an M-by-M orthogonal matrix, S is an M-by-N diagonal matrix, and V is an N-by-N orthogonal matrix
 CswapSwaps the contents of two arrays
 CtraceComputes the trace of a matrix (the sum of the main diagonal elements)
 Ctri_mtx_multComputes the triangular matrix operation: B = alpha * A**T * A + beta * B, or B = alpha * A * A**T + beta * B, where A is a triangular matrix
 Nlinalg_immutableProvides an immutable interface to many of the core linear algebra routines in this library. The intent is to allow for ease of use in situations where memory allocation, or absolute speed are of lesser importance to code readability
 Ceigen_resultsDefines a container for the output of an Eigen analysis of a square matrix
 Clu_resultsDefines a container for the output of an LU factorization
 Clu_results_cmplxDefines a container for the output of an LU factorization
 Cmat_eigenComputes the eigenvalues and eigenvectors (right) of a general N-by-N matrix
 Cmat_luComputes the LU factorization of a square matrix. Notice, partial row pivoting is utilized
 Cmat_mult_diagComputes the matrix operation: C = A * B, where A is a diagonal matrix
 Cmat_mult_lower_triComputes the matrix operation C = A * B, where A is a lower triangular matrix
 Cmat_mult_upper_triComputes the matrix operation C = A * B, where A is an upper triangular matrix
 Cmat_solve_lower_triSolves the lower triangular system A X = B, where A is a lower triangular matrix
 Cmat_solve_upper_triSolves the upper triangular system A X = B, where A is an upper triangular matrix
 Cqr_resultsDefines a container for the output of a QR factorization
 Cqr_results_cmplxDefines a container for the output of a QR factorization
 Csvd_resultsDefines a container for the output of a singular value decomposition of a matrix
 Csvd_results_cmplxDefines a container for the output of a singular value decomposition of a matrix
@@ -104,9 +159,7 @@ diff --git a/doc/html/namespaces_dup.js b/doc/html/namespaces_dup.js index acc85b41..915cf409 100644 --- a/doc/html/namespaces_dup.js +++ b/doc/html/namespaces_dup.js @@ -1,7 +1,81 @@ var namespaces_dup = [ - [ "linalg_c_api", "namespacelinalg__c__api.html", null ], - [ "linalg_constants", "namespacelinalg__constants.html", null ], - [ "linalg_core", "namespacelinalg__core.html", null ], - [ "linalg_immutable", "namespacelinalg__immutable.html", null ] + [ "linalg_c_api", "namespacelinalg__c__api.html", [ + [ "la_cholesky_factor", "namespacelinalg__c__api.html#a99d3ac7f90cad0c643dd8abff6592032", null ], + [ "la_cholesky_factor_cmplx", "namespacelinalg__c__api.html#a800b0d6ba6f8d812d8038dd06c0967a8", null ], + [ "la_cholesky_rank1_downdate", "namespacelinalg__c__api.html#a5b5758f439d34c765ff5285c21fa88c1", null ], + [ "la_cholesky_rank1_downdate_cmplx", "namespacelinalg__c__api.html#a3232c643af8f8615961c4b1bab422a4a", null ], + [ "la_cholesky_rank1_update", "namespacelinalg__c__api.html#ae5c0bda2e1ae3a4dbdaf6d0586247b4c", null ], + [ "la_cholesky_rank1_update_cmplx", "namespacelinalg__c__api.html#a5746e1736802b9a082057c7997325049", null ], + [ "la_det", "namespacelinalg__c__api.html#afd21b0e476168de7eb9a6a5ef3a2e8b4", null ], + [ "la_det_cmplx", "namespacelinalg__c__api.html#a82fcbd45f4a92431587312560fbcc636", null ], + [ "la_diag_mtx_mult", "namespacelinalg__c__api.html#ae866f3e174aed82f3fdfa3483ac91333", null ], + [ "la_diag_mtx_mult_cmplx", "namespacelinalg__c__api.html#a1af56ff742938c0be90fb34146b13365", null ], + [ "la_diag_mtx_mult_mixed", "namespacelinalg__c__api.html#adadfcde438cabd5b104b62f2541712d1", null ], + [ "la_eigen_asymm", "namespacelinalg__c__api.html#af2ed46a8b1285ac08f0f86162288a865", null ], + [ "la_eigen_cmplx", "namespacelinalg__c__api.html#ab133f51c44eb244be0b6e966f5893259", null ], + [ "la_eigen_gen", "namespacelinalg__c__api.html#a93920f1db884cbad9bfc335abe36bed4", null ], + [ "la_eigen_symm", "namespacelinalg__c__api.html#a63372e9678f7052d17c8676324d6e7a7", null ], + [ "la_form_lu", "namespacelinalg__c__api.html#aeab30d9e07601b343f15bf03d8220044", null ], + [ "la_form_lu_cmplx", "namespacelinalg__c__api.html#ae9bcd3e2df3151a5d92da48973501f6b", null ], + [ "la_form_qr", "namespacelinalg__c__api.html#a9426f737c5d551a133f44e2d7cb98a1d", null ], + [ "la_form_qr_cmplx", "namespacelinalg__c__api.html#a9be60e86103e09be4d19fd3728f5d64b", null ], + [ "la_form_qr_cmplx_pvt", "namespacelinalg__c__api.html#a5146fcf6552a097e05d46afaf91f424e", null ], + [ "la_form_qr_pvt", "namespacelinalg__c__api.html#a69d0ec69152e04fc5f766dd7c6d23f98", null ], + [ "la_inverse", "namespacelinalg__c__api.html#a307a6d5e27d90b28a38fba8c02e14461", null ], + [ "la_inverse_cmplx", "namespacelinalg__c__api.html#a715855159abe740aff7bf95303a3f715", null ], + [ "la_lu_factor", "namespacelinalg__c__api.html#a3e91c088c8d173e9b12c17b1ebc9bfa4", null ], + [ "la_lu_factor_cmplx", "namespacelinalg__c__api.html#a1788fe3192429b2cfd3a169d879a6f0e", null ], + [ "la_mtx_mult", "namespacelinalg__c__api.html#a434338a38a5fde94d8df3119b169fd01", null ], + [ "la_mtx_mult_cmplx", "namespacelinalg__c__api.html#abdc93ffffffefdef839370da19f01430", null ], + [ "la_mult_qr", "namespacelinalg__c__api.html#a2604ade114e67587300b3916846fc961", null ], + [ "la_mult_qr_cmplx", "namespacelinalg__c__api.html#a4b8c42819e069a18ec39c5ebb9ef8703", null ], + [ "la_pinverse", "namespacelinalg__c__api.html#a39bb26dcab43d8f54471af87af69e606", null ], + [ "la_pinverse_cmplx", "namespacelinalg__c__api.html#ad0eefe5cf5a74d6848bbde0e8bb22550", null ], + [ "la_qr_factor", "namespacelinalg__c__api.html#a2c896885507a331ad89e579868da0fd3", null ], + [ "la_qr_factor_cmplx", "namespacelinalg__c__api.html#a13a75b6d7bce1788b5e286a879456347", null ], + [ "la_qr_factor_cmplx_pvt", "namespacelinalg__c__api.html#aa7bc80d9671a82aafdfc9a8ab904cb22", null ], + [ "la_qr_factor_pvt", "namespacelinalg__c__api.html#a9868095d332ba323afce1cda4085dd8c", null ], + [ "la_qr_rank1_update", "namespacelinalg__c__api.html#a056fb14e92f98c660573886c0ad940ff", null ], + [ "la_qr_rank1_update_cmplx", "namespacelinalg__c__api.html#a01cf2129d7af3ddc8fb6e1fff7786ff1", null ], + [ "la_rank", "namespacelinalg__c__api.html#a32548b9eb091164d51ed3793afee83e9", null ], + [ "la_rank1_update", "namespacelinalg__c__api.html#a6e47b549d59377db83a0eb27d739df8d", null ], + [ "la_rank1_update_cmplx", "namespacelinalg__c__api.html#ac46bdb1315742f700571bf4f7c705ffd", null ], + [ "la_rank_cmplx", "namespacelinalg__c__api.html#a60244c1c8ef1ac3217a9efa69fdbd229", null ], + [ "la_solve_cholesky", "namespacelinalg__c__api.html#ac286fe9a7ed4d69ca30ecbe03959f209", null ], + [ "la_solve_cholesky_cmplx", "namespacelinalg__c__api.html#a83a08022c84ac2e76f7d20486797bd33", null ], + [ "la_solve_least_squares", "namespacelinalg__c__api.html#af1d700238a8ab71b17ff8c15221a9e02", null ], + [ "la_solve_least_squares_cmplx", "namespacelinalg__c__api.html#a2c691c114d54a8eb89ce2882d0557550", null ], + [ "la_solve_lu", "namespacelinalg__c__api.html#a846baffbc77d4348d7b15d3f83983a04", null ], + [ "la_solve_lu_cmplx", "namespacelinalg__c__api.html#aae9625f2ff12a73b6007b429132a1531", null ], + [ "la_solve_qr", "namespacelinalg__c__api.html#a13ed5d138ff59a9f649babc5c1dd9eab", null ], + [ "la_solve_qr_cmplx", "namespacelinalg__c__api.html#ad05206b75a9cd1c5a2bda147307ef2d5", null ], + [ "la_solve_qr_cmplx_pvt", "namespacelinalg__c__api.html#a17bfa880bc9019cbd654d20cab263ce3", null ], + [ "la_solve_qr_pvt", "namespacelinalg__c__api.html#a0d12474b0ca7772e4ad4ebc7ce227315", null ], + [ "la_solve_tri_mtx", "namespacelinalg__c__api.html#a7a72759b932b32e346a70cec542557ff", null ], + [ "la_solve_tri_mtx_cmplx", "namespacelinalg__c__api.html#a7a8e491e75d2d00911d0992b37aac43d", null ], + [ "la_sort_eigen", "namespacelinalg__c__api.html#ab81f25f6835feac7a88250c9863a4120", null ], + [ "la_sort_eigen_cmplx", "namespacelinalg__c__api.html#a2a0c8ddfd134f3d57849925d359d53b2", null ], + [ "la_svd", "namespacelinalg__c__api.html#a436b645816859aea4a8fbd55e733ab92", null ], + [ "la_svd_cmplx", "namespacelinalg__c__api.html#a45eeb38b8a0d572fc25a7db98690f705", null ], + [ "la_trace", "namespacelinalg__c__api.html#af8627c89c2201ae47c9cfac1d65abfd4", null ], + [ "la_trace_cmplx", "namespacelinalg__c__api.html#a315ef452fe9f00baa454dc930813fedc", null ], + [ "la_tri_mtx_mult", "namespacelinalg__c__api.html#a754866d88e140dbf618c1d85f016c633", null ], + [ "la_tri_mtx_mult_cmplx", "namespacelinalg__c__api.html#aeb63de65aa9a9bc040860b8f78dcd3fa", null ] + ] ], + [ "linalg_constants", "namespacelinalg__constants.html", [ + [ "hermitian_transpose", "namespacelinalg__constants.html#a389e35467a5a18f90927d28fb12ddf70", null ], + [ "la_array_size_error", "namespacelinalg__constants.html#aee0ebff93d8751cc57a3e8e5965b1344", null ], + [ "la_convergence_error", "namespacelinalg__constants.html#a39da5de4ea671010ee5f1e358c991cee", null ], + [ "la_invalid_input_error", "namespacelinalg__constants.html#ac7d8bace23640b21a6d8a960371eb732", null ], + [ "la_invalid_operation_error", "namespacelinalg__constants.html#aaafde862f4d348fecccdccc695e25622", null ], + [ "la_matrix_format_error", "namespacelinalg__constants.html#a252c96a6e7c24b40bf7ef96063824f01", null ], + [ "la_no_error", "namespacelinalg__constants.html#ad4b52ca61ccf1199dead23faa80b9ac7", null ], + [ "la_out_of_memory_error", "namespacelinalg__constants.html#a8d5820c41090117b508a033309ad0870", null ], + [ "la_singular_matrix_error", "namespacelinalg__constants.html#a6607d2d2ac92fe5d902527519279e646", null ], + [ "no_operation", "namespacelinalg__constants.html#abf9e3b763502c2b0af0cbf48b14c918f", null ], + [ "transpose", "namespacelinalg__constants.html#a045d4c1cc5fe061467924ad01bfe77c4", null ] + ] ], + [ "linalg_core", "namespacelinalg__core.html", "namespacelinalg__core" ], + [ "linalg_immutable", "namespacelinalg__immutable.html", "namespacelinalg__immutable" ] ]; \ No newline at end of file diff --git a/doc/html/nav_fd.png b/doc/html/nav_fd.png new file mode 100644 index 0000000000000000000000000000000000000000..032fbdd4c54f54fa9a2e6423b94ef4b2ebdfaceb GIT binary patch literal 169 zcmeAS@N?(olHy`uVBq!ia0vp^j6iI`!2~2XGqLUlQU#tajv*C{Z|C~*H7f|XvG1G8 zt7aS*L7xwMeS}!z6R#{C5tIw-s~AJ==F^i}x3XyJseHR@yF& zerFf(Zf;Dd{+(0lDIROL@Sj-Ju2JQ8&-n%4%q?>|^bShc&lR?}7HeMo@BDl5N(aHY Uj$gdr1MOz;boFyt=akR{0D!zeaR2}S literal 0 HcmV?d00001 diff --git a/doc/html/nav_hd.png b/doc/html/nav_hd.png new file mode 100644 index 0000000000000000000000000000000000000000..de80f18ad6488b9990303f267a76fdc83f0ffd80 GIT binary patch literal 114 zcmeAS@N?(olHy`uVBq!ia0vp^j6lr8!2~3AUOE6t21`#D$B+ufw|9379#G(63FK{W z5s6W-eg#Jd_@e6*DPn)w;=|1H}Zvm9l6xXXB%>yL=NQU;mg M>FVdQ&MBb@0Bdt1Qvd(} literal 0 HcmV?d00001 diff --git a/doc/html/navtree.css b/doc/html/navtree.css index 33341a67..c8a7766a 100644 --- a/doc/html/navtree.css +++ b/doc/html/navtree.css @@ -22,8 +22,13 @@ #nav-tree .selected { background-image: url('tab_a.png'); background-repeat:repeat-x; - color: #fff; - text-shadow: 0px 1px 1px rgba(0, 0, 0, 1.0); + color: var(--nav-text-active-color); + text-shadow: var(--nav-text-active-shadow); +} + +#nav-tree .selected .arrow { + color: var(--nav-arrow-selected-color); + text-shadow: none; } #nav-tree img { @@ -43,7 +48,7 @@ #nav-tree .label { margin:0px; padding:0px; - font: 12px 'Lucida Grande',Geneva,Helvetica,Arial,sans-serif; + font: 12px var(--font-family-nav); } #nav-tree .label a { @@ -52,7 +57,7 @@ #nav-tree .selected a { text-decoration:none; - color:#fff; + color:var(--nav-text-active-color); } #nav-tree .children_ul { @@ -67,7 +72,6 @@ #nav-tree { padding: 0px 0px; - background-color: #FAFAFF; font-size:14px; overflow:auto; } @@ -86,7 +90,8 @@ display:block; position: absolute; left: 0px; - width: 250px; + width: $width; + overflow : hidden; } .ui-resizable .ui-resizable-handle { @@ -94,7 +99,7 @@ } .ui-resizable-e { - background-image:url("splitbar.png"); + background-image:var(--nav-splitbar-image); background-size:100%; background-repeat:repeat-y; background-attachment: scroll; @@ -117,9 +122,8 @@ } #nav-tree { - background-image:url('nav_h.png'); background-repeat:repeat-x; - background-color: #F9FAFC; + background-color: var(--nav-background-color); -webkit-overflow-scrolling : touch; /* iOS 5+ */ } diff --git a/doc/html/navtree.js b/doc/html/navtree.js index edc31efc..27983687 100644 --- a/doc/html/navtree.js +++ b/doc/html/navtree.js @@ -1,24 +1,26 @@ /* - @licstart The following is the entire license notice for the - JavaScript code in this file. + @licstart The following is the entire license notice for the JavaScript code in this file. - Copyright (C) 1997-2019 by Dimitri van Heesch + The MIT License (MIT) - This program is free software; you can redistribute it and/or modify - it under the terms of version 2 of the GNU General Public License as - published by the Free Software Foundation. + Copyright (C) 1997-2020 by Dimitri van Heesch - This program is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. + Permission is hereby granted, free of charge, to any person obtaining a copy of this software + and associated documentation files (the "Software"), to deal in the Software without restriction, + including without limitation the rights to use, copy, modify, merge, publish, distribute, + sublicense, and/or sell copies of the Software, and to permit persons to whom the Software is + furnished to do so, subject to the following conditions: - You should have received a copy of the GNU General Public License along - with this program; if not, write to the Free Software Foundation, Inc., - 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. + The above copyright notice and this permission notice shall be included in all copies or + substantial portions of the Software. - @licend The above is the entire license notice - for the JavaScript code in this file + THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING + BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND + NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, + DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, + OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. + + @licend The above is the entire license notice for the JavaScript code in this file */ var navTreeSubIndices = new Array(); var arrowDown = '▼'; @@ -323,11 +325,14 @@ function selectAndHighlight(hash,n) $(n.itemDiv).addClass('selected'); $(n.itemDiv).attr('id','selected'); } + var topOffset=5; + if (typeof page_layout!=='undefined' && page_layout==1) { + topOffset+=$('#top').outerHeight(); + } if ($('#nav-tree-contents .item:first').hasClass('selected')) { - $('#nav-sync').css('top','30px'); - } else { - $('#nav-sync').css('top','5px'); + topOffset+=25; } + $('#nav-sync').css('top',topOffset+'px'); showRoot(); } diff --git a/doc/html/navtreedata.js b/doc/html/navtreedata.js index e7312aea..a744a0c3 100644 --- a/doc/html/navtreedata.js +++ b/doc/html/navtreedata.js @@ -1,24 +1,26 @@ /* -@licstart The following is the entire license notice for the -JavaScript code in this file. + @licstart The following is the entire license notice for the JavaScript code in this file. -Copyright (C) 1997-2019 by Dimitri van Heesch + The MIT License (MIT) -This program is free software; you can redistribute it and/or modify -it under the terms of version 2 of the GNU General Public License as published by -the Free Software Foundation + Copyright (C) 1997-2020 by Dimitri van Heesch -This program is distributed in the hope that it will be useful, -but WITHOUT ANY WARRANTY; without even the implied warranty of -MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -GNU General Public License for more details. + Permission is hereby granted, free of charge, to any person obtaining a copy of this software + and associated documentation files (the "Software"), to deal in the Software without restriction, + including without limitation the rights to use, copy, modify, merge, publish, distribute, + sublicense, and/or sell copies of the Software, and to permit persons to whom the Software is + furnished to do so, subject to the following conditions: -You should have received a copy of the GNU General Public License along -with this program; if not, write to the Free Software Foundation, Inc., -51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. + The above copyright notice and this permission notice shall be included in all copies or + substantial portions of the Software. -@licend The above is the entire license notice -for the JavaScript code in this file + THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING + BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND + NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, + DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, + OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. + + @licend The above is the entire license notice for the JavaScript code in this file */ var NAVTREE = [ @@ -37,7 +39,6 @@ var NAVTREE = [ "Data Types", "classes.html", null ], [ "Data Fields", "functions.html", [ [ "All", "functions.html", null ], - [ "Functions/Subroutines", "functions_func.html", null ], [ "Variables", "functions_vars.html", null ] ] ] ] ], diff --git a/doc/html/navtreeindex0.js b/doc/html/navtreeindex0.js index 30cb8f9a..2ec02867 100644 --- a/doc/html/navtreeindex0.js +++ b/doc/html/navtreeindex0.js @@ -6,176 +6,87 @@ var NAVTREEINDEX0 = "dir_d44c64559bbebec7f509842c48db8b23.html":[3,0,0], "files.html":[3,0], "functions.html":[2,2,0], -"functions_func.html":[2,2,1], -"functions_vars.html":[2,2,2], +"functions_vars.html":[2,2,1], "index.html":[], "index.html#intro_sec":[0], "interfacelinalg__core_1_1cholesky__factor.html":[2,0,0,0], -"interfacelinalg__core_1_1cholesky__factor.html#a39ee6157586b5ceb4daa96b4941727ff":[2,0,0,0,0], -"interfacelinalg__core_1_1cholesky__factor.html#ad4857bc2e32e8060fb4b1d2f1851b3b9":[2,0,0,0,1], +"interfacelinalg__core_1_1cholesky__factor.html":[1,0,2,0], "interfacelinalg__core_1_1cholesky__rank1__downdate.html":[2,0,0,1], -"interfacelinalg__core_1_1cholesky__rank1__downdate.html#a22a1f2036a36903a46d63de5f872332f":[2,0,0,1,0], -"interfacelinalg__core_1_1cholesky__rank1__downdate.html#a989a77e356f22d120b2254ca6298991f":[2,0,0,1,1], +"interfacelinalg__core_1_1cholesky__rank1__downdate.html":[1,0,2,1], "interfacelinalg__core_1_1cholesky__rank1__update.html":[2,0,0,2], -"interfacelinalg__core_1_1cholesky__rank1__update.html#a39fae441211cfe7becb152f719c7c2d1":[2,0,0,2,1], -"interfacelinalg__core_1_1cholesky__rank1__update.html#a908e013ace93edb69eee8d34caff69b4":[2,0,0,2,0], +"interfacelinalg__core_1_1cholesky__rank1__update.html":[1,0,2,2], +"interfacelinalg__core_1_1det.html":[1,0,2,3], "interfacelinalg__core_1_1det.html":[2,0,0,3], -"interfacelinalg__core_1_1det.html#a04a8ec5518ae621cbf3017e133ab4e72":[2,0,0,3,1], -"interfacelinalg__core_1_1det.html#a7cfb9cc322571ae48dfae4049e039057":[2,0,0,3,0], +"interfacelinalg__core_1_1diag__mtx__mult.html":[1,0,2,4], "interfacelinalg__core_1_1diag__mtx__mult.html":[2,0,0,4], -"interfacelinalg__core_1_1diag__mtx__mult.html#a1f20f7859fc1e05561755e9548806c61":[2,0,0,4,2], -"interfacelinalg__core_1_1diag__mtx__mult.html#a4c3d89fd79a291edd34d3febf45fa5e1":[2,0,0,4,4], -"interfacelinalg__core_1_1diag__mtx__mult.html#a50bceffda2353571dfb27ea0dbe41f8c":[2,0,0,4,5], -"interfacelinalg__core_1_1diag__mtx__mult.html#a6da687e18f9b7f71611841688ee3d99a":[2,0,0,4,1], -"interfacelinalg__core_1_1diag__mtx__mult.html#a776d1da0d2ab563424068cdfe666fb76":[2,0,0,4,0], -"interfacelinalg__core_1_1diag__mtx__mult.html#acda2e3def961341e0a586d24a52d072d":[2,0,0,4,3], "interfacelinalg__core_1_1eigen.html":[2,0,0,5], -"interfacelinalg__core_1_1eigen.html#a16c33318e21dcb941b66f3bd07d0afb5":[2,0,0,5,0], -"interfacelinalg__core_1_1eigen.html#a33c75fab4fe39686bad8ac658450943e":[2,0,0,5,2], -"interfacelinalg__core_1_1eigen.html#a722595e0199e4c48c3161d4401183861":[2,0,0,5,3], -"interfacelinalg__core_1_1eigen.html#a7ea7b48fee19b83b201ce15ed0376d75":[2,0,0,5,1], +"interfacelinalg__core_1_1eigen.html":[1,0,2,5], +"interfacelinalg__core_1_1form__lu.html":[1,0,2,6], "interfacelinalg__core_1_1form__lu.html":[2,0,0,6], -"interfacelinalg__core_1_1form__lu.html#a57bb63f215ba1bcd839b8eb89864d321":[2,0,0,6,2], -"interfacelinalg__core_1_1form__lu.html#a7c1d66b1f0c96969e1aebcc6e4f7c786":[2,0,0,6,3], -"interfacelinalg__core_1_1form__lu.html#a85a3cadccf248edcea22b909a1ef8b94":[2,0,0,6,1], -"interfacelinalg__core_1_1form__lu.html#adfed860145ae6477c24168b5c20bd4da":[2,0,0,6,0], +"interfacelinalg__core_1_1form__qr.html":[1,0,2,7], "interfacelinalg__core_1_1form__qr.html":[2,0,0,7], -"interfacelinalg__core_1_1form__qr.html#a2735b99c98bb4c2c6b55916b2dde7d90":[2,0,0,7,3], -"interfacelinalg__core_1_1form__qr.html#a2894acd27e841990b8ea7a6f7bf22297":[2,0,0,7,0], -"interfacelinalg__core_1_1form__qr.html#a4b4b344f4683a24dbdc43e4a25db95ee":[2,0,0,7,1], -"interfacelinalg__core_1_1form__qr.html#ac8bd0259e78bb03952d14769f5411411":[2,0,0,7,2], +"interfacelinalg__core_1_1lu__factor.html":[1,0,2,8], "interfacelinalg__core_1_1lu__factor.html":[2,0,0,8], -"interfacelinalg__core_1_1lu__factor.html#a0fba1a01c18a0041a255404d30684a30":[2,0,0,8,1], -"interfacelinalg__core_1_1lu__factor.html#a1ed75acf92d93c525c523885565a5a55":[2,0,0,8,0], +"interfacelinalg__core_1_1mtx__inverse.html":[1,0,2,9], "interfacelinalg__core_1_1mtx__inverse.html":[2,0,0,9], -"interfacelinalg__core_1_1mtx__inverse.html#a28a09672b4905ad214788bbeadf96cb1":[2,0,0,9,1], -"interfacelinalg__core_1_1mtx__inverse.html#a3a20ac56f0d02ff4ca6e07c108bab8bd":[2,0,0,9,0], +"interfacelinalg__core_1_1mtx__mult.html":[1,0,2,10], "interfacelinalg__core_1_1mtx__mult.html":[2,0,0,10], -"interfacelinalg__core_1_1mtx__mult.html#a506bbc620273111c86595046a60d540b":[2,0,0,10,0], -"interfacelinalg__core_1_1mtx__mult.html#ab8eb5da2c406e7aabca6b890a04b3fe7":[2,0,0,10,1], -"interfacelinalg__core_1_1mtx__mult.html#aed4be646bc56b90cd098fe934fce2d38":[2,0,0,10,2], -"interfacelinalg__core_1_1mtx__mult.html#afa2ea394935458f58668e0e3caaf4383":[2,0,0,10,3], +"interfacelinalg__core_1_1mtx__pinverse.html":[1,0,2,11], "interfacelinalg__core_1_1mtx__pinverse.html":[2,0,0,11], -"interfacelinalg__core_1_1mtx__pinverse.html#ab52f815dabe1e27b8ea8667bff970047":[2,0,0,11,0], -"interfacelinalg__core_1_1mtx__pinverse.html#af88949881de2db2572f0642877839bc3":[2,0,0,11,1], +"interfacelinalg__core_1_1mtx__rank.html":[1,0,2,12], "interfacelinalg__core_1_1mtx__rank.html":[2,0,0,12], -"interfacelinalg__core_1_1mtx__rank.html#a5e63b452effaa547c5be203c62db60fa":[2,0,0,12,1], -"interfacelinalg__core_1_1mtx__rank.html#adad08e880a8f1ef739f61e9d656b060d":[2,0,0,12,0], +"interfacelinalg__core_1_1mult__qr.html":[1,0,2,13], "interfacelinalg__core_1_1mult__qr.html":[2,0,0,13], -"interfacelinalg__core_1_1mult__qr.html#a1f3592ef3bb5b2694d235416d42e64e7":[2,0,0,13,3], -"interfacelinalg__core_1_1mult__qr.html#a4cb4b3e933ba4259aeb01887705f31be":[2,0,0,13,1], -"interfacelinalg__core_1_1mult__qr.html#a8e5baa02a5ca4e2cd82414983968135d":[2,0,0,13,0], -"interfacelinalg__core_1_1mult__qr.html#ab7197311ff6efaef35484ca830aeed9d":[2,0,0,13,2], +"interfacelinalg__core_1_1mult__rz.html":[1,0,2,14], "interfacelinalg__core_1_1mult__rz.html":[2,0,0,14], -"interfacelinalg__core_1_1mult__rz.html#a2d39ca9006b73630c69fc82df6e9dd77":[2,0,0,14,2], -"interfacelinalg__core_1_1mult__rz.html#a76b53141e4da52f0d67e6fbd65a89d9e":[2,0,0,14,0], -"interfacelinalg__core_1_1mult__rz.html#a7be8c0b623d5f1f4dca554e576883752":[2,0,0,14,1], -"interfacelinalg__core_1_1mult__rz.html#ae2c96a7d1fa2be43e8078ecde60458ef":[2,0,0,14,3], +"interfacelinalg__core_1_1qr__factor.html":[1,0,2,15], "interfacelinalg__core_1_1qr__factor.html":[2,0,0,15], -"interfacelinalg__core_1_1qr__factor.html#a0737d312f4073dbb3afa380189ab84dc":[2,0,0,15,3], -"interfacelinalg__core_1_1qr__factor.html#aa42634b06281e1d0d1424409b661ff32":[2,0,0,15,0], -"interfacelinalg__core_1_1qr__factor.html#ae244d02fe2f7152a850949ba7bbe14da":[2,0,0,15,2], -"interfacelinalg__core_1_1qr__factor.html#aff8a0702ceda39934e81a5ae55ee5d31":[2,0,0,15,1], +"interfacelinalg__core_1_1qr__rank1__update.html":[1,0,2,16], "interfacelinalg__core_1_1qr__rank1__update.html":[2,0,0,16], -"interfacelinalg__core_1_1qr__rank1__update.html#a92fe9964aec2da17e1f177694505aed8":[2,0,0,16,0], -"interfacelinalg__core_1_1qr__rank1__update.html#af0ec18b990d25d496fd2089def203937":[2,0,0,16,1], "interfacelinalg__core_1_1rank1__update.html":[2,0,0,17], -"interfacelinalg__core_1_1rank1__update.html#a6955d5120b75c5cfa149cf2a290de7ad":[2,0,0,17,0], -"interfacelinalg__core_1_1rank1__update.html#ac3da9c58344d9a4abc06c322cf426a05":[2,0,0,17,1], +"interfacelinalg__core_1_1rank1__update.html":[1,0,2,17], "interfacelinalg__core_1_1recip__mult__array.html":[2,0,0,18], -"interfacelinalg__core_1_1recip__mult__array.html#a449f3ceae94a9387973881370ae0b03e":[2,0,0,18,0], +"interfacelinalg__core_1_1recip__mult__array.html":[1,0,2,18], "interfacelinalg__core_1_1rz__factor.html":[2,0,0,19], -"interfacelinalg__core_1_1rz__factor.html#a7c63ddd520fae1bb4e0e59ef96e048a8":[2,0,0,19,1], -"interfacelinalg__core_1_1rz__factor.html#af97cb2eb7528d282d7d60528152712a5":[2,0,0,19,0], +"interfacelinalg__core_1_1rz__factor.html":[1,0,2,19], +"interfacelinalg__core_1_1solve__cholesky.html":[1,0,2,20], "interfacelinalg__core_1_1solve__cholesky.html":[2,0,0,20], -"interfacelinalg__core_1_1solve__cholesky.html#a0e1e98a42d8714f8f5baaf1debe49ca9":[2,0,0,20,2], -"interfacelinalg__core_1_1solve__cholesky.html#a467d821925c88ee9f9be4b860a583ca0":[2,0,0,20,0], -"interfacelinalg__core_1_1solve__cholesky.html#a509978e26ad92622820b3e86ff012ca8":[2,0,0,20,3], -"interfacelinalg__core_1_1solve__cholesky.html#ad8649e9a1abf7c350b34972b397ba605":[2,0,0,20,1], "interfacelinalg__core_1_1solve__least__squares.html":[2,0,0,21], -"interfacelinalg__core_1_1solve__least__squares.html#a38d2c7e427926c7b5a2451d6cee1c5f6":[2,0,0,21,1], -"interfacelinalg__core_1_1solve__least__squares.html#a48cd04a551d8317e29204e08c54c2097":[2,0,0,21,0], -"interfacelinalg__core_1_1solve__least__squares.html#ac4822259e8b7e6428ad0515f71297a89":[2,0,0,21,2], -"interfacelinalg__core_1_1solve__least__squares.html#ac81ec0851b2509524abdc5cd43d0e6cc":[2,0,0,21,3], +"interfacelinalg__core_1_1solve__least__squares.html":[1,0,2,21], "interfacelinalg__core_1_1solve__least__squares__full.html":[2,0,0,22], -"interfacelinalg__core_1_1solve__least__squares__full.html#a638030fb3565b4dcc2a783c5873a755c":[2,0,0,22,0], -"interfacelinalg__core_1_1solve__least__squares__full.html#aa12c4aeeede45409b3970cd932d3f62e":[2,0,0,22,1], -"interfacelinalg__core_1_1solve__least__squares__full.html#ab9e3f854b13edbefb168a74e232e89ee":[2,0,0,22,3], -"interfacelinalg__core_1_1solve__least__squares__full.html#adf2370892a048a02531d8da82f8868d1":[2,0,0,22,2], +"interfacelinalg__core_1_1solve__least__squares__full.html":[1,0,2,22], "interfacelinalg__core_1_1solve__least__squares__svd.html":[2,0,0,23], -"interfacelinalg__core_1_1solve__least__squares__svd.html#a130136d3469487f33479528725fb201f":[2,0,0,23,0], -"interfacelinalg__core_1_1solve__least__squares__svd.html#a54f3853d4cc1d4a311e356bc9fdc0e14":[2,0,0,23,1], +"interfacelinalg__core_1_1solve__least__squares__svd.html":[1,0,2,23], "interfacelinalg__core_1_1solve__lu.html":[2,0,0,24], -"interfacelinalg__core_1_1solve__lu.html#a5dcfd2adbe33f8963bb8c13dc92030c4":[2,0,0,24,3], -"interfacelinalg__core_1_1solve__lu.html#a83b86c8992a35b85dbdd7161bfdec869":[2,0,0,24,0], -"interfacelinalg__core_1_1solve__lu.html#acaf02c125054dd1fc3002f9c6f53b196":[2,0,0,24,2], -"interfacelinalg__core_1_1solve__lu.html#ae9ab55eaaa04492094a508110863752d":[2,0,0,24,1], +"interfacelinalg__core_1_1solve__lu.html":[1,0,2,24], "interfacelinalg__core_1_1solve__qr.html":[2,0,0,25], -"interfacelinalg__core_1_1solve__qr.html#a2c8164f8ebdebcc29bf93131bf469842":[2,0,0,25,4], -"interfacelinalg__core_1_1solve__qr.html#a4ca97568b327291f35e717c97f45df5b":[2,0,0,25,7], -"interfacelinalg__core_1_1solve__qr.html#a511ed1ae9c38deeb07ae6b9d92a6ec7d":[2,0,0,25,5], -"interfacelinalg__core_1_1solve__qr.html#a6eafc498e0e0f985e7b2a09532a00d6f":[2,0,0,25,2], -"interfacelinalg__core_1_1solve__qr.html#a89a25846b3b2c551e50c2f9d7ed8a580":[2,0,0,25,6], -"interfacelinalg__core_1_1solve__qr.html#a9df2e47d07b41f7663815b3dcc7a525b":[2,0,0,25,0], -"interfacelinalg__core_1_1solve__qr.html#aa75f05860def06fd3b9838af62292063":[2,0,0,25,1], -"interfacelinalg__core_1_1solve__qr.html#aefaba8170e630a3dea1fb65da7b9a1e9":[2,0,0,25,3], +"interfacelinalg__core_1_1solve__qr.html":[1,0,2,25], "interfacelinalg__core_1_1solve__triangular__system.html":[2,0,0,26], -"interfacelinalg__core_1_1solve__triangular__system.html#a04fdb16be9760d6c23f516d641d52456":[2,0,0,26,2], -"interfacelinalg__core_1_1solve__triangular__system.html#a085021bf2fc13ea64f66d85be4e7e456":[2,0,0,26,1], -"interfacelinalg__core_1_1solve__triangular__system.html#a535dfbf846a5b44aef6b9f9fea3c1be1":[2,0,0,26,3], -"interfacelinalg__core_1_1solve__triangular__system.html#a868f1684af2b6e369bdb277cb0258474":[2,0,0,26,0], +"interfacelinalg__core_1_1solve__triangular__system.html":[1,0,2,26], "interfacelinalg__core_1_1sort.html":[2,0,0,27], -"interfacelinalg__core_1_1sort.html#a1225ca59d9f0ac6d480314b90059f4b4":[2,0,0,27,2], -"interfacelinalg__core_1_1sort.html#a5b60cdc7f2a95b6564f42fe34d2f3f89":[2,0,0,27,3], -"interfacelinalg__core_1_1sort.html#a6e88f92b2ad9f9190c334c465d6f7a8a":[2,0,0,27,1], -"interfacelinalg__core_1_1sort.html#ab44f125896af28e5eb37ac0d2b4426db":[2,0,0,27,0], -"interfacelinalg__core_1_1sort.html#ac30aa4b1817e7d57499e77e88ebdff02":[2,0,0,27,5], -"interfacelinalg__core_1_1sort.html#aee9c3bf3e5a409ec02202bf1999051a1":[2,0,0,27,4], +"interfacelinalg__core_1_1sort.html":[1,0,2,27], "interfacelinalg__core_1_1svd.html":[2,0,0,28], -"interfacelinalg__core_1_1svd.html#a0191bc389430b36ca20d14e0047e5c22":[2,0,0,28,1], -"interfacelinalg__core_1_1svd.html#ae6c58d6289781f0f58b514474112c064":[2,0,0,28,0], +"interfacelinalg__core_1_1svd.html":[1,0,2,28], +"interfacelinalg__core_1_1swap.html":[1,0,2,29], "interfacelinalg__core_1_1swap.html":[2,0,0,29], -"interfacelinalg__core_1_1swap.html#ab10433b52095e44d93ca12b44af0dfaf":[2,0,0,29,1], -"interfacelinalg__core_1_1swap.html#afe928886fd14d221127474da4e7ff35b":[2,0,0,29,0], +"interfacelinalg__core_1_1trace.html":[1,0,2,30], "interfacelinalg__core_1_1trace.html":[2,0,0,30], -"interfacelinalg__core_1_1trace.html#a753f2d73dae7a5c249ed64db66ff748b":[2,0,0,30,1], -"interfacelinalg__core_1_1trace.html#afafcb57c5baaf6968455f8643c7031b4":[2,0,0,30,0], +"interfacelinalg__core_1_1tri__mtx__mult.html":[1,0,2,31], "interfacelinalg__core_1_1tri__mtx__mult.html":[2,0,0,31], -"interfacelinalg__core_1_1tri__mtx__mult.html#a06049bd2dc476a4802ed5aa30a22be4f":[2,0,0,31,1], -"interfacelinalg__core_1_1tri__mtx__mult.html#abab3c7a15f2b87d0537d52c158e3deec":[2,0,0,31,0], +"interfacelinalg__immutable_1_1mat__eigen.html":[1,0,3,3], "interfacelinalg__immutable_1_1mat__eigen.html":[2,0,1,3], -"interfacelinalg__immutable_1_1mat__eigen.html#a30c4db4bc943963757cc91e6b01e591b":[2,0,1,3,0], -"interfacelinalg__immutable_1_1mat__eigen.html#a9eaef6fd28d9713ebba5dbd3ca44deff":[2,0,1,3,1], +"interfacelinalg__immutable_1_1mat__lu.html":[1,0,3,4], "interfacelinalg__immutable_1_1mat__lu.html":[2,0,1,4], -"interfacelinalg__immutable_1_1mat__lu.html#a085e6774ff582e30cb7bcd45d554a585":[2,0,1,4,0], -"interfacelinalg__immutable_1_1mat__lu.html#ab5bb8b86586008f8958cf7d026cc541f":[2,0,1,4,1], "interfacelinalg__immutable_1_1mat__mult__diag.html":[2,0,1,5], -"interfacelinalg__immutable_1_1mat__mult__diag.html#a126d23945fc3d2280e4a6edbaa2ad5c9":[2,0,1,5,5], -"interfacelinalg__immutable_1_1mat__mult__diag.html#a202551e80ef44a3b0cfc827c1d33cbcd":[2,0,1,5,1], -"interfacelinalg__immutable_1_1mat__mult__diag.html#a2977bc4d536b8c40e77f222be6b1bb9e":[2,0,1,5,2], -"interfacelinalg__immutable_1_1mat__mult__diag.html#a387bdf49e35ada60f819efb7db189f78":[2,0,1,5,4], -"interfacelinalg__immutable_1_1mat__mult__diag.html#a81769d8240f87a60da4e7c66fca2d5f7":[2,0,1,5,3], -"interfacelinalg__immutable_1_1mat__mult__diag.html#ac7e97da527c8e0ba4be582d79fe94331":[2,0,1,5,0], +"interfacelinalg__immutable_1_1mat__mult__diag.html":[1,0,3,5], +"interfacelinalg__immutable_1_1mat__mult__lower__tri.html":[1,0,3,6], "interfacelinalg__immutable_1_1mat__mult__lower__tri.html":[2,0,1,6], -"interfacelinalg__immutable_1_1mat__mult__lower__tri.html#a588ba3472cb80109671f756d611ed023":[2,0,1,6,0], -"interfacelinalg__immutable_1_1mat__mult__lower__tri.html#a9754468f10374e34e1a2fb40ce1206e0":[2,0,1,6,2], -"interfacelinalg__immutable_1_1mat__mult__lower__tri.html#ac1a3df11bc32e8f90d4f623620c7006f":[2,0,1,6,3], -"interfacelinalg__immutable_1_1mat__mult__lower__tri.html#ace28e02e648b20c69f10919e0e9ab839":[2,0,1,6,1], "interfacelinalg__immutable_1_1mat__mult__upper__tri.html":[2,0,1,7], -"interfacelinalg__immutable_1_1mat__mult__upper__tri.html#a20ce53441ab78f4879a43849c1ed2447":[2,0,1,7,0], -"interfacelinalg__immutable_1_1mat__mult__upper__tri.html#a39d766d741737c85e6a7f9f60b36f855":[2,0,1,7,2], -"interfacelinalg__immutable_1_1mat__mult__upper__tri.html#a64fdf72e665743c6b8703b9dec595e3f":[2,0,1,7,3], -"interfacelinalg__immutable_1_1mat__mult__upper__tri.html#a6a23337b162b1b1343fac5c9fc4ecd5e":[2,0,1,7,1], +"interfacelinalg__immutable_1_1mat__mult__upper__tri.html":[1,0,3,7], +"interfacelinalg__immutable_1_1mat__solve__lower__tri.html":[1,0,3,8], "interfacelinalg__immutable_1_1mat__solve__lower__tri.html":[2,0,1,8], -"interfacelinalg__immutable_1_1mat__solve__lower__tri.html#a2dc5a090481dd5226c19214205a2c047":[2,0,1,8,3], -"interfacelinalg__immutable_1_1mat__solve__lower__tri.html#a4e1d7b1aaa7aa8eeff2c09a481cbb9fa":[2,0,1,8,2], -"interfacelinalg__immutable_1_1mat__solve__lower__tri.html#a9b40869b879ddc2e960a7ec46d17c09a":[2,0,1,8,0], -"interfacelinalg__immutable_1_1mat__solve__lower__tri.html#aa0c0c7078ffd02046021c6bd25375a58":[2,0,1,8,1], +"interfacelinalg__immutable_1_1mat__solve__upper__tri.html":[1,0,3,9], "interfacelinalg__immutable_1_1mat__solve__upper__tri.html":[2,0,1,9], -"interfacelinalg__immutable_1_1mat__solve__upper__tri.html#a59e1f0aed5b9fd5b952542d8e669fdbd":[2,0,1,9,1], -"interfacelinalg__immutable_1_1mat__solve__upper__tri.html#a8085ffccaa724ae8f60c897fa38691f7":[2,0,1,9,2], -"interfacelinalg__immutable_1_1mat__solve__upper__tri.html#a93e3f2a1097e88c8da32d6e13eb0472f":[2,0,1,9,3], -"interfacelinalg__immutable_1_1mat__solve__upper__tri.html#a97f528aee778d8ddfdcb52058d048de7":[2,0,1,9,0], "linalg_8h_source.html":[3,0,0,0], "linalg__basic_8f90_source.html":[3,0,1,0], "linalg__c__api_8f90_source.html":[3,0,1,1], @@ -187,41 +98,149 @@ var NAVTREEINDEX0 = "linalg__solve_8f90_source.html":[3,0,1,7], "linalg__sorting_8f90_source.html":[3,0,1,8], "namespacelinalg__c__api.html":[1,0,0], +"namespacelinalg__c__api.html#a01cf2129d7af3ddc8fb6e1fff7786ff1":[1,0,0,36], +"namespacelinalg__c__api.html#a056fb14e92f98c660573886c0ad940ff":[1,0,0,35], +"namespacelinalg__c__api.html#a0d12474b0ca7772e4ad4ebc7ce227315":[1,0,0,50], +"namespacelinalg__c__api.html#a13a75b6d7bce1788b5e286a879456347":[1,0,0,32], +"namespacelinalg__c__api.html#a13ed5d138ff59a9f649babc5c1dd9eab":[1,0,0,47], +"namespacelinalg__c__api.html#a1788fe3192429b2cfd3a169d879a6f0e":[1,0,0,24], +"namespacelinalg__c__api.html#a17bfa880bc9019cbd654d20cab263ce3":[1,0,0,49], +"namespacelinalg__c__api.html#a1af56ff742938c0be90fb34146b13365":[1,0,0,9], +"namespacelinalg__c__api.html#a2604ade114e67587300b3916846fc961":[1,0,0,27], +"namespacelinalg__c__api.html#a2a0c8ddfd134f3d57849925d359d53b2":[1,0,0,54], +"namespacelinalg__c__api.html#a2c691c114d54a8eb89ce2882d0557550":[1,0,0,44], +"namespacelinalg__c__api.html#a2c896885507a331ad89e579868da0fd3":[1,0,0,31], +"namespacelinalg__c__api.html#a307a6d5e27d90b28a38fba8c02e14461":[1,0,0,21], +"namespacelinalg__c__api.html#a315ef452fe9f00baa454dc930813fedc":[1,0,0,58], +"namespacelinalg__c__api.html#a3232c643af8f8615961c4b1bab422a4a":[1,0,0,3], +"namespacelinalg__c__api.html#a32548b9eb091164d51ed3793afee83e9":[1,0,0,37], +"namespacelinalg__c__api.html#a39bb26dcab43d8f54471af87af69e606":[1,0,0,29], +"namespacelinalg__c__api.html#a3e91c088c8d173e9b12c17b1ebc9bfa4":[1,0,0,23], +"namespacelinalg__c__api.html#a434338a38a5fde94d8df3119b169fd01":[1,0,0,25], +"namespacelinalg__c__api.html#a436b645816859aea4a8fbd55e733ab92":[1,0,0,55], +"namespacelinalg__c__api.html#a45eeb38b8a0d572fc25a7db98690f705":[1,0,0,56], +"namespacelinalg__c__api.html#a4b8c42819e069a18ec39c5ebb9ef8703":[1,0,0,28], +"namespacelinalg__c__api.html#a5146fcf6552a097e05d46afaf91f424e":[1,0,0,19], +"namespacelinalg__c__api.html#a5746e1736802b9a082057c7997325049":[1,0,0,5], +"namespacelinalg__c__api.html#a5b5758f439d34c765ff5285c21fa88c1":[1,0,0,2], +"namespacelinalg__c__api.html#a60244c1c8ef1ac3217a9efa69fdbd229":[1,0,0,40], +"namespacelinalg__c__api.html#a63372e9678f7052d17c8676324d6e7a7":[1,0,0,14], +"namespacelinalg__c__api.html#a69d0ec69152e04fc5f766dd7c6d23f98":[1,0,0,20], +"namespacelinalg__c__api.html#a6e47b549d59377db83a0eb27d739df8d":[1,0,0,38], +"namespacelinalg__c__api.html#a715855159abe740aff7bf95303a3f715":[1,0,0,22], +"namespacelinalg__c__api.html#a754866d88e140dbf618c1d85f016c633":[1,0,0,59], +"namespacelinalg__c__api.html#a7a72759b932b32e346a70cec542557ff":[1,0,0,51], +"namespacelinalg__c__api.html#a7a8e491e75d2d00911d0992b37aac43d":[1,0,0,52], +"namespacelinalg__c__api.html#a800b0d6ba6f8d812d8038dd06c0967a8":[1,0,0,1], +"namespacelinalg__c__api.html#a82fcbd45f4a92431587312560fbcc636":[1,0,0,7], +"namespacelinalg__c__api.html#a83a08022c84ac2e76f7d20486797bd33":[1,0,0,42], +"namespacelinalg__c__api.html#a846baffbc77d4348d7b15d3f83983a04":[1,0,0,45], +"namespacelinalg__c__api.html#a93920f1db884cbad9bfc335abe36bed4":[1,0,0,13], +"namespacelinalg__c__api.html#a9426f737c5d551a133f44e2d7cb98a1d":[1,0,0,17], +"namespacelinalg__c__api.html#a9868095d332ba323afce1cda4085dd8c":[1,0,0,34], +"namespacelinalg__c__api.html#a99d3ac7f90cad0c643dd8abff6592032":[1,0,0,0], +"namespacelinalg__c__api.html#a9be60e86103e09be4d19fd3728f5d64b":[1,0,0,18], +"namespacelinalg__c__api.html#aa7bc80d9671a82aafdfc9a8ab904cb22":[1,0,0,33], +"namespacelinalg__c__api.html#aae9625f2ff12a73b6007b429132a1531":[1,0,0,46], +"namespacelinalg__c__api.html#ab133f51c44eb244be0b6e966f5893259":[1,0,0,12], +"namespacelinalg__c__api.html#ab81f25f6835feac7a88250c9863a4120":[1,0,0,53], +"namespacelinalg__c__api.html#abdc93ffffffefdef839370da19f01430":[1,0,0,26], +"namespacelinalg__c__api.html#ac286fe9a7ed4d69ca30ecbe03959f209":[1,0,0,41], +"namespacelinalg__c__api.html#ac46bdb1315742f700571bf4f7c705ffd":[1,0,0,39], +"namespacelinalg__c__api.html#ad05206b75a9cd1c5a2bda147307ef2d5":[1,0,0,48], +"namespacelinalg__c__api.html#ad0eefe5cf5a74d6848bbde0e8bb22550":[1,0,0,30], +"namespacelinalg__c__api.html#adadfcde438cabd5b104b62f2541712d1":[1,0,0,10], +"namespacelinalg__c__api.html#ae5c0bda2e1ae3a4dbdaf6d0586247b4c":[1,0,0,4], +"namespacelinalg__c__api.html#ae866f3e174aed82f3fdfa3483ac91333":[1,0,0,8], +"namespacelinalg__c__api.html#ae9bcd3e2df3151a5d92da48973501f6b":[1,0,0,16], +"namespacelinalg__c__api.html#aeab30d9e07601b343f15bf03d8220044":[1,0,0,15], +"namespacelinalg__c__api.html#aeb63de65aa9a9bc040860b8f78dcd3fa":[1,0,0,60], +"namespacelinalg__c__api.html#af1d700238a8ab71b17ff8c15221a9e02":[1,0,0,43], +"namespacelinalg__c__api.html#af2ed46a8b1285ac08f0f86162288a865":[1,0,0,11], +"namespacelinalg__c__api.html#af8627c89c2201ae47c9cfac1d65abfd4":[1,0,0,57], +"namespacelinalg__c__api.html#afd21b0e476168de7eb9a6a5ef3a2e8b4":[1,0,0,6], "namespacelinalg__constants.html":[1,0,1], -"namespacelinalg__core.html":[2,0,0], +"namespacelinalg__constants.html#a045d4c1cc5fe061467924ad01bfe77c4":[1,0,1,10], +"namespacelinalg__constants.html#a252c96a6e7c24b40bf7ef96063824f01":[1,0,1,5], +"namespacelinalg__constants.html#a389e35467a5a18f90927d28fb12ddf70":[1,0,1,0], +"namespacelinalg__constants.html#a39da5de4ea671010ee5f1e358c991cee":[1,0,1,2], +"namespacelinalg__constants.html#a6607d2d2ac92fe5d902527519279e646":[1,0,1,8], +"namespacelinalg__constants.html#a8d5820c41090117b508a033309ad0870":[1,0,1,7], +"namespacelinalg__constants.html#aaafde862f4d348fecccdccc695e25622":[1,0,1,4], +"namespacelinalg__constants.html#abf9e3b763502c2b0af0cbf48b14c918f":[1,0,1,9], +"namespacelinalg__constants.html#ac7d8bace23640b21a6d8a960371eb732":[1,0,1,3], +"namespacelinalg__constants.html#ad4b52ca61ccf1199dead23faa80b9ac7":[1,0,1,6], +"namespacelinalg__constants.html#aee0ebff93d8751cc57a3e8e5965b1344":[1,0,1,1], "namespacelinalg__core.html":[1,0,2], -"namespacelinalg__immutable.html":[2,0,1], "namespacelinalg__immutable.html":[1,0,3], +"namespacelinalg__immutable.html#a4b09077ad1495833919bab84b144b297":[1,0,3,22], +"namespacelinalg__immutable.html#a5876e7f21f20679fd6c0c84768061a30":[1,0,3,15], +"namespacelinalg__immutable.html#a6236acadb527f7762e3e1c0ee3d9ca82":[1,0,3,24], +"namespacelinalg__immutable.html#a83eaeadc3a3cc5d81c46824174e5a90b":[1,0,3,17], +"namespacelinalg__immutable.html#a8f1ba0ce9f8fbece16a512145bbc197f":[1,0,3,21], +"namespacelinalg__immutable.html#a9648fd41cc3ce8ec40f67236d274f9a8":[1,0,3,23], +"namespacelinalg__immutable.html#a98f5b4e5de682d686cb763ab60fcde7f":[1,0,3,19], +"namespacelinalg__immutable.html#aaf39795f72fad79a38213893b850d793":[1,0,3,20], +"namespacelinalg__immutable.html#ab7abd8e3fd4170b5b5dfad4448a651c9":[1,0,3,18], +"namespacelinalg__immutable.html#aeb1f553973ae3e9b86cb30a1ca1f5700":[1,0,3,14], +"namespacelinalg__immutable.html#afb844327cadfdd08580c94cb1668c2a8":[1,0,3,16], "namespacemembers.html":[1,1,0], "namespacemembers_func.html":[1,1,1], "namespacemembers_vars.html":[1,1,2], "namespaces.html":[1,0], "pages.html":[], +"structlinalg__immutable_1_1eigen__results.html":[1,0,3,0], "structlinalg__immutable_1_1eigen__results.html":[2,0,1,0], "structlinalg__immutable_1_1eigen__results.html#a982607b9c3ff93504bb4524dcd31a442":[2,0,1,0,1], +"structlinalg__immutable_1_1eigen__results.html#a982607b9c3ff93504bb4524dcd31a442":[1,0,3,0,1], +"structlinalg__immutable_1_1eigen__results.html#abb60901ab160c6fd232cfb46ed0bf3cc":[1,0,3,0,0], "structlinalg__immutable_1_1eigen__results.html#abb60901ab160c6fd232cfb46ed0bf3cc":[2,0,1,0,0], +"structlinalg__immutable_1_1lu__results.html":[1,0,3,1], "structlinalg__immutable_1_1lu__results.html":[2,0,1,1], +"structlinalg__immutable_1_1lu__results.html#a7a11c264a8858527ebc021e609600cbb":[1,0,3,1,0], "structlinalg__immutable_1_1lu__results.html#a7a11c264a8858527ebc021e609600cbb":[2,0,1,1,0], "structlinalg__immutable_1_1lu__results.html#ab1af96c7808037f63563e1bf912c4dad":[2,0,1,1,2], +"structlinalg__immutable_1_1lu__results.html#ab1af96c7808037f63563e1bf912c4dad":[1,0,3,1,2], "structlinalg__immutable_1_1lu__results.html#ae1e1fd78123e04a2be4f1bfd25ddddb1":[2,0,1,1,1], +"structlinalg__immutable_1_1lu__results.html#ae1e1fd78123e04a2be4f1bfd25ddddb1":[1,0,3,1,1], +"structlinalg__immutable_1_1lu__results__cmplx.html":[1,0,3,2], "structlinalg__immutable_1_1lu__results__cmplx.html":[2,0,1,2], "structlinalg__immutable_1_1lu__results__cmplx.html#a0634e363082d3c94fab5d5c73755f4ae":[2,0,1,2,0], +"structlinalg__immutable_1_1lu__results__cmplx.html#a0634e363082d3c94fab5d5c73755f4ae":[1,0,3,2,0], "structlinalg__immutable_1_1lu__results__cmplx.html#a7488afe2004b11c8fed4c517400fde98":[2,0,1,2,2], +"structlinalg__immutable_1_1lu__results__cmplx.html#a7488afe2004b11c8fed4c517400fde98":[1,0,3,2,2], "structlinalg__immutable_1_1lu__results__cmplx.html#a99d03bc910361aab08d17fcc4aaa960d":[2,0,1,2,1], +"structlinalg__immutable_1_1lu__results__cmplx.html#a99d03bc910361aab08d17fcc4aaa960d":[1,0,3,2,1], "structlinalg__immutable_1_1qr__results.html":[2,0,1,10], +"structlinalg__immutable_1_1qr__results.html":[1,0,3,10], "structlinalg__immutable_1_1qr__results.html#a053899b9dffba08b5052544c13d4983c":[2,0,1,10,0], +"structlinalg__immutable_1_1qr__results.html#a053899b9dffba08b5052544c13d4983c":[1,0,3,10,0], +"structlinalg__immutable_1_1qr__results.html#a91547ec8def57c0cc59271ccf59b3a01":[1,0,3,10,1], "structlinalg__immutable_1_1qr__results.html#a91547ec8def57c0cc59271ccf59b3a01":[2,0,1,10,1], +"structlinalg__immutable_1_1qr__results.html#aeeea31b1fad256f5fcc2462b2990d56b":[1,0,3,10,2], "structlinalg__immutable_1_1qr__results.html#aeeea31b1fad256f5fcc2462b2990d56b":[2,0,1,10,2], "structlinalg__immutable_1_1qr__results__cmplx.html":[2,0,1,11], +"structlinalg__immutable_1_1qr__results__cmplx.html":[1,0,3,11], "structlinalg__immutable_1_1qr__results__cmplx.html#a782d54320ca646427702d5f2e0a9372f":[2,0,1,11,0], +"structlinalg__immutable_1_1qr__results__cmplx.html#a782d54320ca646427702d5f2e0a9372f":[1,0,3,11,0], "structlinalg__immutable_1_1qr__results__cmplx.html#a7fa839ced2d020c61550d5b6cff9bb69":[2,0,1,11,1], +"structlinalg__immutable_1_1qr__results__cmplx.html#a7fa839ced2d020c61550d5b6cff9bb69":[1,0,3,11,1], +"structlinalg__immutable_1_1qr__results__cmplx.html#a9382745395a25db425c5de89c33df2cd":[1,0,3,11,2], "structlinalg__immutable_1_1qr__results__cmplx.html#a9382745395a25db425c5de89c33df2cd":[2,0,1,11,2], "structlinalg__immutable_1_1svd__results.html":[2,0,1,12], +"structlinalg__immutable_1_1svd__results.html":[1,0,3,12], "structlinalg__immutable_1_1svd__results.html#a582822c9765048fcb8632d72a6ed506a":[2,0,1,12,1], +"structlinalg__immutable_1_1svd__results.html#a582822c9765048fcb8632d72a6ed506a":[1,0,3,12,1], "structlinalg__immutable_1_1svd__results.html#acbc05e1d170351bbfcd4cd1f089c81d8":[2,0,1,12,0], +"structlinalg__immutable_1_1svd__results.html#acbc05e1d170351bbfcd4cd1f089c81d8":[1,0,3,12,0], "structlinalg__immutable_1_1svd__results.html#af5c35f3392431179a5cb15d1cddf7cb1":[2,0,1,12,2], +"structlinalg__immutable_1_1svd__results.html#af5c35f3392431179a5cb15d1cddf7cb1":[1,0,3,12,2], "structlinalg__immutable_1_1svd__results__cmplx.html":[2,0,1,13], +"structlinalg__immutable_1_1svd__results__cmplx.html":[1,0,3,13], "structlinalg__immutable_1_1svd__results__cmplx.html#a66544dafaacf2b5465e6b1c55d804fff":[2,0,1,13,0], +"structlinalg__immutable_1_1svd__results__cmplx.html#a66544dafaacf2b5465e6b1c55d804fff":[1,0,3,13,0], +"structlinalg__immutable_1_1svd__results__cmplx.html#ae65cfdf6d19c3bbb3a7e425db266cb3c":[1,0,3,13,1], "structlinalg__immutable_1_1svd__results__cmplx.html#ae65cfdf6d19c3bbb3a7e425db266cb3c":[2,0,1,13,1], -"structlinalg__immutable_1_1svd__results__cmplx.html#af9e74638b38510fb24de3f3a6ea30de8":[2,0,1,13,2] +"structlinalg__immutable_1_1svd__results__cmplx.html#af9e74638b38510fb24de3f3a6ea30de8":[2,0,1,13,2], +"structlinalg__immutable_1_1svd__results__cmplx.html#af9e74638b38510fb24de3f3a6ea30de8":[1,0,3,13,2] }; diff --git a/doc/html/navtreeindex1.js b/doc/html/navtreeindex1.js new file mode 100644 index 00000000..bdf6a238 --- /dev/null +++ b/doc/html/navtreeindex1.js @@ -0,0 +1,75 @@ +var NAVTREEINDEX1 = +{ +"namespacelinalg__immutable.html#ab2a942c3a6762176fd4135c953699b7b":[1,0,3,37], +"namespacelinalg__immutable.html#ab2fe02a1d4a4f1b4b4099735a8536a44":[1,0,3,35], +"namespacelinalg__immutable.html#ab7abd8e3fd4170b5b5dfad4448a651c9":[1,0,3,18], +"namespacelinalg__immutable.html#ac278e04a89fc8e5e759cca3006b10a77":[1,0,3,32], +"namespacelinalg__immutable.html#ac2b66504ea3cb772e1bf44017d2fe864":[1,0,3,26], +"namespacelinalg__immutable.html#ad1fa7c5e331bf2f2f73b6dbf9ccf77c2":[1,0,3,49], +"namespacelinalg__immutable.html#ad3b277369fe90727b2012bc83ad9046f":[1,0,3,22], +"namespacelinalg__immutable.html#ad8ab2e4958204caafa6bf26d6a7c576e":[1,0,3,31], +"namespacelinalg__immutable.html#add83d93fee8c29482dc2e14694636bbf":[1,0,3,33], +"namespacelinalg__immutable.html#ae4599b0f5c5cbb89e77ee132b6be5386":[1,0,3,48], +"namespacelinalg__immutable.html#aeb1f553973ae3e9b86cb30a1ca1f5700":[1,0,3,14], +"namespacelinalg__immutable.html#af92354265e3c2d5fbaaea92527c2e66d":[1,0,3,44], +"namespacelinalg__immutable.html#afb844327cadfdd08580c94cb1668c2a8":[1,0,3,16], +"namespacemembers.html":[1,1,0], +"namespacemembers_func.html":[1,1,1], +"namespacemembers_vars.html":[1,1,2], +"namespaces.html":[1,0], +"pages.html":[], +"structlinalg__immutable_1_1eigen__results.html":[1,0,3,0], +"structlinalg__immutable_1_1eigen__results.html":[2,0,1,0], +"structlinalg__immutable_1_1eigen__results.html#a982607b9c3ff93504bb4524dcd31a442":[2,0,1,0,1], +"structlinalg__immutable_1_1eigen__results.html#a982607b9c3ff93504bb4524dcd31a442":[1,0,3,0,1], +"structlinalg__immutable_1_1eigen__results.html#abb60901ab160c6fd232cfb46ed0bf3cc":[1,0,3,0,0], +"structlinalg__immutable_1_1eigen__results.html#abb60901ab160c6fd232cfb46ed0bf3cc":[2,0,1,0,0], +"structlinalg__immutable_1_1lu__results.html":[2,0,1,1], +"structlinalg__immutable_1_1lu__results.html":[1,0,3,1], +"structlinalg__immutable_1_1lu__results.html#a7a11c264a8858527ebc021e609600cbb":[2,0,1,1,0], +"structlinalg__immutable_1_1lu__results.html#a7a11c264a8858527ebc021e609600cbb":[1,0,3,1,0], +"structlinalg__immutable_1_1lu__results.html#ab1af96c7808037f63563e1bf912c4dad":[1,0,3,1,2], +"structlinalg__immutable_1_1lu__results.html#ab1af96c7808037f63563e1bf912c4dad":[2,0,1,1,2], +"structlinalg__immutable_1_1lu__results.html#ae1e1fd78123e04a2be4f1bfd25ddddb1":[2,0,1,1,1], +"structlinalg__immutable_1_1lu__results.html#ae1e1fd78123e04a2be4f1bfd25ddddb1":[1,0,3,1,1], +"structlinalg__immutable_1_1lu__results__cmplx.html":[1,0,3,2], +"structlinalg__immutable_1_1lu__results__cmplx.html":[2,0,1,2], +"structlinalg__immutable_1_1lu__results__cmplx.html#a0634e363082d3c94fab5d5c73755f4ae":[2,0,1,2,0], +"structlinalg__immutable_1_1lu__results__cmplx.html#a0634e363082d3c94fab5d5c73755f4ae":[1,0,3,2,0], +"structlinalg__immutable_1_1lu__results__cmplx.html#a7488afe2004b11c8fed4c517400fde98":[2,0,1,2,2], +"structlinalg__immutable_1_1lu__results__cmplx.html#a7488afe2004b11c8fed4c517400fde98":[1,0,3,2,2], +"structlinalg__immutable_1_1lu__results__cmplx.html#a99d03bc910361aab08d17fcc4aaa960d":[1,0,3,2,1], +"structlinalg__immutable_1_1lu__results__cmplx.html#a99d03bc910361aab08d17fcc4aaa960d":[2,0,1,2,1], +"structlinalg__immutable_1_1qr__results.html":[2,0,1,10], +"structlinalg__immutable_1_1qr__results.html":[1,0,3,10], +"structlinalg__immutable_1_1qr__results.html#a053899b9dffba08b5052544c13d4983c":[2,0,1,10,0], +"structlinalg__immutable_1_1qr__results.html#a053899b9dffba08b5052544c13d4983c":[1,0,3,10,0], +"structlinalg__immutable_1_1qr__results.html#a91547ec8def57c0cc59271ccf59b3a01":[2,0,1,10,1], +"structlinalg__immutable_1_1qr__results.html#a91547ec8def57c0cc59271ccf59b3a01":[1,0,3,10,1], +"structlinalg__immutable_1_1qr__results.html#aeeea31b1fad256f5fcc2462b2990d56b":[2,0,1,10,2], +"structlinalg__immutable_1_1qr__results.html#aeeea31b1fad256f5fcc2462b2990d56b":[1,0,3,10,2], +"structlinalg__immutable_1_1qr__results__cmplx.html":[2,0,1,11], +"structlinalg__immutable_1_1qr__results__cmplx.html":[1,0,3,11], +"structlinalg__immutable_1_1qr__results__cmplx.html#a782d54320ca646427702d5f2e0a9372f":[2,0,1,11,0], +"structlinalg__immutable_1_1qr__results__cmplx.html#a782d54320ca646427702d5f2e0a9372f":[1,0,3,11,0], +"structlinalg__immutable_1_1qr__results__cmplx.html#a7fa839ced2d020c61550d5b6cff9bb69":[2,0,1,11,1], +"structlinalg__immutable_1_1qr__results__cmplx.html#a7fa839ced2d020c61550d5b6cff9bb69":[1,0,3,11,1], +"structlinalg__immutable_1_1qr__results__cmplx.html#a9382745395a25db425c5de89c33df2cd":[1,0,3,11,2], +"structlinalg__immutable_1_1qr__results__cmplx.html#a9382745395a25db425c5de89c33df2cd":[2,0,1,11,2], +"structlinalg__immutable_1_1svd__results.html":[1,0,3,12], +"structlinalg__immutable_1_1svd__results.html":[2,0,1,12], +"structlinalg__immutable_1_1svd__results.html#a582822c9765048fcb8632d72a6ed506a":[2,0,1,12,1], +"structlinalg__immutable_1_1svd__results.html#a582822c9765048fcb8632d72a6ed506a":[1,0,3,12,1], +"structlinalg__immutable_1_1svd__results.html#acbc05e1d170351bbfcd4cd1f089c81d8":[1,0,3,12,0], +"structlinalg__immutable_1_1svd__results.html#acbc05e1d170351bbfcd4cd1f089c81d8":[2,0,1,12,0], +"structlinalg__immutable_1_1svd__results.html#af5c35f3392431179a5cb15d1cddf7cb1":[1,0,3,12,2], +"structlinalg__immutable_1_1svd__results.html#af5c35f3392431179a5cb15d1cddf7cb1":[2,0,1,12,2], +"structlinalg__immutable_1_1svd__results__cmplx.html":[1,0,3,13], +"structlinalg__immutable_1_1svd__results__cmplx.html":[2,0,1,13], +"structlinalg__immutable_1_1svd__results__cmplx.html#a66544dafaacf2b5465e6b1c55d804fff":[1,0,3,13,0], +"structlinalg__immutable_1_1svd__results__cmplx.html#a66544dafaacf2b5465e6b1c55d804fff":[2,0,1,13,0], +"structlinalg__immutable_1_1svd__results__cmplx.html#ae65cfdf6d19c3bbb3a7e425db266cb3c":[1,0,3,13,1], +"structlinalg__immutable_1_1svd__results__cmplx.html#ae65cfdf6d19c3bbb3a7e425db266cb3c":[2,0,1,13,1], +"structlinalg__immutable_1_1svd__results__cmplx.html#af9e74638b38510fb24de3f3a6ea30de8":[2,0,1,13,2], +"structlinalg__immutable_1_1svd__results__cmplx.html#af9e74638b38510fb24de3f3a6ea30de8":[1,0,3,13,2] +}; diff --git a/doc/html/resize.js b/doc/html/resize.js index f5291d90..aaeb6fc0 100644 --- a/doc/html/resize.js +++ b/doc/html/resize.js @@ -1,58 +1,66 @@ /* - @licstart The following is the entire license notice for the - JavaScript code in this file. + @licstart The following is the entire license notice for the JavaScript code in this file. - Copyright (C) 1997-2017 by Dimitri van Heesch + The MIT License (MIT) - This program is free software; you can redistribute it and/or modify - it under the terms of the GNU General Public License as published by - the Free Software Foundation; either version 2 of the License, or - (at your option) any later version. + Copyright (C) 1997-2020 by Dimitri van Heesch - This program is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. + Permission is hereby granted, free of charge, to any person obtaining a copy of this software + and associated documentation files (the "Software"), to deal in the Software without restriction, + including without limitation the rights to use, copy, modify, merge, publish, distribute, + sublicense, and/or sell copies of the Software, and to permit persons to whom the Software is + furnished to do so, subject to the following conditions: - You should have received a copy of the GNU General Public License along - with this program; if not, write to the Free Software Foundation, Inc., - 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. + The above copyright notice and this permission notice shall be included in all copies or + substantial portions of the Software. - @licend The above is the entire license notice - for the JavaScript code in this file + THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING + BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND + NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, + DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, + OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. + + @licend The above is the entire license notice for the JavaScript code in this file */ +var once=1; function initResizable() { var cookie_namespace = 'doxygen'; - var sidenav,navtree,content,header,collapsed,collapsedWidth=0,barWidth=6,desktop_vp=768,titleHeight; + var sidenav,navtree,content,header,barWidth=6,desktop_vp=768,titleHeight; - function readCookie(cookie) + function readSetting(cookie) { - var myCookie = cookie_namespace+"_"+cookie+"="; - if (document.cookie) { - var index = document.cookie.indexOf(myCookie); - if (index != -1) { - var valStart = index + myCookie.length; - var valEnd = document.cookie.indexOf(";", valStart); - if (valEnd == -1) { - valEnd = document.cookie.length; + if (window.chrome) { + var val = localStorage.getItem(cookie_namespace+'_width'); + if (val) return val; + } else { + var myCookie = cookie_namespace+"_"+cookie+"="; + if (document.cookie) { + var index = document.cookie.indexOf(myCookie); + if (index != -1) { + var valStart = index + myCookie.length; + var valEnd = document.cookie.indexOf(";", valStart); + if (valEnd == -1) { + valEnd = document.cookie.length; + } + var val = document.cookie.substring(valStart, valEnd); + return val; } - var val = document.cookie.substring(valStart, valEnd); - return val; } } - return 0; + return 250; } - function writeCookie(cookie, val, expiration) + function writeSetting(cookie, val) { - if (val==undefined) return; - if (expiration == null) { + if (window.chrome) { + localStorage.setItem(cookie_namespace+"_width",val); + } else { var date = new Date(); date.setTime(date.getTime()+(10*365*24*60*60*1000)); // default expiration is one week expiration = date.toGMTString(); + document.cookie = cookie_namespace + "_" + cookie + "=" + val + "; SameSite=Lax; expires=" + expiration+"; path=/"; } - document.cookie = cookie_namespace + "_" + cookie + "=" + val + "; expires=" + expiration+"; path=/"; } function resizeWidth() @@ -60,13 +68,19 @@ function initResizable() var windowWidth = $(window).width() + "px"; var sidenavWidth = $(sidenav).outerWidth(); content.css({marginLeft:parseInt(sidenavWidth)+"px"}); - writeCookie('width',sidenavWidth-barWidth, null); + if (typeof page_layout!=='undefined' && page_layout==1) { + footer.css({marginLeft:parseInt(sidenavWidth)+"px"}); + } + writeSetting('width',sidenavWidth-barWidth); } function restoreWidth(navWidth) { var windowWidth = $(window).width() + "px"; content.css({marginLeft:parseInt(navWidth)+barWidth+"px"}); + if (typeof page_layout!=='undefined' && page_layout==1) { + footer.css({marginLeft:parseInt(navWidth)+barWidth+"px"}); + } sidenav.css({width:navWidth + "px"}); } @@ -74,36 +88,38 @@ function initResizable() { var headerHeight = header.outerHeight(); var footerHeight = footer.outerHeight(); - var windowHeight = $(window).height() - headerHeight - footerHeight; - content.css({height:windowHeight + "px"}); - navtree.css({height:windowHeight + "px"}); - sidenav.css({height:windowHeight + "px"}); - var width=$(window).width(); - if (width!=collapsedWidth) { - if (width=desktop_vp) { - if (!collapsed) { - collapseExpand(); - } - } else if (width>desktop_vp && collapsedWidth0) { - restoreWidth(0); - collapsed=true; + newWidth=0; } else { - var width = readCookie('width'); - if (width>200 && width<$(window).width()) { restoreWidth(width); } else { restoreWidth(200); } - collapsed=false; + var width = readSetting('width'); + newWidth = (width>250 && width<$(window).width()) ? width : 250; } + restoreWidth(newWidth); + var sidenavWidth = $(sidenav).outerWidth(); + writeSetting('width',sidenavWidth-barWidth); } header = $("#top"); @@ -122,7 +138,7 @@ function initResizable() $('#nav-sync').css({ right:'34px' }); barWidth=20; } - var width = readCookie('width'); + var width = readSetting('width'); if (width) { restoreWidth(width); } else { resizeWidth(); } resizeHeight(); var url = location.href; @@ -130,7 +146,10 @@ function initResizable() if (i>=0) window.location.hash=url.substr(i); var _preventDefault = function(evt) { evt.preventDefault(); }; $("#splitbar").bind("dragstart", _preventDefault).bind("selectstart", _preventDefault); - $(".ui-resizable-handle").dblclick(collapseExpand); + if (once) { + $(".ui-resizable-handle").dblclick(collapseExpand); + once=0 + } $(window).on('load',resizeHeight); } /* @license-end */ diff --git a/doc/html/search/all_1.js b/doc/html/search/all_1.js index d5b9a563..fa28fb28 100644 --- a/doc/html/search/all_1.js +++ b/doc/html/search/all_1.js @@ -1,5 +1,5 @@ var searchData= [ - ['det_3',['det',['../interfacelinalg__core_1_1det.html',1,'linalg_core']]], - ['diag_5fmtx_5fmult_4',['diag_mtx_mult',['../interfacelinalg__core_1_1diag__mtx__mult.html',1,'linalg_core']]] + ['det_0',['det',['../interfacelinalg__core_1_1det.html',1,'linalg_core']]], + ['diag_5fmtx_5fmult_1',['diag_mtx_mult',['../interfacelinalg__core_1_1diag__mtx__mult.html',1,'linalg_core']]] ]; diff --git a/doc/html/search/all_2.js b/doc/html/search/all_2.js index e1bc0483..269daff0 100644 --- a/doc/html/search/all_2.js +++ b/doc/html/search/all_2.js @@ -1,5 +1,5 @@ var searchData= [ - ['eigen_5',['eigen',['../interfacelinalg__core_1_1eigen.html',1,'linalg_core']]], - ['eigen_5fresults_6',['eigen_results',['../structlinalg__immutable_1_1eigen__results.html',1,'linalg_immutable']]] + ['eigen_0',['eigen',['../interfacelinalg__core_1_1eigen.html',1,'linalg_core']]], + ['eigen_5fresults_1',['eigen_results',['../structlinalg__immutable_1_1eigen__results.html',1,'linalg_immutable']]] ]; diff --git a/doc/html/search/all_3.js b/doc/html/search/all_3.js index b2e670c7..28f50b33 100644 --- a/doc/html/search/all_3.js +++ b/doc/html/search/all_3.js @@ -1,5 +1,5 @@ var searchData= [ - ['form_5flu_7',['form_lu',['../interfacelinalg__core_1_1form__lu.html',1,'linalg_core']]], - ['form_5fqr_8',['form_qr',['../interfacelinalg__core_1_1form__qr.html',1,'linalg_core']]] + ['form_5flu_0',['form_lu',['../interfacelinalg__core_1_1form__lu.html',1,'linalg_core']]], + ['form_5fqr_1',['form_qr',['../interfacelinalg__core_1_1form__qr.html',1,'linalg_core']]] ]; diff --git a/doc/html/search/all_4.js b/doc/html/search/all_4.js index 99c99b3d..fea70413 100644 --- a/doc/html/search/all_4.js +++ b/doc/html/search/all_4.js @@ -1,4 +1,4 @@ var searchData= [ - ['hermitian_5ftranspose_9',['hermitian_transpose',['../namespacelinalg__constants.html#a389e35467a5a18f90927d28fb12ddf70',1,'linalg_constants']]] + ['hermitian_5ftranspose_0',['hermitian_transpose',['../namespacelinalg__constants.html#a389e35467a5a18f90927d28fb12ddf70',1,'linalg_constants']]] ]; diff --git a/doc/html/search/all_5.js b/doc/html/search/all_5.js index ce44e050..7cf2a492 100644 --- a/doc/html/search/all_5.js +++ b/doc/html/search/all_5.js @@ -1,4 +1,4 @@ var searchData= [ - ['identity_10',['identity',['../namespacelinalg__immutable.html#aeb1f553973ae3e9b86cb30a1ca1f5700',1,'linalg_immutable']]] + ['identity_0',['identity',['../namespacelinalg__immutable.html#aeb1f553973ae3e9b86cb30a1ca1f5700',1,'linalg_immutable']]] ]; diff --git a/doc/html/search/all_6.js b/doc/html/search/all_6.js index 1b86236a..9f45affb 100644 --- a/doc/html/search/all_6.js +++ b/doc/html/search/all_6.js @@ -1,79 +1,81 @@ var searchData= [ - ['l_11',['l',['../structlinalg__immutable_1_1lu__results.html#a7a11c264a8858527ebc021e609600cbb',1,'linalg_immutable::lu_results::l()'],['../structlinalg__immutable_1_1lu__results__cmplx.html#a0634e363082d3c94fab5d5c73755f4ae',1,'linalg_immutable::lu_results_cmplx::l()']]], - ['la_5farray_5fsize_5ferror_12',['la_array_size_error',['../namespacelinalg__constants.html#aee0ebff93d8751cc57a3e8e5965b1344',1,'linalg_constants']]], - ['la_5fcholesky_5ffactor_13',['la_cholesky_factor',['../namespacelinalg__c__api.html#a99d3ac7f90cad0c643dd8abff6592032',1,'linalg_c_api']]], - ['la_5fcholesky_5ffactor_5fcmplx_14',['la_cholesky_factor_cmplx',['../namespacelinalg__c__api.html#a800b0d6ba6f8d812d8038dd06c0967a8',1,'linalg_c_api']]], - ['la_5fcholesky_5frank1_5fdowndate_15',['la_cholesky_rank1_downdate',['../namespacelinalg__c__api.html#a5b5758f439d34c765ff5285c21fa88c1',1,'linalg_c_api']]], - ['la_5fcholesky_5frank1_5fdowndate_5fcmplx_16',['la_cholesky_rank1_downdate_cmplx',['../namespacelinalg__c__api.html#a3232c643af8f8615961c4b1bab422a4a',1,'linalg_c_api']]], - ['la_5fcholesky_5frank1_5fupdate_17',['la_cholesky_rank1_update',['../namespacelinalg__c__api.html#ae5c0bda2e1ae3a4dbdaf6d0586247b4c',1,'linalg_c_api']]], - ['la_5fcholesky_5frank1_5fupdate_5fcmplx_18',['la_cholesky_rank1_update_cmplx',['../namespacelinalg__c__api.html#a5746e1736802b9a082057c7997325049',1,'linalg_c_api']]], - ['la_5fconvergence_5ferror_19',['la_convergence_error',['../namespacelinalg__constants.html#a39da5de4ea671010ee5f1e358c991cee',1,'linalg_constants']]], - ['la_5fdet_20',['la_det',['../namespacelinalg__c__api.html#afd21b0e476168de7eb9a6a5ef3a2e8b4',1,'linalg_c_api']]], - ['la_5fdet_5fcmplx_21',['la_det_cmplx',['../namespacelinalg__c__api.html#a82fcbd45f4a92431587312560fbcc636',1,'linalg_c_api']]], - ['la_5fdiag_5fmtx_5fmult_22',['la_diag_mtx_mult',['../namespacelinalg__c__api.html#ae866f3e174aed82f3fdfa3483ac91333',1,'linalg_c_api']]], - ['la_5fdiag_5fmtx_5fmult_5fcmplx_23',['la_diag_mtx_mult_cmplx',['../namespacelinalg__c__api.html#a1af56ff742938c0be90fb34146b13365',1,'linalg_c_api']]], - ['la_5feigen_5fasymm_24',['la_eigen_asymm',['../namespacelinalg__c__api.html#af2ed46a8b1285ac08f0f86162288a865',1,'linalg_c_api']]], - ['la_5feigen_5fcmplx_25',['la_eigen_cmplx',['../namespacelinalg__c__api.html#ab133f51c44eb244be0b6e966f5893259',1,'linalg_c_api']]], - ['la_5feigen_5fgen_26',['la_eigen_gen',['../namespacelinalg__c__api.html#a93920f1db884cbad9bfc335abe36bed4',1,'linalg_c_api']]], - ['la_5feigen_5fsymm_27',['la_eigen_symm',['../namespacelinalg__c__api.html#a63372e9678f7052d17c8676324d6e7a7',1,'linalg_c_api']]], - ['la_5fform_5flu_28',['la_form_lu',['../namespacelinalg__c__api.html#aeab30d9e07601b343f15bf03d8220044',1,'linalg_c_api']]], - ['la_5fform_5flu_5fcmplx_29',['la_form_lu_cmplx',['../namespacelinalg__c__api.html#ae9bcd3e2df3151a5d92da48973501f6b',1,'linalg_c_api']]], - ['la_5fform_5fqr_30',['la_form_qr',['../namespacelinalg__c__api.html#a9426f737c5d551a133f44e2d7cb98a1d',1,'linalg_c_api']]], - ['la_5fform_5fqr_5fcmplx_31',['la_form_qr_cmplx',['../namespacelinalg__c__api.html#a9be60e86103e09be4d19fd3728f5d64b',1,'linalg_c_api']]], - ['la_5fform_5fqr_5fcmplx_5fpvt_32',['la_form_qr_cmplx_pvt',['../namespacelinalg__c__api.html#a5146fcf6552a097e05d46afaf91f424e',1,'linalg_c_api']]], - ['la_5fform_5fqr_5fpvt_33',['la_form_qr_pvt',['../namespacelinalg__c__api.html#a69d0ec69152e04fc5f766dd7c6d23f98',1,'linalg_c_api']]], - ['la_5finvalid_5finput_5ferror_34',['la_invalid_input_error',['../namespacelinalg__constants.html#ac7d8bace23640b21a6d8a960371eb732',1,'linalg_constants']]], - ['la_5finvalid_5foperation_5ferror_35',['la_invalid_operation_error',['../namespacelinalg__constants.html#aaafde862f4d348fecccdccc695e25622',1,'linalg_constants']]], - ['la_5finverse_36',['la_inverse',['../namespacelinalg__c__api.html#a307a6d5e27d90b28a38fba8c02e14461',1,'linalg_c_api']]], - ['la_5finverse_5fcmplx_37',['la_inverse_cmplx',['../namespacelinalg__c__api.html#a715855159abe740aff7bf95303a3f715',1,'linalg_c_api']]], - ['la_5flu_5ffactor_38',['la_lu_factor',['../namespacelinalg__c__api.html#a3e91c088c8d173e9b12c17b1ebc9bfa4',1,'linalg_c_api']]], - ['la_5flu_5ffactor_5fcmplx_39',['la_lu_factor_cmplx',['../namespacelinalg__c__api.html#a1788fe3192429b2cfd3a169d879a6f0e',1,'linalg_c_api']]], - ['la_5fmatrix_5fformat_5ferror_40',['la_matrix_format_error',['../namespacelinalg__constants.html#a252c96a6e7c24b40bf7ef96063824f01',1,'linalg_constants']]], - ['la_5fmtx_5fmult_41',['la_mtx_mult',['../namespacelinalg__c__api.html#a434338a38a5fde94d8df3119b169fd01',1,'linalg_c_api']]], - ['la_5fmtx_5fmult_5fcmplx_42',['la_mtx_mult_cmplx',['../namespacelinalg__c__api.html#abdc93ffffffefdef839370da19f01430',1,'linalg_c_api']]], - ['la_5fmult_5fqr_43',['la_mult_qr',['../namespacelinalg__c__api.html#a2604ade114e67587300b3916846fc961',1,'linalg_c_api']]], - ['la_5fmult_5fqr_5fcmplx_44',['la_mult_qr_cmplx',['../namespacelinalg__c__api.html#a4b8c42819e069a18ec39c5ebb9ef8703',1,'linalg_c_api']]], - ['la_5fno_5ferror_45',['la_no_error',['../namespacelinalg__constants.html#ad4b52ca61ccf1199dead23faa80b9ac7',1,'linalg_constants']]], - ['la_5fout_5fof_5fmemory_5ferror_46',['la_out_of_memory_error',['../namespacelinalg__constants.html#a8d5820c41090117b508a033309ad0870',1,'linalg_constants']]], - ['la_5fpinverse_47',['la_pinverse',['../namespacelinalg__c__api.html#a39bb26dcab43d8f54471af87af69e606',1,'linalg_c_api']]], - ['la_5fpinverse_5fcmplx_48',['la_pinverse_cmplx',['../namespacelinalg__c__api.html#ad0eefe5cf5a74d6848bbde0e8bb22550',1,'linalg_c_api']]], - ['la_5fqr_5ffactor_49',['la_qr_factor',['../namespacelinalg__c__api.html#a2c896885507a331ad89e579868da0fd3',1,'linalg_c_api']]], - ['la_5fqr_5ffactor_5fcmplx_50',['la_qr_factor_cmplx',['../namespacelinalg__c__api.html#a13a75b6d7bce1788b5e286a879456347',1,'linalg_c_api']]], - ['la_5fqr_5ffactor_5fcmplx_5fpvt_51',['la_qr_factor_cmplx_pvt',['../namespacelinalg__c__api.html#aa7bc80d9671a82aafdfc9a8ab904cb22',1,'linalg_c_api']]], - ['la_5fqr_5ffactor_5fpvt_52',['la_qr_factor_pvt',['../namespacelinalg__c__api.html#a9868095d332ba323afce1cda4085dd8c',1,'linalg_c_api']]], - ['la_5fqr_5frank1_5fupdate_53',['la_qr_rank1_update',['../namespacelinalg__c__api.html#a056fb14e92f98c660573886c0ad940ff',1,'linalg_c_api']]], - ['la_5fqr_5frank1_5fupdate_5fcmplx_54',['la_qr_rank1_update_cmplx',['../namespacelinalg__c__api.html#a01cf2129d7af3ddc8fb6e1fff7786ff1',1,'linalg_c_api']]], - ['la_5frank_55',['la_rank',['../namespacelinalg__c__api.html#a32548b9eb091164d51ed3793afee83e9',1,'linalg_c_api']]], - ['la_5frank1_5fupdate_56',['la_rank1_update',['../namespacelinalg__c__api.html#a6e47b549d59377db83a0eb27d739df8d',1,'linalg_c_api']]], - ['la_5frank1_5fupdate_5fcmplx_57',['la_rank1_update_cmplx',['../namespacelinalg__c__api.html#ac46bdb1315742f700571bf4f7c705ffd',1,'linalg_c_api']]], - ['la_5frank_5fcmplx_58',['la_rank_cmplx',['../namespacelinalg__c__api.html#a60244c1c8ef1ac3217a9efa69fdbd229',1,'linalg_c_api']]], - ['la_5fsingular_5fmatrix_5ferror_59',['la_singular_matrix_error',['../namespacelinalg__constants.html#a6607d2d2ac92fe5d902527519279e646',1,'linalg_constants']]], - ['la_5fsolve_5fcholesky_60',['la_solve_cholesky',['../namespacelinalg__c__api.html#ac286fe9a7ed4d69ca30ecbe03959f209',1,'linalg_c_api']]], - ['la_5fsolve_5fcholesky_5fcmplx_61',['la_solve_cholesky_cmplx',['../namespacelinalg__c__api.html#a83a08022c84ac2e76f7d20486797bd33',1,'linalg_c_api']]], - ['la_5fsolve_5fleast_5fsquares_62',['la_solve_least_squares',['../namespacelinalg__c__api.html#af1d700238a8ab71b17ff8c15221a9e02',1,'linalg_c_api']]], - ['la_5fsolve_5fleast_5fsquares_5fcmplx_63',['la_solve_least_squares_cmplx',['../namespacelinalg__c__api.html#a2c691c114d54a8eb89ce2882d0557550',1,'linalg_c_api']]], - ['la_5fsolve_5flu_64',['la_solve_lu',['../namespacelinalg__c__api.html#a846baffbc77d4348d7b15d3f83983a04',1,'linalg_c_api']]], - ['la_5fsolve_5flu_5fcmplx_65',['la_solve_lu_cmplx',['../namespacelinalg__c__api.html#aae9625f2ff12a73b6007b429132a1531',1,'linalg_c_api']]], - ['la_5fsolve_5fqr_66',['la_solve_qr',['../namespacelinalg__c__api.html#a13ed5d138ff59a9f649babc5c1dd9eab',1,'linalg_c_api']]], - ['la_5fsolve_5fqr_5fcmplx_67',['la_solve_qr_cmplx',['../namespacelinalg__c__api.html#ad05206b75a9cd1c5a2bda147307ef2d5',1,'linalg_c_api']]], - ['la_5fsolve_5fqr_5fcmplx_5fpvt_68',['la_solve_qr_cmplx_pvt',['../namespacelinalg__c__api.html#a17bfa880bc9019cbd654d20cab263ce3',1,'linalg_c_api']]], - ['la_5fsolve_5fqr_5fpvt_69',['la_solve_qr_pvt',['../namespacelinalg__c__api.html#a0d12474b0ca7772e4ad4ebc7ce227315',1,'linalg_c_api']]], - ['la_5fsolve_5ftri_5fmtx_70',['la_solve_tri_mtx',['../namespacelinalg__c__api.html#a7a72759b932b32e346a70cec542557ff',1,'linalg_c_api']]], - ['la_5fsolve_5ftri_5fmtx_5fcmplx_71',['la_solve_tri_mtx_cmplx',['../namespacelinalg__c__api.html#a7a8e491e75d2d00911d0992b37aac43d',1,'linalg_c_api']]], - ['la_5fsort_5feigen_72',['la_sort_eigen',['../namespacelinalg__c__api.html#ab81f25f6835feac7a88250c9863a4120',1,'linalg_c_api']]], - ['la_5fsort_5feigen_5fcmplx_73',['la_sort_eigen_cmplx',['../namespacelinalg__c__api.html#a2a0c8ddfd134f3d57849925d359d53b2',1,'linalg_c_api']]], - ['la_5fsvd_74',['la_svd',['../namespacelinalg__c__api.html#a436b645816859aea4a8fbd55e733ab92',1,'linalg_c_api']]], - ['la_5fsvd_5fcmplx_75',['la_svd_cmplx',['../namespacelinalg__c__api.html#a45eeb38b8a0d572fc25a7db98690f705',1,'linalg_c_api']]], - ['la_5ftrace_76',['la_trace',['../namespacelinalg__c__api.html#af8627c89c2201ae47c9cfac1d65abfd4',1,'linalg_c_api']]], - ['la_5ftrace_5fcmplx_77',['la_trace_cmplx',['../namespacelinalg__c__api.html#a315ef452fe9f00baa454dc930813fedc',1,'linalg_c_api']]], - ['la_5ftri_5fmtx_5fmult_78',['la_tri_mtx_mult',['../namespacelinalg__c__api.html#a754866d88e140dbf618c1d85f016c633',1,'linalg_c_api']]], - ['la_5ftri_5fmtx_5fmult_5fcmplx_79',['la_tri_mtx_mult_cmplx',['../namespacelinalg__c__api.html#aeb63de65aa9a9bc040860b8f78dcd3fa',1,'linalg_c_api']]], - ['linalg_5fc_5fapi_80',['linalg_c_api',['../namespacelinalg__c__api.html',1,'']]], - ['linalg_5fconstants_81',['linalg_constants',['../namespacelinalg__constants.html',1,'']]], - ['linalg_5fcore_82',['linalg_core',['../namespacelinalg__core.html',1,'']]], - ['linalg_5fimmutable_83',['linalg_immutable',['../namespacelinalg__immutable.html',1,'']]], - ['lu_5ffactor_84',['lu_factor',['../interfacelinalg__core_1_1lu__factor.html',1,'linalg_core']]], - ['lu_5fresults_85',['lu_results',['../structlinalg__immutable_1_1lu__results.html',1,'linalg_immutable']]], - ['lu_5fresults_5fcmplx_86',['lu_results_cmplx',['../structlinalg__immutable_1_1lu__results__cmplx.html',1,'linalg_immutable']]] + ['l_0',['l',['../structlinalg__immutable_1_1lu__results.html#a7a11c264a8858527ebc021e609600cbb',1,'linalg_immutable::lu_results::l()'],['../structlinalg__immutable_1_1lu__results__cmplx.html#a0634e363082d3c94fab5d5c73755f4ae',1,'linalg_immutable::lu_results_cmplx::l()']]], + ['la_5farray_5fsize_5ferror_1',['la_array_size_error',['../namespacelinalg__constants.html#aee0ebff93d8751cc57a3e8e5965b1344',1,'linalg_constants']]], + ['la_5fcholesky_5ffactor_2',['la_cholesky_factor',['../namespacelinalg__c__api.html#a99d3ac7f90cad0c643dd8abff6592032',1,'linalg_c_api']]], + ['la_5fcholesky_5ffactor_5fcmplx_3',['la_cholesky_factor_cmplx',['../namespacelinalg__c__api.html#a800b0d6ba6f8d812d8038dd06c0967a8',1,'linalg_c_api']]], + ['la_5fcholesky_5frank1_5fdowndate_4',['la_cholesky_rank1_downdate',['../namespacelinalg__c__api.html#a5b5758f439d34c765ff5285c21fa88c1',1,'linalg_c_api']]], + ['la_5fcholesky_5frank1_5fdowndate_5fcmplx_5',['la_cholesky_rank1_downdate_cmplx',['../namespacelinalg__c__api.html#a3232c643af8f8615961c4b1bab422a4a',1,'linalg_c_api']]], + ['la_5fcholesky_5frank1_5fupdate_6',['la_cholesky_rank1_update',['../namespacelinalg__c__api.html#ae5c0bda2e1ae3a4dbdaf6d0586247b4c',1,'linalg_c_api']]], + ['la_5fcholesky_5frank1_5fupdate_5fcmplx_7',['la_cholesky_rank1_update_cmplx',['../namespacelinalg__c__api.html#a5746e1736802b9a082057c7997325049',1,'linalg_c_api']]], + ['la_5fconvergence_5ferror_8',['la_convergence_error',['../namespacelinalg__constants.html#a39da5de4ea671010ee5f1e358c991cee',1,'linalg_constants']]], + ['la_5fdet_9',['la_det',['../namespacelinalg__c__api.html#afd21b0e476168de7eb9a6a5ef3a2e8b4',1,'linalg_c_api']]], + ['la_5fdet_5fcmplx_10',['la_det_cmplx',['../namespacelinalg__c__api.html#a82fcbd45f4a92431587312560fbcc636',1,'linalg_c_api']]], + ['la_5fdiag_5fmtx_5fmult_11',['la_diag_mtx_mult',['../namespacelinalg__c__api.html#ae866f3e174aed82f3fdfa3483ac91333',1,'linalg_c_api']]], + ['la_5fdiag_5fmtx_5fmult_5fcmplx_12',['la_diag_mtx_mult_cmplx',['../namespacelinalg__c__api.html#a1af56ff742938c0be90fb34146b13365',1,'linalg_c_api']]], + ['la_5fdiag_5fmtx_5fmult_5fmixed_13',['la_diag_mtx_mult_mixed',['../namespacelinalg__c__api.html#adadfcde438cabd5b104b62f2541712d1',1,'linalg_c_api']]], + ['la_5feigen_5fasymm_14',['la_eigen_asymm',['../namespacelinalg__c__api.html#af2ed46a8b1285ac08f0f86162288a865',1,'linalg_c_api']]], + ['la_5feigen_5fcmplx_15',['la_eigen_cmplx',['../namespacelinalg__c__api.html#ab133f51c44eb244be0b6e966f5893259',1,'linalg_c_api']]], + ['la_5feigen_5fgen_16',['la_eigen_gen',['../namespacelinalg__c__api.html#a93920f1db884cbad9bfc335abe36bed4',1,'linalg_c_api']]], + ['la_5feigen_5fsymm_17',['la_eigen_symm',['../namespacelinalg__c__api.html#a63372e9678f7052d17c8676324d6e7a7',1,'linalg_c_api']]], + ['la_5fform_5flu_18',['la_form_lu',['../namespacelinalg__c__api.html#aeab30d9e07601b343f15bf03d8220044',1,'linalg_c_api']]], + ['la_5fform_5flu_5fcmplx_19',['la_form_lu_cmplx',['../namespacelinalg__c__api.html#ae9bcd3e2df3151a5d92da48973501f6b',1,'linalg_c_api']]], + ['la_5fform_5fqr_20',['la_form_qr',['../namespacelinalg__c__api.html#a9426f737c5d551a133f44e2d7cb98a1d',1,'linalg_c_api']]], + ['la_5fform_5fqr_5fcmplx_21',['la_form_qr_cmplx',['../namespacelinalg__c__api.html#a9be60e86103e09be4d19fd3728f5d64b',1,'linalg_c_api']]], + ['la_5fform_5fqr_5fcmplx_5fpvt_22',['la_form_qr_cmplx_pvt',['../namespacelinalg__c__api.html#a5146fcf6552a097e05d46afaf91f424e',1,'linalg_c_api']]], + ['la_5fform_5fqr_5fpvt_23',['la_form_qr_pvt',['../namespacelinalg__c__api.html#a69d0ec69152e04fc5f766dd7c6d23f98',1,'linalg_c_api']]], + ['la_5finvalid_5finput_5ferror_24',['la_invalid_input_error',['../namespacelinalg__constants.html#ac7d8bace23640b21a6d8a960371eb732',1,'linalg_constants']]], + ['la_5finvalid_5foperation_5ferror_25',['la_invalid_operation_error',['../namespacelinalg__constants.html#aaafde862f4d348fecccdccc695e25622',1,'linalg_constants']]], + ['la_5finverse_26',['la_inverse',['../namespacelinalg__c__api.html#a307a6d5e27d90b28a38fba8c02e14461',1,'linalg_c_api']]], + ['la_5finverse_5fcmplx_27',['la_inverse_cmplx',['../namespacelinalg__c__api.html#a715855159abe740aff7bf95303a3f715',1,'linalg_c_api']]], + ['la_5flu_5ffactor_28',['la_lu_factor',['../namespacelinalg__c__api.html#a3e91c088c8d173e9b12c17b1ebc9bfa4',1,'linalg_c_api']]], + ['la_5flu_5ffactor_5fcmplx_29',['la_lu_factor_cmplx',['../namespacelinalg__c__api.html#a1788fe3192429b2cfd3a169d879a6f0e',1,'linalg_c_api']]], + ['la_5fmatrix_5fformat_5ferror_30',['la_matrix_format_error',['../namespacelinalg__constants.html#a252c96a6e7c24b40bf7ef96063824f01',1,'linalg_constants']]], + ['la_5fmtx_5fmult_31',['la_mtx_mult',['../namespacelinalg__c__api.html#a434338a38a5fde94d8df3119b169fd01',1,'linalg_c_api']]], + ['la_5fmtx_5fmult_5fcmplx_32',['la_mtx_mult_cmplx',['../namespacelinalg__c__api.html#abdc93ffffffefdef839370da19f01430',1,'linalg_c_api']]], + ['la_5fmult_5fqr_33',['la_mult_qr',['../namespacelinalg__c__api.html#a2604ade114e67587300b3916846fc961',1,'linalg_c_api']]], + ['la_5fmult_5fqr_5fcmplx_34',['la_mult_qr_cmplx',['../namespacelinalg__c__api.html#a4b8c42819e069a18ec39c5ebb9ef8703',1,'linalg_c_api']]], + ['la_5fno_5ferror_35',['la_no_error',['../namespacelinalg__constants.html#ad4b52ca61ccf1199dead23faa80b9ac7',1,'linalg_constants']]], + ['la_5fout_5fof_5fmemory_5ferror_36',['la_out_of_memory_error',['../namespacelinalg__constants.html#a8d5820c41090117b508a033309ad0870',1,'linalg_constants']]], + ['la_5fpinverse_37',['la_pinverse',['../namespacelinalg__c__api.html#a39bb26dcab43d8f54471af87af69e606',1,'linalg_c_api']]], + ['la_5fpinverse_5fcmplx_38',['la_pinverse_cmplx',['../namespacelinalg__c__api.html#ad0eefe5cf5a74d6848bbde0e8bb22550',1,'linalg_c_api']]], + ['la_5fqr_5ffactor_39',['la_qr_factor',['../namespacelinalg__c__api.html#a2c896885507a331ad89e579868da0fd3',1,'linalg_c_api']]], + ['la_5fqr_5ffactor_5fcmplx_40',['la_qr_factor_cmplx',['../namespacelinalg__c__api.html#a13a75b6d7bce1788b5e286a879456347',1,'linalg_c_api']]], + ['la_5fqr_5ffactor_5fcmplx_5fpvt_41',['la_qr_factor_cmplx_pvt',['../namespacelinalg__c__api.html#aa7bc80d9671a82aafdfc9a8ab904cb22',1,'linalg_c_api']]], + ['la_5fqr_5ffactor_5fpvt_42',['la_qr_factor_pvt',['../namespacelinalg__c__api.html#a9868095d332ba323afce1cda4085dd8c',1,'linalg_c_api']]], + ['la_5fqr_5frank1_5fupdate_43',['la_qr_rank1_update',['../namespacelinalg__c__api.html#a056fb14e92f98c660573886c0ad940ff',1,'linalg_c_api']]], + ['la_5fqr_5frank1_5fupdate_5fcmplx_44',['la_qr_rank1_update_cmplx',['../namespacelinalg__c__api.html#a01cf2129d7af3ddc8fb6e1fff7786ff1',1,'linalg_c_api']]], + ['la_5frank_45',['la_rank',['../namespacelinalg__c__api.html#a32548b9eb091164d51ed3793afee83e9',1,'linalg_c_api']]], + ['la_5frank1_5fupdate_46',['la_rank1_update',['../namespacelinalg__c__api.html#a6e47b549d59377db83a0eb27d739df8d',1,'linalg_c_api']]], + ['la_5frank1_5fupdate_5fcmplx_47',['la_rank1_update_cmplx',['../namespacelinalg__c__api.html#ac46bdb1315742f700571bf4f7c705ffd',1,'linalg_c_api']]], + ['la_5frank_5fcmplx_48',['la_rank_cmplx',['../namespacelinalg__c__api.html#a60244c1c8ef1ac3217a9efa69fdbd229',1,'linalg_c_api']]], + ['la_5fsingular_5fmatrix_5ferror_49',['la_singular_matrix_error',['../namespacelinalg__constants.html#a6607d2d2ac92fe5d902527519279e646',1,'linalg_constants']]], + ['la_5fsolve_5fcholesky_50',['la_solve_cholesky',['../namespacelinalg__c__api.html#ac286fe9a7ed4d69ca30ecbe03959f209',1,'linalg_c_api']]], + ['la_5fsolve_5fcholesky_5fcmplx_51',['la_solve_cholesky_cmplx',['../namespacelinalg__c__api.html#a83a08022c84ac2e76f7d20486797bd33',1,'linalg_c_api']]], + ['la_5fsolve_5fleast_5fsquares_52',['la_solve_least_squares',['../namespacelinalg__c__api.html#af1d700238a8ab71b17ff8c15221a9e02',1,'linalg_c_api']]], + ['la_5fsolve_5fleast_5fsquares_5fcmplx_53',['la_solve_least_squares_cmplx',['../namespacelinalg__c__api.html#a2c691c114d54a8eb89ce2882d0557550',1,'linalg_c_api']]], + ['la_5fsolve_5flu_54',['la_solve_lu',['../namespacelinalg__c__api.html#a846baffbc77d4348d7b15d3f83983a04',1,'linalg_c_api']]], + ['la_5fsolve_5flu_5fcmplx_55',['la_solve_lu_cmplx',['../namespacelinalg__c__api.html#aae9625f2ff12a73b6007b429132a1531',1,'linalg_c_api']]], + ['la_5fsolve_5fqr_56',['la_solve_qr',['../namespacelinalg__c__api.html#a13ed5d138ff59a9f649babc5c1dd9eab',1,'linalg_c_api']]], + ['la_5fsolve_5fqr_5fcmplx_57',['la_solve_qr_cmplx',['../namespacelinalg__c__api.html#ad05206b75a9cd1c5a2bda147307ef2d5',1,'linalg_c_api']]], + ['la_5fsolve_5fqr_5fcmplx_5fpvt_58',['la_solve_qr_cmplx_pvt',['../namespacelinalg__c__api.html#a17bfa880bc9019cbd654d20cab263ce3',1,'linalg_c_api']]], + ['la_5fsolve_5fqr_5fpvt_59',['la_solve_qr_pvt',['../namespacelinalg__c__api.html#a0d12474b0ca7772e4ad4ebc7ce227315',1,'linalg_c_api']]], + ['la_5fsolve_5ftri_5fmtx_60',['la_solve_tri_mtx',['../namespacelinalg__c__api.html#a7a72759b932b32e346a70cec542557ff',1,'linalg_c_api']]], + ['la_5fsolve_5ftri_5fmtx_5fcmplx_61',['la_solve_tri_mtx_cmplx',['../namespacelinalg__c__api.html#a7a8e491e75d2d00911d0992b37aac43d',1,'linalg_c_api']]], + ['la_5fsort_5feigen_62',['la_sort_eigen',['../namespacelinalg__c__api.html#ab81f25f6835feac7a88250c9863a4120',1,'linalg_c_api']]], + ['la_5fsort_5feigen_5fcmplx_63',['la_sort_eigen_cmplx',['../namespacelinalg__c__api.html#a2a0c8ddfd134f3d57849925d359d53b2',1,'linalg_c_api']]], + ['la_5fsvd_64',['la_svd',['../namespacelinalg__c__api.html#a436b645816859aea4a8fbd55e733ab92',1,'linalg_c_api']]], + ['la_5fsvd_5fcmplx_65',['la_svd_cmplx',['../namespacelinalg__c__api.html#a45eeb38b8a0d572fc25a7db98690f705',1,'linalg_c_api']]], + ['la_5ftrace_66',['la_trace',['../namespacelinalg__c__api.html#af8627c89c2201ae47c9cfac1d65abfd4',1,'linalg_c_api']]], + ['la_5ftrace_5fcmplx_67',['la_trace_cmplx',['../namespacelinalg__c__api.html#a315ef452fe9f00baa454dc930813fedc',1,'linalg_c_api']]], + ['la_5ftri_5fmtx_5fmult_68',['la_tri_mtx_mult',['../namespacelinalg__c__api.html#a754866d88e140dbf618c1d85f016c633',1,'linalg_c_api']]], + ['la_5ftri_5fmtx_5fmult_5fcmplx_69',['la_tri_mtx_mult_cmplx',['../namespacelinalg__c__api.html#aeb63de65aa9a9bc040860b8f78dcd3fa',1,'linalg_c_api']]], + ['linalg_70',['linalg',['../index.html',1,'']]], + ['linalg_5fc_5fapi_71',['linalg_c_api',['../namespacelinalg__c__api.html',1,'']]], + ['linalg_5fconstants_72',['linalg_constants',['../namespacelinalg__constants.html',1,'']]], + ['linalg_5fcore_73',['linalg_core',['../namespacelinalg__core.html',1,'']]], + ['linalg_5fimmutable_74',['linalg_immutable',['../namespacelinalg__immutable.html',1,'']]], + ['lu_5ffactor_75',['lu_factor',['../interfacelinalg__core_1_1lu__factor.html',1,'linalg_core']]], + ['lu_5fresults_76',['lu_results',['../structlinalg__immutable_1_1lu__results.html',1,'linalg_immutable']]], + ['lu_5fresults_5fcmplx_77',['lu_results_cmplx',['../structlinalg__immutable_1_1lu__results__cmplx.html',1,'linalg_immutable']]] ]; diff --git a/doc/html/search/all_7.js b/doc/html/search/all_7.js index 6606a484..e6a483d9 100644 --- a/doc/html/search/all_7.js +++ b/doc/html/search/all_7.js @@ -1,52 +1,26 @@ var searchData= [ - ['mat_5fcholesky_87',['mat_cholesky',['../namespacelinalg__immutable.html#a5876e7f21f20679fd6c0c84768061a30',1,'linalg_immutable']]], - ['mat_5fcholesky_5frank1_5fdowndate_88',['mat_cholesky_rank1_downdate',['../namespacelinalg__immutable.html#afb844327cadfdd08580c94cb1668c2a8',1,'linalg_immutable']]], - ['mat_5fcholesky_5frank1_5fupdate_89',['mat_cholesky_rank1_update',['../namespacelinalg__immutable.html#a83eaeadc3a3cc5d81c46824174e5a90b',1,'linalg_immutable']]], - ['mat_5fdet_90',['mat_det',['../namespacelinalg__immutable.html#ab7abd8e3fd4170b5b5dfad4448a651c9',1,'linalg_immutable']]], - ['mat_5feigen_91',['mat_eigen',['../interfacelinalg__immutable_1_1mat__eigen.html',1,'linalg_immutable']]], - ['mat_5feigen_5f1_92',['mat_eigen_1',['../interfacelinalg__immutable_1_1mat__eigen.html#a30c4db4bc943963757cc91e6b01e591b',1,'linalg_immutable::mat_eigen::mat_eigen_1()'],['../namespacelinalg__immutable.html#a43cd58b7e0a06b193dce3cf94c4619d1',1,'linalg_immutable::mat_eigen_1()']]], - ['mat_5feigen_5f2_93',['mat_eigen_2',['../interfacelinalg__immutable_1_1mat__eigen.html#a9eaef6fd28d9713ebba5dbd3ca44deff',1,'linalg_immutable::mat_eigen::mat_eigen_2()'],['../namespacelinalg__immutable.html#a989c2bf5f15c717046815005a2280e1d',1,'linalg_immutable::mat_eigen_2()']]], - ['mat_5finverse_94',['mat_inverse',['../namespacelinalg__immutable.html#a98f5b4e5de682d686cb763ab60fcde7f',1,'linalg_immutable']]], - ['mat_5flu_95',['mat_lu',['../interfacelinalg__immutable_1_1mat__lu.html',1,'linalg_immutable']]], - ['mat_5flu_5fcmplx_96',['mat_lu_cmplx',['../interfacelinalg__immutable_1_1mat__lu.html#a085e6774ff582e30cb7bcd45d554a585',1,'linalg_immutable::mat_lu::mat_lu_cmplx()'],['../namespacelinalg__immutable.html#ad3b277369fe90727b2012bc83ad9046f',1,'linalg_immutable::mat_lu_cmplx()']]], - ['mat_5flu_5fdbl_97',['mat_lu_dbl',['../interfacelinalg__immutable_1_1mat__lu.html#ab5bb8b86586008f8958cf7d026cc541f',1,'linalg_immutable::mat_lu::mat_lu_dbl()'],['../namespacelinalg__immutable.html#a47132c922306b87ab5b38635601c4ccd',1,'linalg_immutable::mat_lu_dbl()']]], - ['mat_5fmult_5fdiag_98',['mat_mult_diag',['../interfacelinalg__immutable_1_1mat__mult__diag.html',1,'linalg_immutable']]], - ['mat_5fmult_5fdiag_5f1_99',['mat_mult_diag_1',['../interfacelinalg__immutable_1_1mat__mult__diag.html#ac7e97da527c8e0ba4be582d79fe94331',1,'linalg_immutable::mat_mult_diag::mat_mult_diag_1()'],['../namespacelinalg__immutable.html#a2f1744ac9f0385bd2079c6615b22b4a8',1,'linalg_immutable::mat_mult_diag_1()']]], - ['mat_5fmult_5fdiag_5f1_5fcmplx_100',['mat_mult_diag_1_cmplx',['../interfacelinalg__immutable_1_1mat__mult__diag.html#a202551e80ef44a3b0cfc827c1d33cbcd',1,'linalg_immutable::mat_mult_diag::mat_mult_diag_1_cmplx()'],['../namespacelinalg__immutable.html#a6f225ced64164d9b41215e96cfd83d7f',1,'linalg_immutable::mat_mult_diag_1_cmplx()']]], - ['mat_5fmult_5fdiag_5f2_101',['mat_mult_diag_2',['../interfacelinalg__immutable_1_1mat__mult__diag.html#a2977bc4d536b8c40e77f222be6b1bb9e',1,'linalg_immutable::mat_mult_diag::mat_mult_diag_2()'],['../namespacelinalg__immutable.html#ac2b66504ea3cb772e1bf44017d2fe864',1,'linalg_immutable::mat_mult_diag_2()']]], - ['mat_5fmult_5fdiag_5f2_5fcmplx_102',['mat_mult_diag_2_cmplx',['../interfacelinalg__immutable_1_1mat__mult__diag.html#a81769d8240f87a60da4e7c66fca2d5f7',1,'linalg_immutable::mat_mult_diag::mat_mult_diag_2_cmplx()'],['../namespacelinalg__immutable.html#a25ece4409f695a48fcc73d09ab580717',1,'linalg_immutable::mat_mult_diag_2_cmplx()']]], - ['mat_5fmult_5fdiag_5f3_103',['mat_mult_diag_3',['../interfacelinalg__immutable_1_1mat__mult__diag.html#a387bdf49e35ada60f819efb7db189f78',1,'linalg_immutable::mat_mult_diag::mat_mult_diag_3()'],['../namespacelinalg__immutable.html#aae5f29bbb5069040b9a942d09469d194',1,'linalg_immutable::mat_mult_diag_3()']]], - ['mat_5fmult_5fdiag_5f3_5fcmplx_104',['mat_mult_diag_3_cmplx',['../interfacelinalg__immutable_1_1mat__mult__diag.html#a126d23945fc3d2280e4a6edbaa2ad5c9',1,'linalg_immutable::mat_mult_diag::mat_mult_diag_3_cmplx()'],['../namespacelinalg__immutable.html#a6e50d4cb3ed90be4cfc9f426a35d83cb',1,'linalg_immutable::mat_mult_diag_3_cmplx()']]], - ['mat_5fmult_5flower_5ftri_105',['mat_mult_lower_tri',['../interfacelinalg__immutable_1_1mat__mult__lower__tri.html',1,'linalg_immutable']]], - ['mat_5fmult_5flower_5ftri_5f1_106',['mat_mult_lower_tri_1',['../interfacelinalg__immutable_1_1mat__mult__lower__tri.html#a588ba3472cb80109671f756d611ed023',1,'linalg_immutable::mat_mult_lower_tri::mat_mult_lower_tri_1()'],['../namespacelinalg__immutable.html#a2e4106f6834d3ca9980765f9140a07f6',1,'linalg_immutable::mat_mult_lower_tri_1()']]], - ['mat_5fmult_5flower_5ftri_5f1_5fcmplx_107',['mat_mult_lower_tri_1_cmplx',['../interfacelinalg__immutable_1_1mat__mult__lower__tri.html#ace28e02e648b20c69f10919e0e9ab839',1,'linalg_immutable::mat_mult_lower_tri::mat_mult_lower_tri_1_cmplx()'],['../namespacelinalg__immutable.html#ad8ab2e4958204caafa6bf26d6a7c576e',1,'linalg_immutable::mat_mult_lower_tri_1_cmplx()']]], - ['mat_5fmult_5flower_5ftri_5f2_108',['mat_mult_lower_tri_2',['../interfacelinalg__immutable_1_1mat__mult__lower__tri.html#a9754468f10374e34e1a2fb40ce1206e0',1,'linalg_immutable::mat_mult_lower_tri::mat_mult_lower_tri_2()'],['../namespacelinalg__immutable.html#ac278e04a89fc8e5e759cca3006b10a77',1,'linalg_immutable::mat_mult_lower_tri_2()']]], - ['mat_5fmult_5flower_5ftri_5f2_5fcmplx_109',['mat_mult_lower_tri_2_cmplx',['../interfacelinalg__immutable_1_1mat__mult__lower__tri.html#ac1a3df11bc32e8f90d4f623620c7006f',1,'linalg_immutable::mat_mult_lower_tri::mat_mult_lower_tri_2_cmplx()'],['../namespacelinalg__immutable.html#add83d93fee8c29482dc2e14694636bbf',1,'linalg_immutable::mat_mult_lower_tri_2_cmplx()']]], - ['mat_5fmult_5fupper_5ftri_110',['mat_mult_upper_tri',['../interfacelinalg__immutable_1_1mat__mult__upper__tri.html',1,'linalg_immutable']]], - ['mat_5fmult_5fupper_5ftri_5f1_111',['mat_mult_upper_tri_1',['../interfacelinalg__immutable_1_1mat__mult__upper__tri.html#a20ce53441ab78f4879a43849c1ed2447',1,'linalg_immutable::mat_mult_upper_tri::mat_mult_upper_tri_1()'],['../namespacelinalg__immutable.html#aaf02322c06a6a0ec301f06f120662959',1,'linalg_immutable::mat_mult_upper_tri_1()']]], - ['mat_5fmult_5fupper_5ftri_5f1_5fcmplx_112',['mat_mult_upper_tri_1_cmplx',['../interfacelinalg__immutable_1_1mat__mult__upper__tri.html#a6a23337b162b1b1343fac5c9fc4ecd5e',1,'linalg_immutable::mat_mult_upper_tri::mat_mult_upper_tri_1_cmplx()'],['../namespacelinalg__immutable.html#ab2fe02a1d4a4f1b4b4099735a8536a44',1,'linalg_immutable::mat_mult_upper_tri_1_cmplx()']]], - ['mat_5fmult_5fupper_5ftri_5f2_113',['mat_mult_upper_tri_2',['../interfacelinalg__immutable_1_1mat__mult__upper__tri.html#a39d766d741737c85e6a7f9f60b36f855',1,'linalg_immutable::mat_mult_upper_tri::mat_mult_upper_tri_2()'],['../namespacelinalg__immutable.html#a222bcdc4b18a3297de7fed3ccbbb7aac',1,'linalg_immutable::mat_mult_upper_tri_2()']]], - ['mat_5fmult_5fupper_5ftri_5f2_5fcmplx_114',['mat_mult_upper_tri_2_cmplx',['../interfacelinalg__immutable_1_1mat__mult__upper__tri.html#a64fdf72e665743c6b8703b9dec595e3f',1,'linalg_immutable::mat_mult_upper_tri::mat_mult_upper_tri_2_cmplx()'],['../namespacelinalg__immutable.html#ab2a942c3a6762176fd4135c953699b7b',1,'linalg_immutable::mat_mult_upper_tri_2_cmplx()']]], - ['mat_5fpinverse_115',['mat_pinverse',['../namespacelinalg__immutable.html#aaf39795f72fad79a38213893b850d793',1,'linalg_immutable']]], - ['mat_5fqr_116',['mat_qr',['../namespacelinalg__immutable.html#a8f1ba0ce9f8fbece16a512145bbc197f',1,'linalg_immutable']]], - ['mat_5fqr_5frank1_5fupdate_117',['mat_qr_rank1_update',['../namespacelinalg__immutable.html#a4b09077ad1495833919bab84b144b297',1,'linalg_immutable']]], - ['mat_5frank1_5fupdate_118',['mat_rank1_update',['../namespacelinalg__immutable.html#a9648fd41cc3ce8ec40f67236d274f9a8',1,'linalg_immutable']]], - ['mat_5fsolve_5flower_5ftri_119',['mat_solve_lower_tri',['../interfacelinalg__immutable_1_1mat__solve__lower__tri.html',1,'linalg_immutable']]], - ['mat_5fsolve_5flower_5ftri_5f1_120',['mat_solve_lower_tri_1',['../interfacelinalg__immutable_1_1mat__solve__lower__tri.html#a9b40869b879ddc2e960a7ec46d17c09a',1,'linalg_immutable::mat_solve_lower_tri::mat_solve_lower_tri_1()'],['../namespacelinalg__immutable.html#a7f274a564220237f437d97eb8bb32bed',1,'linalg_immutable::mat_solve_lower_tri_1()']]], - ['mat_5fsolve_5flower_5ftri_5f1_5fcmplx_121',['mat_solve_lower_tri_1_cmplx',['../interfacelinalg__immutable_1_1mat__solve__lower__tri.html#aa0c0c7078ffd02046021c6bd25375a58',1,'linalg_immutable::mat_solve_lower_tri::mat_solve_lower_tri_1_cmplx()'],['../namespacelinalg__immutable.html#a287c258d5a10863d235f95ef63a61f31',1,'linalg_immutable::mat_solve_lower_tri_1_cmplx()']]], - ['mat_5fsolve_5flower_5ftri_5f2_122',['mat_solve_lower_tri_2',['../interfacelinalg__immutable_1_1mat__solve__lower__tri.html#a4e1d7b1aaa7aa8eeff2c09a481cbb9fa',1,'linalg_immutable::mat_solve_lower_tri::mat_solve_lower_tri_2()'],['../namespacelinalg__immutable.html#af92354265e3c2d5fbaaea92527c2e66d',1,'linalg_immutable::mat_solve_lower_tri_2()']]], - ['mat_5fsolve_5flower_5ftri_5f2_5fcmplx_123',['mat_solve_lower_tri_2_cmplx',['../interfacelinalg__immutable_1_1mat__solve__lower__tri.html#a2dc5a090481dd5226c19214205a2c047',1,'linalg_immutable::mat_solve_lower_tri::mat_solve_lower_tri_2_cmplx()'],['../namespacelinalg__immutable.html#a05f08319eaa40487fa8065916e652c7a',1,'linalg_immutable::mat_solve_lower_tri_2_cmplx()']]], - ['mat_5fsolve_5fupper_5ftri_124',['mat_solve_upper_tri',['../interfacelinalg__immutable_1_1mat__solve__upper__tri.html',1,'linalg_immutable']]], - ['mat_5fsolve_5fupper_5ftri_5f1_125',['mat_solve_upper_tri_1',['../interfacelinalg__immutable_1_1mat__solve__upper__tri.html#a97f528aee778d8ddfdcb52058d048de7',1,'linalg_immutable::mat_solve_upper_tri::mat_solve_upper_tri_1()'],['../namespacelinalg__immutable.html#a4906084c7d42b573a13b46996bcdc8eb',1,'linalg_immutable::mat_solve_upper_tri_1()']]], - ['mat_5fsolve_5fupper_5ftri_5f1_5fcmplx_126',['mat_solve_upper_tri_1_cmplx',['../interfacelinalg__immutable_1_1mat__solve__upper__tri.html#a59e1f0aed5b9fd5b952542d8e669fdbd',1,'linalg_immutable::mat_solve_upper_tri::mat_solve_upper_tri_1_cmplx()'],['../namespacelinalg__immutable.html#a0a00f6655a0337341eb881d7d6e0c659',1,'linalg_immutable::mat_solve_upper_tri_1_cmplx()']]], - ['mat_5fsolve_5fupper_5ftri_5f2_127',['mat_solve_upper_tri_2',['../interfacelinalg__immutable_1_1mat__solve__upper__tri.html#a8085ffccaa724ae8f60c897fa38691f7',1,'linalg_immutable::mat_solve_upper_tri::mat_solve_upper_tri_2()'],['../namespacelinalg__immutable.html#ae4599b0f5c5cbb89e77ee132b6be5386',1,'linalg_immutable::mat_solve_upper_tri_2()']]], - ['mat_5fsolve_5fupper_5ftri_5f2_5fcmplx_128',['mat_solve_upper_tri_2_cmplx',['../interfacelinalg__immutable_1_1mat__solve__upper__tri.html#a93e3f2a1097e88c8da32d6e13eb0472f',1,'linalg_immutable::mat_solve_upper_tri::mat_solve_upper_tri_2_cmplx()'],['../namespacelinalg__immutable.html#ad1fa7c5e331bf2f2f73b6dbf9ccf77c2',1,'linalg_immutable::mat_solve_upper_tri_2_cmplx()']]], - ['mat_5fsvd_129',['mat_svd',['../namespacelinalg__immutable.html#a6236acadb527f7762e3e1c0ee3d9ca82',1,'linalg_immutable']]], - ['mtx_5finverse_130',['mtx_inverse',['../interfacelinalg__core_1_1mtx__inverse.html',1,'linalg_core']]], - ['mtx_5fmult_131',['mtx_mult',['../interfacelinalg__core_1_1mtx__mult.html',1,'linalg_core']]], - ['mtx_5fpinverse_132',['mtx_pinverse',['../interfacelinalg__core_1_1mtx__pinverse.html',1,'linalg_core']]], - ['mtx_5frank_133',['mtx_rank',['../interfacelinalg__core_1_1mtx__rank.html',1,'linalg_core']]], - ['mult_5fqr_134',['mult_qr',['../interfacelinalg__core_1_1mult__qr.html',1,'linalg_core']]], - ['mult_5frz_135',['mult_rz',['../interfacelinalg__core_1_1mult__rz.html',1,'linalg_core']]] + ['mat_5fcholesky_0',['mat_cholesky',['../namespacelinalg__immutable.html#a5876e7f21f20679fd6c0c84768061a30',1,'linalg_immutable']]], + ['mat_5fcholesky_5frank1_5fdowndate_1',['mat_cholesky_rank1_downdate',['../namespacelinalg__immutable.html#afb844327cadfdd08580c94cb1668c2a8',1,'linalg_immutable']]], + ['mat_5fcholesky_5frank1_5fupdate_2',['mat_cholesky_rank1_update',['../namespacelinalg__immutable.html#a83eaeadc3a3cc5d81c46824174e5a90b',1,'linalg_immutable']]], + ['mat_5fdet_3',['mat_det',['../namespacelinalg__immutable.html#ab7abd8e3fd4170b5b5dfad4448a651c9',1,'linalg_immutable']]], + ['mat_5feigen_4',['mat_eigen',['../interfacelinalg__immutable_1_1mat__eigen.html',1,'linalg_immutable']]], + ['mat_5finverse_5',['mat_inverse',['../namespacelinalg__immutable.html#a98f5b4e5de682d686cb763ab60fcde7f',1,'linalg_immutable']]], + ['mat_5flu_6',['mat_lu',['../interfacelinalg__immutable_1_1mat__lu.html',1,'linalg_immutable']]], + ['mat_5fmult_5fdiag_7',['mat_mult_diag',['../interfacelinalg__immutable_1_1mat__mult__diag.html',1,'linalg_immutable']]], + ['mat_5fmult_5flower_5ftri_8',['mat_mult_lower_tri',['../interfacelinalg__immutable_1_1mat__mult__lower__tri.html',1,'linalg_immutable']]], + ['mat_5fmult_5fupper_5ftri_9',['mat_mult_upper_tri',['../interfacelinalg__immutable_1_1mat__mult__upper__tri.html',1,'linalg_immutable']]], + ['mat_5fpinverse_10',['mat_pinverse',['../namespacelinalg__immutable.html#aaf39795f72fad79a38213893b850d793',1,'linalg_immutable']]], + ['mat_5fqr_11',['mat_qr',['../namespacelinalg__immutable.html#a8f1ba0ce9f8fbece16a512145bbc197f',1,'linalg_immutable']]], + ['mat_5fqr_5frank1_5fupdate_12',['mat_qr_rank1_update',['../namespacelinalg__immutable.html#a4b09077ad1495833919bab84b144b297',1,'linalg_immutable']]], + ['mat_5frank1_5fupdate_13',['mat_rank1_update',['../namespacelinalg__immutable.html#a9648fd41cc3ce8ec40f67236d274f9a8',1,'linalg_immutable']]], + ['mat_5fsolve_5flower_5ftri_14',['mat_solve_lower_tri',['../interfacelinalg__immutable_1_1mat__solve__lower__tri.html',1,'linalg_immutable']]], + ['mat_5fsolve_5fupper_5ftri_15',['mat_solve_upper_tri',['../interfacelinalg__immutable_1_1mat__solve__upper__tri.html',1,'linalg_immutable']]], + ['mat_5fsvd_16',['mat_svd',['../namespacelinalg__immutable.html#a6236acadb527f7762e3e1c0ee3d9ca82',1,'linalg_immutable']]], + ['mtx_5finverse_17',['mtx_inverse',['../interfacelinalg__core_1_1mtx__inverse.html',1,'linalg_core']]], + ['mtx_5fmult_18',['mtx_mult',['../interfacelinalg__core_1_1mtx__mult.html',1,'linalg_core']]], + ['mtx_5fpinverse_19',['mtx_pinverse',['../interfacelinalg__core_1_1mtx__pinverse.html',1,'linalg_core']]], + ['mtx_5frank_20',['mtx_rank',['../interfacelinalg__core_1_1mtx__rank.html',1,'linalg_core']]], + ['mult_5fqr_21',['mult_qr',['../interfacelinalg__core_1_1mult__qr.html',1,'linalg_core']]], + ['mult_5frz_22',['mult_rz',['../interfacelinalg__core_1_1mult__rz.html',1,'linalg_core']]] ]; diff --git a/doc/html/search/all_8.js b/doc/html/search/all_8.js index e4654cee..1511857c 100644 --- a/doc/html/search/all_8.js +++ b/doc/html/search/all_8.js @@ -1,4 +1,4 @@ var searchData= [ - ['no_5foperation_136',['no_operation',['../namespacelinalg__constants.html#abf9e3b763502c2b0af0cbf48b14c918f',1,'linalg_constants']]] + ['no_5foperation_0',['no_operation',['../namespacelinalg__constants.html#abf9e3b763502c2b0af0cbf48b14c918f',1,'linalg_constants']]] ]; diff --git a/doc/html/search/all_9.js b/doc/html/search/all_9.js index 3ea46472..f0e2a425 100644 --- a/doc/html/search/all_9.js +++ b/doc/html/search/all_9.js @@ -1,4 +1,4 @@ var searchData= [ - ['p_137',['p',['../structlinalg__immutable_1_1lu__results.html#ae1e1fd78123e04a2be4f1bfd25ddddb1',1,'linalg_immutable::lu_results::p()'],['../structlinalg__immutable_1_1lu__results__cmplx.html#a99d03bc910361aab08d17fcc4aaa960d',1,'linalg_immutable::lu_results_cmplx::p()'],['../structlinalg__immutable_1_1qr__results.html#a053899b9dffba08b5052544c13d4983c',1,'linalg_immutable::qr_results::p()'],['../structlinalg__immutable_1_1qr__results__cmplx.html#a782d54320ca646427702d5f2e0a9372f',1,'linalg_immutable::qr_results_cmplx::p()']]] + ['p_0',['p',['../structlinalg__immutable_1_1lu__results.html#ae1e1fd78123e04a2be4f1bfd25ddddb1',1,'linalg_immutable::lu_results::p()'],['../structlinalg__immutable_1_1lu__results__cmplx.html#a99d03bc910361aab08d17fcc4aaa960d',1,'linalg_immutable::lu_results_cmplx::p()'],['../structlinalg__immutable_1_1qr__results.html#a053899b9dffba08b5052544c13d4983c',1,'linalg_immutable::qr_results::p()'],['../structlinalg__immutable_1_1qr__results__cmplx.html#a782d54320ca646427702d5f2e0a9372f',1,'linalg_immutable::qr_results_cmplx::p()']]] ]; diff --git a/doc/html/search/all_a.js b/doc/html/search/all_a.js index 9b27e140..f7f73294 100644 --- a/doc/html/search/all_a.js +++ b/doc/html/search/all_a.js @@ -1,8 +1,8 @@ var searchData= [ - ['q_138',['q',['../structlinalg__immutable_1_1qr__results.html#a91547ec8def57c0cc59271ccf59b3a01',1,'linalg_immutable::qr_results::q()'],['../structlinalg__immutable_1_1qr__results__cmplx.html#a7fa839ced2d020c61550d5b6cff9bb69',1,'linalg_immutable::qr_results_cmplx::q()']]], - ['qr_5ffactor_139',['qr_factor',['../interfacelinalg__core_1_1qr__factor.html',1,'linalg_core']]], - ['qr_5frank1_5fupdate_140',['qr_rank1_update',['../interfacelinalg__core_1_1qr__rank1__update.html',1,'linalg_core']]], - ['qr_5fresults_141',['qr_results',['../structlinalg__immutable_1_1qr__results.html',1,'linalg_immutable']]], - ['qr_5fresults_5fcmplx_142',['qr_results_cmplx',['../structlinalg__immutable_1_1qr__results__cmplx.html',1,'linalg_immutable']]] + ['q_0',['q',['../structlinalg__immutable_1_1qr__results.html#a91547ec8def57c0cc59271ccf59b3a01',1,'linalg_immutable::qr_results::q()'],['../structlinalg__immutable_1_1qr__results__cmplx.html#a7fa839ced2d020c61550d5b6cff9bb69',1,'linalg_immutable::qr_results_cmplx::q()']]], + ['qr_5ffactor_1',['qr_factor',['../interfacelinalg__core_1_1qr__factor.html',1,'linalg_core']]], + ['qr_5frank1_5fupdate_2',['qr_rank1_update',['../interfacelinalg__core_1_1qr__rank1__update.html',1,'linalg_core']]], + ['qr_5fresults_3',['qr_results',['../structlinalg__immutable_1_1qr__results.html',1,'linalg_immutable']]], + ['qr_5fresults_5fcmplx_4',['qr_results_cmplx',['../structlinalg__immutable_1_1qr__results__cmplx.html',1,'linalg_immutable']]] ]; diff --git a/doc/html/search/all_b.js b/doc/html/search/all_b.js index 185d774f..e656de12 100644 --- a/doc/html/search/all_b.js +++ b/doc/html/search/all_b.js @@ -1,7 +1,7 @@ var searchData= [ - ['r_143',['r',['../structlinalg__immutable_1_1qr__results.html#aeeea31b1fad256f5fcc2462b2990d56b',1,'linalg_immutable::qr_results::r()'],['../structlinalg__immutable_1_1qr__results__cmplx.html#a9382745395a25db425c5de89c33df2cd',1,'linalg_immutable::qr_results_cmplx::r()']]], - ['rank1_5fupdate_144',['rank1_update',['../interfacelinalg__core_1_1rank1__update.html',1,'linalg_core']]], - ['recip_5fmult_5farray_145',['recip_mult_array',['../interfacelinalg__core_1_1recip__mult__array.html',1,'linalg_core']]], - ['rz_5ffactor_146',['rz_factor',['../interfacelinalg__core_1_1rz__factor.html',1,'linalg_core']]] + ['r_0',['r',['../structlinalg__immutable_1_1qr__results.html#aeeea31b1fad256f5fcc2462b2990d56b',1,'linalg_immutable::qr_results::r()'],['../structlinalg__immutable_1_1qr__results__cmplx.html#a9382745395a25db425c5de89c33df2cd',1,'linalg_immutable::qr_results_cmplx::r()']]], + ['rank1_5fupdate_1',['rank1_update',['../interfacelinalg__core_1_1rank1__update.html',1,'linalg_core']]], + ['recip_5fmult_5farray_2',['recip_mult_array',['../interfacelinalg__core_1_1recip__mult__array.html',1,'linalg_core']]], + ['rz_5ffactor_3',['rz_factor',['../interfacelinalg__core_1_1rz__factor.html',1,'linalg_core']]] ]; diff --git a/doc/html/search/all_c.js b/doc/html/search/all_c.js index 67a88f4c..037c0866 100644 --- a/doc/html/search/all_c.js +++ b/doc/html/search/all_c.js @@ -1,16 +1,16 @@ var searchData= [ - ['s_147',['s',['../structlinalg__immutable_1_1svd__results.html#acbc05e1d170351bbfcd4cd1f089c81d8',1,'linalg_immutable::svd_results::s()'],['../structlinalg__immutable_1_1svd__results__cmplx.html#a66544dafaacf2b5465e6b1c55d804fff',1,'linalg_immutable::svd_results_cmplx::s()']]], - ['solve_5fcholesky_148',['solve_cholesky',['../interfacelinalg__core_1_1solve__cholesky.html',1,'linalg_core']]], - ['solve_5fleast_5fsquares_149',['solve_least_squares',['../interfacelinalg__core_1_1solve__least__squares.html',1,'linalg_core']]], - ['solve_5fleast_5fsquares_5ffull_150',['solve_least_squares_full',['../interfacelinalg__core_1_1solve__least__squares__full.html',1,'linalg_core']]], - ['solve_5fleast_5fsquares_5fsvd_151',['solve_least_squares_svd',['../interfacelinalg__core_1_1solve__least__squares__svd.html',1,'linalg_core']]], - ['solve_5flu_152',['solve_lu',['../interfacelinalg__core_1_1solve__lu.html',1,'linalg_core']]], - ['solve_5fqr_153',['solve_qr',['../interfacelinalg__core_1_1solve__qr.html',1,'linalg_core']]], - ['solve_5ftriangular_5fsystem_154',['solve_triangular_system',['../interfacelinalg__core_1_1solve__triangular__system.html',1,'linalg_core']]], - ['sort_155',['sort',['../interfacelinalg__core_1_1sort.html',1,'linalg_core']]], - ['svd_156',['svd',['../interfacelinalg__core_1_1svd.html',1,'linalg_core']]], - ['svd_5fresults_157',['svd_results',['../structlinalg__immutable_1_1svd__results.html',1,'linalg_immutable']]], - ['svd_5fresults_5fcmplx_158',['svd_results_cmplx',['../structlinalg__immutable_1_1svd__results__cmplx.html',1,'linalg_immutable']]], - ['swap_159',['swap',['../interfacelinalg__core_1_1swap.html',1,'linalg_core']]] + ['s_0',['s',['../structlinalg__immutable_1_1svd__results.html#acbc05e1d170351bbfcd4cd1f089c81d8',1,'linalg_immutable::svd_results::s()'],['../structlinalg__immutable_1_1svd__results__cmplx.html#a66544dafaacf2b5465e6b1c55d804fff',1,'linalg_immutable::svd_results_cmplx::s()']]], + ['solve_5fcholesky_1',['solve_cholesky',['../interfacelinalg__core_1_1solve__cholesky.html',1,'linalg_core']]], + ['solve_5fleast_5fsquares_2',['solve_least_squares',['../interfacelinalg__core_1_1solve__least__squares.html',1,'linalg_core']]], + ['solve_5fleast_5fsquares_5ffull_3',['solve_least_squares_full',['../interfacelinalg__core_1_1solve__least__squares__full.html',1,'linalg_core']]], + ['solve_5fleast_5fsquares_5fsvd_4',['solve_least_squares_svd',['../interfacelinalg__core_1_1solve__least__squares__svd.html',1,'linalg_core']]], + ['solve_5flu_5',['solve_lu',['../interfacelinalg__core_1_1solve__lu.html',1,'linalg_core']]], + ['solve_5fqr_6',['solve_qr',['../interfacelinalg__core_1_1solve__qr.html',1,'linalg_core']]], + ['solve_5ftriangular_5fsystem_7',['solve_triangular_system',['../interfacelinalg__core_1_1solve__triangular__system.html',1,'linalg_core']]], + ['sort_8',['sort',['../interfacelinalg__core_1_1sort.html',1,'linalg_core']]], + ['svd_9',['svd',['../interfacelinalg__core_1_1svd.html',1,'linalg_core']]], + ['svd_5fresults_10',['svd_results',['../structlinalg__immutable_1_1svd__results.html',1,'linalg_immutable']]], + ['svd_5fresults_5fcmplx_11',['svd_results_cmplx',['../structlinalg__immutable_1_1svd__results__cmplx.html',1,'linalg_immutable']]], + ['swap_12',['swap',['../interfacelinalg__core_1_1swap.html',1,'linalg_core']]] ]; diff --git a/doc/html/search/all_d.js b/doc/html/search/all_d.js index 4684bc9d..ccf59912 100644 --- a/doc/html/search/all_d.js +++ b/doc/html/search/all_d.js @@ -1,6 +1,6 @@ var searchData= [ - ['trace_160',['trace',['../interfacelinalg__core_1_1trace.html',1,'linalg_core']]], - ['transpose_161',['transpose',['../namespacelinalg__constants.html#a045d4c1cc5fe061467924ad01bfe77c4',1,'linalg_constants']]], - ['tri_5fmtx_5fmult_162',['tri_mtx_mult',['../interfacelinalg__core_1_1tri__mtx__mult.html',1,'linalg_core']]] + ['trace_0',['trace',['../interfacelinalg__core_1_1trace.html',1,'linalg_core']]], + ['transpose_1',['transpose',['../namespacelinalg__constants.html#a045d4c1cc5fe061467924ad01bfe77c4',1,'linalg_constants']]], + ['tri_5fmtx_5fmult_2',['tri_mtx_mult',['../interfacelinalg__core_1_1tri__mtx__mult.html',1,'linalg_core']]] ]; diff --git a/doc/html/search/all_e.js b/doc/html/search/all_e.js index b4b1eb31..a5b8bb0e 100644 --- a/doc/html/search/all_e.js +++ b/doc/html/search/all_e.js @@ -1,4 +1,4 @@ var searchData= [ - ['u_163',['u',['../structlinalg__immutable_1_1lu__results.html#ab1af96c7808037f63563e1bf912c4dad',1,'linalg_immutable::lu_results::u()'],['../structlinalg__immutable_1_1lu__results__cmplx.html#a7488afe2004b11c8fed4c517400fde98',1,'linalg_immutable::lu_results_cmplx::u()'],['../structlinalg__immutable_1_1svd__results.html#a582822c9765048fcb8632d72a6ed506a',1,'linalg_immutable::svd_results::u()'],['../structlinalg__immutable_1_1svd__results__cmplx.html#ae65cfdf6d19c3bbb3a7e425db266cb3c',1,'linalg_immutable::svd_results_cmplx::u()']]] + ['u_0',['u',['../structlinalg__immutable_1_1lu__results.html#ab1af96c7808037f63563e1bf912c4dad',1,'linalg_immutable::lu_results::u()'],['../structlinalg__immutable_1_1lu__results__cmplx.html#a7488afe2004b11c8fed4c517400fde98',1,'linalg_immutable::lu_results_cmplx::u()'],['../structlinalg__immutable_1_1svd__results.html#a582822c9765048fcb8632d72a6ed506a',1,'linalg_immutable::svd_results::u()'],['../structlinalg__immutable_1_1svd__results__cmplx.html#ae65cfdf6d19c3bbb3a7e425db266cb3c',1,'linalg_immutable::svd_results_cmplx::u()']]] ]; diff --git a/doc/html/search/all_f.js b/doc/html/search/all_f.js index d94c3223..760107f9 100644 --- a/doc/html/search/all_f.js +++ b/doc/html/search/all_f.js @@ -1,6 +1,6 @@ var searchData= [ - ['values_164',['values',['../structlinalg__immutable_1_1eigen__results.html#abb60901ab160c6fd232cfb46ed0bf3cc',1,'linalg_immutable::eigen_results']]], - ['vectors_165',['vectors',['../structlinalg__immutable_1_1eigen__results.html#a982607b9c3ff93504bb4524dcd31a442',1,'linalg_immutable::eigen_results']]], - ['vt_166',['vt',['../structlinalg__immutable_1_1svd__results.html#af5c35f3392431179a5cb15d1cddf7cb1',1,'linalg_immutable::svd_results::vt()'],['../structlinalg__immutable_1_1svd__results__cmplx.html#af9e74638b38510fb24de3f3a6ea30de8',1,'linalg_immutable::svd_results_cmplx::vt()']]] + ['values_0',['values',['../structlinalg__immutable_1_1eigen__results.html#abb60901ab160c6fd232cfb46ed0bf3cc',1,'linalg_immutable::eigen_results']]], + ['vectors_1',['vectors',['../structlinalg__immutable_1_1eigen__results.html#a982607b9c3ff93504bb4524dcd31a442',1,'linalg_immutable::eigen_results']]], + ['vt_2',['vt',['../structlinalg__immutable_1_1svd__results.html#af5c35f3392431179a5cb15d1cddf7cb1',1,'linalg_immutable::svd_results::vt()'],['../structlinalg__immutable_1_1svd__results__cmplx.html#af9e74638b38510fb24de3f3a6ea30de8',1,'linalg_immutable::svd_results_cmplx::vt()']]] ]; diff --git a/doc/html/search/classes_0.js b/doc/html/search/classes_0.js index a5d865de..1fe80caa 100644 --- a/doc/html/search/classes_0.js +++ b/doc/html/search/classes_0.js @@ -1,6 +1,6 @@ var searchData= [ - ['cholesky_5ffactor_167',['cholesky_factor',['../interfacelinalg__core_1_1cholesky__factor.html',1,'linalg_core']]], - ['cholesky_5frank1_5fdowndate_168',['cholesky_rank1_downdate',['../interfacelinalg__core_1_1cholesky__rank1__downdate.html',1,'linalg_core']]], - ['cholesky_5frank1_5fupdate_169',['cholesky_rank1_update',['../interfacelinalg__core_1_1cholesky__rank1__update.html',1,'linalg_core']]] + ['cholesky_5ffactor_0',['cholesky_factor',['../interfacelinalg__core_1_1cholesky__factor.html',1,'linalg_core']]], + ['cholesky_5frank1_5fdowndate_1',['cholesky_rank1_downdate',['../interfacelinalg__core_1_1cholesky__rank1__downdate.html',1,'linalg_core']]], + ['cholesky_5frank1_5fupdate_2',['cholesky_rank1_update',['../interfacelinalg__core_1_1cholesky__rank1__update.html',1,'linalg_core']]] ]; diff --git a/doc/html/search/classes_1.js b/doc/html/search/classes_1.js index a81b7598..fa28fb28 100644 --- a/doc/html/search/classes_1.js +++ b/doc/html/search/classes_1.js @@ -1,5 +1,5 @@ var searchData= [ - ['det_170',['det',['../interfacelinalg__core_1_1det.html',1,'linalg_core']]], - ['diag_5fmtx_5fmult_171',['diag_mtx_mult',['../interfacelinalg__core_1_1diag__mtx__mult.html',1,'linalg_core']]] + ['det_0',['det',['../interfacelinalg__core_1_1det.html',1,'linalg_core']]], + ['diag_5fmtx_5fmult_1',['diag_mtx_mult',['../interfacelinalg__core_1_1diag__mtx__mult.html',1,'linalg_core']]] ]; diff --git a/doc/html/search/classes_2.js b/doc/html/search/classes_2.js index d21c78fb..269daff0 100644 --- a/doc/html/search/classes_2.js +++ b/doc/html/search/classes_2.js @@ -1,5 +1,5 @@ var searchData= [ - ['eigen_172',['eigen',['../interfacelinalg__core_1_1eigen.html',1,'linalg_core']]], - ['eigen_5fresults_173',['eigen_results',['../structlinalg__immutable_1_1eigen__results.html',1,'linalg_immutable']]] + ['eigen_0',['eigen',['../interfacelinalg__core_1_1eigen.html',1,'linalg_core']]], + ['eigen_5fresults_1',['eigen_results',['../structlinalg__immutable_1_1eigen__results.html',1,'linalg_immutable']]] ]; diff --git a/doc/html/search/classes_3.js b/doc/html/search/classes_3.js index e0ede483..28f50b33 100644 --- a/doc/html/search/classes_3.js +++ b/doc/html/search/classes_3.js @@ -1,5 +1,5 @@ var searchData= [ - ['form_5flu_174',['form_lu',['../interfacelinalg__core_1_1form__lu.html',1,'linalg_core']]], - ['form_5fqr_175',['form_qr',['../interfacelinalg__core_1_1form__qr.html',1,'linalg_core']]] + ['form_5flu_0',['form_lu',['../interfacelinalg__core_1_1form__lu.html',1,'linalg_core']]], + ['form_5fqr_1',['form_qr',['../interfacelinalg__core_1_1form__qr.html',1,'linalg_core']]] ]; diff --git a/doc/html/search/classes_4.js b/doc/html/search/classes_4.js index 65548a3d..c3d893b7 100644 --- a/doc/html/search/classes_4.js +++ b/doc/html/search/classes_4.js @@ -1,6 +1,6 @@ var searchData= [ - ['lu_5ffactor_176',['lu_factor',['../interfacelinalg__core_1_1lu__factor.html',1,'linalg_core']]], - ['lu_5fresults_177',['lu_results',['../structlinalg__immutable_1_1lu__results.html',1,'linalg_immutable']]], - ['lu_5fresults_5fcmplx_178',['lu_results_cmplx',['../structlinalg__immutable_1_1lu__results__cmplx.html',1,'linalg_immutable']]] + ['lu_5ffactor_0',['lu_factor',['../interfacelinalg__core_1_1lu__factor.html',1,'linalg_core']]], + ['lu_5fresults_1',['lu_results',['../structlinalg__immutable_1_1lu__results.html',1,'linalg_immutable']]], + ['lu_5fresults_5fcmplx_2',['lu_results_cmplx',['../structlinalg__immutable_1_1lu__results__cmplx.html',1,'linalg_immutable']]] ]; diff --git a/doc/html/search/classes_5.js b/doc/html/search/classes_5.js index b979a544..0a072974 100644 --- a/doc/html/search/classes_5.js +++ b/doc/html/search/classes_5.js @@ -1,16 +1,16 @@ var searchData= [ - ['mat_5feigen_179',['mat_eigen',['../interfacelinalg__immutable_1_1mat__eigen.html',1,'linalg_immutable']]], - ['mat_5flu_180',['mat_lu',['../interfacelinalg__immutable_1_1mat__lu.html',1,'linalg_immutable']]], - ['mat_5fmult_5fdiag_181',['mat_mult_diag',['../interfacelinalg__immutable_1_1mat__mult__diag.html',1,'linalg_immutable']]], - ['mat_5fmult_5flower_5ftri_182',['mat_mult_lower_tri',['../interfacelinalg__immutable_1_1mat__mult__lower__tri.html',1,'linalg_immutable']]], - ['mat_5fmult_5fupper_5ftri_183',['mat_mult_upper_tri',['../interfacelinalg__immutable_1_1mat__mult__upper__tri.html',1,'linalg_immutable']]], - ['mat_5fsolve_5flower_5ftri_184',['mat_solve_lower_tri',['../interfacelinalg__immutable_1_1mat__solve__lower__tri.html',1,'linalg_immutable']]], - ['mat_5fsolve_5fupper_5ftri_185',['mat_solve_upper_tri',['../interfacelinalg__immutable_1_1mat__solve__upper__tri.html',1,'linalg_immutable']]], - ['mtx_5finverse_186',['mtx_inverse',['../interfacelinalg__core_1_1mtx__inverse.html',1,'linalg_core']]], - ['mtx_5fmult_187',['mtx_mult',['../interfacelinalg__core_1_1mtx__mult.html',1,'linalg_core']]], - ['mtx_5fpinverse_188',['mtx_pinverse',['../interfacelinalg__core_1_1mtx__pinverse.html',1,'linalg_core']]], - ['mtx_5frank_189',['mtx_rank',['../interfacelinalg__core_1_1mtx__rank.html',1,'linalg_core']]], - ['mult_5fqr_190',['mult_qr',['../interfacelinalg__core_1_1mult__qr.html',1,'linalg_core']]], - ['mult_5frz_191',['mult_rz',['../interfacelinalg__core_1_1mult__rz.html',1,'linalg_core']]] + ['mat_5feigen_0',['mat_eigen',['../interfacelinalg__immutable_1_1mat__eigen.html',1,'linalg_immutable']]], + ['mat_5flu_1',['mat_lu',['../interfacelinalg__immutable_1_1mat__lu.html',1,'linalg_immutable']]], + ['mat_5fmult_5fdiag_2',['mat_mult_diag',['../interfacelinalg__immutable_1_1mat__mult__diag.html',1,'linalg_immutable']]], + ['mat_5fmult_5flower_5ftri_3',['mat_mult_lower_tri',['../interfacelinalg__immutable_1_1mat__mult__lower__tri.html',1,'linalg_immutable']]], + ['mat_5fmult_5fupper_5ftri_4',['mat_mult_upper_tri',['../interfacelinalg__immutable_1_1mat__mult__upper__tri.html',1,'linalg_immutable']]], + ['mat_5fsolve_5flower_5ftri_5',['mat_solve_lower_tri',['../interfacelinalg__immutable_1_1mat__solve__lower__tri.html',1,'linalg_immutable']]], + ['mat_5fsolve_5fupper_5ftri_6',['mat_solve_upper_tri',['../interfacelinalg__immutable_1_1mat__solve__upper__tri.html',1,'linalg_immutable']]], + ['mtx_5finverse_7',['mtx_inverse',['../interfacelinalg__core_1_1mtx__inverse.html',1,'linalg_core']]], + ['mtx_5fmult_8',['mtx_mult',['../interfacelinalg__core_1_1mtx__mult.html',1,'linalg_core']]], + ['mtx_5fpinverse_9',['mtx_pinverse',['../interfacelinalg__core_1_1mtx__pinverse.html',1,'linalg_core']]], + ['mtx_5frank_10',['mtx_rank',['../interfacelinalg__core_1_1mtx__rank.html',1,'linalg_core']]], + ['mult_5fqr_11',['mult_qr',['../interfacelinalg__core_1_1mult__qr.html',1,'linalg_core']]], + ['mult_5frz_12',['mult_rz',['../interfacelinalg__core_1_1mult__rz.html',1,'linalg_core']]] ]; diff --git a/doc/html/search/classes_6.js b/doc/html/search/classes_6.js index fd01a1a8..2bc71d51 100644 --- a/doc/html/search/classes_6.js +++ b/doc/html/search/classes_6.js @@ -1,7 +1,7 @@ var searchData= [ - ['qr_5ffactor_192',['qr_factor',['../interfacelinalg__core_1_1qr__factor.html',1,'linalg_core']]], - ['qr_5frank1_5fupdate_193',['qr_rank1_update',['../interfacelinalg__core_1_1qr__rank1__update.html',1,'linalg_core']]], - ['qr_5fresults_194',['qr_results',['../structlinalg__immutable_1_1qr__results.html',1,'linalg_immutable']]], - ['qr_5fresults_5fcmplx_195',['qr_results_cmplx',['../structlinalg__immutable_1_1qr__results__cmplx.html',1,'linalg_immutable']]] + ['qr_5ffactor_0',['qr_factor',['../interfacelinalg__core_1_1qr__factor.html',1,'linalg_core']]], + ['qr_5frank1_5fupdate_1',['qr_rank1_update',['../interfacelinalg__core_1_1qr__rank1__update.html',1,'linalg_core']]], + ['qr_5fresults_2',['qr_results',['../structlinalg__immutable_1_1qr__results.html',1,'linalg_immutable']]], + ['qr_5fresults_5fcmplx_3',['qr_results_cmplx',['../structlinalg__immutable_1_1qr__results__cmplx.html',1,'linalg_immutable']]] ]; diff --git a/doc/html/search/classes_7.js b/doc/html/search/classes_7.js index bf68a7a1..ec47a635 100644 --- a/doc/html/search/classes_7.js +++ b/doc/html/search/classes_7.js @@ -1,6 +1,6 @@ var searchData= [ - ['rank1_5fupdate_196',['rank1_update',['../interfacelinalg__core_1_1rank1__update.html',1,'linalg_core']]], - ['recip_5fmult_5farray_197',['recip_mult_array',['../interfacelinalg__core_1_1recip__mult__array.html',1,'linalg_core']]], - ['rz_5ffactor_198',['rz_factor',['../interfacelinalg__core_1_1rz__factor.html',1,'linalg_core']]] + ['rank1_5fupdate_0',['rank1_update',['../interfacelinalg__core_1_1rank1__update.html',1,'linalg_core']]], + ['recip_5fmult_5farray_1',['recip_mult_array',['../interfacelinalg__core_1_1recip__mult__array.html',1,'linalg_core']]], + ['rz_5ffactor_2',['rz_factor',['../interfacelinalg__core_1_1rz__factor.html',1,'linalg_core']]] ]; diff --git a/doc/html/search/classes_8.js b/doc/html/search/classes_8.js index b9f89451..69551f42 100644 --- a/doc/html/search/classes_8.js +++ b/doc/html/search/classes_8.js @@ -1,15 +1,15 @@ var searchData= [ - ['solve_5fcholesky_199',['solve_cholesky',['../interfacelinalg__core_1_1solve__cholesky.html',1,'linalg_core']]], - ['solve_5fleast_5fsquares_200',['solve_least_squares',['../interfacelinalg__core_1_1solve__least__squares.html',1,'linalg_core']]], - ['solve_5fleast_5fsquares_5ffull_201',['solve_least_squares_full',['../interfacelinalg__core_1_1solve__least__squares__full.html',1,'linalg_core']]], - ['solve_5fleast_5fsquares_5fsvd_202',['solve_least_squares_svd',['../interfacelinalg__core_1_1solve__least__squares__svd.html',1,'linalg_core']]], - ['solve_5flu_203',['solve_lu',['../interfacelinalg__core_1_1solve__lu.html',1,'linalg_core']]], - ['solve_5fqr_204',['solve_qr',['../interfacelinalg__core_1_1solve__qr.html',1,'linalg_core']]], - ['solve_5ftriangular_5fsystem_205',['solve_triangular_system',['../interfacelinalg__core_1_1solve__triangular__system.html',1,'linalg_core']]], - ['sort_206',['sort',['../interfacelinalg__core_1_1sort.html',1,'linalg_core']]], - ['svd_207',['svd',['../interfacelinalg__core_1_1svd.html',1,'linalg_core']]], - ['svd_5fresults_208',['svd_results',['../structlinalg__immutable_1_1svd__results.html',1,'linalg_immutable']]], - ['svd_5fresults_5fcmplx_209',['svd_results_cmplx',['../structlinalg__immutable_1_1svd__results__cmplx.html',1,'linalg_immutable']]], - ['swap_210',['swap',['../interfacelinalg__core_1_1swap.html',1,'linalg_core']]] + ['solve_5fcholesky_0',['solve_cholesky',['../interfacelinalg__core_1_1solve__cholesky.html',1,'linalg_core']]], + ['solve_5fleast_5fsquares_1',['solve_least_squares',['../interfacelinalg__core_1_1solve__least__squares.html',1,'linalg_core']]], + ['solve_5fleast_5fsquares_5ffull_2',['solve_least_squares_full',['../interfacelinalg__core_1_1solve__least__squares__full.html',1,'linalg_core']]], + ['solve_5fleast_5fsquares_5fsvd_3',['solve_least_squares_svd',['../interfacelinalg__core_1_1solve__least__squares__svd.html',1,'linalg_core']]], + ['solve_5flu_4',['solve_lu',['../interfacelinalg__core_1_1solve__lu.html',1,'linalg_core']]], + ['solve_5fqr_5',['solve_qr',['../interfacelinalg__core_1_1solve__qr.html',1,'linalg_core']]], + ['solve_5ftriangular_5fsystem_6',['solve_triangular_system',['../interfacelinalg__core_1_1solve__triangular__system.html',1,'linalg_core']]], + ['sort_7',['sort',['../interfacelinalg__core_1_1sort.html',1,'linalg_core']]], + ['svd_8',['svd',['../interfacelinalg__core_1_1svd.html',1,'linalg_core']]], + ['svd_5fresults_9',['svd_results',['../structlinalg__immutable_1_1svd__results.html',1,'linalg_immutable']]], + ['svd_5fresults_5fcmplx_10',['svd_results_cmplx',['../structlinalg__immutable_1_1svd__results__cmplx.html',1,'linalg_immutable']]], + ['swap_11',['swap',['../interfacelinalg__core_1_1swap.html',1,'linalg_core']]] ]; diff --git a/doc/html/search/classes_9.js b/doc/html/search/classes_9.js index 58f16ae6..251dd1a8 100644 --- a/doc/html/search/classes_9.js +++ b/doc/html/search/classes_9.js @@ -1,5 +1,5 @@ var searchData= [ - ['trace_211',['trace',['../interfacelinalg__core_1_1trace.html',1,'linalg_core']]], - ['tri_5fmtx_5fmult_212',['tri_mtx_mult',['../interfacelinalg__core_1_1tri__mtx__mult.html',1,'linalg_core']]] + ['trace_0',['trace',['../interfacelinalg__core_1_1trace.html',1,'linalg_core']]], + ['tri_5fmtx_5fmult_1',['tri_mtx_mult',['../interfacelinalg__core_1_1tri__mtx__mult.html',1,'linalg_core']]] ]; diff --git a/doc/html/search/close.svg b/doc/html/search/close.svg new file mode 100644 index 00000000..a933eea1 --- /dev/null +++ b/doc/html/search/close.svg @@ -0,0 +1,31 @@ + + + + + + image/svg+xml + + + + + + + + diff --git a/doc/html/search/functions_0.js b/doc/html/search/functions_0.js index 0b3bc744..7cf2a492 100644 --- a/doc/html/search/functions_0.js +++ b/doc/html/search/functions_0.js @@ -1,4 +1,4 @@ var searchData= [ - ['identity_217',['identity',['../namespacelinalg__immutable.html#aeb1f553973ae3e9b86cb30a1ca1f5700',1,'linalg_immutable']]] + ['identity_0',['identity',['../namespacelinalg__immutable.html#aeb1f553973ae3e9b86cb30a1ca1f5700',1,'linalg_immutable']]] ]; diff --git a/doc/html/search/functions_1.js b/doc/html/search/functions_1.js index 2934a557..b0c66b60 100644 --- a/doc/html/search/functions_1.js +++ b/doc/html/search/functions_1.js @@ -1,63 +1,64 @@ var searchData= [ - ['la_5fcholesky_5ffactor_218',['la_cholesky_factor',['../namespacelinalg__c__api.html#a99d3ac7f90cad0c643dd8abff6592032',1,'linalg_c_api']]], - ['la_5fcholesky_5ffactor_5fcmplx_219',['la_cholesky_factor_cmplx',['../namespacelinalg__c__api.html#a800b0d6ba6f8d812d8038dd06c0967a8',1,'linalg_c_api']]], - ['la_5fcholesky_5frank1_5fdowndate_220',['la_cholesky_rank1_downdate',['../namespacelinalg__c__api.html#a5b5758f439d34c765ff5285c21fa88c1',1,'linalg_c_api']]], - ['la_5fcholesky_5frank1_5fdowndate_5fcmplx_221',['la_cholesky_rank1_downdate_cmplx',['../namespacelinalg__c__api.html#a3232c643af8f8615961c4b1bab422a4a',1,'linalg_c_api']]], - ['la_5fcholesky_5frank1_5fupdate_222',['la_cholesky_rank1_update',['../namespacelinalg__c__api.html#ae5c0bda2e1ae3a4dbdaf6d0586247b4c',1,'linalg_c_api']]], - ['la_5fcholesky_5frank1_5fupdate_5fcmplx_223',['la_cholesky_rank1_update_cmplx',['../namespacelinalg__c__api.html#a5746e1736802b9a082057c7997325049',1,'linalg_c_api']]], - ['la_5fdet_224',['la_det',['../namespacelinalg__c__api.html#afd21b0e476168de7eb9a6a5ef3a2e8b4',1,'linalg_c_api']]], - ['la_5fdet_5fcmplx_225',['la_det_cmplx',['../namespacelinalg__c__api.html#a82fcbd45f4a92431587312560fbcc636',1,'linalg_c_api']]], - ['la_5fdiag_5fmtx_5fmult_226',['la_diag_mtx_mult',['../namespacelinalg__c__api.html#ae866f3e174aed82f3fdfa3483ac91333',1,'linalg_c_api']]], - ['la_5fdiag_5fmtx_5fmult_5fcmplx_227',['la_diag_mtx_mult_cmplx',['../namespacelinalg__c__api.html#a1af56ff742938c0be90fb34146b13365',1,'linalg_c_api']]], - ['la_5feigen_5fasymm_228',['la_eigen_asymm',['../namespacelinalg__c__api.html#af2ed46a8b1285ac08f0f86162288a865',1,'linalg_c_api']]], - ['la_5feigen_5fcmplx_229',['la_eigen_cmplx',['../namespacelinalg__c__api.html#ab133f51c44eb244be0b6e966f5893259',1,'linalg_c_api']]], - ['la_5feigen_5fgen_230',['la_eigen_gen',['../namespacelinalg__c__api.html#a93920f1db884cbad9bfc335abe36bed4',1,'linalg_c_api']]], - ['la_5feigen_5fsymm_231',['la_eigen_symm',['../namespacelinalg__c__api.html#a63372e9678f7052d17c8676324d6e7a7',1,'linalg_c_api']]], - ['la_5fform_5flu_232',['la_form_lu',['../namespacelinalg__c__api.html#aeab30d9e07601b343f15bf03d8220044',1,'linalg_c_api']]], - ['la_5fform_5flu_5fcmplx_233',['la_form_lu_cmplx',['../namespacelinalg__c__api.html#ae9bcd3e2df3151a5d92da48973501f6b',1,'linalg_c_api']]], - ['la_5fform_5fqr_234',['la_form_qr',['../namespacelinalg__c__api.html#a9426f737c5d551a133f44e2d7cb98a1d',1,'linalg_c_api']]], - ['la_5fform_5fqr_5fcmplx_235',['la_form_qr_cmplx',['../namespacelinalg__c__api.html#a9be60e86103e09be4d19fd3728f5d64b',1,'linalg_c_api']]], - ['la_5fform_5fqr_5fcmplx_5fpvt_236',['la_form_qr_cmplx_pvt',['../namespacelinalg__c__api.html#a5146fcf6552a097e05d46afaf91f424e',1,'linalg_c_api']]], - ['la_5fform_5fqr_5fpvt_237',['la_form_qr_pvt',['../namespacelinalg__c__api.html#a69d0ec69152e04fc5f766dd7c6d23f98',1,'linalg_c_api']]], - ['la_5finverse_238',['la_inverse',['../namespacelinalg__c__api.html#a307a6d5e27d90b28a38fba8c02e14461',1,'linalg_c_api']]], - ['la_5finverse_5fcmplx_239',['la_inverse_cmplx',['../namespacelinalg__c__api.html#a715855159abe740aff7bf95303a3f715',1,'linalg_c_api']]], - ['la_5flu_5ffactor_240',['la_lu_factor',['../namespacelinalg__c__api.html#a3e91c088c8d173e9b12c17b1ebc9bfa4',1,'linalg_c_api']]], - ['la_5flu_5ffactor_5fcmplx_241',['la_lu_factor_cmplx',['../namespacelinalg__c__api.html#a1788fe3192429b2cfd3a169d879a6f0e',1,'linalg_c_api']]], - ['la_5fmtx_5fmult_242',['la_mtx_mult',['../namespacelinalg__c__api.html#a434338a38a5fde94d8df3119b169fd01',1,'linalg_c_api']]], - ['la_5fmtx_5fmult_5fcmplx_243',['la_mtx_mult_cmplx',['../namespacelinalg__c__api.html#abdc93ffffffefdef839370da19f01430',1,'linalg_c_api']]], - ['la_5fmult_5fqr_244',['la_mult_qr',['../namespacelinalg__c__api.html#a2604ade114e67587300b3916846fc961',1,'linalg_c_api']]], - ['la_5fmult_5fqr_5fcmplx_245',['la_mult_qr_cmplx',['../namespacelinalg__c__api.html#a4b8c42819e069a18ec39c5ebb9ef8703',1,'linalg_c_api']]], - ['la_5fpinverse_246',['la_pinverse',['../namespacelinalg__c__api.html#a39bb26dcab43d8f54471af87af69e606',1,'linalg_c_api']]], - ['la_5fpinverse_5fcmplx_247',['la_pinverse_cmplx',['../namespacelinalg__c__api.html#ad0eefe5cf5a74d6848bbde0e8bb22550',1,'linalg_c_api']]], - ['la_5fqr_5ffactor_248',['la_qr_factor',['../namespacelinalg__c__api.html#a2c896885507a331ad89e579868da0fd3',1,'linalg_c_api']]], - ['la_5fqr_5ffactor_5fcmplx_249',['la_qr_factor_cmplx',['../namespacelinalg__c__api.html#a13a75b6d7bce1788b5e286a879456347',1,'linalg_c_api']]], - ['la_5fqr_5ffactor_5fcmplx_5fpvt_250',['la_qr_factor_cmplx_pvt',['../namespacelinalg__c__api.html#aa7bc80d9671a82aafdfc9a8ab904cb22',1,'linalg_c_api']]], - ['la_5fqr_5ffactor_5fpvt_251',['la_qr_factor_pvt',['../namespacelinalg__c__api.html#a9868095d332ba323afce1cda4085dd8c',1,'linalg_c_api']]], - ['la_5fqr_5frank1_5fupdate_252',['la_qr_rank1_update',['../namespacelinalg__c__api.html#a056fb14e92f98c660573886c0ad940ff',1,'linalg_c_api']]], - ['la_5fqr_5frank1_5fupdate_5fcmplx_253',['la_qr_rank1_update_cmplx',['../namespacelinalg__c__api.html#a01cf2129d7af3ddc8fb6e1fff7786ff1',1,'linalg_c_api']]], - ['la_5frank_254',['la_rank',['../namespacelinalg__c__api.html#a32548b9eb091164d51ed3793afee83e9',1,'linalg_c_api']]], - ['la_5frank1_5fupdate_255',['la_rank1_update',['../namespacelinalg__c__api.html#a6e47b549d59377db83a0eb27d739df8d',1,'linalg_c_api']]], - ['la_5frank1_5fupdate_5fcmplx_256',['la_rank1_update_cmplx',['../namespacelinalg__c__api.html#ac46bdb1315742f700571bf4f7c705ffd',1,'linalg_c_api']]], - ['la_5frank_5fcmplx_257',['la_rank_cmplx',['../namespacelinalg__c__api.html#a60244c1c8ef1ac3217a9efa69fdbd229',1,'linalg_c_api']]], - ['la_5fsolve_5fcholesky_258',['la_solve_cholesky',['../namespacelinalg__c__api.html#ac286fe9a7ed4d69ca30ecbe03959f209',1,'linalg_c_api']]], - ['la_5fsolve_5fcholesky_5fcmplx_259',['la_solve_cholesky_cmplx',['../namespacelinalg__c__api.html#a83a08022c84ac2e76f7d20486797bd33',1,'linalg_c_api']]], - ['la_5fsolve_5fleast_5fsquares_260',['la_solve_least_squares',['../namespacelinalg__c__api.html#af1d700238a8ab71b17ff8c15221a9e02',1,'linalg_c_api']]], - ['la_5fsolve_5fleast_5fsquares_5fcmplx_261',['la_solve_least_squares_cmplx',['../namespacelinalg__c__api.html#a2c691c114d54a8eb89ce2882d0557550',1,'linalg_c_api']]], - ['la_5fsolve_5flu_262',['la_solve_lu',['../namespacelinalg__c__api.html#a846baffbc77d4348d7b15d3f83983a04',1,'linalg_c_api']]], - ['la_5fsolve_5flu_5fcmplx_263',['la_solve_lu_cmplx',['../namespacelinalg__c__api.html#aae9625f2ff12a73b6007b429132a1531',1,'linalg_c_api']]], - ['la_5fsolve_5fqr_264',['la_solve_qr',['../namespacelinalg__c__api.html#a13ed5d138ff59a9f649babc5c1dd9eab',1,'linalg_c_api']]], - ['la_5fsolve_5fqr_5fcmplx_265',['la_solve_qr_cmplx',['../namespacelinalg__c__api.html#ad05206b75a9cd1c5a2bda147307ef2d5',1,'linalg_c_api']]], - ['la_5fsolve_5fqr_5fcmplx_5fpvt_266',['la_solve_qr_cmplx_pvt',['../namespacelinalg__c__api.html#a17bfa880bc9019cbd654d20cab263ce3',1,'linalg_c_api']]], - ['la_5fsolve_5fqr_5fpvt_267',['la_solve_qr_pvt',['../namespacelinalg__c__api.html#a0d12474b0ca7772e4ad4ebc7ce227315',1,'linalg_c_api']]], - ['la_5fsolve_5ftri_5fmtx_268',['la_solve_tri_mtx',['../namespacelinalg__c__api.html#a7a72759b932b32e346a70cec542557ff',1,'linalg_c_api']]], - ['la_5fsolve_5ftri_5fmtx_5fcmplx_269',['la_solve_tri_mtx_cmplx',['../namespacelinalg__c__api.html#a7a8e491e75d2d00911d0992b37aac43d',1,'linalg_c_api']]], - ['la_5fsort_5feigen_270',['la_sort_eigen',['../namespacelinalg__c__api.html#ab81f25f6835feac7a88250c9863a4120',1,'linalg_c_api']]], - ['la_5fsort_5feigen_5fcmplx_271',['la_sort_eigen_cmplx',['../namespacelinalg__c__api.html#a2a0c8ddfd134f3d57849925d359d53b2',1,'linalg_c_api']]], - ['la_5fsvd_272',['la_svd',['../namespacelinalg__c__api.html#a436b645816859aea4a8fbd55e733ab92',1,'linalg_c_api']]], - ['la_5fsvd_5fcmplx_273',['la_svd_cmplx',['../namespacelinalg__c__api.html#a45eeb38b8a0d572fc25a7db98690f705',1,'linalg_c_api']]], - ['la_5ftrace_274',['la_trace',['../namespacelinalg__c__api.html#af8627c89c2201ae47c9cfac1d65abfd4',1,'linalg_c_api']]], - ['la_5ftrace_5fcmplx_275',['la_trace_cmplx',['../namespacelinalg__c__api.html#a315ef452fe9f00baa454dc930813fedc',1,'linalg_c_api']]], - ['la_5ftri_5fmtx_5fmult_276',['la_tri_mtx_mult',['../namespacelinalg__c__api.html#a754866d88e140dbf618c1d85f016c633',1,'linalg_c_api']]], - ['la_5ftri_5fmtx_5fmult_5fcmplx_277',['la_tri_mtx_mult_cmplx',['../namespacelinalg__c__api.html#aeb63de65aa9a9bc040860b8f78dcd3fa',1,'linalg_c_api']]] + ['la_5fcholesky_5ffactor_0',['la_cholesky_factor',['../namespacelinalg__c__api.html#a99d3ac7f90cad0c643dd8abff6592032',1,'linalg_c_api']]], + ['la_5fcholesky_5ffactor_5fcmplx_1',['la_cholesky_factor_cmplx',['../namespacelinalg__c__api.html#a800b0d6ba6f8d812d8038dd06c0967a8',1,'linalg_c_api']]], + ['la_5fcholesky_5frank1_5fdowndate_2',['la_cholesky_rank1_downdate',['../namespacelinalg__c__api.html#a5b5758f439d34c765ff5285c21fa88c1',1,'linalg_c_api']]], + ['la_5fcholesky_5frank1_5fdowndate_5fcmplx_3',['la_cholesky_rank1_downdate_cmplx',['../namespacelinalg__c__api.html#a3232c643af8f8615961c4b1bab422a4a',1,'linalg_c_api']]], + ['la_5fcholesky_5frank1_5fupdate_4',['la_cholesky_rank1_update',['../namespacelinalg__c__api.html#ae5c0bda2e1ae3a4dbdaf6d0586247b4c',1,'linalg_c_api']]], + ['la_5fcholesky_5frank1_5fupdate_5fcmplx_5',['la_cholesky_rank1_update_cmplx',['../namespacelinalg__c__api.html#a5746e1736802b9a082057c7997325049',1,'linalg_c_api']]], + ['la_5fdet_6',['la_det',['../namespacelinalg__c__api.html#afd21b0e476168de7eb9a6a5ef3a2e8b4',1,'linalg_c_api']]], + ['la_5fdet_5fcmplx_7',['la_det_cmplx',['../namespacelinalg__c__api.html#a82fcbd45f4a92431587312560fbcc636',1,'linalg_c_api']]], + ['la_5fdiag_5fmtx_5fmult_8',['la_diag_mtx_mult',['../namespacelinalg__c__api.html#ae866f3e174aed82f3fdfa3483ac91333',1,'linalg_c_api']]], + ['la_5fdiag_5fmtx_5fmult_5fcmplx_9',['la_diag_mtx_mult_cmplx',['../namespacelinalg__c__api.html#a1af56ff742938c0be90fb34146b13365',1,'linalg_c_api']]], + ['la_5fdiag_5fmtx_5fmult_5fmixed_10',['la_diag_mtx_mult_mixed',['../namespacelinalg__c__api.html#adadfcde438cabd5b104b62f2541712d1',1,'linalg_c_api']]], + ['la_5feigen_5fasymm_11',['la_eigen_asymm',['../namespacelinalg__c__api.html#af2ed46a8b1285ac08f0f86162288a865',1,'linalg_c_api']]], + ['la_5feigen_5fcmplx_12',['la_eigen_cmplx',['../namespacelinalg__c__api.html#ab133f51c44eb244be0b6e966f5893259',1,'linalg_c_api']]], + ['la_5feigen_5fgen_13',['la_eigen_gen',['../namespacelinalg__c__api.html#a93920f1db884cbad9bfc335abe36bed4',1,'linalg_c_api']]], + ['la_5feigen_5fsymm_14',['la_eigen_symm',['../namespacelinalg__c__api.html#a63372e9678f7052d17c8676324d6e7a7',1,'linalg_c_api']]], + ['la_5fform_5flu_15',['la_form_lu',['../namespacelinalg__c__api.html#aeab30d9e07601b343f15bf03d8220044',1,'linalg_c_api']]], + ['la_5fform_5flu_5fcmplx_16',['la_form_lu_cmplx',['../namespacelinalg__c__api.html#ae9bcd3e2df3151a5d92da48973501f6b',1,'linalg_c_api']]], + ['la_5fform_5fqr_17',['la_form_qr',['../namespacelinalg__c__api.html#a9426f737c5d551a133f44e2d7cb98a1d',1,'linalg_c_api']]], + ['la_5fform_5fqr_5fcmplx_18',['la_form_qr_cmplx',['../namespacelinalg__c__api.html#a9be60e86103e09be4d19fd3728f5d64b',1,'linalg_c_api']]], + ['la_5fform_5fqr_5fcmplx_5fpvt_19',['la_form_qr_cmplx_pvt',['../namespacelinalg__c__api.html#a5146fcf6552a097e05d46afaf91f424e',1,'linalg_c_api']]], + ['la_5fform_5fqr_5fpvt_20',['la_form_qr_pvt',['../namespacelinalg__c__api.html#a69d0ec69152e04fc5f766dd7c6d23f98',1,'linalg_c_api']]], + ['la_5finverse_21',['la_inverse',['../namespacelinalg__c__api.html#a307a6d5e27d90b28a38fba8c02e14461',1,'linalg_c_api']]], + ['la_5finverse_5fcmplx_22',['la_inverse_cmplx',['../namespacelinalg__c__api.html#a715855159abe740aff7bf95303a3f715',1,'linalg_c_api']]], + ['la_5flu_5ffactor_23',['la_lu_factor',['../namespacelinalg__c__api.html#a3e91c088c8d173e9b12c17b1ebc9bfa4',1,'linalg_c_api']]], + ['la_5flu_5ffactor_5fcmplx_24',['la_lu_factor_cmplx',['../namespacelinalg__c__api.html#a1788fe3192429b2cfd3a169d879a6f0e',1,'linalg_c_api']]], + ['la_5fmtx_5fmult_25',['la_mtx_mult',['../namespacelinalg__c__api.html#a434338a38a5fde94d8df3119b169fd01',1,'linalg_c_api']]], + ['la_5fmtx_5fmult_5fcmplx_26',['la_mtx_mult_cmplx',['../namespacelinalg__c__api.html#abdc93ffffffefdef839370da19f01430',1,'linalg_c_api']]], + ['la_5fmult_5fqr_27',['la_mult_qr',['../namespacelinalg__c__api.html#a2604ade114e67587300b3916846fc961',1,'linalg_c_api']]], + ['la_5fmult_5fqr_5fcmplx_28',['la_mult_qr_cmplx',['../namespacelinalg__c__api.html#a4b8c42819e069a18ec39c5ebb9ef8703',1,'linalg_c_api']]], + ['la_5fpinverse_29',['la_pinverse',['../namespacelinalg__c__api.html#a39bb26dcab43d8f54471af87af69e606',1,'linalg_c_api']]], + ['la_5fpinverse_5fcmplx_30',['la_pinverse_cmplx',['../namespacelinalg__c__api.html#ad0eefe5cf5a74d6848bbde0e8bb22550',1,'linalg_c_api']]], + ['la_5fqr_5ffactor_31',['la_qr_factor',['../namespacelinalg__c__api.html#a2c896885507a331ad89e579868da0fd3',1,'linalg_c_api']]], + ['la_5fqr_5ffactor_5fcmplx_32',['la_qr_factor_cmplx',['../namespacelinalg__c__api.html#a13a75b6d7bce1788b5e286a879456347',1,'linalg_c_api']]], + ['la_5fqr_5ffactor_5fcmplx_5fpvt_33',['la_qr_factor_cmplx_pvt',['../namespacelinalg__c__api.html#aa7bc80d9671a82aafdfc9a8ab904cb22',1,'linalg_c_api']]], + ['la_5fqr_5ffactor_5fpvt_34',['la_qr_factor_pvt',['../namespacelinalg__c__api.html#a9868095d332ba323afce1cda4085dd8c',1,'linalg_c_api']]], + ['la_5fqr_5frank1_5fupdate_35',['la_qr_rank1_update',['../namespacelinalg__c__api.html#a056fb14e92f98c660573886c0ad940ff',1,'linalg_c_api']]], + ['la_5fqr_5frank1_5fupdate_5fcmplx_36',['la_qr_rank1_update_cmplx',['../namespacelinalg__c__api.html#a01cf2129d7af3ddc8fb6e1fff7786ff1',1,'linalg_c_api']]], + ['la_5frank_37',['la_rank',['../namespacelinalg__c__api.html#a32548b9eb091164d51ed3793afee83e9',1,'linalg_c_api']]], + ['la_5frank1_5fupdate_38',['la_rank1_update',['../namespacelinalg__c__api.html#a6e47b549d59377db83a0eb27d739df8d',1,'linalg_c_api']]], + ['la_5frank1_5fupdate_5fcmplx_39',['la_rank1_update_cmplx',['../namespacelinalg__c__api.html#ac46bdb1315742f700571bf4f7c705ffd',1,'linalg_c_api']]], + ['la_5frank_5fcmplx_40',['la_rank_cmplx',['../namespacelinalg__c__api.html#a60244c1c8ef1ac3217a9efa69fdbd229',1,'linalg_c_api']]], + ['la_5fsolve_5fcholesky_41',['la_solve_cholesky',['../namespacelinalg__c__api.html#ac286fe9a7ed4d69ca30ecbe03959f209',1,'linalg_c_api']]], + ['la_5fsolve_5fcholesky_5fcmplx_42',['la_solve_cholesky_cmplx',['../namespacelinalg__c__api.html#a83a08022c84ac2e76f7d20486797bd33',1,'linalg_c_api']]], + ['la_5fsolve_5fleast_5fsquares_43',['la_solve_least_squares',['../namespacelinalg__c__api.html#af1d700238a8ab71b17ff8c15221a9e02',1,'linalg_c_api']]], + ['la_5fsolve_5fleast_5fsquares_5fcmplx_44',['la_solve_least_squares_cmplx',['../namespacelinalg__c__api.html#a2c691c114d54a8eb89ce2882d0557550',1,'linalg_c_api']]], + ['la_5fsolve_5flu_45',['la_solve_lu',['../namespacelinalg__c__api.html#a846baffbc77d4348d7b15d3f83983a04',1,'linalg_c_api']]], + ['la_5fsolve_5flu_5fcmplx_46',['la_solve_lu_cmplx',['../namespacelinalg__c__api.html#aae9625f2ff12a73b6007b429132a1531',1,'linalg_c_api']]], + ['la_5fsolve_5fqr_47',['la_solve_qr',['../namespacelinalg__c__api.html#a13ed5d138ff59a9f649babc5c1dd9eab',1,'linalg_c_api']]], + ['la_5fsolve_5fqr_5fcmplx_48',['la_solve_qr_cmplx',['../namespacelinalg__c__api.html#ad05206b75a9cd1c5a2bda147307ef2d5',1,'linalg_c_api']]], + ['la_5fsolve_5fqr_5fcmplx_5fpvt_49',['la_solve_qr_cmplx_pvt',['../namespacelinalg__c__api.html#a17bfa880bc9019cbd654d20cab263ce3',1,'linalg_c_api']]], + ['la_5fsolve_5fqr_5fpvt_50',['la_solve_qr_pvt',['../namespacelinalg__c__api.html#a0d12474b0ca7772e4ad4ebc7ce227315',1,'linalg_c_api']]], + ['la_5fsolve_5ftri_5fmtx_51',['la_solve_tri_mtx',['../namespacelinalg__c__api.html#a7a72759b932b32e346a70cec542557ff',1,'linalg_c_api']]], + ['la_5fsolve_5ftri_5fmtx_5fcmplx_52',['la_solve_tri_mtx_cmplx',['../namespacelinalg__c__api.html#a7a8e491e75d2d00911d0992b37aac43d',1,'linalg_c_api']]], + ['la_5fsort_5feigen_53',['la_sort_eigen',['../namespacelinalg__c__api.html#ab81f25f6835feac7a88250c9863a4120',1,'linalg_c_api']]], + ['la_5fsort_5feigen_5fcmplx_54',['la_sort_eigen_cmplx',['../namespacelinalg__c__api.html#a2a0c8ddfd134f3d57849925d359d53b2',1,'linalg_c_api']]], + ['la_5fsvd_55',['la_svd',['../namespacelinalg__c__api.html#a436b645816859aea4a8fbd55e733ab92',1,'linalg_c_api']]], + ['la_5fsvd_5fcmplx_56',['la_svd_cmplx',['../namespacelinalg__c__api.html#a45eeb38b8a0d572fc25a7db98690f705',1,'linalg_c_api']]], + ['la_5ftrace_57',['la_trace',['../namespacelinalg__c__api.html#af8627c89c2201ae47c9cfac1d65abfd4',1,'linalg_c_api']]], + ['la_5ftrace_5fcmplx_58',['la_trace_cmplx',['../namespacelinalg__c__api.html#a315ef452fe9f00baa454dc930813fedc',1,'linalg_c_api']]], + ['la_5ftri_5fmtx_5fmult_59',['la_tri_mtx_mult',['../namespacelinalg__c__api.html#a754866d88e140dbf618c1d85f016c633',1,'linalg_c_api']]], + ['la_5ftri_5fmtx_5fmult_5fcmplx_60',['la_tri_mtx_mult_cmplx',['../namespacelinalg__c__api.html#aeb63de65aa9a9bc040860b8f78dcd3fa',1,'linalg_c_api']]] ]; diff --git a/doc/html/search/functions_2.js b/doc/html/search/functions_2.js index a5862e5b..c5450b53 100644 --- a/doc/html/search/functions_2.js +++ b/doc/html/search/functions_2.js @@ -1,39 +1,13 @@ var searchData= [ - ['mat_5fcholesky_278',['mat_cholesky',['../namespacelinalg__immutable.html#a5876e7f21f20679fd6c0c84768061a30',1,'linalg_immutable']]], - ['mat_5fcholesky_5frank1_5fdowndate_279',['mat_cholesky_rank1_downdate',['../namespacelinalg__immutable.html#afb844327cadfdd08580c94cb1668c2a8',1,'linalg_immutable']]], - ['mat_5fcholesky_5frank1_5fupdate_280',['mat_cholesky_rank1_update',['../namespacelinalg__immutable.html#a83eaeadc3a3cc5d81c46824174e5a90b',1,'linalg_immutable']]], - ['mat_5fdet_281',['mat_det',['../namespacelinalg__immutable.html#ab7abd8e3fd4170b5b5dfad4448a651c9',1,'linalg_immutable']]], - ['mat_5feigen_5f1_282',['mat_eigen_1',['../interfacelinalg__immutable_1_1mat__eigen.html#a30c4db4bc943963757cc91e6b01e591b',1,'linalg_immutable::mat_eigen::mat_eigen_1()'],['../namespacelinalg__immutable.html#a43cd58b7e0a06b193dce3cf94c4619d1',1,'linalg_immutable::mat_eigen_1()']]], - ['mat_5feigen_5f2_283',['mat_eigen_2',['../interfacelinalg__immutable_1_1mat__eigen.html#a9eaef6fd28d9713ebba5dbd3ca44deff',1,'linalg_immutable::mat_eigen::mat_eigen_2()'],['../namespacelinalg__immutable.html#a989c2bf5f15c717046815005a2280e1d',1,'linalg_immutable::mat_eigen_2()']]], - ['mat_5finverse_284',['mat_inverse',['../namespacelinalg__immutable.html#a98f5b4e5de682d686cb763ab60fcde7f',1,'linalg_immutable']]], - ['mat_5flu_5fcmplx_285',['mat_lu_cmplx',['../interfacelinalg__immutable_1_1mat__lu.html#a085e6774ff582e30cb7bcd45d554a585',1,'linalg_immutable::mat_lu::mat_lu_cmplx()'],['../namespacelinalg__immutable.html#ad3b277369fe90727b2012bc83ad9046f',1,'linalg_immutable::mat_lu_cmplx()']]], - ['mat_5flu_5fdbl_286',['mat_lu_dbl',['../interfacelinalg__immutable_1_1mat__lu.html#ab5bb8b86586008f8958cf7d026cc541f',1,'linalg_immutable::mat_lu::mat_lu_dbl()'],['../namespacelinalg__immutable.html#a47132c922306b87ab5b38635601c4ccd',1,'linalg_immutable::mat_lu_dbl()']]], - ['mat_5fmult_5fdiag_5f1_287',['mat_mult_diag_1',['../interfacelinalg__immutable_1_1mat__mult__diag.html#ac7e97da527c8e0ba4be582d79fe94331',1,'linalg_immutable::mat_mult_diag::mat_mult_diag_1()'],['../namespacelinalg__immutable.html#a2f1744ac9f0385bd2079c6615b22b4a8',1,'linalg_immutable::mat_mult_diag_1()']]], - ['mat_5fmult_5fdiag_5f1_5fcmplx_288',['mat_mult_diag_1_cmplx',['../interfacelinalg__immutable_1_1mat__mult__diag.html#a202551e80ef44a3b0cfc827c1d33cbcd',1,'linalg_immutable::mat_mult_diag::mat_mult_diag_1_cmplx()'],['../namespacelinalg__immutable.html#a6f225ced64164d9b41215e96cfd83d7f',1,'linalg_immutable::mat_mult_diag_1_cmplx()']]], - ['mat_5fmult_5fdiag_5f2_289',['mat_mult_diag_2',['../interfacelinalg__immutable_1_1mat__mult__diag.html#a2977bc4d536b8c40e77f222be6b1bb9e',1,'linalg_immutable::mat_mult_diag::mat_mult_diag_2()'],['../namespacelinalg__immutable.html#ac2b66504ea3cb772e1bf44017d2fe864',1,'linalg_immutable::mat_mult_diag_2()']]], - ['mat_5fmult_5fdiag_5f2_5fcmplx_290',['mat_mult_diag_2_cmplx',['../interfacelinalg__immutable_1_1mat__mult__diag.html#a81769d8240f87a60da4e7c66fca2d5f7',1,'linalg_immutable::mat_mult_diag::mat_mult_diag_2_cmplx()'],['../namespacelinalg__immutable.html#a25ece4409f695a48fcc73d09ab580717',1,'linalg_immutable::mat_mult_diag_2_cmplx()']]], - ['mat_5fmult_5fdiag_5f3_291',['mat_mult_diag_3',['../interfacelinalg__immutable_1_1mat__mult__diag.html#a387bdf49e35ada60f819efb7db189f78',1,'linalg_immutable::mat_mult_diag::mat_mult_diag_3()'],['../namespacelinalg__immutable.html#aae5f29bbb5069040b9a942d09469d194',1,'linalg_immutable::mat_mult_diag_3()']]], - ['mat_5fmult_5fdiag_5f3_5fcmplx_292',['mat_mult_diag_3_cmplx',['../interfacelinalg__immutable_1_1mat__mult__diag.html#a126d23945fc3d2280e4a6edbaa2ad5c9',1,'linalg_immutable::mat_mult_diag::mat_mult_diag_3_cmplx()'],['../namespacelinalg__immutable.html#a6e50d4cb3ed90be4cfc9f426a35d83cb',1,'linalg_immutable::mat_mult_diag_3_cmplx()']]], - ['mat_5fmult_5flower_5ftri_5f1_293',['mat_mult_lower_tri_1',['../interfacelinalg__immutable_1_1mat__mult__lower__tri.html#a588ba3472cb80109671f756d611ed023',1,'linalg_immutable::mat_mult_lower_tri::mat_mult_lower_tri_1()'],['../namespacelinalg__immutable.html#a2e4106f6834d3ca9980765f9140a07f6',1,'linalg_immutable::mat_mult_lower_tri_1()']]], - ['mat_5fmult_5flower_5ftri_5f1_5fcmplx_294',['mat_mult_lower_tri_1_cmplx',['../interfacelinalg__immutable_1_1mat__mult__lower__tri.html#ace28e02e648b20c69f10919e0e9ab839',1,'linalg_immutable::mat_mult_lower_tri::mat_mult_lower_tri_1_cmplx()'],['../namespacelinalg__immutable.html#ad8ab2e4958204caafa6bf26d6a7c576e',1,'linalg_immutable::mat_mult_lower_tri_1_cmplx()']]], - ['mat_5fmult_5flower_5ftri_5f2_295',['mat_mult_lower_tri_2',['../interfacelinalg__immutable_1_1mat__mult__lower__tri.html#a9754468f10374e34e1a2fb40ce1206e0',1,'linalg_immutable::mat_mult_lower_tri::mat_mult_lower_tri_2()'],['../namespacelinalg__immutable.html#ac278e04a89fc8e5e759cca3006b10a77',1,'linalg_immutable::mat_mult_lower_tri_2()']]], - ['mat_5fmult_5flower_5ftri_5f2_5fcmplx_296',['mat_mult_lower_tri_2_cmplx',['../interfacelinalg__immutable_1_1mat__mult__lower__tri.html#ac1a3df11bc32e8f90d4f623620c7006f',1,'linalg_immutable::mat_mult_lower_tri::mat_mult_lower_tri_2_cmplx()'],['../namespacelinalg__immutable.html#add83d93fee8c29482dc2e14694636bbf',1,'linalg_immutable::mat_mult_lower_tri_2_cmplx()']]], - ['mat_5fmult_5fupper_5ftri_5f1_297',['mat_mult_upper_tri_1',['../interfacelinalg__immutable_1_1mat__mult__upper__tri.html#a20ce53441ab78f4879a43849c1ed2447',1,'linalg_immutable::mat_mult_upper_tri::mat_mult_upper_tri_1()'],['../namespacelinalg__immutable.html#aaf02322c06a6a0ec301f06f120662959',1,'linalg_immutable::mat_mult_upper_tri_1()']]], - ['mat_5fmult_5fupper_5ftri_5f1_5fcmplx_298',['mat_mult_upper_tri_1_cmplx',['../interfacelinalg__immutable_1_1mat__mult__upper__tri.html#a6a23337b162b1b1343fac5c9fc4ecd5e',1,'linalg_immutable::mat_mult_upper_tri::mat_mult_upper_tri_1_cmplx()'],['../namespacelinalg__immutable.html#ab2fe02a1d4a4f1b4b4099735a8536a44',1,'linalg_immutable::mat_mult_upper_tri_1_cmplx()']]], - ['mat_5fmult_5fupper_5ftri_5f2_299',['mat_mult_upper_tri_2',['../interfacelinalg__immutable_1_1mat__mult__upper__tri.html#a39d766d741737c85e6a7f9f60b36f855',1,'linalg_immutable::mat_mult_upper_tri::mat_mult_upper_tri_2()'],['../namespacelinalg__immutable.html#a222bcdc4b18a3297de7fed3ccbbb7aac',1,'linalg_immutable::mat_mult_upper_tri_2()']]], - ['mat_5fmult_5fupper_5ftri_5f2_5fcmplx_300',['mat_mult_upper_tri_2_cmplx',['../interfacelinalg__immutable_1_1mat__mult__upper__tri.html#a64fdf72e665743c6b8703b9dec595e3f',1,'linalg_immutable::mat_mult_upper_tri::mat_mult_upper_tri_2_cmplx()'],['../namespacelinalg__immutable.html#ab2a942c3a6762176fd4135c953699b7b',1,'linalg_immutable::mat_mult_upper_tri_2_cmplx()']]], - ['mat_5fpinverse_301',['mat_pinverse',['../namespacelinalg__immutable.html#aaf39795f72fad79a38213893b850d793',1,'linalg_immutable']]], - ['mat_5fqr_302',['mat_qr',['../namespacelinalg__immutable.html#a8f1ba0ce9f8fbece16a512145bbc197f',1,'linalg_immutable']]], - ['mat_5fqr_5frank1_5fupdate_303',['mat_qr_rank1_update',['../namespacelinalg__immutable.html#a4b09077ad1495833919bab84b144b297',1,'linalg_immutable']]], - ['mat_5frank1_5fupdate_304',['mat_rank1_update',['../namespacelinalg__immutable.html#a9648fd41cc3ce8ec40f67236d274f9a8',1,'linalg_immutable']]], - ['mat_5fsolve_5flower_5ftri_5f1_305',['mat_solve_lower_tri_1',['../interfacelinalg__immutable_1_1mat__solve__lower__tri.html#a9b40869b879ddc2e960a7ec46d17c09a',1,'linalg_immutable::mat_solve_lower_tri::mat_solve_lower_tri_1()'],['../namespacelinalg__immutable.html#a7f274a564220237f437d97eb8bb32bed',1,'linalg_immutable::mat_solve_lower_tri_1()']]], - ['mat_5fsolve_5flower_5ftri_5f1_5fcmplx_306',['mat_solve_lower_tri_1_cmplx',['../interfacelinalg__immutable_1_1mat__solve__lower__tri.html#aa0c0c7078ffd02046021c6bd25375a58',1,'linalg_immutable::mat_solve_lower_tri::mat_solve_lower_tri_1_cmplx()'],['../namespacelinalg__immutable.html#a287c258d5a10863d235f95ef63a61f31',1,'linalg_immutable::mat_solve_lower_tri_1_cmplx()']]], - ['mat_5fsolve_5flower_5ftri_5f2_307',['mat_solve_lower_tri_2',['../interfacelinalg__immutable_1_1mat__solve__lower__tri.html#a4e1d7b1aaa7aa8eeff2c09a481cbb9fa',1,'linalg_immutable::mat_solve_lower_tri::mat_solve_lower_tri_2()'],['../namespacelinalg__immutable.html#af92354265e3c2d5fbaaea92527c2e66d',1,'linalg_immutable::mat_solve_lower_tri_2()']]], - ['mat_5fsolve_5flower_5ftri_5f2_5fcmplx_308',['mat_solve_lower_tri_2_cmplx',['../interfacelinalg__immutable_1_1mat__solve__lower__tri.html#a2dc5a090481dd5226c19214205a2c047',1,'linalg_immutable::mat_solve_lower_tri::mat_solve_lower_tri_2_cmplx()'],['../namespacelinalg__immutable.html#a05f08319eaa40487fa8065916e652c7a',1,'linalg_immutable::mat_solve_lower_tri_2_cmplx()']]], - ['mat_5fsolve_5fupper_5ftri_5f1_309',['mat_solve_upper_tri_1',['../interfacelinalg__immutable_1_1mat__solve__upper__tri.html#a97f528aee778d8ddfdcb52058d048de7',1,'linalg_immutable::mat_solve_upper_tri::mat_solve_upper_tri_1()'],['../namespacelinalg__immutable.html#a4906084c7d42b573a13b46996bcdc8eb',1,'linalg_immutable::mat_solve_upper_tri_1()']]], - ['mat_5fsolve_5fupper_5ftri_5f1_5fcmplx_310',['mat_solve_upper_tri_1_cmplx',['../interfacelinalg__immutable_1_1mat__solve__upper__tri.html#a59e1f0aed5b9fd5b952542d8e669fdbd',1,'linalg_immutable::mat_solve_upper_tri::mat_solve_upper_tri_1_cmplx()'],['../namespacelinalg__immutable.html#a0a00f6655a0337341eb881d7d6e0c659',1,'linalg_immutable::mat_solve_upper_tri_1_cmplx()']]], - ['mat_5fsolve_5fupper_5ftri_5f2_311',['mat_solve_upper_tri_2',['../interfacelinalg__immutable_1_1mat__solve__upper__tri.html#a8085ffccaa724ae8f60c897fa38691f7',1,'linalg_immutable::mat_solve_upper_tri::mat_solve_upper_tri_2()'],['../namespacelinalg__immutable.html#ae4599b0f5c5cbb89e77ee132b6be5386',1,'linalg_immutable::mat_solve_upper_tri_2()']]], - ['mat_5fsolve_5fupper_5ftri_5f2_5fcmplx_312',['mat_solve_upper_tri_2_cmplx',['../interfacelinalg__immutable_1_1mat__solve__upper__tri.html#a93e3f2a1097e88c8da32d6e13eb0472f',1,'linalg_immutable::mat_solve_upper_tri::mat_solve_upper_tri_2_cmplx()'],['../namespacelinalg__immutable.html#ad1fa7c5e331bf2f2f73b6dbf9ccf77c2',1,'linalg_immutable::mat_solve_upper_tri_2_cmplx()']]], - ['mat_5fsvd_313',['mat_svd',['../namespacelinalg__immutable.html#a6236acadb527f7762e3e1c0ee3d9ca82',1,'linalg_immutable']]] + ['mat_5fcholesky_0',['mat_cholesky',['../namespacelinalg__immutable.html#a5876e7f21f20679fd6c0c84768061a30',1,'linalg_immutable']]], + ['mat_5fcholesky_5frank1_5fdowndate_1',['mat_cholesky_rank1_downdate',['../namespacelinalg__immutable.html#afb844327cadfdd08580c94cb1668c2a8',1,'linalg_immutable']]], + ['mat_5fcholesky_5frank1_5fupdate_2',['mat_cholesky_rank1_update',['../namespacelinalg__immutable.html#a83eaeadc3a3cc5d81c46824174e5a90b',1,'linalg_immutable']]], + ['mat_5fdet_3',['mat_det',['../namespacelinalg__immutable.html#ab7abd8e3fd4170b5b5dfad4448a651c9',1,'linalg_immutable']]], + ['mat_5finverse_4',['mat_inverse',['../namespacelinalg__immutable.html#a98f5b4e5de682d686cb763ab60fcde7f',1,'linalg_immutable']]], + ['mat_5fpinverse_5',['mat_pinverse',['../namespacelinalg__immutable.html#aaf39795f72fad79a38213893b850d793',1,'linalg_immutable']]], + ['mat_5fqr_6',['mat_qr',['../namespacelinalg__immutable.html#a8f1ba0ce9f8fbece16a512145bbc197f',1,'linalg_immutable']]], + ['mat_5fqr_5frank1_5fupdate_7',['mat_qr_rank1_update',['../namespacelinalg__immutable.html#a4b09077ad1495833919bab84b144b297',1,'linalg_immutable']]], + ['mat_5frank1_5fupdate_8',['mat_rank1_update',['../namespacelinalg__immutable.html#a9648fd41cc3ce8ec40f67236d274f9a8',1,'linalg_immutable']]], + ['mat_5fsvd_9',['mat_svd',['../namespacelinalg__immutable.html#a6236acadb527f7762e3e1c0ee3d9ca82',1,'linalg_immutable']]] ]; diff --git a/doc/html/search/mag.svg b/doc/html/search/mag.svg new file mode 100644 index 00000000..9f46b301 --- /dev/null +++ b/doc/html/search/mag.svg @@ -0,0 +1,37 @@ + + + + + + image/svg+xml + + + + + + + + + diff --git a/doc/html/search/mag_d.svg b/doc/html/search/mag_d.svg new file mode 100644 index 00000000..b9a814c7 --- /dev/null +++ b/doc/html/search/mag_d.svg @@ -0,0 +1,37 @@ + + + + + + image/svg+xml + + + + + + + + + diff --git a/doc/html/search/mag_sel.svg b/doc/html/search/mag_sel.svg new file mode 100644 index 00000000..03626f64 --- /dev/null +++ b/doc/html/search/mag_sel.svg @@ -0,0 +1,74 @@ + + + + + + + + image/svg+xml + + + + + + + + + + + diff --git a/doc/html/search/mag_seld.svg b/doc/html/search/mag_seld.svg new file mode 100644 index 00000000..6e720dcc --- /dev/null +++ b/doc/html/search/mag_seld.svg @@ -0,0 +1,74 @@ + + + + + + + + image/svg+xml + + + + + + + + + + + diff --git a/doc/html/search/namespaces_0.js b/doc/html/search/namespaces_0.js index 4fb9b843..ecf60b9d 100644 --- a/doc/html/search/namespaces_0.js +++ b/doc/html/search/namespaces_0.js @@ -1,7 +1,7 @@ var searchData= [ - ['linalg_5fc_5fapi_213',['linalg_c_api',['../namespacelinalg__c__api.html',1,'']]], - ['linalg_5fconstants_214',['linalg_constants',['../namespacelinalg__constants.html',1,'']]], - ['linalg_5fcore_215',['linalg_core',['../namespacelinalg__core.html',1,'']]], - ['linalg_5fimmutable_216',['linalg_immutable',['../namespacelinalg__immutable.html',1,'']]] + ['linalg_5fc_5fapi_0',['linalg_c_api',['../namespacelinalg__c__api.html',1,'']]], + ['linalg_5fconstants_1',['linalg_constants',['../namespacelinalg__constants.html',1,'']]], + ['linalg_5fcore_2',['linalg_core',['../namespacelinalg__core.html',1,'']]], + ['linalg_5fimmutable_3',['linalg_immutable',['../namespacelinalg__immutable.html',1,'']]] ]; diff --git a/doc/html/search/pages_0.js b/doc/html/search/pages_0.js new file mode 100644 index 00000000..0768ea63 --- /dev/null +++ b/doc/html/search/pages_0.js @@ -0,0 +1,4 @@ +var searchData= +[ + ['linalg_0',['linalg',['../index.html',1,'']]] +]; diff --git a/doc/html/search/search.css b/doc/html/search/search.css index 3cf9df94..19f76f9d 100644 --- a/doc/html/search/search.css +++ b/doc/html/search/search.css @@ -1,106 +1,124 @@ -/*---------------- Search Box */ +/*---------------- Search Box positioning */ -#FSearchBox { - float: left; +#main-menu > li:last-child { + /* This
  • object is the parent of the search bar */ + display: flex; + justify-content: center; + align-items: center; + height: 36px; + margin-right: 1em; +} + +/*---------------- Search box styling */ + +.SRPage * { + font-weight: normal; + line-height: normal; +} + +dark-mode-toggle { + margin-left: 5px; + display: flex; + float: right; } #MSearchBox { + display: inline-block; white-space : nowrap; - float: none; - margin-top: 8px; - right: 0px; - width: 170px; - height: 24px; + background: var(--search-background-color); + border-radius: 0.65em; + box-shadow: var(--search-box-shadow); z-index: 102; } -#MSearchBox .left -{ - display:block; - position:absolute; - left:10px; - width:20px; - height:19px; - background:url('search_l.png') no-repeat; - background-position:right; +#MSearchBox .left { + display: inline-block; + vertical-align: middle; + height: 1.4em; } #MSearchSelect { - display:block; - position:absolute; - width:20px; - height:19px; + display: inline-block; + vertical-align: middle; + width: 20px; + height: 19px; + background-image: var(--search-magnification-select-image); + margin: 0 0 0 0.3em; + padding: 0; } -.left #MSearchSelect { - left:4px; +#MSearchSelectExt { + display: inline-block; + vertical-align: middle; + width: 10px; + height: 19px; + background-image: var(--search-magnification-image); + margin: 0 0 0 0.5em; + padding: 0; } -.right #MSearchSelect { - right:5px; -} #MSearchField { - display:block; - position:absolute; - height:19px; - background:url('search_m.png') repeat-x; + display: inline-block; + vertical-align: middle; + width: 7.5em; + height: 19px; + margin: 0 0.15em; + padding: 0; + line-height: 1em; border:none; - width:115px; - margin-left:20px; - padding-left:4px; - color: #909090; + color: var(--search-foreground-color); outline: none; - font: 9pt Arial, Verdana, sans-serif; + font-family: var(--font-family-search); -webkit-border-radius: 0px; + border-radius: 0px; + background: none; } -#FSearchBox #MSearchField { - margin-left:15px; +@media(hover: none) { + /* to avoid zooming on iOS */ + #MSearchField { + font-size: 16px; + } } #MSearchBox .right { - display:block; - position:absolute; - right:10px; - top:8px; - width:20px; - height:19px; - background:url('search_r.png') no-repeat; - background-position:left; + display: inline-block; + vertical-align: middle; + width: 1.4em; + height: 1.4em; } #MSearchClose { display: none; - position: absolute; - top: 4px; + font-size: inherit; background : none; border: none; - margin: 0px 4px 0px 0px; - padding: 0px 0px; + margin: 0; + padding: 0; outline: none; -} -.left #MSearchClose { - left: 6px; } -.right #MSearchClose { - right: 2px; +#MSearchCloseImg { + padding: 0.3em; + margin: 0; } .MSearchBoxActive #MSearchField { - color: #000000; + color: var(--search-active-color); } + + /*---------------- Search filter selection */ #MSearchSelectWindow { display: none; position: absolute; left: 0; top: 0; - border: 1px solid #90A5CE; - background-color: #F9FAFC; + border: 1px solid var(--search-filter-border-color); + background-color: var(--search-filter-background-color); z-index: 10001; padding-top: 4px; padding-bottom: 4px; @@ -113,7 +131,7 @@ } .SelectItem { - font: 8pt Arial, Verdana, sans-serif; + font: 8pt var(--font-family-search); padding-left: 2px; padding-right: 12px; border: 0px; @@ -121,7 +139,7 @@ span.SelectionMark { margin-right: 4px; - font-family: monospace; + font-family: var(--font-family-monospace); outline-style: none; text-decoration: none; } @@ -129,7 +147,7 @@ span.SelectionMark { a.SelectItem { display: block; outline-style: none; - color: #000000; + color: var(--search-filter-foreground-color); text-decoration: none; padding-left: 6px; padding-right: 12px; @@ -137,14 +155,14 @@ a.SelectItem { a.SelectItem:focus, a.SelectItem:active { - color: #000000; + color: var(--search-filter-foreground-color); outline-style: none; text-decoration: none; } a.SelectItem:hover { - color: #FFFFFF; - background-color: #3D578C; + color: var(--search-filter-highlight-text-color); + background-color: var(--search-filter-highlight-bg-color); outline-style: none; text-decoration: none; cursor: pointer; @@ -154,7 +172,7 @@ a.SelectItem:hover { /*---------------- Search results window */ iframe#MSearchResults { - width: 60ex; + /*width: 60ex;*/ height: 15em; } @@ -162,9 +180,12 @@ iframe#MSearchResults { display: none; position: absolute; left: 0; top: 0; - border: 1px solid #000; - background-color: #EEF1F7; + border: 1px solid var(--search-results-border-color); + background-color: var(--search-results-background-color); z-index:10000; + width: 300px; + height: 400px; + overflow: auto; } /* ----------------------------------- */ @@ -172,7 +193,6 @@ iframe#MSearchResults { #SRIndex { clear:both; - padding-bottom: 15px; } .SREntry { @@ -185,8 +205,9 @@ iframe#MSearchResults { padding: 1px 5px; } -body.SRPage { +div.SRPage { margin: 5px 2px; + background-color: var(--search-results-background-color); } .SRChildren { @@ -198,17 +219,18 @@ body.SRPage { } .SRSymbol { - font-weight: bold; - color: #425E97; - font-family: Arial, Verdana, sans-serif; + font-weight: bold; + color: var(--search-results-foreground-color); + font-family: var(--font-family-search); text-decoration: none; outline: none; } a.SRScope { display: block; - color: #425E97; - font-family: Arial, Verdana, sans-serif; + color: var(--search-results-foreground-color); + font-family: var(--font-family-search); + font-size: 8pt; text-decoration: none; outline: none; } @@ -220,33 +242,31 @@ a.SRScope:focus, a.SRScope:active { span.SRScope { padding-left: 4px; + font-family: var(--font-family-search); } .SRPage .SRStatus { padding: 2px 5px; font-size: 8pt; font-style: italic; + font-family: var(--font-family-search); } .SRResult { display: none; } -DIV.searchresults { +div.searchresults { margin-left: 10px; margin-right: 10px; } /*---------------- External search page results */ -.searchresult { - background-color: #F0F3F8; -} - .pages b { color: white; padding: 5px 5px 3px 5px; - background-image: url("../tab_a.png"); + background-image: var(--nav-gradient-active-image-parent); background-repeat: repeat-x; text-shadow: 0 1px 1px #000000; } diff --git a/doc/html/search/search.js b/doc/html/search/search.js index a554ab9c..e103a262 100644 --- a/doc/html/search/search.js +++ b/doc/html/search/search.js @@ -1,25 +1,26 @@ /* - @licstart The following is the entire license notice for the - JavaScript code in this file. + @licstart The following is the entire license notice for the JavaScript code in this file. - Copyright (C) 1997-2017 by Dimitri van Heesch + The MIT License (MIT) - This program is free software; you can redistribute it and/or modify - it under the terms of the GNU General Public License as published by - the Free Software Foundation; either version 2 of the License, or - (at your option) any later version. + Copyright (C) 1997-2020 by Dimitri van Heesch - This program is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. + Permission is hereby granted, free of charge, to any person obtaining a copy of this software + and associated documentation files (the "Software"), to deal in the Software without restriction, + including without limitation the rights to use, copy, modify, merge, publish, distribute, + sublicense, and/or sell copies of the Software, and to permit persons to whom the Software is + furnished to do so, subject to the following conditions: - You should have received a copy of the GNU General Public License along - with this program; if not, write to the Free Software Foundation, Inc., - 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. + The above copyright notice and this permission notice shall be included in all copies or + substantial portions of the Software. - @licend The above is the entire license notice - for the JavaScript code in this file + THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING + BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND + NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, + DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, + OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. + + @licend The above is the entire license notice for the JavaScript code in this file */ function convertToId(search) { @@ -72,6 +73,8 @@ function getYPos(item) return y; } +var searchResults = new SearchResults("searchResults"); + /* A class handling everything associated with the search panel. Parameters: @@ -79,9 +82,10 @@ function getYPos(item) storing this instance. Is needed to be able to set timeouts. resultPath - path to use for external files */ -function SearchBox(name, resultsPath, inFrame, label) +function SearchBox(name, resultsPath, extension) { if (!name || !resultsPath) { alert("Missing parameters to SearchBox."); } + if (!extension || extension == "") { extension = ".html"; } // ---------- Instance variables this.name = name; @@ -94,8 +98,7 @@ function SearchBox(name, resultsPath, inFrame, label) this.hideTimeout = 0; this.searchIndex = 0; this.searchActive = false; - this.insideFrame = inFrame; - this.searchLabel = label; + this.extension = extension; // ----------- DOM Elements @@ -133,30 +136,14 @@ function SearchBox(name, resultsPath, inFrame, label) var searchSelectWindow = this.DOMSearchSelectWindow(); var searchField = this.DOMSearchSelect(); - if (this.insideFrame) - { - var left = getXPos(searchField); - var top = getYPos(searchField); - left += searchField.offsetWidth + 6; - top += searchField.offsetHeight; + var left = getXPos(searchField); + var top = getYPos(searchField); + top += searchField.offsetHeight; - // show search selection popup - searchSelectWindow.style.display='block'; - left -= searchSelectWindow.offsetWidth; - searchSelectWindow.style.left = left + 'px'; - searchSelectWindow.style.top = top + 'px'; - } - else - { - var left = getXPos(searchField); - var top = getYPos(searchField); - top += searchField.offsetHeight; - - // show search selection popup - searchSelectWindow.style.display='block'; - searchSelectWindow.style.left = left + 'px'; - searchSelectWindow.style.top = top + 'px'; - } + // show search selection popup + searchSelectWindow.style.display='block'; + searchSelectWindow.style.left = left + 'px'; + searchSelectWindow.style.top = top + 'px'; // stop selection hide timer if (this.hideTimeout) @@ -200,9 +187,9 @@ function SearchBox(name, resultsPath, inFrame, label) } return; } - else if (window.frames.MSearchResults.searchResults) + else { - var elem = window.frames.MSearchResults.searchResults.NavNext(0); + var elem = searchResults.NavNext(0); if (elem) elem.focus(); } } @@ -339,55 +326,66 @@ function SearchBox(name, resultsPath, inFrame, label) idxChar = searchValue.substr(0, 2); } - var resultsPage; - var resultsPageWithSearch; - var hasResultsPage; + var jsFile; var idx = indexSectionsWithContent[this.searchIndex].indexOf(idxChar); if (idx!=-1) { var hexCode=idx.toString(16); - resultsPage = this.resultsPath + '/' + indexSectionNames[this.searchIndex] + '_' + hexCode + '.html'; - resultsPageWithSearch = resultsPage+'?'+escape(searchValue); - hasResultsPage = true; + jsFile = this.resultsPath + indexSectionNames[this.searchIndex] + '_' + hexCode + '.js'; } - else // nothing available for this search term - { - resultsPage = this.resultsPath + '/nomatches.html'; - resultsPageWithSearch = resultsPage; - hasResultsPage = false; + + var loadJS = function(url, impl, loc){ + var scriptTag = document.createElement('script'); + scriptTag.src = url; + scriptTag.onload = impl; + scriptTag.onreadystatechange = impl; + loc.appendChild(scriptTag); } - window.frames.MSearchResults.location = resultsPageWithSearch; var domPopupSearchResultsWindow = this.DOMPopupSearchResultsWindow(); + var domSearchBox = this.DOMSearchBox(); + var domPopupSearchResults = this.DOMPopupSearchResults(); + var domSearchClose = this.DOMSearchClose(); + var resultsPath = this.resultsPath; + + var handleResults = function() { + document.getElementById("Loading").style.display="none"; + if (typeof searchData !== 'undefined') { + createResults(resultsPath); + document.getElementById("NoMatches").style.display="none"; + } + + searchResults.Search(searchValue); - if (domPopupSearchResultsWindow.style.display!='block') - { - var domSearchBox = this.DOMSearchBox(); - this.DOMSearchClose().style.display = 'inline'; - if (this.insideFrame) - { - var domPopupSearchResults = this.DOMPopupSearchResults(); - domPopupSearchResultsWindow.style.position = 'relative'; - domPopupSearchResultsWindow.style.display = 'block'; - var width = document.body.clientWidth - 8; // the -8 is for IE :-( - domPopupSearchResultsWindow.style.width = width + 'px'; - domPopupSearchResults.style.width = width + 'px'; - } - else - { - var domPopupSearchResults = this.DOMPopupSearchResults(); - var left = getXPos(domSearchBox) + 150; // domSearchBox.offsetWidth; - var top = getYPos(domSearchBox) + 20; // domSearchBox.offsetHeight + 1; - domPopupSearchResultsWindow.style.display = 'block'; - left -= domPopupSearchResults.offsetWidth; - domPopupSearchResultsWindow.style.top = top + 'px'; - domPopupSearchResultsWindow.style.left = left + 'px'; - } + if (domPopupSearchResultsWindow.style.display!='block') + { + domSearchClose.style.display = 'inline-block'; + var left = getXPos(domSearchBox) + 150; + var top = getYPos(domSearchBox) + 20; + domPopupSearchResultsWindow.style.display = 'block'; + left -= domPopupSearchResults.offsetWidth; + var maxWidth = document.body.clientWidth; + var maxHeight = document.body.clientHeight; + var width = 300; + if (left<10) left=10; + if (width+left+8>maxWidth) width=maxWidth-left-8; + var height = 400; + if (height+top+8>maxHeight) height=maxHeight-top-8; + domPopupSearchResultsWindow.style.top = top + 'px'; + domPopupSearchResultsWindow.style.left = left + 'px'; + domPopupSearchResultsWindow.style.width = width + 'px'; + domPopupSearchResultsWindow.style.height = height + 'px'; + } + } + + if (jsFile) { + loadJS(jsFile, handleResults, this.DOMPopupSearchResultsWindow()); + } else { + handleResults(); } this.lastSearchValue = searchValue; - this.lastResultsPage = resultsPage; } // -------- Activation Functions @@ -401,22 +399,15 @@ function SearchBox(name, resultsPath, inFrame, label) ) { this.DOMSearchBox().className = 'MSearchBoxActive'; - - var searchField = this.DOMSearchField(); - - if (searchField.value == this.searchLabel) // clear "Search" term upon entry - { - searchField.value = ''; - this.searchActive = true; - } + this.searchActive = true; } else if (!isActive) // directly remove the panel { this.DOMSearchBox().className = 'MSearchBoxInactive'; - this.DOMSearchField().value = this.searchLabel; this.searchActive = false; this.lastSearchValue = '' this.lastResultsPage = ''; + this.DOMSearchField().value = ''; } } } @@ -439,12 +430,12 @@ function SearchResults(name) while (element && element!=parentElement) { - if (element.nodeName == 'DIV' && element.className == 'SRChildren') + if (element.nodeName.toLowerCase() == 'div' && element.className == 'SRChildren') { return element; } - if (element.nodeName == 'DIV' && element.hasChildNodes()) + if (element.nodeName.toLowerCase() == 'div' && element.hasChildNodes()) { element = element.firstChild; } @@ -645,7 +636,7 @@ function SearchResults(name) } else // return focus to search field { - parent.document.getElementById("MSearchField").focus(); + document.getElementById("MSearchField").focus(); } } else if (this.lastKey==40) // Down @@ -675,8 +666,8 @@ function SearchResults(name) } else if (this.lastKey==27) // Escape { - parent.searchBox.CloseResultsWindow(); - parent.document.getElementById("MSearchField").focus(); + searchBox.CloseResultsWindow(); + document.getElementById("MSearchField").focus(); } else if (this.lastKey==13) // Enter { @@ -718,8 +709,8 @@ function SearchResults(name) } else if (this.lastKey==27) // Escape { - parent.searchBox.CloseResultsWindow(); - parent.document.getElementById("MSearchField").focus(); + searchBox.CloseResultsWindow(); + document.getElementById("MSearchField").focus(); } else if (this.lastKey==13) // Enter { @@ -742,9 +733,10 @@ function setClassAttr(elem,attr) elem.setAttribute('className',attr); } -function createResults() +function createResults(resultsPath) { var results = document.getElementById("SRResults"); + results.innerHTML = ''; for (var e=0; e-{AmhX=Jf@VhhFKy35^fiT zT~&lUj3=cDh^%3HDY9k5CEku}PHXNoNC(_$U3XPb&Q*ME25pT;2(*BOgAf<+R$lzakPG`kF31()Fx{L5Wrac|GQzjeE= zueY1`Ze{#x<8=S|`~MgGetGce)#vN&|J{Cd^tS%;tBYTo?+^d68<#n_Y_xx`J||4O V@QB{^CqU0Kc)I$ztaD0e0svEzbJzd? literal 0 HcmV?d00001 diff --git a/doc/html/structlinalg__immutable_1_1eigen__results-members.html b/doc/html/structlinalg__immutable_1_1eigen__results-members.html index e38ec7ed..29a8b8f1 100644 --- a/doc/html/structlinalg__immutable_1_1eigen__results-members.html +++ b/doc/html/structlinalg__immutable_1_1eigen__results-members.html @@ -1,9 +1,9 @@ - + - - + + linalg: Member List @@ -13,13 +13,16 @@ - + + @@ -27,10 +30,9 @@
    - - + @@ -39,21 +41,22 @@
    -
    linalg -  1.6.0 +
    +
    linalg 1.6.1
    A linear algebra library that provides a user-friendly interface to several BLAS and LAPACK routines.
    - + +/* @license-end */ +
  • @@ -67,8 +70,8 @@
    @@ -81,29 +84,33 @@
    - +
    +
    +
    +
    +
    Loading...
    +
    Searching...
    +
    No Matches
    +
    +
    +
    -
    -
    linalg_immutable::eigen_results Member List
    +
    linalg_immutable::eigen_results Member List
    diff --git a/doc/html/structlinalg__immutable_1_1eigen__results.html b/doc/html/structlinalg__immutable_1_1eigen__results.html index d8295170..5efd2485 100644 --- a/doc/html/structlinalg__immutable_1_1eigen__results.html +++ b/doc/html/structlinalg__immutable_1_1eigen__results.html @@ -1,9 +1,9 @@ - + - - + + linalg: linalg_immutable::eigen_results Type Reference @@ -13,13 +13,16 @@ - + + @@ -27,10 +30,9 @@
    - - + @@ -39,21 +41,22 @@
    -
    linalg -  1.6.0 +
    +
    linalg 1.6.1
    A linear algebra library that provides a user-friendly interface to several BLAS and LAPACK routines.
    - + +/* @license-end */ +
    @@ -67,8 +70,8 @@
    @@ -81,40 +84,81 @@
    - +
    +
    +
    +
    +
    Loading...
    +
    Searching...
    +
    No Matches
    +
    +
    +
    -
    -
    linalg_immutable::eigen_results Type Reference
    +
    linalg_immutable::eigen_results Type Reference

    Defines a container for the output of an Eigen analysis of a square matrix. More...

    - - - + + + - - + +

    -Private Attributes

    -complex(real64), dimension(:), allocatable values
     An N-element array containing the eigenvalues.

    +Public Attributes

    complex(real64), dimension(:), allocatable values
     An N-element array containing the eigenvalues. More...
     
    -complex(real64), dimension(:,:), allocatable vectors
     An N-by-N matrix containing the N right eigenvectors (one per column).
    complex(real64), dimension(:,:), allocatable vectors
     An N-by-N matrix containing the N right eigenvectors (one per column). More...
     

    Detailed Description

    -

    Defines a container for the output of an Eigen analysis of a square matrix.

    +

    Defines a container for the output of an Eigen analysis of a square matrix.

    Definition at line 187 of file linalg_immutable.f90.

    -

    The documentation for this type was generated from the following file:

    Member Data Documentation

    + +

    ◆ values

    + +
    +
    + + + + +
    complex(real64), dimension(:), allocatable linalg_immutable::eigen_results::values
    +
    + +

    An N-element array containing the eigenvalues.

    + +

    Definition at line 189 of file linalg_immutable.f90.

    + +
    +
    + +

    ◆ vectors

    + +
    +
    + + + + +
    complex(real64), dimension(:,:), allocatable linalg_immutable::eigen_results::vectors
    +
    + +

    An N-by-N matrix containing the N right eigenvectors (one per column).

    + +

    Definition at line 192 of file linalg_immutable.f90.

    + +
    +
    +
    The documentation for this type was generated from the following file:
    @@ -122,9 +166,7 @@ diff --git a/doc/html/structlinalg__immutable_1_1lu__results-members.html b/doc/html/structlinalg__immutable_1_1lu__results-members.html index 5c8d6388..7fed858a 100644 --- a/doc/html/structlinalg__immutable_1_1lu__results-members.html +++ b/doc/html/structlinalg__immutable_1_1lu__results-members.html @@ -1,9 +1,9 @@ - + - - + + linalg: Member List @@ -13,13 +13,16 @@ - + + @@ -27,10 +30,9 @@
    - - + @@ -39,21 +41,22 @@
    -
    linalg -  1.6.0 +
    +
    linalg 1.6.1
    A linear algebra library that provides a user-friendly interface to several BLAS and LAPACK routines.
    - + +/* @license-end */ +
    @@ -67,8 +70,8 @@
    @@ -81,30 +84,34 @@
    - +
    +
    +
    +
    +
    Loading...
    +
    Searching...
    +
    No Matches
    +
    +
    +
    -
    -
    linalg_immutable::lu_results Member List
    +
    linalg_immutable::lu_results Member List
    diff --git a/doc/html/structlinalg__immutable_1_1lu__results.html b/doc/html/structlinalg__immutable_1_1lu__results.html index 84bfd061..6ab6a505 100644 --- a/doc/html/structlinalg__immutable_1_1lu__results.html +++ b/doc/html/structlinalg__immutable_1_1lu__results.html @@ -1,9 +1,9 @@ - + - - + + linalg: linalg_immutable::lu_results Type Reference @@ -13,13 +13,16 @@ - + + @@ -27,10 +30,9 @@
    - - + @@ -39,21 +41,22 @@
    -
    linalg -  1.6.0 +
    +
    linalg 1.6.1
    A linear algebra library that provides a user-friendly interface to several BLAS and LAPACK routines.
    - + +/* @license-end */ +
    @@ -67,8 +70,8 @@
    @@ -81,44 +84,102 @@
    - +
    +
    +
    +
    +
    Loading...
    +
    Searching...
    +
    No Matches
    +
    +
    +
    -
    -
    linalg_immutable::lu_results Type Reference
    +
    linalg_immutable::lu_results Type Reference

    Defines a container for the output of an LU factorization. More...

    - - - + + + - - + + - - + +

    -Private Attributes

    -real(real64), dimension(:,:), allocatable l
     The lower triangular matrix L.

    +Public Attributes

    real(real64), dimension(:,:), allocatable l
     The lower triangular matrix L. More...
     
    -real(real64), dimension(:,:), allocatable u
     The upper triangular matrix U.
    real(real64), dimension(:,:), allocatable u
     The upper triangular matrix U. More...
     
    -real(real64), dimension(:,:), allocatable p
     The row pivot tracking matrix P where P A = L U.
    real(real64), dimension(:,:), allocatable p
     The row pivot tracking matrix P where P A = L U. More...
     

    Detailed Description

    -

    Defines a container for the output of an LU factorization.

    +

    Defines a container for the output of an LU factorization.

    Definition at line 116 of file linalg_immutable.f90.

    -

    The documentation for this type was generated from the following file:

    Member Data Documentation

    + +

    ◆ l

    + +
    +
    + + + + +
    real(real64), dimension(:,:), allocatable linalg_immutable::lu_results::l
    +
    + +

    The lower triangular matrix L.

    + +

    Definition at line 118 of file linalg_immutable.f90.

    + +
    +
    + +

    ◆ p

    + +
    +
    + + + + +
    real(real64), dimension(:,:), allocatable linalg_immutable::lu_results::p
    +
    + +

    The row pivot tracking matrix P where P A = L U.

    + +

    Definition at line 122 of file linalg_immutable.f90.

    + +
    +
    + +

    ◆ u

    + +
    +
    + + + + +
    real(real64), dimension(:,:), allocatable linalg_immutable::lu_results::u
    +
    + +

    The upper triangular matrix U.

    + +

    Definition at line 120 of file linalg_immutable.f90.

    + +
    +
    +
    The documentation for this type was generated from the following file:
    @@ -126,9 +187,7 @@ diff --git a/doc/html/structlinalg__immutable_1_1lu__results__cmplx-members.html b/doc/html/structlinalg__immutable_1_1lu__results__cmplx-members.html index 65e9f3bc..672710fe 100644 --- a/doc/html/structlinalg__immutable_1_1lu__results__cmplx-members.html +++ b/doc/html/structlinalg__immutable_1_1lu__results__cmplx-members.html @@ -1,9 +1,9 @@ - + - - + + linalg: Member List @@ -13,13 +13,16 @@ - + + @@ -27,10 +30,9 @@
    - - + @@ -39,21 +41,22 @@
    -
    linalg -  1.6.0 +
    +
    linalg 1.6.1
    A linear algebra library that provides a user-friendly interface to several BLAS and LAPACK routines.
    - + +/* @license-end */ +
    @@ -67,8 +70,8 @@
    @@ -81,30 +84,34 @@
    - +
    +
    +
    +
    +
    Loading...
    +
    Searching...
    +
    No Matches
    +
    +
    +
    -
    -
    linalg_immutable::lu_results_cmplx Member List
    +
    linalg_immutable::lu_results_cmplx Member List
    diff --git a/doc/html/structlinalg__immutable_1_1lu__results__cmplx.html b/doc/html/structlinalg__immutable_1_1lu__results__cmplx.html index b7d838b8..0dbbfbca 100644 --- a/doc/html/structlinalg__immutable_1_1lu__results__cmplx.html +++ b/doc/html/structlinalg__immutable_1_1lu__results__cmplx.html @@ -1,9 +1,9 @@ - + - - + + linalg: linalg_immutable::lu_results_cmplx Type Reference @@ -13,13 +13,16 @@ - + + @@ -27,10 +30,9 @@
    - - + @@ -39,21 +41,22 @@
    -
    linalg -  1.6.0 +
    +
    linalg 1.6.1
    A linear algebra library that provides a user-friendly interface to several BLAS and LAPACK routines.
    - + +/* @license-end */ +
    @@ -67,8 +70,8 @@
    @@ -81,44 +84,102 @@
    - +
    +
    +
    +
    +
    Loading...
    +
    Searching...
    +
    No Matches
    +
    +
    +
    -
    -
    linalg_immutable::lu_results_cmplx Type Reference
    +
    linalg_immutable::lu_results_cmplx Type Reference

    Defines a container for the output of an LU factorization. More...

    - - - + + + - - + + - - + +

    -Private Attributes

    -complex(real64), dimension(:,:), allocatable l
     The lower triangular matrix L.

    +Public Attributes

    complex(real64), dimension(:,:), allocatable l
     The lower triangular matrix L. More...
     
    -complex(real64), dimension(:,:), allocatable u
     The upper triangular matrix U.
    complex(real64), dimension(:,:), allocatable u
     The upper triangular matrix U. More...
     
    -real(real64), dimension(:,:), allocatable p
     The row pivot tracking matrix P where P A = L U.
    real(real64), dimension(:,:), allocatable p
     The row pivot tracking matrix P where P A = L U. More...
     

    Detailed Description

    -

    Defines a container for the output of an LU factorization.

    +

    Defines a container for the output of an LU factorization.

    Definition at line 127 of file linalg_immutable.f90.

    -

    The documentation for this type was generated from the following file:

    Member Data Documentation

    + +

    ◆ l

    + +
    +
    + + + + +
    complex(real64), dimension(:,:), allocatable linalg_immutable::lu_results_cmplx::l
    +
    + +

    The lower triangular matrix L.

    + +

    Definition at line 129 of file linalg_immutable.f90.

    + +
    +
    + +

    ◆ p

    + +
    +
    + + + + +
    real(real64), dimension(:,:), allocatable linalg_immutable::lu_results_cmplx::p
    +
    + +

    The row pivot tracking matrix P where P A = L U.

    + +

    Definition at line 133 of file linalg_immutable.f90.

    + +
    +
    + +

    ◆ u

    + +
    +
    + + + + +
    complex(real64), dimension(:,:), allocatable linalg_immutable::lu_results_cmplx::u
    +
    + +

    The upper triangular matrix U.

    + +

    Definition at line 131 of file linalg_immutable.f90.

    + +
    +
    +
    The documentation for this type was generated from the following file:
    @@ -126,9 +187,7 @@ diff --git a/doc/html/structlinalg__immutable_1_1qr__results-members.html b/doc/html/structlinalg__immutable_1_1qr__results-members.html index 5732f8c5..ef45d425 100644 --- a/doc/html/structlinalg__immutable_1_1qr__results-members.html +++ b/doc/html/structlinalg__immutable_1_1qr__results-members.html @@ -1,9 +1,9 @@ - + - - + + linalg: Member List @@ -13,13 +13,16 @@ - + + @@ -27,10 +30,9 @@
    - - + @@ -39,21 +41,22 @@
    -
    linalg -  1.6.0 +
    +
    linalg 1.6.1
    A linear algebra library that provides a user-friendly interface to several BLAS and LAPACK routines.
    - + +/* @license-end */ +
    @@ -67,8 +70,8 @@
    @@ -81,30 +84,34 @@
    - +
    +
    +
    +
    +
    Loading...
    +
    Searching...
    +
    No Matches
    +
    +
    +
    -
    -
    linalg_immutable::qr_results Member List
    +
    linalg_immutable::qr_results Member List
    diff --git a/doc/html/structlinalg__immutable_1_1qr__results.html b/doc/html/structlinalg__immutable_1_1qr__results.html index 45a0fda6..fb5ad841 100644 --- a/doc/html/structlinalg__immutable_1_1qr__results.html +++ b/doc/html/structlinalg__immutable_1_1qr__results.html @@ -1,9 +1,9 @@ - + - - + + linalg: linalg_immutable::qr_results Type Reference @@ -13,13 +13,16 @@ - + + @@ -27,10 +30,9 @@
    - - + @@ -39,21 +41,22 @@
    -
    linalg -  1.6.0 +
    +
    linalg 1.6.1
    A linear algebra library that provides a user-friendly interface to several BLAS and LAPACK routines.
    - + +/* @license-end */ +
    @@ -67,8 +70,8 @@
    @@ -81,44 +84,102 @@
    - +
    +
    +
    +
    +
    Loading...
    +
    Searching...
    +
    No Matches
    +
    +
    +
    -
    -
    linalg_immutable::qr_results Type Reference
    +
    linalg_immutable::qr_results Type Reference

    Defines a container for the output of a QR factorization. More...

    - - - + + + - - + + - - + +

    -Private Attributes

    -real(real64), dimension(:,:), allocatable q
     The M-by-M orthogonal matrix Q.

    +Public Attributes

    real(real64), dimension(:,:), allocatable q
     The M-by-M orthogonal matrix Q. More...
     
    -real(real64), dimension(:,:), allocatable r
     The M-by-N upper trapezoidal matrix R.
    real(real64), dimension(:,:), allocatable r
     The M-by-N upper trapezoidal matrix R. More...
     
    -real(real64), dimension(:,:), allocatable p
     The N-by-N column pivot tracking matrix P where A P = Q R. If no column pivoting is utilized, this matrix is left unallocated.
    real(real64), dimension(:,:), allocatable p
     The N-by-N column pivot tracking matrix P where A P = Q R. If no column pivoting is utilized, this matrix is left unallocated. More...
     

    Detailed Description

    -

    Defines a container for the output of a QR factorization.

    +

    Defines a container for the output of a QR factorization.

    Definition at line 138 of file linalg_immutable.f90.

    -

    The documentation for this type was generated from the following file:

    Member Data Documentation

    + +

    ◆ p

    + +
    +
    + + + + +
    real(real64), dimension(:,:), allocatable linalg_immutable::qr_results::p
    +
    + +

    The N-by-N column pivot tracking matrix P where A P = Q R. If no column pivoting is utilized, this matrix is left unallocated.

    + +

    Definition at line 145 of file linalg_immutable.f90.

    + +
    +
    + +

    ◆ q

    + +
    +
    + + + + +
    real(real64), dimension(:,:), allocatable linalg_immutable::qr_results::q
    +
    + +

    The M-by-M orthogonal matrix Q.

    + +

    Definition at line 140 of file linalg_immutable.f90.

    + +
    +
    + +

    ◆ r

    + +
    +
    + + + + +
    real(real64), dimension(:,:), allocatable linalg_immutable::qr_results::r
    +
    + +

    The M-by-N upper trapezoidal matrix R.

    + +

    Definition at line 142 of file linalg_immutable.f90.

    + +
    +
    +
    The documentation for this type was generated from the following file:
    @@ -126,9 +187,7 @@ diff --git a/doc/html/structlinalg__immutable_1_1qr__results__cmplx-members.html b/doc/html/structlinalg__immutable_1_1qr__results__cmplx-members.html index fc249008..51fc8896 100644 --- a/doc/html/structlinalg__immutable_1_1qr__results__cmplx-members.html +++ b/doc/html/structlinalg__immutable_1_1qr__results__cmplx-members.html @@ -1,9 +1,9 @@ - + - - + + linalg: Member List @@ -13,13 +13,16 @@ - + + @@ -27,10 +30,9 @@
    - - + @@ -39,21 +41,22 @@
    -
    linalg -  1.6.0 +
    +
    linalg 1.6.1
    A linear algebra library that provides a user-friendly interface to several BLAS and LAPACK routines.
    - + +/* @license-end */ +
    @@ -67,8 +70,8 @@
    @@ -81,30 +84,34 @@
    - +
    +
    +
    +
    +
    Loading...
    +
    Searching...
    +
    No Matches
    +
    +
    +
    -
    -
    linalg_immutable::qr_results_cmplx Member List
    +
    linalg_immutable::qr_results_cmplx Member List
    diff --git a/doc/html/structlinalg__immutable_1_1qr__results__cmplx.html b/doc/html/structlinalg__immutable_1_1qr__results__cmplx.html index ce12ac12..434f3148 100644 --- a/doc/html/structlinalg__immutable_1_1qr__results__cmplx.html +++ b/doc/html/structlinalg__immutable_1_1qr__results__cmplx.html @@ -1,9 +1,9 @@ - + - - + + linalg: linalg_immutable::qr_results_cmplx Type Reference @@ -13,13 +13,16 @@ - + + @@ -27,10 +30,9 @@
    - - + @@ -39,21 +41,22 @@
    -
    linalg -  1.6.0 +
    +
    linalg 1.6.1
    A linear algebra library that provides a user-friendly interface to several BLAS and LAPACK routines.
    - + +/* @license-end */ +
    @@ -67,8 +70,8 @@
    @@ -81,44 +84,102 @@
    - +
    +
    +
    +
    +
    Loading...
    +
    Searching...
    +
    No Matches
    +
    +
    +
    -
    -
    linalg_immutable::qr_results_cmplx Type Reference
    +
    linalg_immutable::qr_results_cmplx Type Reference

    Defines a container for the output of a QR factorization. More...

    - - - + + + - - + + - - + +

    -Private Attributes

    -complex(real64), dimension(:,:), allocatable q
     The M-by-M orthogonal matrix Q.

    +Public Attributes

    complex(real64), dimension(:,:), allocatable q
     The M-by-M orthogonal matrix Q. More...
     
    -complex(real64), dimension(:,:), allocatable r
     The M-by-N upper trapezoidal matrix R.
    complex(real64), dimension(:,:), allocatable r
     The M-by-N upper trapezoidal matrix R. More...
     
    -complex(real64), dimension(:,:), allocatable p
     The N-by-N column pivot tracking matrix P where A P = Q R. If no column pivoting is utilized, this matrix is left unallocated.
    complex(real64), dimension(:,:), allocatable p
     The N-by-N column pivot tracking matrix P where A P = Q R. If no column pivoting is utilized, this matrix is left unallocated. More...
     

    Detailed Description

    -

    Defines a container for the output of a QR factorization.

    +

    Defines a container for the output of a QR factorization.

    Definition at line 150 of file linalg_immutable.f90.

    -

    The documentation for this type was generated from the following file:

    Member Data Documentation

    + +

    ◆ p

    + +
    +
    + + + + +
    complex(real64), dimension(:,:), allocatable linalg_immutable::qr_results_cmplx::p
    +
    + +

    The N-by-N column pivot tracking matrix P where A P = Q R. If no column pivoting is utilized, this matrix is left unallocated.

    + +

    Definition at line 157 of file linalg_immutable.f90.

    + +
    +
    + +

    ◆ q

    + +
    +
    + + + + +
    complex(real64), dimension(:,:), allocatable linalg_immutable::qr_results_cmplx::q
    +
    + +

    The M-by-M orthogonal matrix Q.

    + +

    Definition at line 152 of file linalg_immutable.f90.

    + +
    +
    + +

    ◆ r

    + +
    +
    + + + + +
    complex(real64), dimension(:,:), allocatable linalg_immutable::qr_results_cmplx::r
    +
    + +

    The M-by-N upper trapezoidal matrix R.

    + +

    Definition at line 154 of file linalg_immutable.f90.

    + +
    +
    +
    The documentation for this type was generated from the following file:
    @@ -126,9 +187,7 @@ diff --git a/doc/html/structlinalg__immutable_1_1svd__results-members.html b/doc/html/structlinalg__immutable_1_1svd__results-members.html index f01b9bd2..250759d5 100644 --- a/doc/html/structlinalg__immutable_1_1svd__results-members.html +++ b/doc/html/structlinalg__immutable_1_1svd__results-members.html @@ -1,9 +1,9 @@ - + - - + + linalg: Member List @@ -13,13 +13,16 @@ - + + @@ -27,10 +30,9 @@
    - - + @@ -39,21 +41,22 @@
    -
    linalg -  1.6.0 +
    +
    linalg 1.6.1
    A linear algebra library that provides a user-friendly interface to several BLAS and LAPACK routines.
    - + +/* @license-end */ +
    @@ -67,8 +70,8 @@
    @@ -81,30 +84,34 @@
    - +
    +
    +
    +
    +
    Loading...
    +
    Searching...
    +
    No Matches
    +
    +
    +
    -
    -
    linalg_immutable::svd_results Member List
    +
    linalg_immutable::svd_results Member List
    diff --git a/doc/html/structlinalg__immutable_1_1svd__results.html b/doc/html/structlinalg__immutable_1_1svd__results.html index f67fafbd..9ce241f0 100644 --- a/doc/html/structlinalg__immutable_1_1svd__results.html +++ b/doc/html/structlinalg__immutable_1_1svd__results.html @@ -1,9 +1,9 @@ - + - - + + linalg: linalg_immutable::svd_results Type Reference @@ -13,13 +13,16 @@ - + + @@ -27,10 +30,9 @@
    - - + @@ -39,21 +41,22 @@
    -
    linalg -  1.6.0 +
    +
    linalg 1.6.1
    A linear algebra library that provides a user-friendly interface to several BLAS and LAPACK routines.
    - + +/* @license-end */ +
    @@ -67,8 +70,8 @@
    @@ -81,44 +84,102 @@
    - +
    +
    +
    +
    +
    Loading...
    +
    Searching...
    +
    No Matches
    +
    +
    +
    -
    -
    linalg_immutable::svd_results Type Reference
    +
    linalg_immutable::svd_results Type Reference

    Defines a container for the output of a singular value decomposition of a matrix. More...

    - - - + + + - - + + - - + +

    -Private Attributes

    -real(real64), dimension(:,:), allocatable u
     The M-by-M orthogonal matrix U.

    +Public Attributes

    real(real64), dimension(:,:), allocatable u
     The M-by-M orthogonal matrix U. More...
     
    -real(real64), dimension(:,:), allocatable s
     The M-by-N matrix containing the singular values on its diagonal.
    real(real64), dimension(:,:), allocatable s
     The M-by-N matrix containing the singular values on its diagonal. More...
     
    -real(real64), dimension(:,:), allocatable vt
     The N-by-N transpose of the matrix V.
    real(real64), dimension(:,:), allocatable vt
     The N-by-N transpose of the matrix V. More...
     

    Detailed Description

    -

    Defines a container for the output of a singular value decomposition of a matrix.

    +

    Defines a container for the output of a singular value decomposition of a matrix.

    Definition at line 163 of file linalg_immutable.f90.

    -

    The documentation for this type was generated from the following file:

    Member Data Documentation

    + +

    ◆ s

    + +
    +
    + + + + +
    real(real64), dimension(:,:), allocatable linalg_immutable::svd_results::s
    +
    + +

    The M-by-N matrix containing the singular values on its diagonal.

    + +

    Definition at line 167 of file linalg_immutable.f90.

    + +
    +
    + +

    ◆ u

    + +
    +
    + + + + +
    real(real64), dimension(:,:), allocatable linalg_immutable::svd_results::u
    +
    + +

    The M-by-M orthogonal matrix U.

    + +

    Definition at line 165 of file linalg_immutable.f90.

    + +
    +
    + +

    ◆ vt

    + +
    +
    + + + + +
    real(real64), dimension(:,:), allocatable linalg_immutable::svd_results::vt
    +
    + +

    The N-by-N transpose of the matrix V.

    + +

    Definition at line 169 of file linalg_immutable.f90.

    + +
    +
    +
    The documentation for this type was generated from the following file:
    @@ -126,9 +187,7 @@ diff --git a/doc/html/structlinalg__immutable_1_1svd__results__cmplx-members.html b/doc/html/structlinalg__immutable_1_1svd__results__cmplx-members.html index 2bfd6a20..283dc9a0 100644 --- a/doc/html/structlinalg__immutable_1_1svd__results__cmplx-members.html +++ b/doc/html/structlinalg__immutable_1_1svd__results__cmplx-members.html @@ -1,9 +1,9 @@ - + - - + + linalg: Member List @@ -13,13 +13,16 @@ - + + @@ -27,10 +30,9 @@
    - - + @@ -39,21 +41,22 @@
    -
    linalg -  1.6.0 +
    +
    linalg 1.6.1
    A linear algebra library that provides a user-friendly interface to several BLAS and LAPACK routines.
    - + +/* @license-end */ +
    @@ -67,8 +70,8 @@
    @@ -81,30 +84,34 @@
    - +
    +
    +
    +
    +
    Loading...
    +
    Searching...
    +
    No Matches
    +
    +
    +
    -
    -
    linalg_immutable::svd_results_cmplx Member List
    +
    linalg_immutable::svd_results_cmplx Member List
    diff --git a/doc/html/structlinalg__immutable_1_1svd__results__cmplx.html b/doc/html/structlinalg__immutable_1_1svd__results__cmplx.html index f716a515..d1142499 100644 --- a/doc/html/structlinalg__immutable_1_1svd__results__cmplx.html +++ b/doc/html/structlinalg__immutable_1_1svd__results__cmplx.html @@ -1,9 +1,9 @@ - + - - + + linalg: linalg_immutable::svd_results_cmplx Type Reference @@ -13,13 +13,16 @@ - + + @@ -27,10 +30,9 @@
    - - + @@ -39,21 +41,22 @@
    -
    linalg -  1.6.0 +
    +
    linalg 1.6.1
    A linear algebra library that provides a user-friendly interface to several BLAS and LAPACK routines.
    - + +/* @license-end */ +
    @@ -67,8 +70,8 @@
    @@ -81,44 +84,102 @@
    - +
    +
    +
    +
    +
    Loading...
    +
    Searching...
    +
    No Matches
    +
    +
    +
    -
    -
    linalg_immutable::svd_results_cmplx Type Reference
    +
    linalg_immutable::svd_results_cmplx Type Reference

    Defines a container for the output of a singular value decomposition of a matrix. More...

    - - - + + + - - + + - - + +

    -Private Attributes

    -complex(real64), dimension(:,:), allocatable u
     The M-by-M orthogonal matrix U.

    +Public Attributes

    complex(real64), dimension(:,:), allocatable u
     The M-by-M orthogonal matrix U. More...
     
    -real(real64), dimension(:,:), allocatable s
     The M-by-N matrix containing the singular values on its diagonal.
    real(real64), dimension(:,:), allocatable s
     The M-by-N matrix containing the singular values on its diagonal. More...
     
    -complex(real64), dimension(:,:), allocatable vt
     The N-by-N conjugate transpose of the matrix V.
    complex(real64), dimension(:,:), allocatable vt
     The N-by-N conjugate transpose of the matrix V. More...
     

    Detailed Description

    -

    Defines a container for the output of a singular value decomposition of a matrix.

    +

    Defines a container for the output of a singular value decomposition of a matrix.

    Definition at line 175 of file linalg_immutable.f90.

    -

    The documentation for this type was generated from the following file:

    Member Data Documentation

    + +

    ◆ s

    + +
    +
    + + + + +
    real(real64), dimension(:,:), allocatable linalg_immutable::svd_results_cmplx::s
    +
    + +

    The M-by-N matrix containing the singular values on its diagonal.

    + +

    Definition at line 179 of file linalg_immutable.f90.

    + +
    +
    + +

    ◆ u

    + +
    +
    + + + + +
    complex(real64), dimension(:,:), allocatable linalg_immutable::svd_results_cmplx::u
    +
    + +

    The M-by-M orthogonal matrix U.

    + +

    Definition at line 177 of file linalg_immutable.f90.

    + +
    +
    + +

    ◆ vt

    + +
    +
    + + + + +
    complex(real64), dimension(:,:), allocatable linalg_immutable::svd_results_cmplx::vt
    +
    + +

    The N-by-N conjugate transpose of the matrix V.

    + +

    Definition at line 181 of file linalg_immutable.f90.

    + +
    +
    +
    The documentation for this type was generated from the following file:
    @@ -126,9 +187,7 @@ diff --git a/doc/html/tab_ad.png b/doc/html/tab_ad.png new file mode 100644 index 0000000000000000000000000000000000000000..e34850acfc24be58da6d2fd1ccc6b29cc84fe34d GIT binary patch literal 135 zcmeAS@N?(olHy`uVBq!ia0vp^j6kfy!2~3aiye;!QhuH;jv*C{Z|5d*H3V=pKi{In zd2jxLclDRPylmD}^l7{QOtL{vUjO{-WqItb5sQp2h-99b8^^Scr-=2mblCdZuUm?4 jzOJvgvt3{(cjKLW5(A@0qPS@<&}0TrS3j3^P6y&q2{!U5bk+Tso_B!YCpDh>v z{CM*1U8YvQRyBUHt^Ju0W_sq-?;9@_4equ-bavTs=gk796zopr0EBT&m;e9( literal 0 HcmV?d00001 diff --git a/doc/html/tab_sd.png b/doc/html/tab_sd.png new file mode 100644 index 0000000000000000000000000000000000000000..757a565ced4730f85c833fb2547d8e199ae68f19 GIT binary patch literal 188 zcmeAS@N?(olHy`uVBq!ia0vp^j6kfy!2~3aiye;!Qq7(&jv*C{Z|_!fH5o7*c=%9% zcILh!EA=pAQKdx-Cdiev=v{eg{8Ht<{e8_NAN~b=)%W>-WDCE0PyDHGemi$BoXwcK z{>e9^za6*c1ilttWw&V+U;WCPlV9{LdC~Ey%_H(qj`xgfES(4Yz5jSTZfCt`4E$0YRsR*S^mTCR^;V&sxC8{l_Cp7w8-YPgg&ebxsLQ00$vXK>z>% literal 0 HcmV?d00001 diff --git a/doc/html/tabs.css b/doc/html/tabs.css index 85a0cd5b..71c8a470 100644 --- a/doc/html/tabs.css +++ b/doc/html/tabs.css @@ -1 +1 @@ -.sm{position:relative;z-index:9999}.sm,.sm ul,.sm li{display:block;list-style:none;margin:0;padding:0;line-height:normal;direction:ltr;text-align:left;-webkit-tap-highlight-color:rgba(0,0,0,0)}.sm-rtl,.sm-rtl ul,.sm-rtl li{direction:rtl;text-align:right}.sm>li>h1,.sm>li>h2,.sm>li>h3,.sm>li>h4,.sm>li>h5,.sm>li>h6{margin:0;padding:0}.sm ul{display:none}.sm li,.sm a{position:relative}.sm a{display:block}.sm a.disabled{cursor:not-allowed}.sm:after{content:"\00a0";display:block;height:0;font:0/0 serif;clear:both;visibility:hidden;overflow:hidden}.sm,.sm *,.sm *:before,.sm *:after{-moz-box-sizing:border-box;-webkit-box-sizing:border-box;box-sizing:border-box}.sm-dox{background-image:url("tab_b.png")}.sm-dox a,.sm-dox a:focus,.sm-dox a:hover,.sm-dox a:active{padding:0 12px;padding-right:43px;font-family:"Lucida Grande","Geneva","Helvetica",Arial,sans-serif;font-size:13px;font-weight:bold;line-height:36px;text-decoration:none;text-shadow:0 1px 1px rgba(255,255,255,0.9);color:#283a5d;outline:0}.sm-dox a:hover{background-image:url("tab_a.png");background-repeat:repeat-x;color:white;text-shadow:0 1px 1px black}.sm-dox a.current{color:#d23600}.sm-dox a.disabled{color:#bbb}.sm-dox a span.sub-arrow{position:absolute;top:50%;margin-top:-14px;left:auto;right:3px;width:28px;height:28px;overflow:hidden;font:bold 12px/28px monospace!important;text-align:center;text-shadow:none;background:rgba(255,255,255,0.5);-moz-border-radius:5px;-webkit-border-radius:5px;border-radius:5px}.sm-dox a.highlighted span.sub-arrow:before{display:block;content:'-'}.sm-dox>li:first-child>a,.sm-dox>li:first-child>:not(ul) a{-moz-border-radius:5px 5px 0 0;-webkit-border-radius:5px;border-radius:5px 5px 0 0}.sm-dox>li:last-child>a,.sm-dox>li:last-child>*:not(ul) a,.sm-dox>li:last-child>ul,.sm-dox>li:last-child>ul>li:last-child>a,.sm-dox>li:last-child>ul>li:last-child>*:not(ul) a,.sm-dox>li:last-child>ul>li:last-child>ul,.sm-dox>li:last-child>ul>li:last-child>ul>li:last-child>a,.sm-dox>li:last-child>ul>li:last-child>ul>li:last-child>*:not(ul) a,.sm-dox>li:last-child>ul>li:last-child>ul>li:last-child>ul,.sm-dox>li:last-child>ul>li:last-child>ul>li:last-child>ul>li:last-child>a,.sm-dox>li:last-child>ul>li:last-child>ul>li:last-child>ul>li:last-child>*:not(ul) a,.sm-dox>li:last-child>ul>li:last-child>ul>li:last-child>ul>li:last-child>ul,.sm-dox>li:last-child>ul>li:last-child>ul>li:last-child>ul>li:last-child>ul>li:last-child>a,.sm-dox>li:last-child>ul>li:last-child>ul>li:last-child>ul>li:last-child>ul>li:last-child>*:not(ul) a,.sm-dox>li:last-child>ul>li:last-child>ul>li:last-child>ul>li:last-child>ul>li:last-child>ul{-moz-border-radius:0 0 5px 5px;-webkit-border-radius:0;border-radius:0 0 5px 5px}.sm-dox>li:last-child>a.highlighted,.sm-dox>li:last-child>*:not(ul) a.highlighted,.sm-dox>li:last-child>ul>li:last-child>a.highlighted,.sm-dox>li:last-child>ul>li:last-child>*:not(ul) a.highlighted,.sm-dox>li:last-child>ul>li:last-child>ul>li:last-child>a.highlighted,.sm-dox>li:last-child>ul>li:last-child>ul>li:last-child>*:not(ul) a.highlighted,.sm-dox>li:last-child>ul>li:last-child>ul>li:last-child>ul>li:last-child>a.highlighted,.sm-dox>li:last-child>ul>li:last-child>ul>li:last-child>ul>li:last-child>*:not(ul) a.highlighted,.sm-dox>li:last-child>ul>li:last-child>ul>li:last-child>ul>li:last-child>ul>li:last-child>a.highlighted,.sm-dox>li:last-child>ul>li:last-child>ul>li:last-child>ul>li:last-child>ul>li:last-child>*:not(ul) a.highlighted{-moz-border-radius:0;-webkit-border-radius:0;border-radius:0}.sm-dox ul{background:rgba(162,162,162,0.1)}.sm-dox ul a,.sm-dox ul a:focus,.sm-dox ul a:hover,.sm-dox ul a:active{font-size:12px;border-left:8px solid transparent;line-height:36px;text-shadow:none;background-color:white;background-image:none}.sm-dox ul a:hover{background-image:url("tab_a.png");background-repeat:repeat-x;color:white;text-shadow:0 1px 1px black}.sm-dox ul ul a,.sm-dox ul ul a:hover,.sm-dox ul ul a:focus,.sm-dox ul ul a:active{border-left:16px solid transparent}.sm-dox ul ul ul a,.sm-dox ul ul ul a:hover,.sm-dox ul ul ul a:focus,.sm-dox ul ul ul a:active{border-left:24px solid transparent}.sm-dox ul ul ul ul a,.sm-dox ul ul ul ul a:hover,.sm-dox ul ul ul ul a:focus,.sm-dox ul ul ul ul a:active{border-left:32px solid transparent}.sm-dox ul ul ul ul ul a,.sm-dox ul ul ul ul ul a:hover,.sm-dox ul ul ul ul ul a:focus,.sm-dox ul ul ul ul ul a:active{border-left:40px solid transparent}@media(min-width:768px){.sm-dox ul{position:absolute;width:12em}.sm-dox li{float:left}.sm-dox.sm-rtl li{float:right}.sm-dox ul li,.sm-dox.sm-rtl ul li,.sm-dox.sm-vertical li{float:none}.sm-dox a{white-space:nowrap}.sm-dox ul a,.sm-dox.sm-vertical a{white-space:normal}.sm-dox .sm-nowrap>li>a,.sm-dox .sm-nowrap>li>:not(ul) a{white-space:nowrap}.sm-dox{padding:0 10px;background-image:url("tab_b.png");line-height:36px}.sm-dox a span.sub-arrow{top:50%;margin-top:-2px;right:12px;width:0;height:0;border-width:4px;border-style:solid dashed dashed dashed;border-color:#283a5d transparent transparent transparent;background:transparent;-moz-border-radius:0;-webkit-border-radius:0;border-radius:0}.sm-dox a,.sm-dox a:focus,.sm-dox a:active,.sm-dox a:hover,.sm-dox a.highlighted{padding:0 12px;background-image:url("tab_s.png");background-repeat:no-repeat;background-position:right;-moz-border-radius:0!important;-webkit-border-radius:0;border-radius:0!important}.sm-dox a:hover{background-image:url("tab_a.png");background-repeat:repeat-x;color:white;text-shadow:0 1px 1px black}.sm-dox a:hover span.sub-arrow{border-color:white transparent transparent transparent}.sm-dox a.has-submenu{padding-right:24px}.sm-dox li{border-top:0}.sm-dox>li>ul:before,.sm-dox>li>ul:after{content:'';position:absolute;top:-18px;left:30px;width:0;height:0;overflow:hidden;border-width:9px;border-style:dashed dashed solid dashed;border-color:transparent transparent #bbb transparent}.sm-dox>li>ul:after{top:-16px;left:31px;border-width:8px;border-color:transparent transparent #fff transparent}.sm-dox ul{border:1px solid #bbb;padding:5px 0;background:#fff;-moz-border-radius:5px!important;-webkit-border-radius:5px;border-radius:5px!important;-moz-box-shadow:0 5px 9px rgba(0,0,0,0.2);-webkit-box-shadow:0 5px 9px rgba(0,0,0,0.2);box-shadow:0 5px 9px rgba(0,0,0,0.2)}.sm-dox ul a span.sub-arrow{right:8px;top:50%;margin-top:-5px;border-width:5px;border-color:transparent transparent transparent #555;border-style:dashed dashed dashed solid}.sm-dox ul a,.sm-dox ul a:hover,.sm-dox ul a:focus,.sm-dox ul a:active,.sm-dox ul a.highlighted{color:#555;background-image:none;border:0!important;color:#555;background-image:none}.sm-dox ul a:hover{background-image:url("tab_a.png");background-repeat:repeat-x;color:white;text-shadow:0 1px 1px black}.sm-dox ul a:hover span.sub-arrow{border-color:transparent transparent transparent white}.sm-dox span.scroll-up,.sm-dox span.scroll-down{position:absolute;display:none;visibility:hidden;overflow:hidden;background:#fff;height:36px}.sm-dox span.scroll-up:hover,.sm-dox span.scroll-down:hover{background:#eee}.sm-dox span.scroll-up:hover span.scroll-up-arrow,.sm-dox span.scroll-up:hover span.scroll-down-arrow{border-color:transparent transparent #d23600 transparent}.sm-dox span.scroll-down:hover span.scroll-down-arrow{border-color:#d23600 transparent transparent transparent}.sm-dox span.scroll-up-arrow,.sm-dox span.scroll-down-arrow{position:absolute;top:0;left:50%;margin-left:-6px;width:0;height:0;overflow:hidden;border-width:6px;border-style:dashed dashed solid dashed;border-color:transparent transparent #555 transparent}.sm-dox span.scroll-down-arrow{top:8px;border-style:solid dashed dashed dashed;border-color:#555 transparent transparent transparent}.sm-dox.sm-rtl a.has-submenu{padding-right:12px;padding-left:24px}.sm-dox.sm-rtl a span.sub-arrow{right:auto;left:12px}.sm-dox.sm-rtl.sm-vertical a.has-submenu{padding:10px 20px}.sm-dox.sm-rtl.sm-vertical a span.sub-arrow{right:auto;left:8px;border-style:dashed solid dashed dashed;border-color:transparent #555 transparent transparent}.sm-dox.sm-rtl>li>ul:before{left:auto;right:30px}.sm-dox.sm-rtl>li>ul:after{left:auto;right:31px}.sm-dox.sm-rtl ul a.has-submenu{padding:10px 20px!important}.sm-dox.sm-rtl ul a span.sub-arrow{right:auto;left:8px;border-style:dashed solid dashed dashed;border-color:transparent #555 transparent transparent}.sm-dox.sm-vertical{padding:10px 0;-moz-border-radius:5px;-webkit-border-radius:5px;border-radius:5px}.sm-dox.sm-vertical a{padding:10px 20px}.sm-dox.sm-vertical a:hover,.sm-dox.sm-vertical a:focus,.sm-dox.sm-vertical a:active,.sm-dox.sm-vertical a.highlighted{background:#fff}.sm-dox.sm-vertical a.disabled{background-image:url("tab_b.png")}.sm-dox.sm-vertical a span.sub-arrow{right:8px;top:50%;margin-top:-5px;border-width:5px;border-style:dashed dashed dashed solid;border-color:transparent transparent transparent #555}.sm-dox.sm-vertical>li>ul:before,.sm-dox.sm-vertical>li>ul:after{display:none}.sm-dox.sm-vertical ul a{padding:10px 20px}.sm-dox.sm-vertical ul a:hover,.sm-dox.sm-vertical ul a:focus,.sm-dox.sm-vertical ul a:active,.sm-dox.sm-vertical ul a.highlighted{background:#eee}.sm-dox.sm-vertical ul a.disabled{background:#fff}} \ No newline at end of file +.sm{position:relative;z-index:9999}.sm,.sm ul,.sm li{display:block;list-style:none;margin:0;padding:0;line-height:normal;direction:ltr;text-align:left;-webkit-tap-highlight-color:rgba(0,0,0,0)}.sm-rtl,.sm-rtl ul,.sm-rtl li{direction:rtl;text-align:right}.sm>li>h1,.sm>li>h2,.sm>li>h3,.sm>li>h4,.sm>li>h5,.sm>li>h6{margin:0;padding:0}.sm ul{display:none}.sm li,.sm a{position:relative}.sm a{display:block}.sm a.disabled{cursor:not-allowed}.sm:after{content:"\00a0";display:block;height:0;font:0/0 serif;clear:both;visibility:hidden;overflow:hidden}.sm,.sm *,.sm *:before,.sm *:after{-moz-box-sizing:border-box;-webkit-box-sizing:border-box;box-sizing:border-box}.main-menu-btn{position:relative;display:inline-block;width:36px;height:36px;text-indent:36px;margin-left:8px;white-space:nowrap;overflow:hidden;cursor:pointer;-webkit-tap-highlight-color:rgba(0,0,0,0)}.main-menu-btn-icon,.main-menu-btn-icon:before,.main-menu-btn-icon:after{position:absolute;top:50%;left:2px;height:2px;width:24px;background:var(--nav-menu-button-color);-webkit-transition:all .25s;transition:all .25s}.main-menu-btn-icon:before{content:'';top:-7px;left:0}.main-menu-btn-icon:after{content:'';top:7px;left:0}#main-menu-state:checked ~ .main-menu-btn .main-menu-btn-icon{height:0}#main-menu-state:checked ~ .main-menu-btn .main-menu-btn-icon:before{top:0;-webkit-transform:rotate(-45deg);transform:rotate(-45deg)}#main-menu-state:checked ~ .main-menu-btn .main-menu-btn-icon:after{top:0;-webkit-transform:rotate(45deg);transform:rotate(45deg)}#main-menu-state{position:absolute;width:1px;height:1px;margin:-1px;border:0;padding:0;overflow:hidden;clip:rect(1px,1px,1px,1px)}#main-menu-state:not(:checked) ~ #main-menu{display:none}#main-menu-state:checked ~ #main-menu{display:block}@media(min-width:768px){.main-menu-btn{position:absolute;top:-99999px}#main-menu-state:not(:checked) ~ #main-menu{display:block}}.sm-dox{background-image:var(--nav-gradient-image)}.sm-dox a,.sm-dox a:focus,.sm-dox a:hover,.sm-dox a:active{padding:0 12px;padding-right:43px;font-family:var(--font-family-nav);font-size:13px;font-weight:bold;line-height:36px;text-decoration:none;text-shadow:var(--nav-text-normal-shadow);color:var(--nav-text-normal-color);outline:0}.sm-dox a:hover{background-image:var(--nav-gradient-active-image);background-repeat:repeat-x;color:var(--nav-text-hover-color);text-shadow:var(--nav-text-hover-shadow)}.sm-dox a.current{color:#d23600}.sm-dox a.disabled{color:#bbb}.sm-dox a span.sub-arrow{position:absolute;top:50%;margin-top:-14px;left:auto;right:3px;width:28px;height:28px;overflow:hidden;font:bold 12px/28px monospace !important;text-align:center;text-shadow:none;background:var(--nav-menu-toggle-color);-moz-border-radius:5px;-webkit-border-radius:5px;border-radius:5px}.sm-dox a span.sub-arrow:before{display:block;content:'+'}.sm-dox a.highlighted span.sub-arrow:before{display:block;content:'-'}.sm-dox>li:first-child>a,.sm-dox>li:first-child>:not(ul) a{-moz-border-radius:5px 5px 0 0;-webkit-border-radius:5px;border-radius:5px 5px 0 0}.sm-dox>li:last-child>a,.sm-dox>li:last-child>*:not(ul) a,.sm-dox>li:last-child>ul,.sm-dox>li:last-child>ul>li:last-child>a,.sm-dox>li:last-child>ul>li:last-child>*:not(ul) a,.sm-dox>li:last-child>ul>li:last-child>ul,.sm-dox>li:last-child>ul>li:last-child>ul>li:last-child>a,.sm-dox>li:last-child>ul>li:last-child>ul>li:last-child>*:not(ul) a,.sm-dox>li:last-child>ul>li:last-child>ul>li:last-child>ul,.sm-dox>li:last-child>ul>li:last-child>ul>li:last-child>ul>li:last-child>a,.sm-dox>li:last-child>ul>li:last-child>ul>li:last-child>ul>li:last-child>*:not(ul) a,.sm-dox>li:last-child>ul>li:last-child>ul>li:last-child>ul>li:last-child>ul,.sm-dox>li:last-child>ul>li:last-child>ul>li:last-child>ul>li:last-child>ul>li:last-child>a,.sm-dox>li:last-child>ul>li:last-child>ul>li:last-child>ul>li:last-child>ul>li:last-child>*:not(ul) a,.sm-dox>li:last-child>ul>li:last-child>ul>li:last-child>ul>li:last-child>ul>li:last-child>ul{-moz-border-radius:0 0 5px 5px;-webkit-border-radius:0;border-radius:0 0 5px 5px}.sm-dox>li:last-child>a.highlighted,.sm-dox>li:last-child>*:not(ul) a.highlighted,.sm-dox>li:last-child>ul>li:last-child>a.highlighted,.sm-dox>li:last-child>ul>li:last-child>*:not(ul) a.highlighted,.sm-dox>li:last-child>ul>li:last-child>ul>li:last-child>a.highlighted,.sm-dox>li:last-child>ul>li:last-child>ul>li:last-child>*:not(ul) a.highlighted,.sm-dox>li:last-child>ul>li:last-child>ul>li:last-child>ul>li:last-child>a.highlighted,.sm-dox>li:last-child>ul>li:last-child>ul>li:last-child>ul>li:last-child>*:not(ul) a.highlighted,.sm-dox>li:last-child>ul>li:last-child>ul>li:last-child>ul>li:last-child>ul>li:last-child>a.highlighted,.sm-dox>li:last-child>ul>li:last-child>ul>li:last-child>ul>li:last-child>ul>li:last-child>*:not(ul) a.highlighted{-moz-border-radius:0;-webkit-border-radius:0;border-radius:0}.sm-dox ul{background:var(--nav-menu-background-color)}.sm-dox ul a,.sm-dox ul a:focus,.sm-dox ul a:hover,.sm-dox ul a:active{font-size:12px;border-left:8px solid transparent;line-height:36px;text-shadow:none;background-color:var(--nav-menu-background-color);background-image:none}.sm-dox ul a:hover{background-image:var(--nav-gradient-active-image);background-repeat:repeat-x;color:var(--nav-text-hover-color);text-shadow:0 1px 1px black}.sm-dox ul ul a,.sm-dox ul ul a:hover,.sm-dox ul ul a:focus,.sm-dox ul ul a:active{border-left:16px solid transparent}.sm-dox ul ul ul a,.sm-dox ul ul ul a:hover,.sm-dox ul ul ul a:focus,.sm-dox ul ul ul a:active{border-left:24px solid transparent}.sm-dox ul ul ul ul a,.sm-dox ul ul ul ul a:hover,.sm-dox ul ul ul ul a:focus,.sm-dox ul ul ul ul a:active{border-left:32px solid transparent}.sm-dox ul ul ul ul ul a,.sm-dox ul ul ul ul ul a:hover,.sm-dox ul ul ul ul ul a:focus,.sm-dox ul ul ul ul ul a:active{border-left:40px solid transparent}@media(min-width:768px){.sm-dox ul{position:absolute;width:12em}.sm-dox li{float:left}.sm-dox.sm-rtl li{float:right}.sm-dox ul li,.sm-dox.sm-rtl ul li,.sm-dox.sm-vertical li{float:none}.sm-dox a{white-space:nowrap}.sm-dox ul a,.sm-dox.sm-vertical a{white-space:normal}.sm-dox .sm-nowrap>li>a,.sm-dox .sm-nowrap>li>:not(ul) a{white-space:nowrap}.sm-dox{padding:0 10px;background-image:var(--nav-gradient-image);line-height:36px}.sm-dox a span.sub-arrow{top:50%;margin-top:-2px;right:12px;width:0;height:0;border-width:4px;border-style:solid dashed dashed dashed;border-color:var(--nav-text-normal-color) transparent transparent transparent;background:transparent;-moz-border-radius:0;-webkit-border-radius:0;border-radius:0}.sm-dox a,.sm-dox a:focus,.sm-dox a:active,.sm-dox a:hover,.sm-dox a.highlighted{padding:0 12px;background-image:var(--nav-separator-image);background-repeat:no-repeat;background-position:right;-moz-border-radius:0 !important;-webkit-border-radius:0;border-radius:0 !important}.sm-dox a:hover{background-image:var(--nav-gradient-active-image);background-repeat:repeat-x;color:var(--nav-text-hover-color);text-shadow:var(--nav-text-hover-shadow)}.sm-dox a:hover span.sub-arrow{border-color:var(--nav-text-hover-color) transparent transparent transparent}.sm-dox a.has-submenu{padding-right:24px}.sm-dox li{border-top:0}.sm-dox>li>ul:before,.sm-dox>li>ul:after{content:'';position:absolute;top:-18px;left:30px;width:0;height:0;overflow:hidden;border-width:9px;border-style:dashed dashed solid dashed;border-color:transparent transparent #bbb transparent}.sm-dox>li>ul:after{top:-16px;left:31px;border-width:8px;border-color:transparent transparent var(--nav-menu-background-color) transparent}.sm-dox ul{border:1px solid #bbb;padding:5px 0;background:var(--nav-menu-background-color);-moz-border-radius:5px !important;-webkit-border-radius:5px;border-radius:5px !important;-moz-box-shadow:0 5px 9px rgba(0,0,0,0.2);-webkit-box-shadow:0 5px 9px rgba(0,0,0,0.2);box-shadow:0 5px 9px rgba(0,0,0,0.2)}.sm-dox ul a span.sub-arrow{right:8px;top:50%;margin-top:-5px;border-width:5px;border-color:transparent transparent transparent var(--nav-menu-foreground-color);border-style:dashed dashed dashed solid}.sm-dox ul a,.sm-dox ul a:hover,.sm-dox ul a:focus,.sm-dox ul a:active,.sm-dox ul a.highlighted{color:var(--nav-menu-foreground-color);background-image:none;border:0 !important;color:var(--nav-menu-foreground-color);background-image:none}.sm-dox ul a:hover{background-image:var(--nav-gradient-active-image);background-repeat:repeat-x;color:var(--nav-text-hover-color);text-shadow:var(--nav-text-hover-shadow)}.sm-dox ul a:hover span.sub-arrow{border-color:transparent transparent transparent var(--nav-text-hover-color)}.sm-dox span.scroll-up,.sm-dox span.scroll-down{position:absolute;display:none;visibility:hidden;overflow:hidden;background:var(--nav-menu-background-color);height:36px}.sm-dox span.scroll-up:hover,.sm-dox span.scroll-down:hover{background:#eee}.sm-dox span.scroll-up:hover span.scroll-up-arrow,.sm-dox span.scroll-up:hover span.scroll-down-arrow{border-color:transparent transparent #d23600 transparent}.sm-dox span.scroll-down:hover span.scroll-down-arrow{border-color:#d23600 transparent transparent transparent}.sm-dox span.scroll-up-arrow,.sm-dox span.scroll-down-arrow{position:absolute;top:0;left:50%;margin-left:-6px;width:0;height:0;overflow:hidden;border-width:6px;border-style:dashed dashed solid dashed;border-color:transparent transparent var(--nav-menu-foreground-color) transparent}.sm-dox span.scroll-down-arrow{top:8px;border-style:solid dashed dashed dashed;border-color:var(--nav-menu-foreground-color) transparent transparent transparent}.sm-dox.sm-rtl a.has-submenu{padding-right:12px;padding-left:24px}.sm-dox.sm-rtl a span.sub-arrow{right:auto;left:12px}.sm-dox.sm-rtl.sm-vertical a.has-submenu{padding:10px 20px}.sm-dox.sm-rtl.sm-vertical a span.sub-arrow{right:auto;left:8px;border-style:dashed solid dashed dashed;border-color:transparent #555 transparent transparent}.sm-dox.sm-rtl>li>ul:before{left:auto;right:30px}.sm-dox.sm-rtl>li>ul:after{left:auto;right:31px}.sm-dox.sm-rtl ul a.has-submenu{padding:10px 20px !important}.sm-dox.sm-rtl ul a span.sub-arrow{right:auto;left:8px;border-style:dashed solid dashed dashed;border-color:transparent #555 transparent transparent}.sm-dox.sm-vertical{padding:10px 0;-moz-border-radius:5px;-webkit-border-radius:5px;border-radius:5px}.sm-dox.sm-vertical a{padding:10px 20px}.sm-dox.sm-vertical a:hover,.sm-dox.sm-vertical a:focus,.sm-dox.sm-vertical a:active,.sm-dox.sm-vertical a.highlighted{background:#fff}.sm-dox.sm-vertical a.disabled{background-image:var(--nav-gradient-image)}.sm-dox.sm-vertical a span.sub-arrow{right:8px;top:50%;margin-top:-5px;border-width:5px;border-style:dashed dashed dashed solid;border-color:transparent transparent transparent #555}.sm-dox.sm-vertical>li>ul:before,.sm-dox.sm-vertical>li>ul:after{display:none}.sm-dox.sm-vertical ul a{padding:10px 20px}.sm-dox.sm-vertical ul a:hover,.sm-dox.sm-vertical ul a:focus,.sm-dox.sm-vertical ul a:active,.sm-dox.sm-vertical ul a.highlighted{background:#eee}.sm-dox.sm-vertical ul a.disabled{background:var(--nav-menu-background-color)}} \ No newline at end of file diff --git a/src/linalg_core.f90 b/src/linalg_core.f90 index eccbc2a8..65057c4a 100644 --- a/src/linalg_core.f90 +++ b/src/linalg_core.f90 @@ -8,7 +8,7 @@ !! to several BLAS and LAPACK routines. !! !! @author Jason Christopherson -!! @version 1.6.0 +!! @version 1.6.1 !> @brief Provides a set of common linear algebra routines. @@ -56,7 +56,66 @@ module linalg_core ! INTERFACES ! ------------------------------------------------------------------------------ !> @brief Performs the matrix operation: -!! C = alpha * op(A) * op(B) + beta * C. +!! \f$ C = \alpha op(A) op(B) + \beta C \f$. +!! +!! @par Syntax 1 +!! @code{.f90} +!! subroutine mtx_mult(logical transa, logical transb, real(real64) alpha, real(real64) a(:,:), real(real64) b(:,:), real(real64) beta, real(real64) c(:,:), optional class(errors) err) +!! subroutine mtx_mult(integer(int32) transa, integer(int32) transb, complex(real64) alpha, complex(real64) a(:,:), complex(real64) b(:,:), complex(real64) beta, complex(real64) c(:,:), optional class(errors) err) +!! @endcode +!! +!! @param[in] transa Set to true if \f$ op(A) = A^T \f$; else, set to false for +!! \f$ op(A) = A\f$. In the complex case set to LA_TRANSPOSE if +!! \f$ op(A) = A^T \f$, set to LA_HERMITIAN_TRANSPOSE if \f$ op(A) = A^H \f$, +!! otherwise set to LA_NO_OPERATION if \f$ op(A) = A \f$. +!! @param[in] transb Set to true if \f$ op(B) = B^T \f$; else, set to false for +!! \f$ op(B) = B\f$. In the complex case set to LA_TRANSPOSE if +!! \f$ op(B) = B^T \f$, set to LA_HERMITIAN_TRANSPOSE if \f$ op(B) = B^H \f$, +!! otherwise set to LA_NO_OPERATION if \f$ op(B) = B \f$. +!! @param[in] alpha A scalar multiplier. +!! @param[in] a If @p transa is set to true, an K-by-M matrix; else, if +!! @p transa is set to false, an M-by-K matrix. +!! @param[in] b If @p transb is set to true, an N-by-K matrix; else, if +!! @p transb is set to false, a K-by-N matrix. +!! @param[in] beta A scalar multiplier. +!! @param[in,out] c On input, the M-by-N matrix C. On output, the M-by-N +!! result. +!! @param[in,out] err An optional errors-based object that if provided can be +!! used to retrieve information relating to any errors encountered during +!! execution. If not provided, a default implementation of the errors +!! class is used internally to provide error handling. Possible errors and +!! warning messages that may be encountered are as follows. +!! - LA_ARRAY_SIZE_ERROR: Occurs if any of the input array sizes are +!! incorrect. +!! +!! @par Syntax 2 +!! @code{.f90} +!! subroutine mtx_mult(logical trans, real(real64) alpha, real(real64) a(:,:), real(real64) b(:), real(real64) beta, real(real64) c(:)) +!! subroutine mtx_mult(logical trans, complex(real64) alpha, complex(real64) a(:,:), complex(real64) b(:), complex(real64) beta, complex(real64) c(:)) +!! @endcode +!! +!! @param[in] trans Set to true if \f$ op(A) = A^T \f$; else, set to false for +!! \f$ op(A) = A\f$. In the complex case set to LA_TRANSPOSE if +!! \f$ op(A) = A^T \f$, set to LA_HERMITIAN_TRANSPOSE if \f$ op(A) = A^H \f$, +!! otherwise set to LA_NO_OPERATION if \f$ op(A) = A \f$. +!! @param[in] alpha A scalar multiplier. +!! @param[in] a The M-by-N matrix A. +!! @param[in] b If @p trans is set to true, an M-element array; else, if +!! @p trans is set to false, an N-element array. +!! @param[in] beta A scalar multiplier. +!! @param[in,out] c On input, if @p trans is set to true, an N-element +!! array; else, if @p trans is set to false, an M-element array. On +!! output, the results of the operation. +!! @param[in,out] err An optional errors-based object that if provided can be +!! used to retrieve information relating to any errors encountered during +!! execution. If not provided, a default implementation of the errors +!! class is used internally to provide error handling. Possible errors and +!! warning messages that may be encountered are as follows. +!! - LA_ARRAY_SIZE_ERROR: Occurs if any of the input array sizes are +!! incorrect. +!! +!! @par Notes +!! This routine utilizes the BLAS routines DGEMM, ZGEMM, DGEMV, or ZGEMV. interface mtx_mult module procedure :: mtx_mult_mtx module procedure :: mtx_mult_vec @@ -66,9 +125,32 @@ module linalg_core ! ------------------------------------------------------------------------------ !> @brief Performs the rank-1 update to matrix A such that: -!! A = alpha * X * Y**T + A, where A is an M-by-N matrix, alpha is a scalar, -!! X is an M-element array, and N is an N-element array. In the -!! event that Y is complex, Y**H is used instead of Y**T. +!! \f$ A = \alpha X Y^T + A \f$, where \f$ A \f$ is an M-by-N matrix, +!! \f$ \alpha \f$is a scalar, \f$ X \f$ is an M-element array, and \f$ Y \f$ +!! is an N-element array. In the event that \f$ Y \f$ is complex, \f$ Y^H \f$ +!! is used instead of \f$ Y^T \f$. +!! +!! @par Syntax +!! @code{.f90} +!! subroutine rank1_update(real(real64) alpha, real(real64) x(:), real(real64) y(:), real(real64) a(:,:), class(errors) err) +!! subroutine rank1_update(complex(real64) alpha, complex(real64) x(:), complex(real64) y(:), complex(real64) a(:,:), class(errors) err) +!! @endcode +!! +!! @param[in] alpha The scalar multiplier. +!! @param[in] x An M-element array. +!! @param[in] y An N-element array. +!! @param[in,out] a On input, the M-by-N matrix to update. On output, the +!! updated M-by-N matrix. +!! @param[in,out] err An optional errors-based object that if provided can be +!! used to retrieve information relating to any errors encountered during +!! execution. If not provided, a default implementation of the errors +!! class is used internally to provide error handling. Possible errors and +!! warning messages that may be encountered are as follows. +!! - LA_ARRAY_SIZE_ERROR: Occurs if the size of @p a does not match with +!! @p x and @p y. +!! +!! @par Notes +!! This routine is based upon the BLAS routine DGER or ZGER. interface rank1_update module procedure :: rank1_update_dbl module procedure :: rank1_update_cmplx @@ -77,6 +159,69 @@ module linalg_core ! ------------------------------------------------------------------------------ !> @brief Multiplies a diagonal matrix with another matrix or array. !! +!! @par Syntax 1 +!! Computes the matrix operation: \f$ C = \alpha A op(B) + \beta C \f$, +!! or \f$ C = \alpha op(B) A + \beta C \f$. +!! @code{.f90} +!! subroutine diag_mtx_mult(logical lside, logical trans, real(real64) alpha, real(real64) a(:), real(real64) b(:,:), real(real64) beta, real(real64) c(:,:), optional class(errors) err) +!! subroutine diag_mtx_mult(logical lside, logical trans, real(real64) alpha, complex(real64) a(:), complex(real64) b(:,:), real(real64) beta, complex(real64) c(:,:), optional class(errors) err) +!! subroutine diag_mtx_mult(logical lside, logical trans, real(real64) alpha, complex(real64) a(:), real(real64) b(:,:), real(real64) beta, complex(real64) c(:,:), optional class(errors) err) +!! subroutine diag_mtx_mult(logical lside, logical trans, complex(real64) alpha, complex(real64) a(:), complex(real64) b(:,:), complex(real64) beta, complex(real64) c(:,:), optional class(errors) err) +!! subroutine diag_mtx_mult(logical lside, logical trans, complex(real64) alpha, real(real64) a(:), complex(real64) b(:,:), complex(real64) beta, complex(real64) c(:,:), optional class(errors) err) +!! @endcode +!! +!! @param[in] lside Set to true to apply matrix A from the left; else, set +!! to false to apply matrix A from the left. +!! @param[in] trans Set to true if \f$ op(B) = B^T \f$; else, set to false for +!! \f$ op(B) = B\f$. In the complex case set to LA_TRANSPOSE if +!! \f$ op(B) = B^T \f$, set to LA_HERMITIAN_TRANSPOSE if \f$ op(B) = B^H \f$, +!! otherwise set to LA_NO_OPERATION if \f$ op(B) = B \f$. +!! @param[in] alpha A scalar multiplier. +!! @param[in] a A K-element array containing the diagonal elements of A +!! where K = MIN(M,P) if @p lside is true; else, if @p lside is +!! false, K = MIN(N,P). +!! @param[in] b The LDB-by-TDB matrix B where (LDB = leading dimension of B, +!! and TDB = trailing dimension of B): +!! - @p lside == true & @p trans == true: LDB = N, TDB = P +!! - @p lside == true & @p trans == false: LDB = P, TDB = N +!! - @p lside == false & @p trans == true: LDB = P, TDB = M +!! - @p lside == false & @p trans == false: LDB = M, TDB = P +!! @param[in] beta A scalar multiplier. +!! @param[in,out] c On input, the M-by-N matrix C. On output, the resulting +!! M-by-N matrix. +!! @param[out] err An optional errors-based object that if provided can be +!! used to retrieve information relating to any errors encountered during +!! execution. If not provided, a default implementation of the errors +!! class is used internally to provide error handling. Possible errors and +!! warning messages that may be encountered are as follows. +!! - LA_ARRAY_SIZE_ERROR: Occurs if any of the input array sizes are +!! incorrect. +!! +!! @par Syntax 2 +!! Computes the matrix operation: \f$ B = \alpha A op(B) \f$, or +!! \f$ B = \alpha op(B) * A \f$. +!! @code{.f90} +!! subroutine diag_mtx_mult(logical lside, real(real64) alpha, real(real64) a(:), real(real64) b(:,:), optional class(errors) err) +!! subroutine diag_mtx_mult(logical lside, complex(real64) alpha, complex(real64) a(:), complex(real64) b(:,:), optional class(errors) err) +!! subroutine diag_mtx_mult(logical lside, complex(real64) alpha, real(real64) a(:), complex(real64) b(:,:), optional class(errors) err) +!! @endcode +!! +!! @param[in] lside Set to true to apply matrix A from the left; else, set +!! to false to apply matrix A from the left. +!! @param[in] alpha A scalar multiplier. +!! @param[in] a A K-element array containing the diagonal elements of A +!! where K = MIN(M,P) if @p lside is true; else, if @p lside is +!! false, K = MIN(N,P). +!! @param[in] b On input, the M-by-N matrix B. On output, the resulting +!! M-by-N matrix. +!! @param[out] err An optional errors-based object that if provided can be +!! used to retrieve information relating to any errors encountered during +!! execution. If not provided, a default implementation of the errors +!! class is used internally to provide error handling. Possible errors and +!! warning messages that may be encountered are as follows. +!! - LA_ARRAY_SIZE_ERROR: Occurs if any of the input array sizes are +!! incorrect. +!! !! @par Usage !! The following example illustrates the use of the diagonal matrix !! multiplication routine to compute the S * V**T component of a singular @@ -1643,31 +1788,6 @@ module linalg_core ! LINALG_BASIC.F90 ! ------------------------------------------------------------------------------ interface - !> @brief Performs the matrix operation: C = alpha * op(A) * op(B) + - !! beta * C. - !! - !! @param[in] transa Set to true if op(A) = A**T; else, set to false for - !! op(A) = A. - !! @param[in] transb Set to true if op(B) = B**T; else, set to false for - !! op(B) = B. - !! @param[in] alpha A scalar multiplier. - !! @param[in] a If @p transa is set to true, an K-by-M matrix; else, if - !! @p transa is set to false, an M-by-K matrix. - !! @param[in] b If @p transb is set to true, an N-by-K matrix; else, if - !! @p transb is set to false, a K-by-N matrix. - !! @param[in] beta A scalar multiplier. - !! @param[in,out] c On input, the M-by-N matrix C. On output, the M-by-N - !! result. - !! @param[out] err An optional errors-based object that if provided can be - !! used to retrieve information relating to any errors encountered during - !! execution. If not provided, a default implementation of the errors - !! class is used internally to provide error handling. Possible errors and - !! warning messages that may be encountered are as follows. - !! - LA_ARRAY_SIZE_ERROR: Occurs if any of the input array sizes are - !! incorrect. - !! - !! @par Notes - !! This routine utilizes the BLAS routine DGEMM. module subroutine mtx_mult_mtx(transa, transb, alpha, a, b, beta, c, err) logical, intent(in) :: transa, transb real(real64), intent(in) :: alpha, beta @@ -1675,30 +1795,7 @@ module subroutine mtx_mult_mtx(transa, transb, alpha, a, b, beta, c, err) real(real64), intent(inout), dimension(:,:) :: c class(errors), intent(inout), optional, target :: err end subroutine - - !> @brief Performs the matrix-vector operation: c = alpha * op(A) * b + - !! beta * c. - !! - !! @param[in] trans Set to true if op(A) = A**T; else, set to false for - !! op(A) = A. - !! @param[in] alpha A scalar multiplier. - !! @param[in] a The M-by-N matrix A. - !! @param[in] b If @p trans is set to true, an M-element array; else, if - !! @p trans is set to false, an N-element array. - !! @param[in] beta A scalar multiplier. - !! @param[in,out] c On input, if @p trans is set to true, an N-element - !! array; else, if @p trans is set to false, an M-element array. On - !! output, the results of the operation. - !! @param[out] err An optional errors-based object that if provided can be - !! used to retrieve information relating to any errors encountered during - !! execution. If not provided, a default implementation of the errors - !! class is used internally to provide error handling. Possible errors and - !! warning messages that may be encountered are as follows. - !! - LA_ARRAY_SIZE_ERROR: Occurs if any of the input array sizes are - !! incorrect. - !! - !! @par Notes - !! This routine utilizes the BLAS routine DGEMV. + module subroutine mtx_mult_vec(trans, alpha, a, b, beta, c, err) logical, intent(in) :: trans real(real64), intent(in) :: alpha, beta @@ -1707,34 +1804,7 @@ module subroutine mtx_mult_vec(trans, alpha, a, b, beta, c, err) real(real64), intent(inout), dimension(:) :: c class(errors), intent(inout), optional, target :: err end subroutine - - !> @brief Performs the matrix operation: C = alpha * op(A) * op(B) + - !! beta * C. - !! - !! @param[in] opa Set to TRANSPOSE if op(A) = A**T, set to - !! HERMITIAN_TRANSPOSE if op(A) == A**H, otherwise set to - !! NO_OPERATION if op(A) == A. - !! @param[in] opb Set to TRANSPOSE if op(B) = B**T, set to - !! HERMITIAN_TRANSPOSE if op(B) == B**H, otherwise set to - !! NO_OPERATION if op(B) == B. - !! @param[in] alpha A scalar multiplier. - !! @param[in] a If @p transa is set to true, an K-by-M matrix; else, if - !! @p transa is set to false, an M-by-K matrix. - !! @param[in] b If @p transb is set to true, an N-by-K matrix; else, if - !! @p transb is set to false, a K-by-N matrix. - !! @param[in] beta A scalar multiplier. - !! @param[in,out] c On input, the M-by-N matrix C. On output, the M-by-N - !! result. - !! @param[out] err An optional errors-based object that if provided can be - !! used to retrieve information relating to any errors encountered during - !! execution. If not provided, a default implementation of the errors - !! class is used internally to provide error handling. Possible errors and - !! warning messages that may be encountered are as follows. - !! - LA_ARRAY_SIZE_ERROR: Occurs if any of the input array sizes are - !! incorrect. - !! - !! @par Notes - !! This routine utilizes the BLAS routine ZGEMM. + module subroutine cmtx_mult_mtx(opa, opb, alpha, a, b, beta, c, err) integer(int32), intent(in) :: opa, opb complex(real64), intent(in) :: alpha, beta @@ -1743,30 +1813,6 @@ module subroutine cmtx_mult_mtx(opa, opb, alpha, a, b, beta, c, err) class(errors), intent(inout), optional, target :: err end subroutine - !> @brief Performs the matrix-vector operation: c = alpha * op(A) * b + - !! beta * c. - !! - !! @param[in] trans opa Set to TRANSPOSE if op(A) = A**T, set to - !! HERMITIAN_TRANSPOSE if op(A) == A**H, otherwise set to - !! NO_OPERATION if op(A) == A. - !! @param[in] alpha A scalar multiplier. - !! @param[in] a The M-by-N matrix A. - !! @param[in] b If @p trans is set to true, an M-element array; else, if - !! @p trans is set to false, an N-element array. - !! @param[in] beta A scalar multiplier. - !! @param[in,out] c On input, if @p trans is set to true, an N-element - !! array; else, if @p trans is set to false, an M-element array. On - !! output, the results of the operation. - !! @param[out] err An optional errors-based object that if provided can be - !! used to retrieve information relating to any errors encountered during - !! execution. If not provided, a default implementation of the errors - !! class is used internally to provide error handling. Possible errors and - !! warning messages that may be encountered are as follows. - !! - LA_ARRAY_SIZE_ERROR: Occurs if any of the input array sizes are - !! incorrect. - !! - !! @par Notes - !! This routine utilizes the BLAS routine ZGEMV. module subroutine cmtx_mult_vec(opa, alpha, a, b, beta, c, err) integer(int32), intent(in) :: opa complex(real64), intent(in) :: alpha, beta @@ -1775,86 +1821,21 @@ module subroutine cmtx_mult_vec(opa, alpha, a, b, beta, c, err) complex(real64), intent(inout), dimension(:) :: c class(errors), intent(inout), optional, target :: err end subroutine - - !> @brief Performs the rank-1 update to matrix A such that: - !! A = alpha * X * Y**T + A, where A is an M-by-N matrix, alpha is a scalar, - !! X is an M-element array, and N is an N-element array. - !! - !! @param[in] alpha The scalar multiplier. - !! @param[in] x An M-element array. - !! @param[in] y An N-element array. - !! @param[in,out] a On input, the M-by-N matrix to update. On output, the - !! updated M-by-N matrix. - !! @param[out] err An optional errors-based object that if provided can be - !! used to retrieve information relating to any errors encountered during - !! execution. If not provided, a default implementation of the errors - !! class is used internally to provide error handling. Possible errors and - !! warning messages that may be encountered are as follows. - !! - LA_ARRAY_SIZE_ERROR: Occurs if the size of @p a does not match with - !! @p x and @p y. - !! - !! @par Notes - !! This routine is based upon the BLAS routine DGER. + module subroutine rank1_update_dbl(alpha, x, y, a, err) real(real64), intent(in) :: alpha real(real64), intent(in), dimension(:) :: x, y real(real64), intent(inout), dimension(:,:) :: a class(errors), intent(inout), optional, target :: err end subroutine - - !> @brief Performs the rank-1 update to matrix A such that: - !! A = alpha * X * Y**T + A, where A is an M-by-N matrix, alpha is a scalar, - !! X is an M-element array, and N is an N-element array. - !! - !! @param[in] alpha The scalar multiplier. - !! @param[in] x An M-element array. - !! @param[in] y An N-element array. - !! @param[in,out] a On input, the M-by-N matrix to update. On output, the - !! updated M-by-N matrix. - !! @param[out] err An optional errors-based object that if provided can be - !! used to retrieve information relating to any errors encountered during - !! execution. If not provided, a default implementation of the errors - !! class is used internally to provide error handling. Possible errors and - !! warning messages that may be encountered are as follows. - !! - LA_ARRAY_SIZE_ERROR: Occurs if the size of @p a does not match with - !! @p x and @p y. - !! - !! @par Notes - !! This routine is based upon the BLAS routine ZGER. + module subroutine rank1_update_cmplx(alpha, x, y, a, err) complex(real64), intent(in) :: alpha complex(real64), intent(in), dimension(:) :: x, y complex(real64), intent(inout), dimension(:,:) :: a class(errors), intent(inout), optional, target :: err end subroutine - - !> @brief Computes the matrix operation: C = alpha * A * op(B) + beta * C, - !! or C = alpha * op(B) * A + beta * C. - !! - !! @param[in] lside Set to true to apply matrix A from the left; else, set - !! to false to apply matrix A from the left. - !! @param[in] trans Set to true if op(B) == B**T; else, set to false if - !! op(B) == B. - !! @param[in] alpha A scalar multiplier. - !! @param[in] a A K-element array containing the diagonal elements of A - !! where K = MIN(M,P) if @p lside is true; else, if @p lside is - !! false, K = MIN(N,P). - !! @param[in] b The LDB-by-TDB matrix B where (LDB = leading dimension of B, - !! and TDB = trailing dimension of B): - !! - @p lside == true & @p trans == true: LDB = N, TDB = P - !! - @p lside == true & @p trans == false: LDB = P, TDB = N - !! - @p lside == false & @p trans == true: LDB = P, TDB = M - !! - @p lside == false & @p trans == false: LDB = M, TDB = P - !! @param[in] beta A scalar multiplier. - !! @param[in,out] c On input, the M-by-N matrix C. On output, the resulting - !! M-by-N matrix. - !! @param[out] err An optional errors-based object that if provided can be - !! used to retrieve information relating to any errors encountered during - !! execution. If not provided, a default implementation of the errors - !! class is used internally to provide error handling. Possible errors and - !! warning messages that may be encountered are as follows. - !! - LA_ARRAY_SIZE_ERROR: Occurs if any of the input array sizes are - !! incorrect. + module subroutine diag_mtx_mult_mtx(lside, trans, alpha, a, b, beta, c, err) logical, intent(in) :: lside, trans real(real64) :: alpha, beta @@ -1864,24 +1845,6 @@ module subroutine diag_mtx_mult_mtx(lside, trans, alpha, a, b, beta, c, err) class(errors), intent(inout), optional, target :: err end subroutine - !> @brief Computes the matrix operation: B = alpha * A * op(B), or - !! B = alpha * op(B) * A. - !! - !! @param[in] lside Set to true to apply matrix A from the left; else, set - !! to false to apply matrix A from the left. - !! @param[in] alpha A scalar multiplier. - !! @param[in] a A K-element array containing the diagonal elements of A - !! where K = MIN(M,P) if @p lside is true; else, if @p lside is - !! false, K = MIN(N,P). - !! @param[in] b On input, the M-by-N matrix B. On output, the resulting - !! M-by-N matrix. - !! @param[out] err An optional errors-based object that if provided can be - !! used to retrieve information relating to any errors encountered during - !! execution. If not provided, a default implementation of the errors - !! class is used internally to provide error handling. Possible errors and - !! warning messages that may be encountered are as follows. - !! - LA_ARRAY_SIZE_ERROR: Occurs if any of the input array sizes are - !! incorrect. module subroutine diag_mtx_mult_mtx2(lside, alpha, a, b, err) logical, intent(in) :: lside real(real64), intent(in) :: alpha @@ -1889,34 +1852,7 @@ module subroutine diag_mtx_mult_mtx2(lside, alpha, a, b, err) real(real64), intent(inout), dimension(:,:) :: b class(errors), intent(inout), optional, target :: err end subroutine - - !> @brief Computes the matrix operation: C = alpha * A * op(B) + beta * C, - !! or C = alpha * op(B) * A + beta * C, where A and C are complex-valued. - !! - !! @param[in] lside Set to true to apply matrix A from the left; else, set - !! to false to apply matrix A from the left. - !! @param[in] trans Set to true if op(B) == B**T; else, set to false if - !! op(B) == B. - !! @param[in] alpha A scalar multiplier. - !! @param[in] a A K-element array containing the diagonal elements of A - !! where K = MIN(M,P) if @p lside is true; else, if @p lside is - !! false, K = MIN(N,P). - !! @param[in] b The LDB-by-TDB matrix B where (LDB = leading dimension of B, - !! and TDB = trailing dimension of B): - !! - @p lside == true & @p trans == true: LDB = N, TDB = P - !! - @p lside == true & @p trans == false: LDB = P, TDB = N - !! - @p lside == false & @p trans == true: LDB = P, TDB = M - !! - @p lside == false & @p trans == false: LDB = M, TDB = P - !! @param[in] beta A scalar multiplier. - !! @param[in,out] c On input, the M-by-N matrix C. On output, the resulting - !! M-by-N matrix. - !! @param[out] err An optional errors-based object that if provided can be - !! used to retrieve information relating to any errors encountered during - !! execution. If not provided, a default implementation of the errors - !! class is used internally to provide error handling. Possible errors and - !! warning messages that may be encountered are as follows. - !! - LA_ARRAY_SIZE_ERROR: Occurs if any of the input array sizes are - !! incorrect. + module subroutine diag_mtx_mult_mtx3(lside, trans, alpha, a, b, beta, c, err) logical, intent(in) :: lside, trans real(real64) :: alpha, beta @@ -1925,35 +1861,7 @@ module subroutine diag_mtx_mult_mtx3(lside, trans, alpha, a, b, beta, c, err) complex(real64), intent(inout), dimension(:,:) :: c class(errors), intent(inout), optional, target :: err end subroutine - - !> @brief Computes the matrix operation: C = alpha * A * op(B) + beta * C, - !! or C = alpha * op(B) * A + beta * C, where A, B, and C are - !! complex-valued. - !! - !! @param[in] lside Set to true to apply matrix A from the left; else, set - !! to false to apply matrix A from the left. - !! @param[in] opb Set to TRANSPOSE if op(B) = B**T, set to - !! HERMITIAN_TRANSPOSE if op(B) == B**H, otherwise set to - !! NO_OPERATION if op(B) == B. - !! @param[in] alpha A scalar multiplier. - !! @param[in] a A K-element array containing the diagonal elements of A - !! where K = MIN(M,P) if @p lside is true; else, if @p lside is - !! false, K = MIN(N,P). - !! @param[in] b The LDB-by-TDB matrix B where: - !! - @p lside == true & @p trans == true: LDA = N, TDB = P - !! - @p lside == true & @p trans == false: LDA = P, TDB = N - !! - @p lside == false & @p trans == true: LDA = P, TDB = M - !! - @p lside == false & @p trans == false: LDA = M, TDB = P - !! @param[in] beta A scalar multiplier. - !! @param[in,out] c On input, the M-by-N matrix C. On output, the resulting - !! M-by-N matrix. - !! @param[out] err An optional errors-based object that if provided can be - !! used to retrieve information relating to any errors encountered during - !! execution. If not provided, a default implementation of the errors - !! class is used internally to provide error handling. Possible errors and - !! warning messages that may be encountered are as follows. - !! - LA_ARRAY_SIZE_ERROR: Occurs if any of the input array sizes are - !! incorrect. + module subroutine diag_mtx_mult_mtx4(lside, opb, alpha, a, b, beta, c, err) logical, intent(in) :: lside integer(int32), intent(in) :: opb @@ -1964,34 +1872,6 @@ module subroutine diag_mtx_mult_mtx4(lside, opb, alpha, a, b, beta, c, err) class(errors), intent(inout), optional, target :: err end subroutine - !> @brief Computes the matrix operation: C = alpha * A * op(B) + beta * C, - !! or C = alpha * op(B) * A + beta * C. - !! - !! @param[in] lside Set to true to apply matrix A from the left; else, set - !! to false to apply matrix A from the left. - !! @param[in] opb Set to TRANSPOSE if op(B) = B**T, set to - !! HERMITIAN_TRANSPOSE if op(B) == B**H, otherwise set to - !! NO_OPERATION if op(B) == B. - !! @param[in] alpha A scalar multiplier. - !! @param[in] a A K-element array containing the diagonal elements of A - !! where K = MIN(M,P) if @p lside is true; else, if @p lside is - !! false, K = MIN(N,P). - !! @param[in] b The LDB-by-TDB matrix B where (LDB = leading dimension of B, - !! and TDB = trailing dimension of B): - !! - @p lside == true & @p trans == true: LDB = N, TDB = P - !! - @p lside == true & @p trans == false: LDB = P, TDB = N - !! - @p lside == false & @p trans == true: LDB = P, TDB = M - !! - @p lside == false & @p trans == false: LDB = M, TDB = P - !! @param[in] beta A scalar multiplier. - !! @param[in,out] c On input, the M-by-N matrix C. On output, the resulting - !! M-by-N matrix. - !! @param[out] err An optional errors-based object that if provided can be - !! used to retrieve information relating to any errors encountered during - !! execution. If not provided, a default implementation of the errors - !! class is used internally to provide error handling. Possible errors and - !! warning messages that may be encountered are as follows. - !! - LA_ARRAY_SIZE_ERROR: Occurs if any of the input array sizes are - !! incorrect. module subroutine diag_mtx_mult_mtx_cmplx(lside, opb, alpha, a, b, beta, c, err) logical, intent(in) :: lside integer(int32), intent(in) :: opb @@ -2002,24 +1882,6 @@ module subroutine diag_mtx_mult_mtx_cmplx(lside, opb, alpha, a, b, beta, c, err) class(errors), intent(inout), optional, target :: err end subroutine - !> @brief Computes the matrix operation: B = alpha * A * B, or - !! B = alpha * B * A. - !! - !! @param[in] lside Set to true to apply matrix A from the left; else, set - !! to false to apply matrix A from the left. - !! @param[in] alpha A scalar multiplier. - !! @param[in] a A K-element array containing the diagonal elements of A - !! where K = MIN(M,P) if @p lside is true; else, if @p lside is - !! false, K = MIN(N,P). - !! @param[in] b On input, the M-by-N matrix B. On output, the resulting - !! M-by-N matrix. - !! @param[out] err An optional errors-based object that if provided can be - !! used to retrieve information relating to any errors encountered during - !! execution. If not provided, a default implementation of the errors - !! class is used internally to provide error handling. Possible errors and - !! warning messages that may be encountered are as follows. - !! - LA_ARRAY_SIZE_ERROR: Occurs if any of the input array sizes are - !! incorrect. module subroutine diag_mtx_mult_mtx2_cmplx(lside, alpha, a, b, err) logical, intent(in) :: lside complex(real64), intent(in) :: alpha @@ -2027,35 +1889,7 @@ module subroutine diag_mtx_mult_mtx2_cmplx(lside, alpha, a, b, err) complex(real64), intent(inout), dimension(:,:) :: b class(errors), intent(inout), optional, target :: err end subroutine - - !> @brief Computes the matrix operation: C = alpha * A * op(B) + beta * C, - !! or C = alpha * op(B) * A + beta * C. - !! - !! @param[in] lside Set to true to apply matrix A from the left; else, set - !! to false to apply matrix A from the left. - !! @param[in] opb Set to TRANSPOSE if op(B) = B**T, set to - !! HERMITIAN_TRANSPOSE if op(B) == B**H, otherwise set to - !! NO_OPERATION if op(B) == B. - !! @param[in] alpha A scalar multiplier. - !! @param[in] a A K-element array containing the diagonal elements of A - !! where K = MIN(M,P) if @p lside is true; else, if @p lside is - !! false, K = MIN(N,P). - !! @param[in] b The LDB-by-TDB matrix B where (LDB = leading dimension of B, - !! and TDB = trailing dimension of B): - !! - @p lside == true & @p trans == true: LDB = N, TDB = P - !! - @p lside == true & @p trans == false: LDB = P, TDB = N - !! - @p lside == false & @p trans == true: LDB = P, TDB = M - !! - @p lside == false & @p trans == false: LDB = M, TDB = P - !! @param[in] beta A scalar multiplier. - !! @param[in,out] c On input, the M-by-N matrix C. On output, the resulting - !! M-by-N matrix. - !! @param[out] err An optional errors-based object that if provided can be - !! used to retrieve information relating to any errors encountered during - !! execution. If not provided, a default implementation of the errors - !! class is used internally to provide error handling. Possible errors and - !! warning messages that may be encountered are as follows. - !! - LA_ARRAY_SIZE_ERROR: Occurs if any of the input array sizes are - !! incorrect. + module subroutine diag_mtx_mult_mtx_mix(lside, opb, alpha, a, b, beta, c, err) logical, intent(in) :: lside integer(int32), intent(in) :: opb @@ -2065,25 +1899,7 @@ module subroutine diag_mtx_mult_mtx_mix(lside, opb, alpha, a, b, beta, c, err) complex(real64), intent(inout), dimension(:,:) :: c class(errors), intent(inout), optional, target :: err end subroutine - - !> @brief Computes the matrix operation: B = alpha * A * B, or - !! B = alpha * B * A. - !! - !! @param[in] lside Set to true to apply matrix A from the left; else, set - !! to false to apply matrix A from the left. - !! @param[in] alpha A scalar multiplier. - !! @param[in] a A K-element array containing the diagonal elements of A - !! where K = MIN(M,P) if @p lside is true; else, if @p lside is - !! false, K = MIN(N,P). - !! @param[in] b On input, the M-by-N matrix B. On output, the resulting - !! M-by-N matrix. - !! @param[out] err An optional errors-based object that if provided can be - !! used to retrieve information relating to any errors encountered during - !! execution. If not provided, a default implementation of the errors - !! class is used internally to provide error handling. Possible errors and - !! warning messages that may be encountered are as follows. - !! - LA_ARRAY_SIZE_ERROR: Occurs if any of the input array sizes are - !! incorrect. + module subroutine diag_mtx_mult_mtx2_mix(lside, alpha, a, b, err) logical, intent(in) :: lside complex(real64), intent(in) :: alpha From 06a6bf4a386c4c3d958d8b568feef0a8ba36aa3f Mon Sep 17 00:00:00 2001 From: jchristopherson Date: Tue, 13 Dec 2022 09:40:32 -0600 Subject: [PATCH 14/65] Update documentation --- doc/html/annotated.html | 2 +- ...rfacelinalg__core_1_1cholesky__factor.html | 8 +- ...lg__core_1_1cholesky__rank1__downdate.html | 6 +- ...nalg__core_1_1cholesky__rank1__update.html | 6 +- doc/html/interfacelinalg__core_1_1det.html | 18 +- ...erfacelinalg__core_1_1diag__mtx__mult.html | 23 +- doc/html/interfacelinalg__core_1_1eigen.html | 4 +- .../interfacelinalg__core_1_1form__lu.html | 49 +- .../interfacelinalg__core_1_1form__qr.html | 8 +- .../interfacelinalg__core_1_1lu__factor.html | 27 +- ...interfacelinalg__core_1_1mtx__inverse.html | 4 +- ...nterfacelinalg__core_1_1mtx__pinverse.html | 4 +- .../interfacelinalg__core_1_1mtx__rank.html | 25 +- .../interfacelinalg__core_1_1mult__qr.html | 8 +- .../interfacelinalg__core_1_1mult__rz.html | 2 +- .../interfacelinalg__core_1_1qr__factor.html | 6 +- ...facelinalg__core_1_1qr__rank1__update.html | 8 +- ...acelinalg__core_1_1recip__mult__array.html | 12 +- .../interfacelinalg__core_1_1rz__factor.html | 2 +- ...erfacelinalg__core_1_1solve__cholesky.html | 8 +- ...linalg__core_1_1solve__least__squares.html | 4 +- ...__core_1_1solve__least__squares__full.html | 4 +- ...g__core_1_1solve__least__squares__svd.html | 4 +- .../interfacelinalg__core_1_1solve__lu.html | 6 +- .../interfacelinalg__core_1_1solve__qr.html | 6 +- ...lg__core_1_1solve__triangular__system.html | 8 +- doc/html/interfacelinalg__core_1_1sort.html | 2 +- doc/html/interfacelinalg__core_1_1svd.html | 6 +- doc/html/interfacelinalg__core_1_1swap.html | 16 +- doc/html/interfacelinalg__core_1_1trace.html | 12 +- ...terfacelinalg__core_1_1tri__mtx__mult.html | 23 +- doc/html/linalg__c__api_8f90_source.html | 48 +- doc/html/linalg__core_8f90_source.html | 2228 ++++++++--------- doc/html/linalg__immutable_8f90_source.html | 32 +- doc/html/namespacelinalg__core.html | 2 +- doc/html/namespaces.html | 2 +- src/linalg_core.f90 | 576 ++--- 37 files changed, 1626 insertions(+), 1583 deletions(-) diff --git a/doc/html/annotated.html b/doc/html/annotated.html index ae371314..6a9b3aaf 100644 --- a/doc/html/annotated.html +++ b/doc/html/annotated.html @@ -134,7 +134,7 @@

     CsvdComputes the singular value decomposition of a matrix A. The SVD is defined as: A = U * S * V**T, where U is an M-by-M orthogonal matrix, S is an M-by-N diagonal matrix, and V is an N-by-N orthogonal matrix
     CswapSwaps the contents of two arrays
     CtraceComputes the trace of a matrix (the sum of the main diagonal elements)
     Ctri_mtx_multComputes the triangular matrix operation: B = alpha * A**T * A + beta * B, or B = alpha * A * A**T + beta * B, where A is a triangular matrix
     Ctri_mtx_multComputes the triangular matrix operation: \( B = \alpha A^T A + \beta B \), or \( B = \alpha A A^T + \beta B \), where A is a triangular matrix
     Nlinalg_immutableProvides an immutable interface to many of the core linear algebra routines in this library. The intent is to allow for ease of use in situations where memory allocation, or absolute speed are of lesser importance to code readability
     Ceigen_resultsDefines a container for the output of an Eigen analysis of a square matrix
     Clu_resultsDefines a container for the output of an LU factorization
    + + + +
    [in,out]aOn input, the N-by-N matrix on which to operate. On output the contents are overwritten by the LU factorization of the original matrix.
    [out]iworkAn optional input, that if provided, prevents any local memory allocation. If not provided, the memory required is allocated within. If provided, the length of the array must be at least N-elements.
    [in,out]errAn optional errors-based object that if provided can be used to retrieve information relating to any errors encountered during execution. If not provided, a default implementation of the errors class is used internally to provide error handling. Possible errors and warning messages that may be encountered are as follows.
      +
    • LA_ARRAY_SIZE_ERROR: Occurs if any of the input arrays are not sized appropriately.
    • +
    • LA_OUT_OF_MEMORY_ERROR: Occurs if local memory must be allocated, and there is insufficient memory available.
    • +
    +
    + + +
    Returns
    The determinant of a.
    -

    Definition at line 301 of file linalg_core.f90.

    +

    Definition at line 394 of file linalg_core.f90.


    The documentation for this interface was generated from the following file: diff --git a/doc/html/interfacelinalg__core_1_1diag__mtx__mult.html b/doc/html/interfacelinalg__core_1_1diag__mtx__mult.html index 7437e01b..1962579e 100644 --- a/doc/html/interfacelinalg__core_1_1diag__mtx__mult.html +++ b/doc/html/interfacelinalg__core_1_1diag__mtx__mult.html @@ -128,7 +128,7 @@
    [in]betaA scalar multiplier.
    [in,out]cOn input, the M-by-N matrix C. On output, the resulting M-by-N matrix.
    [out]errAn optional errors-based object that if provided can be used to retrieve information relating to any errors encountered during execution. If not provided, a default implementation of the errors class is used internally to provide error handling. Possible errors and warning messages that may be encountered are as follows.
      +
    [in,out]errAn optional errors-based object that if provided can be used to retrieve information relating to any errors encountered during execution. If not provided, a default implementation of the errors class is used internally to provide error handling. Possible errors and warning messages that may be encountered are as follows.
    • LA_ARRAY_SIZE_ERROR: Occurs if any of the input array sizes are incorrect.
    + + + + + +
    [in]lsideSet to true to apply matrix A from the left; else, set to false to apply matrix A from the left.
    [in]alphaA scalar multiplier.
    [in]aA K-element array containing the diagonal elements of A where K = MIN(M,P) if lside is true; else, if lside is false, K = MIN(N,P).
    [in]bOn input, the M-by-N matrix B. On output, the resulting M-by-N matrix.
    [in,out]errAn optional errors-based object that if provided can be used to retrieve information relating to any errors encountered during execution. If not provided, a default implementation of the errors class is used internally to provide error handling. Possible errors and warning messages that may be encountered are as follows.
      +
    • LA_ARRAY_SIZE_ERROR: Occurs if any of the input array sizes are incorrect.
    • +
    +
    + +
    Usage
    The following example illustrates the use of the diagonal matrix multiplication routine to compute the S * V**T component of a singular value decomposition.
    program example
    use iso_fortran_env, only : int32, real64
    @@ -172,7 +185,7 @@
    print *, vt(i,:)
    end do
    -
    ! Compute U * S * V**T, but first establish S in full form
    +
    ! Compute U * S * V**T
    call diag_mtx_mult(.true., 1.0d0, s, vt) ! Compute: VT = S * V**T
    ac = matmul(u(:,1:2), vt)
    print '(A)', "U * S * V**T ="
    @@ -180,8 +193,8 @@
    print *, ac(i,:)
    end do
    end program
    -
    Multiplies a diagonal matrix with another matrix or array.
    -
    Computes the singular value decomposition of a matrix A. The SVD is defined as: A = U * S * V**T,...
    +
    Multiplies a diagonal matrix with another matrix or array.
    +
    Computes the singular value decomposition of a matrix A. The SVD is defined as: A = U * S * V**T,...
    Provides a set of common linear algebra routines.
    Definition: linalg_core.f90:15
    The above program produces the following output.
    U =
    -0.47411577501825380 -0.81850539032073777 -0.32444284226152509
    @@ -199,7 +212,7 @@
    -1.0000000000000000 0.99999999999999967
    -

    Definition at line 273 of file linalg_core.f90.

    +

    Definition at line 289 of file linalg_core.f90.


    The documentation for this interface was generated from the following file: diff --git a/doc/html/interfacelinalg__core_1_1eigen.html b/doc/html/interfacelinalg__core_1_1eigen.html index 53209ed6..5c12c180 100644 --- a/doc/html/interfacelinalg__core_1_1eigen.html +++ b/doc/html/interfacelinalg__core_1_1eigen.html @@ -164,7 +164,7 @@
    print '(F10.3)', (real(modeshapes(j,i)), j = 1, size(natfreq))
    end do
    end program
    -
    Computes the eigenvalues, and optionally the eigenvectors, of a matrix.
    +
    Computes the eigenvalues, and optionally the eigenvectors, of a matrix.
    Provides a set of common linear algebra routines.
    Definition: linalg_core.f90:15
    The above program produces the following output.
    Modal Information:
    Mode 1: (232.9225 Hz)
    @@ -187,7 +187,7 @@ -

    Definition at line 1752 of file linalg_core.f90.

    +

    Definition at line 1979 of file linalg_core.f90.


    The documentation for this interface was generated from the following file: diff --git a/doc/html/interfacelinalg__core_1_1form__lu.html b/doc/html/interfacelinalg__core_1_1form__lu.html index 44ca558d..d593d969 100644 --- a/doc/html/interfacelinalg__core_1_1form__lu.html +++ b/doc/html/interfacelinalg__core_1_1form__lu.html @@ -107,6 +107,47 @@ More...

    Detailed Description

    Extracts the L and U matrices from the condensed [L\U] storage format used by the lu_factor.

    +
    Syntax 1
    subroutine form_lu(real(real64) lu(:,:), integer(int32) ipvt(:), real(real64) u(:,:), real(real64) p(:,:), optional class(errors) err)
    +
    subroutine form_lu(complex(real64) lu(:,:), integer(int32) ipvt(:), complex(real64) u(:,:), real(real64) p(:,:), optional class(errors) err)
    +
    +
    Parameters
    + + + + + + +
    [in,out]luOn input, the N-by-N matrix as output by lu_factor. On output, the N-by-N lower triangular matrix L.
    [in]ipvtThe N-element pivot array as output by lu_factor.
    [out]uAn N-by-N matrix where the U matrix will be written.
    [out]pAn N-by-N matrix where the row permutation matrix will be written.
    [in,out]errAn optional errors-based object that if provided can be used to retrieve information relating to any errors encountered during execution. If not provided, a default implementation of the errors class is used internally to provide error handling. Possible errors and warning messages that may be encountered are as follows.
      +
    • LA_ARRAY_SIZE_ERROR: Occurs if any of the input array sizes are incorrect.
    • +
    +
    +
    +
    +
    Syntax 2
    subroutine form_lu(real(real64) lu(:,:), real(real64) u(:,:), optional class(errors) err)
    +
    subroutine form_lu(complex(real64) lu(:,:), complex(real64) u(:,:), optional class(errors) err)
    +
    +
    Parameters
    + + + + +
    [in,out]luOn input, the N-by-N matrix as output by lu_factor. On output, the N-by-N lower triangular matrix L.
    [out]uAn N-by-N matrix where the U matrix will be written.
    [in,out]errAn optional errors-based object that if provided can be used to retrieve information relating to any errors encountered during execution. If not provided, a default implementation of the errors class is used internally to provide error handling. Possible errors and warning messages that may be encountered are as follows.
      +
    • LA_ARRAY_SIZE_ERROR: Occurs if any of the input array sizes are incorrect.
    • +
    +
    +
    +
    +
    Remarks
    This routine allows extraction of the actual "L", "U", and "P" matrices of the decomposition. To use these matrices to solve the system \( A X = B \), the following approach is used.
    +
      +
    1. First, solve the linear system: \( L Y = P B \) for \( Y \).
    2. +
    3. Second, solve the linear system: \( U X = Y \) for \( X \).
    4. +
    +

    Notice, as both L and U are triangular in structure, the above equations can be solved by forward and backward substitution.

    +
    See Also
    +
    Usage
    The following example illustrates how to extract the L, U, and P matrices in order to solve a system of LU factored equations.
    program example
    use iso_fortran_env, only : real64, int32
    @@ -156,9 +197,9 @@
    print '(A)', "LU Solution: X = "
    print '(F8.4)', (b(i), i = 1, size(b))
    end program
    -
    Extracts the L and U matrices from the condensed [L\U] storage format used by the lu_factor.
    -
    Computes the LU factorization of an M-by-N matrix.
    -
    Solves a triangular system of equations.
    +
    Extracts the L and U matrices from the condensed [L\U] storage format used by the lu_factor.
    +
    Computes the LU factorization of an M-by-N matrix.
    +
    Solves a triangular system of equations.
    Provides a set of common linear algebra routines.
    Definition: linalg_core.f90:15
    The above program produces the following output.
    LU Solution: X =
    0.3333
    @@ -166,7 +207,7 @@
    0.0000
    -

    Definition at line 450 of file linalg_core.f90.

    +

    Definition at line 677 of file linalg_core.f90.


    The documentation for this interface was generated from the following file: diff --git a/doc/html/interfacelinalg__core_1_1form__qr.html b/doc/html/interfacelinalg__core_1_1form__qr.html index 7f5f4525..0dcff9e3 100644 --- a/doc/html/interfacelinalg__core_1_1form__qr.html +++ b/doc/html/interfacelinalg__core_1_1form__qr.html @@ -162,9 +162,9 @@
    ! for by noting that Q * R = A * P, where P is an N-by-N matrix describing
    ! the column pivoting operations.
    end program
    -
    Forms the full M-by-M orthogonal matrix Q from the elementary reflectors returned by the base QR fact...
    -
    Computes the QR factorization of an M-by-N matrix.
    -
    Solves a triangular system of equations.
    +
    Forms the full M-by-M orthogonal matrix Q from the elementary reflectors returned by the base QR fact...
    +
    Computes the QR factorization of an M-by-N matrix.
    +
    Solves a triangular system of equations.
    Provides a set of common linear algebra routines.
    Definition: linalg_core.f90:15
    The above program produces the following output.
    QR Solution: X =
    0.3333
    @@ -177,7 +177,7 @@ -

    Definition at line 603 of file linalg_core.f90.

    +

    Definition at line 830 of file linalg_core.f90.


    The documentation for this interface was generated from the following file: diff --git a/doc/html/interfacelinalg__core_1_1lu__factor.html b/doc/html/interfacelinalg__core_1_1lu__factor.html index 37915c9f..a245a729 100644 --- a/doc/html/interfacelinalg__core_1_1lu__factor.html +++ b/doc/html/interfacelinalg__core_1_1lu__factor.html @@ -107,6 +107,27 @@ More...

    Detailed Description

    Computes the LU factorization of an M-by-N matrix.

    +
    Syntax
    subroutine lu_factor(real(real64) a(:,:), integer(int32) ipvt(:), optional class(errors))
    +
    subroutine lu_factor(complex(real64) a(:,:), integer(int32) ipvt(:), optional class(errors))
    +
    +
    Parameters
    + + + + +
    [in,out]aOn input, the M-by-N matrix on which to operate. On output, the LU factored matrix in the form [L\U] where the unit diagonal elements of L are not stored.
    [out]ipvtAn MIN(M, N)-element array used to track row-pivot operations. The array stored pivot information such that row I is interchanged with row IPVT(I).
    [in,out]errAn optional errors-based object that if provided can be used to retrieve information relating to any errors encountered during execution. If not provided, a default implementation of the errors class is used internally to provide error handling. Possible errors and warning messages that may be encountered are as follows.
      +
    • LA_ARRAY_SIZE_ERROR: Occurs if ipvt is not sized appropriately.
    • +
    • LA_SINGULAR_MATRIX_ERROR: Occurs as a warning if a is found to be singular.
    • +
    +
    +
    +
    +
    Notes
    This routine utilizes the LAPACK routine DGETRF.
    +
    See Also
    +
    Usage
    To solve a system of 3 equations of 3 unknowns using LU factorization, the following code will suffice.
    program example
    use iso_fortran_env
    @@ -145,8 +166,8 @@
    print '(A)', "LU Solution: X = "
    print '(F8.4)', (b(i), i = 1, size(b))
    end program
    -
    Computes the LU factorization of an M-by-N matrix.
    -
    Solves a system of LU-factored equations.
    +
    Computes the LU factorization of an M-by-N matrix.
    +
    Solves a system of LU-factored equations.
    Provides a set of common linear algebra routines.
    Definition: linalg_core.f90:15
    The program generates the following output.
    LU Solution: X =
    0.3333
    @@ -154,7 +175,7 @@
    0.0000
    -

    Definition at line 381 of file linalg_core.f90.

    +

    Definition at line 555 of file linalg_core.f90.


    The documentation for this interface was generated from the following file: diff --git a/doc/html/interfacelinalg__core_1_1mtx__inverse.html b/doc/html/interfacelinalg__core_1_1mtx__inverse.html index 785dd2e6..3cc41c50 100644 --- a/doc/html/interfacelinalg__core_1_1mtx__inverse.html +++ b/doc/html/interfacelinalg__core_1_1mtx__inverse.html @@ -143,7 +143,7 @@
    print *, c(i,:)
    end do
    end program
    -
    Computes the inverse of a square matrix.
    +
    Computes the inverse of a square matrix.
    Provides a set of common linear algebra routines.
    Definition: linalg_core.f90:15
    The above program produces the following output.
    Inverse:
    -1.7777777777777777 0.88888888888888884 -0.11111111111111110
    @@ -155,7 +155,7 @@
    1.7763568394002505E-015 -8.8817841970012523E-016 1.0000000000000000
    -

    Definition at line 1597 of file linalg_core.f90.

    +

    Definition at line 1824 of file linalg_core.f90.


    The documentation for this interface was generated from the following file: diff --git a/doc/html/interfacelinalg__core_1_1mtx__pinverse.html b/doc/html/interfacelinalg__core_1_1mtx__pinverse.html index 3a0ab9f7..eeadaa69 100644 --- a/doc/html/interfacelinalg__core_1_1mtx__pinverse.html +++ b/doc/html/interfacelinalg__core_1_1mtx__pinverse.html @@ -145,7 +145,7 @@
    print *, c(i,:)
    end do
    end program
    -
    Computes the Moore-Penrose pseudo-inverse of a M-by-N matrix using the singular value decomposition o...
    +
    Computes the Moore-Penrose pseudo-inverse of a M-by-N matrix using the singular value decomposition o...
    Provides a set of common linear algebra routines.
    Definition: linalg_core.f90:15
    The above program produces the following output.
    Inverse:
    1.0000000000000000 0.0000000000000000 0.0000000000000000
    @@ -155,7 +155,7 @@
    0.0000000000000000 0.99999999999999967
    -

    Definition at line 1658 of file linalg_core.f90.

    +

    Definition at line 1885 of file linalg_core.f90.


    The documentation for this interface was generated from the following file: diff --git a/doc/html/interfacelinalg__core_1_1mtx__rank.html b/doc/html/interfacelinalg__core_1_1mtx__rank.html index bb748d83..849f6ac2 100644 --- a/doc/html/interfacelinalg__core_1_1mtx__rank.html +++ b/doc/html/interfacelinalg__core_1_1mtx__rank.html @@ -107,8 +107,31 @@ More...

    Detailed Description

    Computes the rank of a matrix.

    +
    Syntax
    integer(int32) function mtx_rank(real(real64) a(:,:), optional real(real64) tol, optional real(real64) work(:), optional integer(int32) olwork, optional class(errors) err)
    +
    integer(int32) function mtx_rank(complex(real64) a(:,:), optional real(real64) tol, optional complex(real64) work(:), optional integer(int32) olwork, optional real(real64) rwork(:), optional class(errors) err)
    +
    +
    Parameters
    + + + + + + + +
    [in,out]aOn input, the M-by-N matrix of interest. On output, the contents of the matrix are overwritten.
    [in]tolAn optional input, that if supplied, overrides the default tolerance on singular values such that singular values less than this tolerance are treated as zero. The default tolerance is: MAX(M, N) * EPS * MAX(S). If the supplied value is less than the smallest value that causes an overflow if inverted, the tolerance reverts back to its default value, and the operation continues; however, a warning message is issued.
    [out]workAn optional input, that if provided, prevents any local memory allocation. If not provided, the memory required is allocated within. If provided, the length of the array must be at least olwork.
    [out]olworkAn optional output used to determine workspace size. If supplied, the routine determines the optimal size for work, and returns without performing any actual calculations.
    [out]rworkAn optional input, that if provided, prevents any local memory allocation for real-valued workspace arrays. If not provided, the memory required is allocated within. If provided, the length of the array must be at least 6 * MIN(M, N).
    [in,out]errAn optional errors-based object that if provided can be used to retrieve information relating to any errors encountered during execution. If not provided, a default implementation of the errors class is used internally to provide error handling. Possible errors and warning messages that may be encountered are as follows.
      +
    • LA_ARRAY_SIZE_ERROR: Occurs if any of the input arrays are not sized appropriately.
    • +
    • LA_OUT_OF_MEMORY_ERROR: Occurs if local memory must be allocated, and there is insufficient memory available.
    • +
    • LA_CONVERGENCE_ERROR: Occurs as a warning if the QR iteration process could not converge to a zero value.
    • +
    +
    +
    +
    +
    See Also
    +
    -

    Definition at line 294 of file linalg_core.f90.

    +

    Definition at line 361 of file linalg_core.f90.


    The documentation for this interface was generated from the following file: diff --git a/doc/html/interfacelinalg__core_1_1mult__qr.html b/doc/html/interfacelinalg__core_1_1mult__qr.html index d0536d5a..87b79167 100644 --- a/doc/html/interfacelinalg__core_1_1mult__qr.html +++ b/doc/html/interfacelinalg__core_1_1mult__qr.html @@ -160,9 +160,9 @@
    ! for by noting that Q * R = A * P, where P is an N-by-N matrix describing
    ! the column pivoting operations.
    end program
    -
    Multiplies a general matrix by the orthogonal matrix Q from a QR factorization.
    -
    Computes the QR factorization of an M-by-N matrix.
    -
    Solves a triangular system of equations.
    +
    Multiplies a general matrix by the orthogonal matrix Q from a QR factorization.
    +
    Computes the QR factorization of an M-by-N matrix.
    +
    Solves a triangular system of equations.
    Provides a set of common linear algebra routines.
    Definition: linalg_core.f90:15
    The above program produces the following output.
    QR Solution: X =
    0.3333
    @@ -170,7 +170,7 @@
    0.0000
    -

    Definition at line 680 of file linalg_core.f90.

    +

    Definition at line 907 of file linalg_core.f90.


    The documentation for this interface was generated from the following file: diff --git a/doc/html/interfacelinalg__core_1_1mult__rz.html b/doc/html/interfacelinalg__core_1_1mult__rz.html index e61876ae..f07c99e2 100644 --- a/doc/html/interfacelinalg__core_1_1mult__rz.html +++ b/doc/html/interfacelinalg__core_1_1mult__rz.html @@ -108,7 +108,7 @@

    Detailed Description

    Multiplies a general matrix by the orthogonal matrix Z from an RZ factorization.

    -

    Definition at line 1016 of file linalg_core.f90.

    +

    Definition at line 1243 of file linalg_core.f90.


    The documentation for this interface was generated from the following file: diff --git a/doc/html/interfacelinalg__core_1_1qr__factor.html b/doc/html/interfacelinalg__core_1_1qr__factor.html index 3850c784..fc445a7f 100644 --- a/doc/html/interfacelinalg__core_1_1qr__factor.html +++ b/doc/html/interfacelinalg__core_1_1qr__factor.html @@ -150,8 +150,8 @@
    ! same manner. The only difference is to omit the PVT array (column pivot
    ! tracking array).
    end program
    -
    Computes the QR factorization of an M-by-N matrix.
    -
    Solves a system of M QR-factored equations of N unknowns.
    +
    Computes the QR factorization of an M-by-N matrix.
    +
    Solves a system of M QR-factored equations of N unknowns.
    Provides a set of common linear algebra routines.
    Definition: linalg_core.f90:15
    The above program produces the following output.
    QR Solution: X =
    0.3333
    @@ -165,7 +165,7 @@ -

    Definition at line 520 of file linalg_core.f90.

    +

    Definition at line 747 of file linalg_core.f90.


    The documentation for this interface was generated from the following file: diff --git a/doc/html/interfacelinalg__core_1_1qr__rank1__update.html b/doc/html/interfacelinalg__core_1_1qr__rank1__update.html index e5a56b03..a2413c9b 100644 --- a/doc/html/interfacelinalg__core_1_1qr__rank1__update.html +++ b/doc/html/interfacelinalg__core_1_1qr__rank1__update.html @@ -171,9 +171,9 @@
    print *, a(i,:)
    end do
    end program
    -
    Forms the full M-by-M orthogonal matrix Q from the elementary reflectors returned by the base QR fact...
    -
    Computes the QR factorization of an M-by-N matrix.
    -
    Computes the rank 1 update to an M-by-N QR factored matrix A (M >= N) where A = Q * R,...
    +
    Forms the full M-by-M orthogonal matrix Q from the elementary reflectors returned by the base QR fact...
    +
    Computes the QR factorization of an M-by-N matrix.
    +
    Computes the rank 1 update to an M-by-N QR factored matrix A (M >= N) where A = Q * R,...
    Performs the rank-1 update to matrix A such that: , where is an M-by-N matrix, is a scalar,...
    Provides a set of common linear algebra routines.
    Definition: linalg_core.f90:15
    The above program produces the following output.
    Updating the Factored Form:
    @@ -196,7 +196,7 @@
    0.0000000000000000 0.0000000000000000 -5.2929341121113058
    -

    Definition at line 782 of file linalg_core.f90.

    +

    Definition at line 1009 of file linalg_core.f90.


    The documentation for this interface was generated from the following file: diff --git a/doc/html/interfacelinalg__core_1_1recip__mult__array.html b/doc/html/interfacelinalg__core_1_1recip__mult__array.html index 01a1f1a0..8f2b6eeb 100644 --- a/doc/html/interfacelinalg__core_1_1recip__mult__array.html +++ b/doc/html/interfacelinalg__core_1_1recip__mult__array.html @@ -107,8 +107,18 @@ More...

    Detailed Description

    Multiplies a vector by the reciprocal of a real scalar.

    +
    Syntax
    subroutine recip_mult_array(real(real64) a, real(real64) x(:))
    +
    +
    Parameters
    + + + +
    [in]aThe scalar which is used to divide each component of X. The value must be >= 0, or the subroutine will divide by zero.
    [in,out]xThe vector.
    +
    +
    +
    Notes
    This routine is based upon the LAPACK routine DRSCL.
    -

    Definition at line 315 of file linalg_core.f90.

    +

    Definition at line 435 of file linalg_core.f90.


    The documentation for this interface was generated from the following file: diff --git a/doc/html/interfacelinalg__core_1_1rz__factor.html b/doc/html/interfacelinalg__core_1_1rz__factor.html index 4f9b1e59..c347ff53 100644 --- a/doc/html/interfacelinalg__core_1_1rz__factor.html +++ b/doc/html/interfacelinalg__core_1_1rz__factor.html @@ -108,7 +108,7 @@

    Detailed Description

    Factors an upper trapezoidal matrix by means of orthogonal transformations such that A = R * Z = (R 0) * Z. Z is an orthogonal matrix of dimension N-by-N, and R is an M-by-M upper triangular matrix.

    -

    Definition at line 1008 of file linalg_core.f90.

    +

    Definition at line 1235 of file linalg_core.f90.


    The documentation for this interface was generated from the following file: diff --git a/doc/html/interfacelinalg__core_1_1solve__cholesky.html b/doc/html/interfacelinalg__core_1_1solve__cholesky.html index 7c76aba8..c5c4daff 100644 --- a/doc/html/interfacelinalg__core_1_1solve__cholesky.html +++ b/doc/html/interfacelinalg__core_1_1solve__cholesky.html @@ -157,9 +157,9 @@
    print '(A)', "Cholesky Solution (Manual Approach): X = "
    print '(F8.4)', (bu(i), i = 1, size(bu))
    end program
    -
    Computes the Cholesky factorization of a symmetric, positive definite matrix.
    -
    Solves a system of Cholesky factored equations.
    -
    Solves a triangular system of equations.
    +
    Computes the Cholesky factorization of a symmetric, positive definite matrix.
    +
    Solves a system of Cholesky factored equations.
    +
    Solves a triangular system of equations.
    Provides a set of common linear algebra routines.
    Definition: linalg_core.f90:15
    The above program produces the following output.
    Cholesky Solution: X =
    239.5833
    @@ -171,7 +171,7 @@
    10.3333
    -

    Definition at line 1374 of file linalg_core.f90.

    +

    Definition at line 1601 of file linalg_core.f90.


    The documentation for this interface was generated from the following file: diff --git a/doc/html/interfacelinalg__core_1_1solve__least__squares.html b/doc/html/interfacelinalg__core_1_1solve__least__squares.html index 6d8abbc1..fc3522c2 100644 --- a/doc/html/interfacelinalg__core_1_1solve__least__squares.html +++ b/doc/html/interfacelinalg__core_1_1solve__least__squares.html @@ -139,14 +139,14 @@
    print '(A)', "Least Squares Solution: X = "
    print '(F9.5)', (b(i), i = 1, size(a, 2))
    end program
    -
    Solves the overdetermined or underdetermined system (A*X = B) of M equations of N unknowns.
    +
    Solves the overdetermined or underdetermined system (A*X = B) of M equations of N unknowns.
    Provides a set of common linear algebra routines.
    Definition: linalg_core.f90:15
    The above program produces the following output.
    Least Squares Solution: X =
    0.13158
    -0.57895
    -

    Definition at line 1428 of file linalg_core.f90.

    +

    Definition at line 1655 of file linalg_core.f90.


    The documentation for this interface was generated from the following file: diff --git a/doc/html/interfacelinalg__core_1_1solve__least__squares__full.html b/doc/html/interfacelinalg__core_1_1solve__least__squares__full.html index 18c5245e..0b901162 100644 --- a/doc/html/interfacelinalg__core_1_1solve__least__squares__full.html +++ b/doc/html/interfacelinalg__core_1_1solve__least__squares__full.html @@ -139,14 +139,14 @@
    print '(A)', "Least Squares Solution: X = "
    print '(F9.5)', (b(i), i = 1, size(a, 2))
    end program
    -
    Solves the overdetermined or underdetermined system (A*X = B) of M equations of N unknowns,...
    +
    Solves the overdetermined or underdetermined system (A*X = B) of M equations of N unknowns,...
    Provides a set of common linear algebra routines.
    Definition: linalg_core.f90:15
    The above program produces the following output.
    Least Squares Solution: X =
    0.13158
    -0.57895
    -

    Definition at line 1483 of file linalg_core.f90.

    +

    Definition at line 1710 of file linalg_core.f90.


    The documentation for this interface was generated from the following file: diff --git a/doc/html/interfacelinalg__core_1_1solve__least__squares__svd.html b/doc/html/interfacelinalg__core_1_1solve__least__squares__svd.html index 524559de..347b574d 100644 --- a/doc/html/interfacelinalg__core_1_1solve__least__squares__svd.html +++ b/doc/html/interfacelinalg__core_1_1solve__least__squares__svd.html @@ -139,14 +139,14 @@
    print '(A)', "Least Squares Solution: X = "
    print '(F9.5)', (b(i), i = 1, size(a, 2))
    end program
    -
    Solves the overdetermined or underdetermined system (A*X = B) of M equations of N unknowns using a si...
    +
    Solves the overdetermined or underdetermined system (A*X = B) of M equations of N unknowns using a si...
    Provides a set of common linear algebra routines.
    Definition: linalg_core.f90:15
    The above program produces the following output.
    Least Squares Solution: X =
    0.13158
    -0.57895
    -

    Definition at line 1538 of file linalg_core.f90.

    +

    Definition at line 1765 of file linalg_core.f90.


    The documentation for this interface was generated from the following file: diff --git a/doc/html/interfacelinalg__core_1_1solve__lu.html b/doc/html/interfacelinalg__core_1_1solve__lu.html index cf8dc610..93c2dd51 100644 --- a/doc/html/interfacelinalg__core_1_1solve__lu.html +++ b/doc/html/interfacelinalg__core_1_1solve__lu.html @@ -145,8 +145,8 @@
    print '(A)', "LU Solution: X = "
    print '(F8.4)', (b(i), i = 1, size(b))
    end program
    -
    Computes the LU factorization of an M-by-N matrix.
    -
    Solves a system of LU-factored equations.
    +
    Computes the LU factorization of an M-by-N matrix.
    +
    Solves a system of LU-factored equations.
    Provides a set of common linear algebra routines.
    Definition: linalg_core.f90:15
    The program generates the following output.
    LU Solution: X =
    0.3333
    @@ -159,7 +159,7 @@ -

    Definition at line 1225 of file linalg_core.f90.

    +

    Definition at line 1452 of file linalg_core.f90.


    The documentation for this interface was generated from the following file: diff --git a/doc/html/interfacelinalg__core_1_1solve__qr.html b/doc/html/interfacelinalg__core_1_1solve__qr.html index 9838ddee..d5b326f0 100644 --- a/doc/html/interfacelinalg__core_1_1solve__qr.html +++ b/doc/html/interfacelinalg__core_1_1solve__qr.html @@ -150,8 +150,8 @@
    ! same manner. The only difference is to omit the PVT array (column pivot
    ! tracking array).
    end program
    -
    Computes the QR factorization of an M-by-N matrix.
    -
    Solves a system of M QR-factored equations of N unknowns.
    +
    Computes the QR factorization of an M-by-N matrix.
    +
    Solves a system of M QR-factored equations of N unknowns.
    Provides a set of common linear algebra routines.
    Definition: linalg_core.f90:15
    The above program produces the following output.
    QR Solution: X =
    0.3333
    @@ -164,7 +164,7 @@ -

    Definition at line 1294 of file linalg_core.f90.

    +

    Definition at line 1521 of file linalg_core.f90.


    The documentation for this interface was generated from the following file: diff --git a/doc/html/interfacelinalg__core_1_1solve__triangular__system.html b/doc/html/interfacelinalg__core_1_1solve__triangular__system.html index c2bd04b5..5a9e5e8d 100644 --- a/doc/html/interfacelinalg__core_1_1solve__triangular__system.html +++ b/doc/html/interfacelinalg__core_1_1solve__triangular__system.html @@ -156,9 +156,9 @@
    print '(A)', "LU Solution: X = "
    print '(F8.4)', (b(i), i = 1, size(b))
    end program
    -
    Extracts the L and U matrices from the condensed [L\U] storage format used by the lu_factor.
    -
    Computes the LU factorization of an M-by-N matrix.
    -
    Solves a triangular system of equations.
    +
    Extracts the L and U matrices from the condensed [L\U] storage format used by the lu_factor.
    +
    Computes the LU factorization of an M-by-N matrix.
    +
    Solves a triangular system of equations.
    Provides a set of common linear algebra routines.
    Definition: linalg_core.f90:15
    The above program produces the following output.
    LU Solution: X =
    0.3333
    @@ -166,7 +166,7 @@
    0.0000
    -

    Definition at line 1161 of file linalg_core.f90.

    +

    Definition at line 1388 of file linalg_core.f90.


    The documentation for this interface was generated from the following file: diff --git a/doc/html/interfacelinalg__core_1_1sort.html b/doc/html/interfacelinalg__core_1_1sort.html index ee6fb0b6..ac119609 100644 --- a/doc/html/interfacelinalg__core_1_1sort.html +++ b/doc/html/interfacelinalg__core_1_1sort.html @@ -108,7 +108,7 @@

    Detailed Description

    Sorts an array.

    -

    Definition at line 1761 of file linalg_core.f90.

    +

    Definition at line 1988 of file linalg_core.f90.


    The documentation for this interface was generated from the following file: diff --git a/doc/html/interfacelinalg__core_1_1svd.html b/doc/html/interfacelinalg__core_1_1svd.html index c2cfc76a..0d3541d1 100644 --- a/doc/html/interfacelinalg__core_1_1svd.html +++ b/doc/html/interfacelinalg__core_1_1svd.html @@ -148,8 +148,8 @@
    print *, ac(i,:)
    end do
    end program
    -
    Multiplies a diagonal matrix with another matrix or array.
    -
    Computes the singular value decomposition of a matrix A. The SVD is defined as: A = U * S * V**T,...
    +
    Multiplies a diagonal matrix with another matrix or array.
    +
    Computes the singular value decomposition of a matrix A. The SVD is defined as: A = U * S * V**T,...
    Provides a set of common linear algebra routines.
    Definition: linalg_core.f90:15
    The above program produces the following output.
    U =
    -0.47411577501825380 -0.81850539032073777 -0.32444284226152509
    @@ -167,7 +167,7 @@
    -1.0000000000000000 0.99999999999999967
    -

    Definition at line 1092 of file linalg_core.f90.

    +

    Definition at line 1319 of file linalg_core.f90.


    The documentation for this interface was generated from the following file: diff --git a/doc/html/interfacelinalg__core_1_1swap.html b/doc/html/interfacelinalg__core_1_1swap.html index 40874aeb..08d9f4c3 100644 --- a/doc/html/interfacelinalg__core_1_1swap.html +++ b/doc/html/interfacelinalg__core_1_1swap.html @@ -107,8 +107,22 @@ More...

    Detailed Description

    Swaps the contents of two arrays.

    +
    Syntax
    subroutine swap(real(real64) x(:), real(real64) y(:), optional class(errors) err)
    +
    subroutine swap(complex(real64) x(:), complex(real64) y(:), optional class(errors) err)
    +
    +
    Parameters
    + + + + +
    [in,out]xOne of the N-element arrays.
    [in,out]yThe other N-element array.
    [in,out]errAn optional errors-based object that if provided can be used to retrieve information relating to any errors encountered during execution. If not provided, a default implementation of the errors class is used internally to provide error handling. Possible errors and warning messages that may be encountered are as follows.
      +
    • LA_ARRAY_SIZE_ERROR: Occurs if x and y are not the same size.
    • +
    +
    +
    +
    -

    Definition at line 308 of file linalg_core.f90.

    +

    Definition at line 416 of file linalg_core.f90.


    The documentation for this interface was generated from the following file: diff --git a/doc/html/interfacelinalg__core_1_1trace.html b/doc/html/interfacelinalg__core_1_1trace.html index a3805911..d5022084 100644 --- a/doc/html/interfacelinalg__core_1_1trace.html +++ b/doc/html/interfacelinalg__core_1_1trace.html @@ -107,8 +107,18 @@ More...

    Detailed Description

    Computes the trace of a matrix (the sum of the main diagonal elements).

    +
    Syntax
    real(real64) function trace(real(real64) x(:,:))
    +
    complex(real64) function trace(complex(real64) x(:,:))
    +
    +
    Parameters
    + + +
    [in]xThe matrix on which to operate.
    +
    +
    +
    Returns
    The trace of x.
    -

    Definition at line 287 of file linalg_core.f90.

    +

    Definition at line 313 of file linalg_core.f90.


    The documentation for this interface was generated from the following file: diff --git a/doc/html/interfacelinalg__core_1_1tri__mtx__mult.html b/doc/html/interfacelinalg__core_1_1tri__mtx__mult.html index 03db1b51..94e02619 100644 --- a/doc/html/interfacelinalg__core_1_1tri__mtx__mult.html +++ b/doc/html/interfacelinalg__core_1_1tri__mtx__mult.html @@ -103,12 +103,29 @@
    -

    Computes the triangular matrix operation: B = alpha * A**T * A + beta * B, or B = alpha * A * A**T + beta * B, where A is a triangular matrix. +

    Computes the triangular matrix operation: \( B = \alpha A^T A + \beta B \), or \( B = \alpha A A^T + \beta B \), where A is a triangular matrix. More...

    Detailed Description

    -

    Computes the triangular matrix operation: B = alpha * A**T * A + beta * B, or B = alpha * A * A**T + beta * B, where A is a triangular matrix.

    +

    Computes the triangular matrix operation: \( B = \alpha A^T A + \beta B \), or \( B = \alpha A A^T + \beta B \), where A is a triangular matrix.

    +
    Syntax
    subroutine tri_mtx_mult(logical upper, real(real64) alpha, real(real64) a(:,:), real(real64) beta, real(real64) b(:,:), optional class(errors) err)
    +
    subroutine tri_mtx_mult(logical upper, complex(real64) alpha, complex(real64) a(:,:), complex(real64) beta, complex(real64) b(:,:), optional class(errors) err)
    +
    +
    Parameters
    + + + + + + + +
    [in]upperSet to true if matrix A is upper triangular, and \( B = \alpha A^T A + \beta B \) is to be calculated; else, set to false if A is lower triangular, and \( B = \alpha A A^T + \beta B \) is to be computed.
    [in]alphaA scalar multiplier.
    [in]aThe N-by-N triangular matrix. Notice, if upper is true only the upper triangular portion of this matrix is referenced; else, if upper is false, only the lower triangular portion of this matrix is referenced.
    [in]betaA scalar multiplier.
    [in,out]bOn input, the N-by-N matrix B. On output, the N-by-N solution matrix.
    [in,out]errAn optional errors-based object that if provided can be used to retrieve information relating to any errors encountered during execution. If not provided, a default implementation of the errors class is used internally to provide error handling. Possible errors and warning messages that may be encountered are as follows.
      +
    • LA_ARRAY_SIZE_ERROR: Occurs if any of the input arrays are not sized appropriately.
    • +
    +
    +
    +
    -

    Definition at line 323 of file linalg_core.f90.

    +

    Definition at line 469 of file linalg_core.f90.


    The documentation for this interface was generated from the following file: diff --git a/doc/html/linalg__c__api_8f90_source.html b/doc/html/linalg__c__api_8f90_source.html index c844a85b..70f7259c 100644 --- a/doc/html/linalg__c__api_8f90_source.html +++ b/doc/html/linalg__c__api_8f90_source.html @@ -2022,31 +2022,31 @@
    3159
    3160! ------------------------------------------------------------------------------
    3161end module
    -
    Computes the Cholesky factorization of a symmetric, positive definite matrix.
    -
    Computes the rank 1 downdate to a Cholesky factored matrix (upper triangular).
    -
    Computes the rank 1 update to a Cholesky factored matrix (upper triangular).
    -
    Computes the determinant of a square matrix.
    -
    Multiplies a diagonal matrix with another matrix or array.
    -
    Computes the eigenvalues, and optionally the eigenvectors, of a matrix.
    -
    Extracts the L and U matrices from the condensed [L\U] storage format used by the lu_factor.
    -
    Forms the full M-by-M orthogonal matrix Q from the elementary reflectors returned by the base QR fact...
    -
    Computes the LU factorization of an M-by-N matrix.
    -
    Computes the inverse of a square matrix.
    -
    Computes the Moore-Penrose pseudo-inverse of a M-by-N matrix using the singular value decomposition o...
    -
    Computes the rank of a matrix.
    -
    Multiplies a general matrix by the orthogonal matrix Q from a QR factorization.
    -
    Computes the QR factorization of an M-by-N matrix.
    -
    Computes the rank 1 update to an M-by-N QR factored matrix A (M >= N) where A = Q * R,...
    +
    Computes the Cholesky factorization of a symmetric, positive definite matrix.
    +
    Computes the rank 1 downdate to a Cholesky factored matrix (upper triangular).
    +
    Computes the rank 1 update to a Cholesky factored matrix (upper triangular).
    +
    Computes the determinant of a square matrix.
    +
    Multiplies a diagonal matrix with another matrix or array.
    +
    Computes the eigenvalues, and optionally the eigenvectors, of a matrix.
    +
    Extracts the L and U matrices from the condensed [L\U] storage format used by the lu_factor.
    +
    Forms the full M-by-M orthogonal matrix Q from the elementary reflectors returned by the base QR fact...
    +
    Computes the LU factorization of an M-by-N matrix.
    +
    Computes the inverse of a square matrix.
    +
    Computes the Moore-Penrose pseudo-inverse of a M-by-N matrix using the singular value decomposition o...
    +
    Computes the rank of a matrix.
    +
    Multiplies a general matrix by the orthogonal matrix Q from a QR factorization.
    +
    Computes the QR factorization of an M-by-N matrix.
    +
    Computes the rank 1 update to an M-by-N QR factored matrix A (M >= N) where A = Q * R,...
    Performs the rank-1 update to matrix A such that: , where is an M-by-N matrix, is a scalar,...
    -
    Solves a system of Cholesky factored equations.
    -
    Solves the overdetermined or underdetermined system (A*X = B) of M equations of N unknowns.
    -
    Solves a system of LU-factored equations.
    -
    Solves a system of M QR-factored equations of N unknowns.
    -
    Solves a triangular system of equations.
    -
    Sorts an array.
    -
    Computes the singular value decomposition of a matrix A. The SVD is defined as: A = U * S * V**T,...
    -
    Computes the trace of a matrix (the sum of the main diagonal elements).
    -
    Computes the triangular matrix operation: B = alpha * A**T * A + beta * B, or B = alpha * A * A**T + ...
    +
    Solves a system of Cholesky factored equations.
    +
    Solves the overdetermined or underdetermined system (A*X = B) of M equations of N unknowns.
    +
    Solves a system of LU-factored equations.
    +
    Solves a system of M QR-factored equations of N unknowns.
    +
    Solves a triangular system of equations.
    +
    Sorts an array.
    +
    Computes the singular value decomposition of a matrix A. The SVD is defined as: A = U * S * V**T,...
    +
    Computes the trace of a matrix (the sum of the main diagonal elements).
    +
    Computes the triangular matrix operation: , or , where A is a triangular matrix.
    Provides a C-friendly API to the LINALG library. Notice, all C-API LINALG routines begin with the pre...
    Definition: linalg_c_api.f90:5
    Provides a set of constants and error flags for the library.
    Provides a set of common linear algebra routines.
    Definition: linalg_core.f90:15
    diff --git a/doc/html/linalg__core_8f90_source.html b/doc/html/linalg__core_8f90_source.html index 7c438db1..8551254c 100644 --- a/doc/html/linalg__core_8f90_source.html +++ b/doc/html/linalg__core_8f90_source.html @@ -162,1146 +162,1144 @@
    157end interface
    158
    159! ------------------------------------------------------------------------------
    - -
    274 module procedure :: diag_mtx_mult_mtx
    -
    275 module procedure :: diag_mtx_mult_mtx2
    -
    276 module procedure :: diag_mtx_mult_mtx3
    -
    277 module procedure :: diag_mtx_mult_mtx4
    -
    278 module procedure :: diag_mtx_mult_mtx_cmplx
    -
    279 module procedure :: diag_mtx_mult_mtx2_cmplx
    -
    280 module procedure :: diag_mtx_mult_mtx_mix
    -
    281 module procedure :: diag_mtx_mult_mtx2_mix
    -
    282end interface
    -
    283
    -
    284! ------------------------------------------------------------------------------
    -
    287interface trace
    -
    288 module procedure :: trace_dbl
    -
    289 module procedure :: trace_cmplx
    -
    290end interface
    -
    291
    -
    292! ------------------------------------------------------------------------------
    -
    294interface mtx_rank
    -
    295 module procedure :: mtx_rank_dbl
    -
    296 module procedure :: mtx_rank_cmplx
    -
    297end interface
    -
    298
    -
    299! ------------------------------------------------------------------------------
    -
    301interface det
    -
    302 module procedure :: det_dbl
    -
    303 module procedure :: det_cmplx
    -
    304end interface
    -
    305
    -
    306! ------------------------------------------------------------------------------
    -
    308interface swap
    -
    309 module procedure :: swap_dbl
    -
    310 module procedure :: swap_cmplx
    -
    311end interface
    -
    312
    -
    313! ------------------------------------------------------------------------------
    - -
    316 module procedure :: recip_mult_array_dbl
    -
    317end interface
    -
    318
    -
    319! ------------------------------------------------------------------------------
    - -
    324 module procedure :: tri_mtx_mult_dbl
    -
    325 module procedure :: tri_mtx_mult_cmplx
    -
    326end interface
    -
    327
    -
    328! ------------------------------------------------------------------------------
    -
    381interface lu_factor
    -
    382 module procedure :: lu_factor_dbl
    -
    383 module procedure :: lu_factor_cmplx
    -
    384end interface
    -
    385
    -
    450interface form_lu
    -
    451 module procedure :: form_lu_all
    -
    452 module procedure :: form_lu_all_cmplx
    -
    453 module procedure :: form_lu_only
    -
    454 module procedure :: form_lu_only_cmplx
    -
    455end interface
    -
    456
    -
    457! ------------------------------------------------------------------------------
    -
    520interface qr_factor
    -
    521 module procedure :: qr_factor_no_pivot
    -
    522 module procedure :: qr_factor_no_pivot_cmplx
    -
    523 module procedure :: qr_factor_pivot
    -
    524 module procedure :: qr_factor_pivot_cmplx
    -
    525end interface
    -
    526
    -
    527! ------------------------------------------------------------------------------
    -
    603interface form_qr
    -
    604 module procedure :: form_qr_no_pivot
    -
    605 module procedure :: form_qr_no_pivot_cmplx
    -
    606 module procedure :: form_qr_pivot
    -
    607 module procedure :: form_qr_pivot_cmplx
    -
    608end interface
    -
    609
    -
    610! ------------------------------------------------------------------------------
    -
    680interface mult_qr
    -
    681 module procedure :: mult_qr_mtx
    -
    682 module procedure :: mult_qr_mtx_cmplx
    -
    683 module procedure :: mult_qr_vec
    -
    684 module procedure :: mult_qr_vec_cmplx
    -
    685end interface
    -
    686
    -
    687! ------------------------------------------------------------------------------
    - -
    783 module procedure :: qr_rank1_update_dbl
    -
    784 module procedure :: qr_rank1_update_cmplx
    -
    785end interface
    -
    786
    -
    787! ------------------------------------------------------------------------------
    - -
    858 module procedure :: cholesky_factor_dbl
    -
    859 module procedure :: cholesky_factor_cmplx
    -
    860end interface
    -
    861
    -
    862! ------------------------------------------------------------------------------
    - -
    926 module procedure :: cholesky_rank1_update_dbl
    -
    927 module procedure :: cholesky_rank1_update_cmplx
    -
    928end interface
    -
    929
    -
    930! ------------------------------------------------------------------------------
    - -
    999 module procedure :: cholesky_rank1_downdate_dbl
    -
    1000 module procedure :: cholesky_rank1_downdate_cmplx
    -
    1001end interface
    -
    1002
    -
    1003! ------------------------------------------------------------------------------
    -
    1008interface rz_factor
    -
    1009 module procedure :: rz_factor_dbl
    -
    1010 module procedure :: rz_factor_cmplx
    -
    1011end interface
    -
    1012
    -
    1013! ------------------------------------------------------------------------------
    -
    1016interface mult_rz
    -
    1017 module procedure :: mult_rz_mtx
    -
    1018 module procedure :: mult_rz_mtx_cmplx
    -
    1019 module procedure :: mult_rz_vec
    -
    1020 module procedure :: mult_rz_vec_cmplx
    -
    1021end interface
    -
    1022
    -
    1023! ------------------------------------------------------------------------------
    -
    1092interface svd
    -
    1093 module procedure :: svd_dbl
    -
    1094 module procedure :: svd_cmplx
    -
    1095end interface
    -
    1096
    -
    1097! ------------------------------------------------------------------------------
    - -
    1162 module procedure :: solve_tri_mtx
    -
    1163 module procedure :: solve_tri_mtx_cmplx
    -
    1164 module procedure :: solve_tri_vec
    -
    1165 module procedure :: solve_tri_vec_cmplx
    -
    1166end interface
    -
    1167
    -
    1168! ------------------------------------------------------------------------------
    -
    1225interface solve_lu
    -
    1226 module procedure :: solve_lu_mtx
    -
    1227 module procedure :: solve_lu_mtx_cmplx
    -
    1228 module procedure :: solve_lu_vec
    -
    1229 module procedure :: solve_lu_vec_cmplx
    -
    1230end interface
    -
    1231
    -
    1232! ------------------------------------------------------------------------------
    -
    1294interface solve_qr
    -
    1295 module procedure :: solve_qr_no_pivot_mtx
    -
    1296 module procedure :: solve_qr_no_pivot_mtx_cmplx
    -
    1297 module procedure :: solve_qr_no_pivot_vec
    -
    1298 module procedure :: solve_qr_no_pivot_vec_cmplx
    -
    1299 module procedure :: solve_qr_pivot_mtx
    -
    1300 module procedure :: solve_qr_pivot_mtx_cmplx
    -
    1301 module procedure :: solve_qr_pivot_vec
    -
    1302 module procedure :: solve_qr_pivot_vec_cmplx
    -
    1303end interface
    -
    1304
    -
    1305! ------------------------------------------------------------------------------
    - -
    1375 module procedure :: solve_cholesky_mtx
    -
    1376 module procedure :: solve_cholesky_mtx_cmplx
    -
    1377 module procedure :: solve_cholesky_vec
    -
    1378 module procedure :: solve_cholesky_vec_cmplx
    -
    1379end interface
    -
    1380
    -
    1381! ------------------------------------------------------------------------------
    - -
    1429 module procedure :: solve_least_squares_mtx
    -
    1430 module procedure :: solve_least_squares_mtx_cmplx
    -
    1431 module procedure :: solve_least_squares_vec
    -
    1432 module procedure :: solve_least_squares_vec_cmplx
    -
    1433end interface
    -
    1434
    -
    1435! ------------------------------------------------------------------------------
    - -
    1484 module procedure :: solve_least_squares_mtx_pvt
    -
    1485 module procedure :: solve_least_squares_mtx_pvt_cmplx
    -
    1486 module procedure :: solve_least_squares_vec_pvt
    -
    1487 module procedure :: solve_least_squares_vec_pvt_cmplx
    -
    1488end interface
    -
    1489
    -
    1490! ------------------------------------------------------------------------------
    - -
    1539 module procedure :: solve_least_squares_mtx_svd
    -
    1540 module procedure :: solve_least_squares_vec_svd
    -
    1541end interface
    -
    1542
    -
    1543! ------------------------------------------------------------------------------
    - -
    1598 module procedure :: mtx_inverse_dbl
    -
    1599 module procedure :: mtx_inverse_cmplx
    -
    1600end interface
    -
    1601
    -
    1602! ------------------------------------------------------------------------------
    - -
    1659 module procedure :: mtx_pinverse_dbl
    -
    1660 module procedure :: mtx_pinverse_cmplx
    -
    1661end interface
    -
    1662
    -
    1663! ------------------------------------------------------------------------------
    -
    1752interface eigen
    -
    1753 module procedure :: eigen_symm
    -
    1754 module procedure :: eigen_asymm
    -
    1755 module procedure :: eigen_gen
    -
    1756 module procedure :: eigen_cmplx
    -
    1757end interface
    -
    1758
    -
    1759! ------------------------------------------------------------------------------
    -
    1761interface sort
    -
    1762 module procedure :: sort_dbl_array
    -
    1763 module procedure :: sort_dbl_array_ind
    -
    1764 module procedure :: sort_cmplx_array
    -
    1765 module procedure :: sort_cmplx_array_ind
    -
    1766 module procedure :: sort_eigen_cmplx
    -
    1767 module procedure :: sort_eigen_dbl
    + +
    290 module procedure :: diag_mtx_mult_mtx
    +
    291 module procedure :: diag_mtx_mult_mtx2
    +
    292 module procedure :: diag_mtx_mult_mtx3
    +
    293 module procedure :: diag_mtx_mult_mtx4
    +
    294 module procedure :: diag_mtx_mult_mtx_cmplx
    +
    295 module procedure :: diag_mtx_mult_mtx2_cmplx
    +
    296 module procedure :: diag_mtx_mult_mtx_mix
    +
    297 module procedure :: diag_mtx_mult_mtx2_mix
    +
    298end interface
    +
    299
    +
    300! ------------------------------------------------------------------------------
    +
    313interface trace
    +
    314 module procedure :: trace_dbl
    +
    315 module procedure :: trace_cmplx
    +
    316end interface
    +
    317
    +
    318! ------------------------------------------------------------------------------
    +
    361interface mtx_rank
    +
    362 module procedure :: mtx_rank_dbl
    +
    363 module procedure :: mtx_rank_cmplx
    +
    364end interface
    +
    365
    +
    366! ------------------------------------------------------------------------------
    +
    394interface det
    +
    395 module procedure :: det_dbl
    +
    396 module procedure :: det_cmplx
    +
    397end interface
    +
    398
    +
    399! ------------------------------------------------------------------------------
    +
    416interface swap
    +
    417 module procedure :: swap_dbl
    +
    418 module procedure :: swap_cmplx
    +
    419end interface
    +
    420
    +
    421! ------------------------------------------------------------------------------
    + +
    436 module procedure :: recip_mult_array_dbl
    +
    437end interface
    +
    438
    +
    439! ------------------------------------------------------------------------------
    + +
    470 module procedure :: tri_mtx_mult_dbl
    +
    471 module procedure :: tri_mtx_mult_cmplx
    +
    472end interface
    +
    473
    +
    474! ------------------------------------------------------------------------------
    +
    555interface lu_factor
    +
    556 module procedure :: lu_factor_dbl
    +
    557 module procedure :: lu_factor_cmplx
    +
    558end interface
    +
    559
    +
    677interface form_lu
    +
    678 module procedure :: form_lu_all
    +
    679 module procedure :: form_lu_all_cmplx
    +
    680 module procedure :: form_lu_only
    +
    681 module procedure :: form_lu_only_cmplx
    +
    682end interface
    +
    683
    +
    684! ------------------------------------------------------------------------------
    +
    747interface qr_factor
    +
    748 module procedure :: qr_factor_no_pivot
    +
    749 module procedure :: qr_factor_no_pivot_cmplx
    +
    750 module procedure :: qr_factor_pivot
    +
    751 module procedure :: qr_factor_pivot_cmplx
    +
    752end interface
    +
    753
    +
    754! ------------------------------------------------------------------------------
    +
    830interface form_qr
    +
    831 module procedure :: form_qr_no_pivot
    +
    832 module procedure :: form_qr_no_pivot_cmplx
    +
    833 module procedure :: form_qr_pivot
    +
    834 module procedure :: form_qr_pivot_cmplx
    +
    835end interface
    +
    836
    +
    837! ------------------------------------------------------------------------------
    +
    907interface mult_qr
    +
    908 module procedure :: mult_qr_mtx
    +
    909 module procedure :: mult_qr_mtx_cmplx
    +
    910 module procedure :: mult_qr_vec
    +
    911 module procedure :: mult_qr_vec_cmplx
    +
    912end interface
    +
    913
    +
    914! ------------------------------------------------------------------------------
    + +
    1010 module procedure :: qr_rank1_update_dbl
    +
    1011 module procedure :: qr_rank1_update_cmplx
    +
    1012end interface
    +
    1013
    +
    1014! ------------------------------------------------------------------------------
    + +
    1085 module procedure :: cholesky_factor_dbl
    +
    1086 module procedure :: cholesky_factor_cmplx
    +
    1087end interface
    +
    1088
    +
    1089! ------------------------------------------------------------------------------
    + +
    1153 module procedure :: cholesky_rank1_update_dbl
    +
    1154 module procedure :: cholesky_rank1_update_cmplx
    +
    1155end interface
    +
    1156
    +
    1157! ------------------------------------------------------------------------------
    + +
    1226 module procedure :: cholesky_rank1_downdate_dbl
    +
    1227 module procedure :: cholesky_rank1_downdate_cmplx
    +
    1228end interface
    +
    1229
    +
    1230! ------------------------------------------------------------------------------
    +
    1235interface rz_factor
    +
    1236 module procedure :: rz_factor_dbl
    +
    1237 module procedure :: rz_factor_cmplx
    +
    1238end interface
    +
    1239
    +
    1240! ------------------------------------------------------------------------------
    +
    1243interface mult_rz
    +
    1244 module procedure :: mult_rz_mtx
    +
    1245 module procedure :: mult_rz_mtx_cmplx
    +
    1246 module procedure :: mult_rz_vec
    +
    1247 module procedure :: mult_rz_vec_cmplx
    +
    1248end interface
    +
    1249
    +
    1250! ------------------------------------------------------------------------------
    +
    1319interface svd
    +
    1320 module procedure :: svd_dbl
    +
    1321 module procedure :: svd_cmplx
    +
    1322end interface
    +
    1323
    +
    1324! ------------------------------------------------------------------------------
    + +
    1389 module procedure :: solve_tri_mtx
    +
    1390 module procedure :: solve_tri_mtx_cmplx
    +
    1391 module procedure :: solve_tri_vec
    +
    1392 module procedure :: solve_tri_vec_cmplx
    +
    1393end interface
    +
    1394
    +
    1395! ------------------------------------------------------------------------------
    +
    1452interface solve_lu
    +
    1453 module procedure :: solve_lu_mtx
    +
    1454 module procedure :: solve_lu_mtx_cmplx
    +
    1455 module procedure :: solve_lu_vec
    +
    1456 module procedure :: solve_lu_vec_cmplx
    +
    1457end interface
    +
    1458
    +
    1459! ------------------------------------------------------------------------------
    +
    1521interface solve_qr
    +
    1522 module procedure :: solve_qr_no_pivot_mtx
    +
    1523 module procedure :: solve_qr_no_pivot_mtx_cmplx
    +
    1524 module procedure :: solve_qr_no_pivot_vec
    +
    1525 module procedure :: solve_qr_no_pivot_vec_cmplx
    +
    1526 module procedure :: solve_qr_pivot_mtx
    +
    1527 module procedure :: solve_qr_pivot_mtx_cmplx
    +
    1528 module procedure :: solve_qr_pivot_vec
    +
    1529 module procedure :: solve_qr_pivot_vec_cmplx
    +
    1530end interface
    +
    1531
    +
    1532! ------------------------------------------------------------------------------
    + +
    1602 module procedure :: solve_cholesky_mtx
    +
    1603 module procedure :: solve_cholesky_mtx_cmplx
    +
    1604 module procedure :: solve_cholesky_vec
    +
    1605 module procedure :: solve_cholesky_vec_cmplx
    +
    1606end interface
    +
    1607
    +
    1608! ------------------------------------------------------------------------------
    + +
    1656 module procedure :: solve_least_squares_mtx
    +
    1657 module procedure :: solve_least_squares_mtx_cmplx
    +
    1658 module procedure :: solve_least_squares_vec
    +
    1659 module procedure :: solve_least_squares_vec_cmplx
    +
    1660end interface
    +
    1661
    +
    1662! ------------------------------------------------------------------------------
    + +
    1711 module procedure :: solve_least_squares_mtx_pvt
    +
    1712 module procedure :: solve_least_squares_mtx_pvt_cmplx
    +
    1713 module procedure :: solve_least_squares_vec_pvt
    +
    1714 module procedure :: solve_least_squares_vec_pvt_cmplx
    +
    1715end interface
    +
    1716
    +
    1717! ------------------------------------------------------------------------------
    + +
    1766 module procedure :: solve_least_squares_mtx_svd
    +
    1767 module procedure :: solve_least_squares_vec_svd
    1768end interface
    1769
    -
    1770
    -
    1771! ******************************************************************************
    -
    1772! LINALG_BASIC.F90
    -
    1773! ------------------------------------------------------------------------------
    -
    1774interface
    -
    1775 module subroutine mtx_mult_mtx(transa, transb, alpha, a, b, beta, c, err)
    -
    1776 logical, intent(in) :: transa, transb
    -
    1777 real(real64), intent(in) :: alpha, beta
    -
    1778 real(real64), intent(in), dimension(:,:) :: a, b
    -
    1779 real(real64), intent(inout), dimension(:,:) :: c
    -
    1780 class(errors), intent(inout), optional, target :: err
    -
    1781 end subroutine
    -
    1782
    -
    1783 module subroutine mtx_mult_vec(trans, alpha, a, b, beta, c, err)
    -
    1784 logical, intent(in) :: trans
    -
    1785 real(real64), intent(in) :: alpha, beta
    -
    1786 real(real64), intent(in), dimension(:,:) :: a
    -
    1787 real(real64), intent(in), dimension(:) :: b
    -
    1788 real(real64), intent(inout), dimension(:) :: c
    -
    1789 class(errors), intent(inout), optional, target :: err
    -
    1790 end subroutine
    -
    1791
    -
    1792 module subroutine cmtx_mult_mtx(opa, opb, alpha, a, b, beta, c, err)
    -
    1793 integer(int32), intent(in) :: opa, opb
    -
    1794 complex(real64), intent(in) :: alpha, beta
    -
    1795 complex(real64), intent(in), dimension(:,:) :: a, b
    -
    1796 complex(real64), intent(inout), dimension(:,:) :: c
    -
    1797 class(errors), intent(inout), optional, target :: err
    -
    1798 end subroutine
    -
    1799
    -
    1800 module subroutine cmtx_mult_vec(opa, alpha, a, b, beta, c, err)
    -
    1801 integer(int32), intent(in) :: opa
    -
    1802 complex(real64), intent(in) :: alpha, beta
    -
    1803 complex(real64), intent(in), dimension(:,:) :: a
    -
    1804 complex(real64), intent(in), dimension(:) :: b
    -
    1805 complex(real64), intent(inout), dimension(:) :: c
    -
    1806 class(errors), intent(inout), optional, target :: err
    -
    1807 end subroutine
    -
    1808
    -
    1809 module subroutine rank1_update_dbl(alpha, x, y, a, err)
    -
    1810 real(real64), intent(in) :: alpha
    -
    1811 real(real64), intent(in), dimension(:) :: x, y
    -
    1812 real(real64), intent(inout), dimension(:,:) :: a
    -
    1813 class(errors), intent(inout), optional, target :: err
    -
    1814 end subroutine
    -
    1815
    -
    1816 module subroutine rank1_update_cmplx(alpha, x, y, a, err)
    -
    1817 complex(real64), intent(in) :: alpha
    -
    1818 complex(real64), intent(in), dimension(:) :: x, y
    -
    1819 complex(real64), intent(inout), dimension(:,:) :: a
    -
    1820 class(errors), intent(inout), optional, target :: err
    -
    1821 end subroutine
    -
    1822
    -
    1850 module subroutine diag_mtx_mult_mtx(lside, trans, alpha, a, b, beta, c, err)
    -
    1851 logical, intent(in) :: lside, trans
    -
    1852 real(real64) :: alpha, beta
    -
    1853 real(real64), intent(in), dimension(:) :: a
    -
    1854 real(real64), intent(in), dimension(:,:) :: b
    -
    1855 real(real64), intent(inout), dimension(:,:) :: c
    -
    1856 class(errors), intent(inout), optional, target :: err
    -
    1857 end subroutine
    -
    1858
    -
    1877 module subroutine diag_mtx_mult_mtx2(lside, alpha, a, b, err)
    -
    1878 logical, intent(in) :: lside
    -
    1879 real(real64), intent(in) :: alpha
    -
    1880 real(real64), intent(in), dimension(:) :: a
    -
    1881 real(real64), intent(inout), dimension(:,:) :: b
    -
    1882 class(errors), intent(inout), optional, target :: err
    -
    1883 end subroutine
    -
    1884
    -
    1912 module subroutine diag_mtx_mult_mtx3(lside, trans, alpha, a, b, beta, c, err)
    -
    1913 logical, intent(in) :: lside, trans
    -
    1914 real(real64) :: alpha, beta
    -
    1915 complex(real64), intent(in), dimension(:) :: a
    -
    1916 real(real64), intent(in), dimension(:,:) :: b
    -
    1917 complex(real64), intent(inout), dimension(:,:) :: c
    -
    1918 class(errors), intent(inout), optional, target :: err
    -
    1919 end subroutine
    -
    1920
    -
    1949 module subroutine diag_mtx_mult_mtx4(lside, opb, alpha, a, b, beta, c, err)
    -
    1950 logical, intent(in) :: lside
    -
    1951 integer(int32), intent(in) :: opb
    -
    1952 real(real64) :: alpha, beta
    -
    1953 complex(real64), intent(in), dimension(:) :: a
    -
    1954 complex(real64), intent(in), dimension(:,:) :: b
    -
    1955 complex(real64), intent(inout), dimension(:,:) :: c
    -
    1956 class(errors), intent(inout), optional, target :: err
    -
    1957 end subroutine
    -
    1958
    -
    1987 module subroutine diag_mtx_mult_mtx_cmplx(lside, opb, alpha, a, b, beta, c, err)
    -
    1988 logical, intent(in) :: lside
    -
    1989 integer(int32), intent(in) :: opb
    -
    1990 complex(real64) :: alpha, beta
    -
    1991 complex(real64), intent(in), dimension(:) :: a
    -
    1992 complex(real64), intent(in), dimension(:,:) :: b
    -
    1993 complex(real64), intent(inout), dimension(:,:) :: c
    -
    1994 class(errors), intent(inout), optional, target :: err
    -
    1995 end subroutine
    +
    1770! ------------------------------------------------------------------------------
    + +
    1825 module procedure :: mtx_inverse_dbl
    +
    1826 module procedure :: mtx_inverse_cmplx
    +
    1827end interface
    +
    1828
    +
    1829! ------------------------------------------------------------------------------
    + +
    1886 module procedure :: mtx_pinverse_dbl
    +
    1887 module procedure :: mtx_pinverse_cmplx
    +
    1888end interface
    +
    1889
    +
    1890! ------------------------------------------------------------------------------
    +
    1979interface eigen
    +
    1980 module procedure :: eigen_symm
    +
    1981 module procedure :: eigen_asymm
    +
    1982 module procedure :: eigen_gen
    +
    1983 module procedure :: eigen_cmplx
    +
    1984end interface
    +
    1985
    +
    1986! ------------------------------------------------------------------------------
    +
    1988interface sort
    +
    1989 module procedure :: sort_dbl_array
    +
    1990 module procedure :: sort_dbl_array_ind
    +
    1991 module procedure :: sort_cmplx_array
    +
    1992 module procedure :: sort_cmplx_array_ind
    +
    1993 module procedure :: sort_eigen_cmplx
    +
    1994 module procedure :: sort_eigen_dbl
    +
    1995end interface
    1996
    -
    2015 module subroutine diag_mtx_mult_mtx2_cmplx(lside, alpha, a, b, err)
    -
    2016 logical, intent(in) :: lside
    -
    2017 complex(real64), intent(in) :: alpha
    -
    2018 complex(real64), intent(in), dimension(:) :: a
    -
    2019 complex(real64), intent(inout), dimension(:,:) :: b
    -
    2020 class(errors), intent(inout), optional, target :: err
    -
    2021 end subroutine
    -
    2022
    -
    2051 module subroutine diag_mtx_mult_mtx_mix(lside, opb, alpha, a, b, beta, c, err)
    -
    2052 logical, intent(in) :: lside
    -
    2053 integer(int32), intent(in) :: opb
    -
    2054 complex(real64) :: alpha, beta
    -
    2055 real(real64), intent(in), dimension(:) :: a
    -
    2056 complex(real64), intent(in), dimension(:,:) :: b
    -
    2057 complex(real64), intent(inout), dimension(:,:) :: c
    -
    2058 class(errors), intent(inout), optional, target :: err
    -
    2059 end subroutine
    -
    2060
    -
    2079 module subroutine diag_mtx_mult_mtx2_mix(lside, alpha, a, b, err)
    -
    2080 logical, intent(in) :: lside
    -
    2081 complex(real64), intent(in) :: alpha
    -
    2082 real(real64), intent(in), dimension(:) :: a
    -
    2083 complex(real64), intent(inout), dimension(:,:) :: b
    -
    2084 class(errors), intent(inout), optional, target :: err
    -
    2085 end subroutine
    -
    2086
    -
    2087
    -
    2094 pure module function trace_dbl(x) result(y)
    -
    2095 real(real64), intent(in), dimension(:,:) :: x
    -
    2096 real(real64) :: y
    -
    2097 end function
    -
    2098
    -
    2105 pure module function trace_cmplx(x) result(y)
    -
    2106 complex(real64), intent(in), dimension(:,:) :: x
    -
    2107 complex(real64) :: y
    -
    2108 end function
    -
    2109
    -
    2142 module function mtx_rank_dbl(a, tol, work, olwork, err) result(rnk)
    -
    2143 real(real64), intent(inout), dimension(:,:) :: a
    -
    2144 real(real64), intent(in), optional :: tol
    -
    2145 real(real64), intent(out), target, optional, dimension(:) :: work
    -
    2146 integer(int32), intent(out), optional :: olwork
    +
    1997
    +
    1998! ******************************************************************************
    +
    1999! LINALG_BASIC.F90
    +
    2000! ------------------------------------------------------------------------------
    +
    2001interface
    +
    2002 module subroutine mtx_mult_mtx(transa, transb, alpha, a, b, beta, c, err)
    +
    2003 logical, intent(in) :: transa, transb
    +
    2004 real(real64), intent(in) :: alpha, beta
    +
    2005 real(real64), intent(in), dimension(:,:) :: a, b
    +
    2006 real(real64), intent(inout), dimension(:,:) :: c
    +
    2007 class(errors), intent(inout), optional, target :: err
    +
    2008 end subroutine
    +
    2009
    +
    2010 module subroutine mtx_mult_vec(trans, alpha, a, b, beta, c, err)
    +
    2011 logical, intent(in) :: trans
    +
    2012 real(real64), intent(in) :: alpha, beta
    +
    2013 real(real64), intent(in), dimension(:,:) :: a
    +
    2014 real(real64), intent(in), dimension(:) :: b
    +
    2015 real(real64), intent(inout), dimension(:) :: c
    +
    2016 class(errors), intent(inout), optional, target :: err
    +
    2017 end subroutine
    +
    2018
    +
    2019 module subroutine cmtx_mult_mtx(opa, opb, alpha, a, b, beta, c, err)
    +
    2020 integer(int32), intent(in) :: opa, opb
    +
    2021 complex(real64), intent(in) :: alpha, beta
    +
    2022 complex(real64), intent(in), dimension(:,:) :: a, b
    +
    2023 complex(real64), intent(inout), dimension(:,:) :: c
    +
    2024 class(errors), intent(inout), optional, target :: err
    +
    2025 end subroutine
    +
    2026
    +
    2027 module subroutine cmtx_mult_vec(opa, alpha, a, b, beta, c, err)
    +
    2028 integer(int32), intent(in) :: opa
    +
    2029 complex(real64), intent(in) :: alpha, beta
    +
    2030 complex(real64), intent(in), dimension(:,:) :: a
    +
    2031 complex(real64), intent(in), dimension(:) :: b
    +
    2032 complex(real64), intent(inout), dimension(:) :: c
    +
    2033 class(errors), intent(inout), optional, target :: err
    +
    2034 end subroutine
    +
    2035
    +
    2036 module subroutine rank1_update_dbl(alpha, x, y, a, err)
    +
    2037 real(real64), intent(in) :: alpha
    +
    2038 real(real64), intent(in), dimension(:) :: x, y
    +
    2039 real(real64), intent(inout), dimension(:,:) :: a
    +
    2040 class(errors), intent(inout), optional, target :: err
    +
    2041 end subroutine
    +
    2042
    +
    2043 module subroutine rank1_update_cmplx(alpha, x, y, a, err)
    +
    2044 complex(real64), intent(in) :: alpha
    +
    2045 complex(real64), intent(in), dimension(:) :: x, y
    +
    2046 complex(real64), intent(inout), dimension(:,:) :: a
    +
    2047 class(errors), intent(inout), optional, target :: err
    +
    2048 end subroutine
    +
    2049
    +
    2050 module subroutine diag_mtx_mult_mtx(lside, trans, alpha, a, b, beta, c, err)
    +
    2051 logical, intent(in) :: lside, trans
    +
    2052 real(real64) :: alpha, beta
    +
    2053 real(real64), intent(in), dimension(:) :: a
    +
    2054 real(real64), intent(in), dimension(:,:) :: b
    +
    2055 real(real64), intent(inout), dimension(:,:) :: c
    +
    2056 class(errors), intent(inout), optional, target :: err
    +
    2057 end subroutine
    +
    2058
    +
    2059 module subroutine diag_mtx_mult_mtx2(lside, alpha, a, b, err)
    +
    2060 logical, intent(in) :: lside
    +
    2061 real(real64), intent(in) :: alpha
    +
    2062 real(real64), intent(in), dimension(:) :: a
    +
    2063 real(real64), intent(inout), dimension(:,:) :: b
    +
    2064 class(errors), intent(inout), optional, target :: err
    +
    2065 end subroutine
    +
    2066
    +
    2067 module subroutine diag_mtx_mult_mtx3(lside, trans, alpha, a, b, beta, c, err)
    +
    2068 logical, intent(in) :: lside, trans
    +
    2069 real(real64) :: alpha, beta
    +
    2070 complex(real64), intent(in), dimension(:) :: a
    +
    2071 real(real64), intent(in), dimension(:,:) :: b
    +
    2072 complex(real64), intent(inout), dimension(:,:) :: c
    +
    2073 class(errors), intent(inout), optional, target :: err
    +
    2074 end subroutine
    +
    2075
    +
    2076 module subroutine diag_mtx_mult_mtx4(lside, opb, alpha, a, b, beta, c, err)
    +
    2077 logical, intent(in) :: lside
    +
    2078 integer(int32), intent(in) :: opb
    +
    2079 real(real64) :: alpha, beta
    +
    2080 complex(real64), intent(in), dimension(:) :: a
    +
    2081 complex(real64), intent(in), dimension(:,:) :: b
    +
    2082 complex(real64), intent(inout), dimension(:,:) :: c
    +
    2083 class(errors), intent(inout), optional, target :: err
    +
    2084 end subroutine
    +
    2085
    +
    2086 module subroutine diag_mtx_mult_mtx_cmplx(lside, opb, alpha, a, b, beta, c, err)
    +
    2087 logical, intent(in) :: lside
    +
    2088 integer(int32), intent(in) :: opb
    +
    2089 complex(real64) :: alpha, beta
    +
    2090 complex(real64), intent(in), dimension(:) :: a
    +
    2091 complex(real64), intent(in), dimension(:,:) :: b
    +
    2092 complex(real64), intent(inout), dimension(:,:) :: c
    +
    2093 class(errors), intent(inout), optional, target :: err
    +
    2094 end subroutine
    +
    2095
    +
    2096 module subroutine diag_mtx_mult_mtx2_cmplx(lside, alpha, a, b, err)
    +
    2097 logical, intent(in) :: lside
    +
    2098 complex(real64), intent(in) :: alpha
    +
    2099 complex(real64), intent(in), dimension(:) :: a
    +
    2100 complex(real64), intent(inout), dimension(:,:) :: b
    +
    2101 class(errors), intent(inout), optional, target :: err
    +
    2102 end subroutine
    +
    2103
    +
    2104 module subroutine diag_mtx_mult_mtx_mix(lside, opb, alpha, a, b, beta, c, err)
    +
    2105 logical, intent(in) :: lside
    +
    2106 integer(int32), intent(in) :: opb
    +
    2107 complex(real64) :: alpha, beta
    +
    2108 real(real64), intent(in), dimension(:) :: a
    +
    2109 complex(real64), intent(in), dimension(:,:) :: b
    +
    2110 complex(real64), intent(inout), dimension(:,:) :: c
    +
    2111 class(errors), intent(inout), optional, target :: err
    +
    2112 end subroutine
    +
    2113
    +
    2114 module subroutine diag_mtx_mult_mtx2_mix(lside, alpha, a, b, err)
    +
    2115 logical, intent(in) :: lside
    +
    2116 complex(real64), intent(in) :: alpha
    +
    2117 real(real64), intent(in), dimension(:) :: a
    +
    2118 complex(real64), intent(inout), dimension(:,:) :: b
    +
    2119 class(errors), intent(inout), optional, target :: err
    +
    2120 end subroutine
    +
    2121
    +
    2122 pure module function trace_dbl(x) result(y)
    +
    2123 real(real64), intent(in), dimension(:,:) :: x
    +
    2124 real(real64) :: y
    +
    2125 end function
    +
    2126
    +
    2127 pure module function trace_cmplx(x) result(y)
    +
    2128 complex(real64), intent(in), dimension(:,:) :: x
    +
    2129 complex(real64) :: y
    +
    2130 end function
    +
    2131
    +
    2132 module function mtx_rank_dbl(a, tol, work, olwork, err) result(rnk)
    +
    2133 real(real64), intent(inout), dimension(:,:) :: a
    +
    2134 real(real64), intent(in), optional :: tol
    +
    2135 real(real64), intent(out), target, optional, dimension(:) :: work
    +
    2136 integer(int32), intent(out), optional :: olwork
    +
    2137 class(errors), intent(inout), optional, target :: err
    +
    2138 integer(int32) :: rnk
    +
    2139 end function
    +
    2140
    +
    2141 module function mtx_rank_cmplx(a, tol, work, olwork, rwork, err) result(rnk)
    +
    2142 complex(real64), intent(inout), dimension(:,:) :: a
    +
    2143 real(real64), intent(in), optional :: tol
    +
    2144 complex(real64), intent(out), target, optional, dimension(:) :: work
    +
    2145 integer(int32), intent(out), optional :: olwork
    +
    2146 real(real64), intent(out), target, optional, dimension(:) :: rwork
    2147 class(errors), intent(inout), optional, target :: err
    2148 integer(int32) :: rnk
    2149 end function
    -
    2150
    -
    2187 module function mtx_rank_cmplx(a, tol, work, olwork, rwork, err) result(rnk)
    -
    2188 complex(real64), intent(inout), dimension(:,:) :: a
    -
    2189 real(real64), intent(in), optional :: tol
    -
    2190 complex(real64), intent(out), target, optional, dimension(:) :: work
    -
    2191 integer(int32), intent(out), optional :: olwork
    -
    2192 real(real64), intent(out), target, optional, dimension(:) :: rwork
    +
    2150
    +
    2151 module function det_dbl(a, iwork, err) result(x)
    +
    2152 real(real64), intent(inout), dimension(:,:) :: a
    +
    2153 integer(int32), intent(out), target, optional, dimension(:) :: iwork
    +
    2154 class(errors), intent(inout), optional, target :: err
    +
    2155 real(real64) :: x
    +
    2156 end function
    +
    2157
    +
    2158 module function det_cmplx(a, iwork, err) result(x)
    +
    2159 complex(real64), intent(inout), dimension(:,:) :: a
    +
    2160 integer(int32), intent(out), target, optional, dimension(:) :: iwork
    +
    2161 class(errors), intent(inout), optional, target :: err
    +
    2162 complex(real64) :: x
    +
    2163 end function
    +
    2164
    +
    2165 module subroutine swap_dbl(x, y, err)
    +
    2166 real(real64), intent(inout), dimension(:) :: x, y
    +
    2167 class(errors), intent(inout), optional, target :: err
    +
    2168 end subroutine
    +
    2169
    +
    2170 module subroutine swap_cmplx(x, y, err)
    +
    2171 complex(real64), intent(inout), dimension(:) :: x, y
    +
    2172 class(errors), intent(inout), optional, target :: err
    +
    2173 end subroutine
    +
    2174
    +
    2175 module subroutine recip_mult_array_dbl(a, x)
    +
    2176 real(real64), intent(in) :: a
    +
    2177 real(real64), intent(inout), dimension(:) :: x
    +
    2178 end subroutine
    +
    2179
    +
    2180 module subroutine tri_mtx_mult_dbl(upper, alpha, a, beta, b, err)
    +
    2181 logical, intent(in) :: upper
    +
    2182 real(real64), intent(in) :: alpha, beta
    +
    2183 real(real64), intent(in), dimension(:,:) :: a
    +
    2184 real(real64), intent(inout), dimension(:,:) :: b
    +
    2185 class(errors), intent(inout), optional, target :: err
    +
    2186 end subroutine
    +
    2187
    +
    2188 module subroutine tri_mtx_mult_cmplx(upper, alpha, a, beta, b, err)
    +
    2189 logical, intent(in) :: upper
    +
    2190 complex(real64), intent(in) :: alpha, beta
    +
    2191 complex(real64), intent(in), dimension(:,:) :: a
    +
    2192 complex(real64), intent(inout), dimension(:,:) :: b
    2193 class(errors), intent(inout), optional, target :: err
    -
    2194 integer(int32) :: rnk
    -
    2195 end function
    -
    2196
    -
    2217 module function det_dbl(a, iwork, err) result(x)
    -
    2218 real(real64), intent(inout), dimension(:,:) :: a
    -
    2219 integer(int32), intent(out), target, optional, dimension(:) :: iwork
    -
    2220 class(errors), intent(inout), optional, target :: err
    -
    2221 real(real64) :: x
    -
    2222 end function
    -
    2223
    -
    2244 module function det_cmplx(a, iwork, err) result(x)
    -
    2245 complex(real64), intent(inout), dimension(:,:) :: a
    -
    2246 integer(int32), intent(out), target, optional, dimension(:) :: iwork
    -
    2247 class(errors), intent(inout), optional, target :: err
    -
    2248 complex(real64) :: x
    -
    2249 end function
    -
    2250
    -
    2261 module subroutine swap_dbl(x, y, err)
    -
    2262 real(real64), intent(inout), dimension(:) :: x, y
    -
    2263 class(errors), intent(inout), optional, target :: err
    -
    2264 end subroutine
    -
    2265
    -
    2276 module subroutine swap_cmplx(x, y, err)
    -
    2277 complex(real64), intent(inout), dimension(:) :: x, y
    -
    2278 class(errors), intent(inout), optional, target :: err
    -
    2279 end subroutine
    -
    2280
    -
    2289 module subroutine recip_mult_array_dbl(a, x)
    -
    2290 real(real64), intent(in) :: a
    -
    2291 real(real64), intent(inout), dimension(:) :: x
    -
    2292 end subroutine
    -
    2293
    -
    2317 module subroutine tri_mtx_mult_dbl(upper, alpha, a, beta, b, err)
    -
    2318 logical, intent(in) :: upper
    -
    2319 real(real64), intent(in) :: alpha, beta
    -
    2320 real(real64), intent(in), dimension(:,:) :: a
    -
    2321 real(real64), intent(inout), dimension(:,:) :: b
    -
    2322 class(errors), intent(inout), optional, target :: err
    -
    2323 end subroutine
    -
    2324
    -
    2348 module subroutine tri_mtx_mult_cmplx(upper, alpha, a, beta, b, err)
    -
    2349 logical, intent(in) :: upper
    -
    2350 complex(real64), intent(in) :: alpha, beta
    -
    2351 complex(real64), intent(in), dimension(:,:) :: a
    -
    2352 complex(real64), intent(inout), dimension(:,:) :: b
    -
    2353 class(errors), intent(inout), optional, target :: err
    -
    2354 end subroutine
    -
    2355
    -
    2356end interface
    -
    2357
    -
    2358! ******************************************************************************
    -
    2359! LINALG_FACTOR.F90
    -
    2360! ------------------------------------------------------------------------------
    -
    2361interface
    -
    2362
    -
    2385 module subroutine lu_factor_dbl(a, ipvt, err)
    -
    2386 real(real64), intent(inout), dimension(:,:) :: a
    -
    2387 integer(int32), intent(out), dimension(:) :: ipvt
    -
    2388 class(errors), intent(inout), optional, target :: err
    -
    2389 end subroutine
    -
    2390
    -
    2414 module subroutine lu_factor_cmplx(a, ipvt, err)
    -
    2415 complex(real64), intent(inout), dimension(:,:) :: a
    -
    2416 integer(int32), intent(out), dimension(:) :: ipvt
    -
    2417 class(errors), intent(inout), optional, target :: err
    -
    2418 end subroutine
    -
    2419
    -
    2452 module subroutine form_lu_all(lu, ipvt, u, p, err)
    -
    2453 real(real64), intent(inout), dimension(:,:) :: lu
    -
    2454 integer(int32), intent(in), dimension(:) :: ipvt
    -
    2455 real(real64), intent(out), dimension(:,:) :: u, p
    +
    2194 end subroutine
    +
    2195
    +
    2196end interface
    +
    2197
    +
    2198! ******************************************************************************
    +
    2199! LINALG_FACTOR.F90
    +
    2200! ------------------------------------------------------------------------------
    +
    2201interface
    +
    2202 module subroutine lu_factor_dbl(a, ipvt, err)
    +
    2203 real(real64), intent(inout), dimension(:,:) :: a
    +
    2204 integer(int32), intent(out), dimension(:) :: ipvt
    +
    2205 class(errors), intent(inout), optional, target :: err
    +
    2206 end subroutine
    +
    2207
    +
    2208 module subroutine lu_factor_cmplx(a, ipvt, err)
    +
    2209 complex(real64), intent(inout), dimension(:,:) :: a
    +
    2210 integer(int32), intent(out), dimension(:) :: ipvt
    +
    2211 class(errors), intent(inout), optional, target :: err
    +
    2212 end subroutine
    +
    2213
    +
    2214 module subroutine form_lu_all(lu, ipvt, u, p, err)
    +
    2215 real(real64), intent(inout), dimension(:,:) :: lu
    +
    2216 integer(int32), intent(in), dimension(:) :: ipvt
    +
    2217 real(real64), intent(out), dimension(:,:) :: u, p
    +
    2218 class(errors), intent(inout), optional, target :: err
    +
    2219 end subroutine
    +
    2220
    +
    2221 module subroutine form_lu_all_cmplx(lu, ipvt, u, p, err)
    +
    2222 complex(real64), intent(inout), dimension(:,:) :: lu
    +
    2223 integer(int32), intent(in), dimension(:) :: ipvt
    +
    2224 complex(real64), intent(out), dimension(:,:) :: u
    +
    2225 real(real64), intent(out), dimension(:,:) :: p
    +
    2226 class(errors), intent(inout), optional, target :: err
    +
    2227 end subroutine
    +
    2228
    +
    2229 module subroutine form_lu_only(lu, u, err)
    +
    2230 real(real64), intent(inout), dimension(:,:) :: lu
    +
    2231 real(real64), intent(out), dimension(:,:) :: u
    +
    2232 class(errors), intent(inout), optional, target :: err
    +
    2233 end subroutine
    +
    2234
    +
    2235 module subroutine form_lu_only_cmplx(lu, u, err)
    +
    2236 complex(real64), intent(inout), dimension(:,:) :: lu
    +
    2237 complex(real64), intent(out), dimension(:,:) :: u
    +
    2238 class(errors), intent(inout), optional, target :: err
    +
    2239 end subroutine
    +
    2240
    +
    2276 module subroutine qr_factor_no_pivot(a, tau, work, olwork, err)
    +
    2277 real(real64), intent(inout), dimension(:,:) :: a
    +
    2278 real(real64), intent(out), dimension(:) :: tau
    +
    2279 real(real64), intent(out), target, dimension(:), optional :: work
    +
    2280 integer(int32), intent(out), optional :: olwork
    +
    2281 class(errors), intent(inout), optional, target :: err
    +
    2282 end subroutine
    +
    2283
    +
    2319 module subroutine qr_factor_no_pivot_cmplx(a, tau, work, olwork, err)
    +
    2320 complex(real64), intent(inout), dimension(:,:) :: a
    +
    2321 complex(real64), intent(out), dimension(:) :: tau
    +
    2322 complex(real64), intent(out), target, dimension(:), optional :: work
    +
    2323 integer(int32), intent(out), optional :: olwork
    +
    2324 class(errors), intent(inout), optional, target :: err
    +
    2325 end subroutine
    +
    2326
    +
    2360 module subroutine qr_factor_pivot(a, tau, jpvt, work, olwork, err)
    +
    2361 real(real64), intent(inout), dimension(:,:) :: a
    +
    2362 real(real64), intent(out), dimension(:) :: tau
    +
    2363 integer(int32), intent(inout), dimension(:) :: jpvt
    +
    2364 real(real64), intent(out), target, dimension(:), optional :: work
    +
    2365 integer(int32), intent(out), optional :: olwork
    +
    2366 class(errors), intent(inout), optional, target :: err
    +
    2367 end subroutine
    +
    2368
    +
    2406 module subroutine qr_factor_pivot_cmplx(a, tau, jpvt, work, olwork, rwork, &
    +
    2407 err)
    +
    2408 complex(real64), intent(inout), dimension(:,:) :: a
    +
    2409 complex(real64), intent(out), dimension(:) :: tau
    +
    2410 integer(int32), intent(inout), dimension(:) :: jpvt
    +
    2411 complex(real64), intent(out), target, dimension(:), optional :: work
    +
    2412 integer(int32), intent(out), optional :: olwork
    +
    2413 real(real64), intent(out), target, dimension(:), optional :: rwork
    +
    2414 class(errors), intent(inout), optional, target :: err
    +
    2415 end subroutine
    +
    2416
    +
    2450 module subroutine form_qr_no_pivot(r, tau, q, work, olwork, err)
    +
    2451 real(real64), intent(inout), dimension(:,:) :: r
    +
    2452 real(real64), intent(in), dimension(:) :: tau
    +
    2453 real(real64), intent(out), dimension(:,:) :: q
    +
    2454 real(real64), intent(out), target, dimension(:), optional :: work
    +
    2455 integer(int32), intent(out), optional :: olwork
    2456 class(errors), intent(inout), optional, target :: err
    2457 end subroutine
    2458
    -
    2491 module subroutine form_lu_all_cmplx(lu, ipvt, u, p, err)
    -
    2492 complex(real64), intent(inout), dimension(:,:) :: lu
    -
    2493 integer(int32), intent(in), dimension(:) :: ipvt
    -
    2494 complex(real64), intent(out), dimension(:,:) :: u
    -
    2495 real(real64), intent(out), dimension(:,:) :: p
    -
    2496 class(errors), intent(inout), optional, target :: err
    -
    2497 end subroutine
    -
    2498
    -
    2512 module subroutine form_lu_only(lu, u, err)
    -
    2513 real(real64), intent(inout), dimension(:,:) :: lu
    -
    2514 real(real64), intent(out), dimension(:,:) :: u
    -
    2515 class(errors), intent(inout), optional, target :: err
    -
    2516 end subroutine
    -
    2517
    -
    2531 module subroutine form_lu_only_cmplx(lu, u, err)
    -
    2532 complex(real64), intent(inout), dimension(:,:) :: lu
    -
    2533 complex(real64), intent(out), dimension(:,:) :: u
    -
    2534 class(errors), intent(inout), optional, target :: err
    -
    2535 end subroutine
    -
    2536
    -
    2572 module subroutine qr_factor_no_pivot(a, tau, work, olwork, err)
    -
    2573 real(real64), intent(inout), dimension(:,:) :: a
    -
    2574 real(real64), intent(out), dimension(:) :: tau
    -
    2575 real(real64), intent(out), target, dimension(:), optional :: work
    -
    2576 integer(int32), intent(out), optional :: olwork
    -
    2577 class(errors), intent(inout), optional, target :: err
    -
    2578 end subroutine
    -
    2579
    -
    2615 module subroutine qr_factor_no_pivot_cmplx(a, tau, work, olwork, err)
    -
    2616 complex(real64), intent(inout), dimension(:,:) :: a
    -
    2617 complex(real64), intent(out), dimension(:) :: tau
    -
    2618 complex(real64), intent(out), target, dimension(:), optional :: work
    -
    2619 integer(int32), intent(out), optional :: olwork
    -
    2620 class(errors), intent(inout), optional, target :: err
    -
    2621 end subroutine
    -
    2622
    -
    2656 module subroutine qr_factor_pivot(a, tau, jpvt, work, olwork, err)
    -
    2657 real(real64), intent(inout), dimension(:,:) :: a
    -
    2658 real(real64), intent(out), dimension(:) :: tau
    -
    2659 integer(int32), intent(inout), dimension(:) :: jpvt
    -
    2660 real(real64), intent(out), target, dimension(:), optional :: work
    -
    2661 integer(int32), intent(out), optional :: olwork
    -
    2662 class(errors), intent(inout), optional, target :: err
    -
    2663 end subroutine
    -
    2664
    -
    2702 module subroutine qr_factor_pivot_cmplx(a, tau, jpvt, work, olwork, rwork, &
    -
    2703 err)
    -
    2704 complex(real64), intent(inout), dimension(:,:) :: a
    -
    2705 complex(real64), intent(out), dimension(:) :: tau
    -
    2706 integer(int32), intent(inout), dimension(:) :: jpvt
    -
    2707 complex(real64), intent(out), target, dimension(:), optional :: work
    -
    2708 integer(int32), intent(out), optional :: olwork
    -
    2709 real(real64), intent(out), target, dimension(:), optional :: rwork
    -
    2710 class(errors), intent(inout), optional, target :: err
    -
    2711 end subroutine
    -
    2712
    -
    2746 module subroutine form_qr_no_pivot(r, tau, q, work, olwork, err)
    -
    2747 real(real64), intent(inout), dimension(:,:) :: r
    -
    2748 real(real64), intent(in), dimension(:) :: tau
    -
    2749 real(real64), intent(out), dimension(:,:) :: q
    -
    2750 real(real64), intent(out), target, dimension(:), optional :: work
    -
    2751 integer(int32), intent(out), optional :: olwork
    -
    2752 class(errors), intent(inout), optional, target :: err
    -
    2753 end subroutine
    -
    2754
    -
    2788 module subroutine form_qr_no_pivot_cmplx(r, tau, q, work, olwork, err)
    -
    2789 complex(real64), intent(inout), dimension(:,:) :: r
    -
    2790 complex(real64), intent(in), dimension(:) :: tau
    -
    2791 complex(real64), intent(out), dimension(:,:) :: q
    -
    2792 complex(real64), intent(out), target, dimension(:), optional :: work
    -
    2793 integer(int32), intent(out), optional :: olwork
    -
    2794 class(errors), intent(inout), optional, target :: err
    -
    2795 end subroutine
    -
    2796
    -
    2833 module subroutine form_qr_pivot(r, tau, pvt, q, p, work, olwork, err)
    -
    2834 real(real64), intent(inout), dimension(:,:) :: r
    -
    2835 real(real64), intent(in), dimension(:) :: tau
    -
    2836 integer(int32), intent(in), dimension(:) :: pvt
    -
    2837 real(real64), intent(out), dimension(:,:) :: q, p
    -
    2838 real(real64), intent(out), target, dimension(:), optional :: work
    -
    2839 integer(int32), intent(out), optional :: olwork
    -
    2840 class(errors), intent(inout), optional, target :: err
    -
    2841 end subroutine
    -
    2842
    -
    2879 module subroutine form_qr_pivot_cmplx(r, tau, pvt, q, p, work, olwork, err)
    -
    2880 complex(real64), intent(inout), dimension(:,:) :: r
    -
    2881 complex(real64), intent(in), dimension(:) :: tau
    -
    2882 integer(int32), intent(in), dimension(:) :: pvt
    -
    2883 complex(real64), intent(out), dimension(:,:) :: q, p
    -
    2884 complex(real64), intent(out), target, dimension(:), optional :: work
    -
    2885 integer(int32), intent(out), optional :: olwork
    -
    2886 class(errors), intent(inout), optional, target :: err
    -
    2887 end subroutine
    -
    2888
    -
    2923 module subroutine mult_qr_mtx(lside, trans, a, tau, c, work, olwork, err)
    -
    2924 logical, intent(in) :: lside, trans
    -
    2925 real(real64), intent(in), dimension(:) :: tau
    -
    2926 real(real64), intent(inout), dimension(:,:) :: a, c
    -
    2927 real(real64), intent(out), target, dimension(:), optional :: work
    -
    2928 integer(int32), intent(out), optional :: olwork
    -
    2929 class(errors), intent(inout), optional, target :: err
    -
    2930 end subroutine
    -
    2931
    -
    2966 module subroutine mult_qr_mtx_cmplx(lside, trans, a, tau, c, work, olwork, err)
    -
    2967 logical, intent(in) :: lside, trans
    -
    2968 complex(real64), intent(in), dimension(:) :: tau
    -
    2969 complex(real64), intent(inout), dimension(:,:) :: a, c
    -
    2970 complex(real64), intent(out), target, dimension(:), optional :: work
    -
    2971 integer(int32), intent(out), optional :: olwork
    +
    2492 module subroutine form_qr_no_pivot_cmplx(r, tau, q, work, olwork, err)
    +
    2493 complex(real64), intent(inout), dimension(:,:) :: r
    +
    2494 complex(real64), intent(in), dimension(:) :: tau
    +
    2495 complex(real64), intent(out), dimension(:,:) :: q
    +
    2496 complex(real64), intent(out), target, dimension(:), optional :: work
    +
    2497 integer(int32), intent(out), optional :: olwork
    +
    2498 class(errors), intent(inout), optional, target :: err
    +
    2499 end subroutine
    +
    2500
    +
    2537 module subroutine form_qr_pivot(r, tau, pvt, q, p, work, olwork, err)
    +
    2538 real(real64), intent(inout), dimension(:,:) :: r
    +
    2539 real(real64), intent(in), dimension(:) :: tau
    +
    2540 integer(int32), intent(in), dimension(:) :: pvt
    +
    2541 real(real64), intent(out), dimension(:,:) :: q, p
    +
    2542 real(real64), intent(out), target, dimension(:), optional :: work
    +
    2543 integer(int32), intent(out), optional :: olwork
    +
    2544 class(errors), intent(inout), optional, target :: err
    +
    2545 end subroutine
    +
    2546
    +
    2583 module subroutine form_qr_pivot_cmplx(r, tau, pvt, q, p, work, olwork, err)
    +
    2584 complex(real64), intent(inout), dimension(:,:) :: r
    +
    2585 complex(real64), intent(in), dimension(:) :: tau
    +
    2586 integer(int32), intent(in), dimension(:) :: pvt
    +
    2587 complex(real64), intent(out), dimension(:,:) :: q, p
    +
    2588 complex(real64), intent(out), target, dimension(:), optional :: work
    +
    2589 integer(int32), intent(out), optional :: olwork
    +
    2590 class(errors), intent(inout), optional, target :: err
    +
    2591 end subroutine
    +
    2592
    +
    2627 module subroutine mult_qr_mtx(lside, trans, a, tau, c, work, olwork, err)
    +
    2628 logical, intent(in) :: lside, trans
    +
    2629 real(real64), intent(in), dimension(:) :: tau
    +
    2630 real(real64), intent(inout), dimension(:,:) :: a, c
    +
    2631 real(real64), intent(out), target, dimension(:), optional :: work
    +
    2632 integer(int32), intent(out), optional :: olwork
    +
    2633 class(errors), intent(inout), optional, target :: err
    +
    2634 end subroutine
    +
    2635
    +
    2670 module subroutine mult_qr_mtx_cmplx(lside, trans, a, tau, c, work, olwork, err)
    +
    2671 logical, intent(in) :: lside, trans
    +
    2672 complex(real64), intent(in), dimension(:) :: tau
    +
    2673 complex(real64), intent(inout), dimension(:,:) :: a, c
    +
    2674 complex(real64), intent(out), target, dimension(:), optional :: work
    +
    2675 integer(int32), intent(out), optional :: olwork
    +
    2676 class(errors), intent(inout), optional, target :: err
    +
    2677 end subroutine
    +
    2678
    +
    2709 module subroutine mult_qr_vec(trans, a, tau, c, work, olwork, err)
    +
    2710 logical, intent(in) :: trans
    +
    2711 real(real64), intent(inout), dimension(:,:) :: a
    +
    2712 real(real64), intent(in), dimension(:) :: tau
    +
    2713 real(real64), intent(inout), dimension(:) :: c
    +
    2714 real(real64), intent(out), target, dimension(:), optional :: work
    +
    2715 integer(int32), intent(out), optional :: olwork
    +
    2716 class(errors), intent(inout), optional, target :: err
    +
    2717 end subroutine
    +
    2718
    +
    2749 module subroutine mult_qr_vec_cmplx(trans, a, tau, c, work, olwork, err)
    +
    2750 logical, intent(in) :: trans
    +
    2751 complex(real64), intent(inout), dimension(:,:) :: a
    +
    2752 complex(real64), intent(in), dimension(:) :: tau
    +
    2753 complex(real64), intent(inout), dimension(:) :: c
    +
    2754 complex(real64), intent(out), target, dimension(:), optional :: work
    +
    2755 integer(int32), intent(out), optional :: olwork
    +
    2756 class(errors), intent(inout), optional, target :: err
    +
    2757 end subroutine
    +
    2758
    +
    2799 module subroutine qr_rank1_update_dbl(q, r, u, v, work, err)
    +
    2800 real(real64), intent(inout), dimension(:,:) :: q, r
    +
    2801 real(real64), intent(inout), dimension(:) :: u, v
    +
    2802 real(real64), intent(out), target, optional, dimension(:) :: work
    +
    2803 class(errors), intent(inout), optional, target :: err
    +
    2804 end subroutine
    +
    2805
    +
    2849 module subroutine qr_rank1_update_cmplx(q, r, u, v, work, rwork, err)
    +
    2850 complex(real64), intent(inout), dimension(:,:) :: q, r
    +
    2851 complex(real64), intent(inout), dimension(:) :: u, v
    +
    2852 complex(real64), intent(out), target, optional, dimension(:) :: work
    +
    2853 real(real64), intent(out), target, optional, dimension(:) :: rwork
    +
    2854 class(errors), intent(inout), optional, target :: err
    +
    2855 end subroutine
    +
    2856
    +
    2877 module subroutine cholesky_factor_dbl(a, upper, err)
    +
    2878 real(real64), intent(inout), dimension(:,:) :: a
    +
    2879 logical, intent(in), optional :: upper
    +
    2880 class(errors), intent(inout), optional, target :: err
    +
    2881 end subroutine
    +
    2882
    +
    2903 module subroutine cholesky_factor_cmplx(a, upper, err)
    +
    2904 complex(real64), intent(inout), dimension(:,:) :: a
    +
    2905 logical, intent(in), optional :: upper
    +
    2906 class(errors), intent(inout), optional, target :: err
    +
    2907 end subroutine
    +
    2908
    +
    2935 module subroutine cholesky_rank1_update_dbl(r, u, work, err)
    +
    2936 real(real64), intent(inout), dimension(:,:) :: r
    +
    2937 real(real64), intent(inout), dimension(:) :: u
    +
    2938 real(real64), intent(out), target, optional, dimension(:) :: work
    +
    2939 class(errors), intent(inout), optional, target :: err
    +
    2940 end subroutine
    +
    2941
    +
    2968 module subroutine cholesky_rank1_update_cmplx(r, u, work, err)
    +
    2969 complex(real64), intent(inout), dimension(:,:) :: r
    +
    2970 complex(real64), intent(inout), dimension(:) :: u
    +
    2971 real(real64), intent(out), target, optional, dimension(:) :: work
    2972 class(errors), intent(inout), optional, target :: err
    2973 end subroutine
    2974
    -
    3005 module subroutine mult_qr_vec(trans, a, tau, c, work, olwork, err)
    -
    3006 logical, intent(in) :: trans
    -
    3007 real(real64), intent(inout), dimension(:,:) :: a
    -
    3008 real(real64), intent(in), dimension(:) :: tau
    -
    3009 real(real64), intent(inout), dimension(:) :: c
    -
    3010 real(real64), intent(out), target, dimension(:), optional :: work
    -
    3011 integer(int32), intent(out), optional :: olwork
    -
    3012 class(errors), intent(inout), optional, target :: err
    -
    3013 end subroutine
    -
    3014
    -
    3045 module subroutine mult_qr_vec_cmplx(trans, a, tau, c, work, olwork, err)
    -
    3046 logical, intent(in) :: trans
    -
    3047 complex(real64), intent(inout), dimension(:,:) :: a
    -
    3048 complex(real64), intent(in), dimension(:) :: tau
    -
    3049 complex(real64), intent(inout), dimension(:) :: c
    -
    3050 complex(real64), intent(out), target, dimension(:), optional :: work
    -
    3051 integer(int32), intent(out), optional :: olwork
    -
    3052 class(errors), intent(inout), optional, target :: err
    -
    3053 end subroutine
    -
    3054
    -
    3095 module subroutine qr_rank1_update_dbl(q, r, u, v, work, err)
    -
    3096 real(real64), intent(inout), dimension(:,:) :: q, r
    -
    3097 real(real64), intent(inout), dimension(:) :: u, v
    -
    3098 real(real64), intent(out), target, optional, dimension(:) :: work
    -
    3099 class(errors), intent(inout), optional, target :: err
    -
    3100 end subroutine
    -
    3101
    -
    3145 module subroutine qr_rank1_update_cmplx(q, r, u, v, work, rwork, err)
    -
    3146 complex(real64), intent(inout), dimension(:,:) :: q, r
    -
    3147 complex(real64), intent(inout), dimension(:) :: u, v
    -
    3148 complex(real64), intent(out), target, optional, dimension(:) :: work
    -
    3149 real(real64), intent(out), target, optional, dimension(:) :: rwork
    -
    3150 class(errors), intent(inout), optional, target :: err
    -
    3151 end subroutine
    -
    3152
    -
    3173 module subroutine cholesky_factor_dbl(a, upper, err)
    -
    3174 real(real64), intent(inout), dimension(:,:) :: a
    -
    3175 logical, intent(in), optional :: upper
    -
    3176 class(errors), intent(inout), optional, target :: err
    -
    3177 end subroutine
    -
    3178
    -
    3199 module subroutine cholesky_factor_cmplx(a, upper, err)
    -
    3200 complex(real64), intent(inout), dimension(:,:) :: a
    -
    3201 logical, intent(in), optional :: upper
    -
    3202 class(errors), intent(inout), optional, target :: err
    -
    3203 end subroutine
    -
    3204
    -
    3231 module subroutine cholesky_rank1_update_dbl(r, u, work, err)
    -
    3232 real(real64), intent(inout), dimension(:,:) :: r
    -
    3233 real(real64), intent(inout), dimension(:) :: u
    -
    3234 real(real64), intent(out), target, optional, dimension(:) :: work
    -
    3235 class(errors), intent(inout), optional, target :: err
    -
    3236 end subroutine
    -
    3237
    -
    3264 module subroutine cholesky_rank1_update_cmplx(r, u, work, err)
    -
    3265 complex(real64), intent(inout), dimension(:,:) :: r
    -
    3266 complex(real64), intent(inout), dimension(:) :: u
    -
    3267 real(real64), intent(out), target, optional, dimension(:) :: work
    -
    3268 class(errors), intent(inout), optional, target :: err
    -
    3269 end subroutine
    -
    3270
    -
    3300 module subroutine cholesky_rank1_downdate_dbl(r, u, work, err)
    -
    3301 real(real64), intent(inout), dimension(:,:) :: r
    -
    3302 real(real64), intent(inout), dimension(:) :: u
    -
    3303 real(real64), intent(out), target, optional, dimension(:) :: work
    -
    3304 class(errors), intent(inout), optional, target :: err
    -
    3305 end subroutine
    -
    3306
    -
    3336 module subroutine cholesky_rank1_downdate_cmplx(r, u, work, err)
    -
    3337 complex(real64), intent(inout), dimension(:,:) :: r
    -
    3338 complex(real64), intent(inout), dimension(:) :: u
    -
    3339 real(real64), intent(out), target, optional, dimension(:) :: work
    -
    3340 class(errors), intent(inout), optional, target :: err
    -
    3341 end subroutine
    -
    3342
    -
    3405 module subroutine rz_factor_dbl(a, tau, work, olwork, err)
    -
    3406 real(real64), intent(inout), dimension(:,:) :: a
    -
    3407 real(real64), intent(out), dimension(:) :: tau
    -
    3408 real(real64), intent(out), target, optional, dimension(:) :: work
    -
    3409 integer(int32), intent(out), optional :: olwork
    -
    3410 class(errors), intent(inout), optional, target :: err
    -
    3411 end subroutine
    -
    3412
    -
    3475 module subroutine rz_factor_cmplx(a, tau, work, olwork, err)
    -
    3476 complex(real64), intent(inout), dimension(:,:) :: a
    -
    3477 complex(real64), intent(out), dimension(:) :: tau
    -
    3478 complex(real64), intent(out), target, optional, dimension(:) :: work
    -
    3479 integer(int32), intent(out), optional :: olwork
    -
    3480 class(errors), intent(inout), optional, target :: err
    -
    3481 end subroutine
    -
    3482
    -
    3520 module subroutine mult_rz_mtx(lside, trans, l, a, tau, c, work, olwork, err)
    -
    3521 logical, intent(in) :: lside, trans
    -
    3522 integer(int32), intent(in) :: l
    -
    3523 real(real64), intent(inout), dimension(:,:) :: a, c
    -
    3524 real(real64), intent(in), dimension(:) :: tau
    -
    3525 real(real64), intent(out), target, optional, dimension(:) :: work
    -
    3526 integer(int32), intent(out), optional :: olwork
    -
    3527 class(errors), intent(inout), optional, target :: err
    -
    3528 end subroutine
    -
    3529
    -
    3567 module subroutine mult_rz_mtx_cmplx(lside, trans, l, a, tau, c, work, olwork, err)
    -
    3568 logical, intent(in) :: lside, trans
    -
    3569 integer(int32), intent(in) :: l
    -
    3570 complex(real64), intent(inout), dimension(:,:) :: a, c
    -
    3571 complex(real64), intent(in), dimension(:) :: tau
    -
    3572 complex(real64), intent(out), target, optional, dimension(:) :: work
    -
    3573 integer(int32), intent(out), optional :: olwork
    -
    3574 class(errors), intent(inout), optional, target :: err
    -
    3575 end subroutine
    -
    3576
    -
    3612 module subroutine mult_rz_vec(trans, l, a, tau, c, work, olwork, err)
    -
    3613 logical, intent(in) :: trans
    -
    3614 integer(int32), intent(in) :: l
    -
    3615 real(real64), intent(inout), dimension(:,:) :: a
    -
    3616 real(real64), intent(in), dimension(:) :: tau
    -
    3617 real(real64), intent(inout), dimension(:) :: c
    -
    3618 real(real64), intent(out), target, optional, dimension(:) :: work
    -
    3619 integer(int32), intent(out), optional :: olwork
    -
    3620 class(errors), intent(inout), optional, target :: err
    -
    3621 end subroutine
    -
    3622
    -
    3658 module subroutine mult_rz_vec_cmplx(trans, l, a, tau, c, work, olwork, err)
    -
    3659 logical, intent(in) :: trans
    -
    3660 integer(int32), intent(in) :: l
    -
    3661 complex(real64), intent(inout), dimension(:,:) :: a
    -
    3662 complex(real64), intent(in), dimension(:) :: tau
    -
    3663 complex(real64), intent(inout), dimension(:) :: c
    -
    3664 complex(real64), intent(out), target, optional, dimension(:) :: work
    -
    3665 integer(int32), intent(out), optional :: olwork
    -
    3666 class(errors), intent(inout), optional, target :: err
    -
    3667 end subroutine
    -
    3668
    -
    3711 module subroutine svd_dbl(a, s, u, vt, work, olwork, err)
    -
    3712 real(real64), intent(inout), dimension(:,:) :: a
    -
    3713 real(real64), intent(out), dimension(:) :: s
    -
    3714 real(real64), intent(out), optional, dimension(:,:) :: u, vt
    -
    3715 real(real64), intent(out), target, optional, dimension(:) :: work
    -
    3716 integer(int32), intent(out), optional :: olwork
    -
    3717 class(errors), intent(inout), optional, target :: err
    -
    3718 end subroutine
    -
    3719
    -
    3766 module subroutine svd_cmplx(a, s, u, vt, work, olwork, rwork, err)
    -
    3767 complex(real64), intent(inout), dimension(:,:) :: a
    -
    3768 real(real64), intent(out), dimension(:) :: s
    -
    3769 complex(real64), intent(out), optional, dimension(:,:) :: u, vt
    -
    3770 complex(real64), intent(out), target, optional, dimension(:) :: work
    -
    3771 integer(int32), intent(out), optional :: olwork
    -
    3772 real(real64), intent(out), target, optional, dimension(:) :: rwork
    -
    3773 class(errors), intent(inout), optional, target :: err
    -
    3774 end subroutine
    -
    3775end interface
    -
    3776
    -
    3777! ******************************************************************************
    -
    3778! LINALG_SOLVE.F90
    -
    3779! ------------------------------------------------------------------------------
    -
    3780interface
    -
    3781
    -
    3809 module subroutine solve_tri_mtx(lside, upper, trans, nounit, alpha, a, b, err)
    -
    3810 logical, intent(in) :: lside, upper, trans, nounit
    -
    3811 real(real64), intent(in) :: alpha
    -
    3812 real(real64), intent(in), dimension(:,:) :: a
    -
    3813 real(real64), intent(inout), dimension(:,:) :: b
    -
    3814 class(errors), intent(inout), optional, target :: err
    -
    3815 end subroutine
    -
    3816
    -
    3845 module subroutine solve_tri_mtx_cmplx(lside, upper, trans, nounit, alpha, a, b, err)
    -
    3846 logical, intent(in) :: lside, upper, trans, nounit
    -
    3847 complex(real64), intent(in) :: alpha
    -
    3848 complex(real64), intent(in), dimension(:,:) :: a
    -
    3849 complex(real64), intent(inout), dimension(:,:) :: b
    -
    3850 class(errors), intent(inout), optional, target :: err
    -
    3851 end subroutine
    -
    3852
    -
    3897 module subroutine solve_tri_vec(upper, trans, nounit, a, x, err)
    -
    3898 logical, intent(in) :: upper, trans, nounit
    -
    3899 real(real64), intent(in), dimension(:,:) :: a
    -
    3900 real(real64), intent(inout), dimension(:) :: x
    -
    3901 class(errors), intent(inout), optional, target :: err
    -
    3902 end subroutine
    -
    3903
    -
    3948 module subroutine solve_tri_vec_cmplx(upper, trans, nounit, a, x, err)
    -
    3949 logical, intent(in) :: upper, trans, nounit
    -
    3950 complex(real64), intent(in), dimension(:,:) :: a
    -
    3951 complex(real64), intent(inout), dimension(:) :: x
    -
    3952 class(errors), intent(inout), optional, target :: err
    -
    3953 end subroutine
    -
    3954
    -
    3971 module subroutine solve_lu_mtx(a, ipvt, b, err)
    -
    3972 real(real64), intent(in), dimension(:,:) :: a
    -
    3973 integer(int32), intent(in), dimension(:) :: ipvt
    -
    3974 real(real64), intent(inout), dimension(:,:) :: b
    -
    3975 class(errors), intent(inout), optional, target :: err
    -
    3976 end subroutine
    -
    3977
    -
    3994 module subroutine solve_lu_mtx_cmplx(a, ipvt, b, err)
    -
    3995 complex(real64), intent(in), dimension(:,:) :: a
    -
    3996 integer(int32), intent(in), dimension(:) :: ipvt
    -
    3997 complex(real64), intent(inout), dimension(:,:) :: b
    -
    3998 class(errors), intent(inout), optional, target :: err
    -
    3999 end subroutine
    -
    4000
    -
    4017 module subroutine solve_lu_vec(a, ipvt, b, err)
    -
    4018 real(real64), intent(in), dimension(:,:) :: a
    -
    4019 integer(int32), intent(in), dimension(:) :: ipvt
    -
    4020 real(real64), intent(inout), dimension(:) :: b
    +
    3004 module subroutine cholesky_rank1_downdate_dbl(r, u, work, err)
    +
    3005 real(real64), intent(inout), dimension(:,:) :: r
    +
    3006 real(real64), intent(inout), dimension(:) :: u
    +
    3007 real(real64), intent(out), target, optional, dimension(:) :: work
    +
    3008 class(errors), intent(inout), optional, target :: err
    +
    3009 end subroutine
    +
    3010
    +
    3040 module subroutine cholesky_rank1_downdate_cmplx(r, u, work, err)
    +
    3041 complex(real64), intent(inout), dimension(:,:) :: r
    +
    3042 complex(real64), intent(inout), dimension(:) :: u
    +
    3043 real(real64), intent(out), target, optional, dimension(:) :: work
    +
    3044 class(errors), intent(inout), optional, target :: err
    +
    3045 end subroutine
    +
    3046
    +
    3109 module subroutine rz_factor_dbl(a, tau, work, olwork, err)
    +
    3110 real(real64), intent(inout), dimension(:,:) :: a
    +
    3111 real(real64), intent(out), dimension(:) :: tau
    +
    3112 real(real64), intent(out), target, optional, dimension(:) :: work
    +
    3113 integer(int32), intent(out), optional :: olwork
    +
    3114 class(errors), intent(inout), optional, target :: err
    +
    3115 end subroutine
    +
    3116
    +
    3179 module subroutine rz_factor_cmplx(a, tau, work, olwork, err)
    +
    3180 complex(real64), intent(inout), dimension(:,:) :: a
    +
    3181 complex(real64), intent(out), dimension(:) :: tau
    +
    3182 complex(real64), intent(out), target, optional, dimension(:) :: work
    +
    3183 integer(int32), intent(out), optional :: olwork
    +
    3184 class(errors), intent(inout), optional, target :: err
    +
    3185 end subroutine
    +
    3186
    +
    3224 module subroutine mult_rz_mtx(lside, trans, l, a, tau, c, work, olwork, err)
    +
    3225 logical, intent(in) :: lside, trans
    +
    3226 integer(int32), intent(in) :: l
    +
    3227 real(real64), intent(inout), dimension(:,:) :: a, c
    +
    3228 real(real64), intent(in), dimension(:) :: tau
    +
    3229 real(real64), intent(out), target, optional, dimension(:) :: work
    +
    3230 integer(int32), intent(out), optional :: olwork
    +
    3231 class(errors), intent(inout), optional, target :: err
    +
    3232 end subroutine
    +
    3233
    +
    3271 module subroutine mult_rz_mtx_cmplx(lside, trans, l, a, tau, c, work, olwork, err)
    +
    3272 logical, intent(in) :: lside, trans
    +
    3273 integer(int32), intent(in) :: l
    +
    3274 complex(real64), intent(inout), dimension(:,:) :: a, c
    +
    3275 complex(real64), intent(in), dimension(:) :: tau
    +
    3276 complex(real64), intent(out), target, optional, dimension(:) :: work
    +
    3277 integer(int32), intent(out), optional :: olwork
    +
    3278 class(errors), intent(inout), optional, target :: err
    +
    3279 end subroutine
    +
    3280
    +
    3316 module subroutine mult_rz_vec(trans, l, a, tau, c, work, olwork, err)
    +
    3317 logical, intent(in) :: trans
    +
    3318 integer(int32), intent(in) :: l
    +
    3319 real(real64), intent(inout), dimension(:,:) :: a
    +
    3320 real(real64), intent(in), dimension(:) :: tau
    +
    3321 real(real64), intent(inout), dimension(:) :: c
    +
    3322 real(real64), intent(out), target, optional, dimension(:) :: work
    +
    3323 integer(int32), intent(out), optional :: olwork
    +
    3324 class(errors), intent(inout), optional, target :: err
    +
    3325 end subroutine
    +
    3326
    +
    3362 module subroutine mult_rz_vec_cmplx(trans, l, a, tau, c, work, olwork, err)
    +
    3363 logical, intent(in) :: trans
    +
    3364 integer(int32), intent(in) :: l
    +
    3365 complex(real64), intent(inout), dimension(:,:) :: a
    +
    3366 complex(real64), intent(in), dimension(:) :: tau
    +
    3367 complex(real64), intent(inout), dimension(:) :: c
    +
    3368 complex(real64), intent(out), target, optional, dimension(:) :: work
    +
    3369 integer(int32), intent(out), optional :: olwork
    +
    3370 class(errors), intent(inout), optional, target :: err
    +
    3371 end subroutine
    +
    3372
    +
    3415 module subroutine svd_dbl(a, s, u, vt, work, olwork, err)
    +
    3416 real(real64), intent(inout), dimension(:,:) :: a
    +
    3417 real(real64), intent(out), dimension(:) :: s
    +
    3418 real(real64), intent(out), optional, dimension(:,:) :: u, vt
    +
    3419 real(real64), intent(out), target, optional, dimension(:) :: work
    +
    3420 integer(int32), intent(out), optional :: olwork
    +
    3421 class(errors), intent(inout), optional, target :: err
    +
    3422 end subroutine
    +
    3423
    +
    3470 module subroutine svd_cmplx(a, s, u, vt, work, olwork, rwork, err)
    +
    3471 complex(real64), intent(inout), dimension(:,:) :: a
    +
    3472 real(real64), intent(out), dimension(:) :: s
    +
    3473 complex(real64), intent(out), optional, dimension(:,:) :: u, vt
    +
    3474 complex(real64), intent(out), target, optional, dimension(:) :: work
    +
    3475 integer(int32), intent(out), optional :: olwork
    +
    3476 real(real64), intent(out), target, optional, dimension(:) :: rwork
    +
    3477 class(errors), intent(inout), optional, target :: err
    +
    3478 end subroutine
    +
    3479end interface
    +
    3480
    +
    3481! ******************************************************************************
    +
    3482! LINALG_SOLVE.F90
    +
    3483! ------------------------------------------------------------------------------
    +
    3484interface
    +
    3485
    +
    3513 module subroutine solve_tri_mtx(lside, upper, trans, nounit, alpha, a, b, err)
    +
    3514 logical, intent(in) :: lside, upper, trans, nounit
    +
    3515 real(real64), intent(in) :: alpha
    +
    3516 real(real64), intent(in), dimension(:,:) :: a
    +
    3517 real(real64), intent(inout), dimension(:,:) :: b
    +
    3518 class(errors), intent(inout), optional, target :: err
    +
    3519 end subroutine
    +
    3520
    +
    3549 module subroutine solve_tri_mtx_cmplx(lside, upper, trans, nounit, alpha, a, b, err)
    +
    3550 logical, intent(in) :: lside, upper, trans, nounit
    +
    3551 complex(real64), intent(in) :: alpha
    +
    3552 complex(real64), intent(in), dimension(:,:) :: a
    +
    3553 complex(real64), intent(inout), dimension(:,:) :: b
    +
    3554 class(errors), intent(inout), optional, target :: err
    +
    3555 end subroutine
    +
    3556
    +
    3601 module subroutine solve_tri_vec(upper, trans, nounit, a, x, err)
    +
    3602 logical, intent(in) :: upper, trans, nounit
    +
    3603 real(real64), intent(in), dimension(:,:) :: a
    +
    3604 real(real64), intent(inout), dimension(:) :: x
    +
    3605 class(errors), intent(inout), optional, target :: err
    +
    3606 end subroutine
    +
    3607
    +
    3652 module subroutine solve_tri_vec_cmplx(upper, trans, nounit, a, x, err)
    +
    3653 logical, intent(in) :: upper, trans, nounit
    +
    3654 complex(real64), intent(in), dimension(:,:) :: a
    +
    3655 complex(real64), intent(inout), dimension(:) :: x
    +
    3656 class(errors), intent(inout), optional, target :: err
    +
    3657 end subroutine
    +
    3658
    +
    3675 module subroutine solve_lu_mtx(a, ipvt, b, err)
    +
    3676 real(real64), intent(in), dimension(:,:) :: a
    +
    3677 integer(int32), intent(in), dimension(:) :: ipvt
    +
    3678 real(real64), intent(inout), dimension(:,:) :: b
    +
    3679 class(errors), intent(inout), optional, target :: err
    +
    3680 end subroutine
    +
    3681
    +
    3698 module subroutine solve_lu_mtx_cmplx(a, ipvt, b, err)
    +
    3699 complex(real64), intent(in), dimension(:,:) :: a
    +
    3700 integer(int32), intent(in), dimension(:) :: ipvt
    +
    3701 complex(real64), intent(inout), dimension(:,:) :: b
    +
    3702 class(errors), intent(inout), optional, target :: err
    +
    3703 end subroutine
    +
    3704
    +
    3721 module subroutine solve_lu_vec(a, ipvt, b, err)
    +
    3722 real(real64), intent(in), dimension(:,:) :: a
    +
    3723 integer(int32), intent(in), dimension(:) :: ipvt
    +
    3724 real(real64), intent(inout), dimension(:) :: b
    +
    3725 class(errors), intent(inout), optional, target :: err
    +
    3726 end subroutine
    +
    3727
    +
    3744 module subroutine solve_lu_vec_cmplx(a, ipvt, b, err)
    +
    3745 complex(real64), intent(in), dimension(:,:) :: a
    +
    3746 integer(int32), intent(in), dimension(:) :: ipvt
    +
    3747 complex(real64), intent(inout), dimension(:) :: b
    +
    3748 class(errors), intent(inout), optional, target :: err
    +
    3749 end subroutine
    +
    3750
    +
    3780 module subroutine solve_qr_no_pivot_mtx(a, tau, b, work, olwork, err)
    +
    3781 real(real64), intent(inout), dimension(:,:) :: a, b
    +
    3782 real(real64), intent(in), dimension(:) :: tau
    +
    3783 real(real64), intent(out), target, optional, dimension(:) :: work
    +
    3784 integer(int32), intent(out), optional :: olwork
    +
    3785 class(errors), intent(inout), optional, target :: err
    +
    3786 end subroutine
    +
    3787
    +
    3817 module subroutine solve_qr_no_pivot_mtx_cmplx(a, tau, b, work, olwork, err)
    +
    3818 complex(real64), intent(inout), dimension(:,:) :: a, b
    +
    3819 complex(real64), intent(in), dimension(:) :: tau
    +
    3820 complex(real64), intent(out), target, optional, dimension(:) :: work
    +
    3821 integer(int32), intent(out), optional :: olwork
    +
    3822 class(errors), intent(inout), optional, target :: err
    +
    3823 end subroutine
    +
    3824
    +
    3854 module subroutine solve_qr_no_pivot_vec(a, tau, b, work, olwork, err)
    +
    3855 real(real64), intent(inout), dimension(:,:) :: a
    +
    3856 real(real64), intent(in), dimension(:) :: tau
    +
    3857 real(real64), intent(inout), dimension(:) :: b
    +
    3858 real(real64), intent(out), target, optional, dimension(:) :: work
    +
    3859 integer(int32), intent(out), optional :: olwork
    +
    3860 class(errors), intent(inout), optional, target :: err
    +
    3861 end subroutine
    +
    3862
    +
    3892 module subroutine solve_qr_no_pivot_vec_cmplx(a, tau, b, work, olwork, err)
    +
    3893 complex(real64), intent(inout), dimension(:,:) :: a
    +
    3894 complex(real64), intent(in), dimension(:) :: tau
    +
    3895 complex(real64), intent(inout), dimension(:) :: b
    +
    3896 complex(real64), intent(out), target, optional, dimension(:) :: work
    +
    3897 integer(int32), intent(out), optional :: olwork
    +
    3898 class(errors), intent(inout), optional, target :: err
    +
    3899 end subroutine
    +
    3900
    +
    3932 module subroutine solve_qr_pivot_mtx(a, tau, jpvt, b, work, olwork, err)
    +
    3933 real(real64), intent(inout), dimension(:,:) :: a
    +
    3934 real(real64), intent(in), dimension(:) :: tau
    +
    3935 integer(int32), intent(in), dimension(:) :: jpvt
    +
    3936 real(real64), intent(inout), dimension(:,:) :: b
    +
    3937 real(real64), intent(out), target, optional, dimension(:) :: work
    +
    3938 integer(int32), intent(out), optional :: olwork
    +
    3939 class(errors), intent(inout), optional, target :: err
    +
    3940 end subroutine
    +
    3941
    +
    3973 module subroutine solve_qr_pivot_mtx_cmplx(a, tau, jpvt, b, work, olwork, err)
    +
    3974 complex(real64), intent(inout), dimension(:,:) :: a
    +
    3975 complex(real64), intent(in), dimension(:) :: tau
    +
    3976 integer(int32), intent(in), dimension(:) :: jpvt
    +
    3977 complex(real64), intent(inout), dimension(:,:) :: b
    +
    3978 complex(real64), intent(out), target, optional, dimension(:) :: work
    +
    3979 integer(int32), intent(out), optional :: olwork
    +
    3980 class(errors), intent(inout), optional, target :: err
    +
    3981 end subroutine
    +
    3982
    +
    4014 module subroutine solve_qr_pivot_vec(a, tau, jpvt, b, work, olwork, err)
    +
    4015 real(real64), intent(inout), dimension(:,:) :: a
    +
    4016 real(real64), intent(in), dimension(:) :: tau
    +
    4017 integer(int32), intent(in), dimension(:) :: jpvt
    +
    4018 real(real64), intent(inout), dimension(:) :: b
    +
    4019 real(real64), intent(out), target, optional, dimension(:) :: work
    +
    4020 integer(int32), intent(out), optional :: olwork
    4021 class(errors), intent(inout), optional, target :: err
    4022 end subroutine
    4023
    -
    4040 module subroutine solve_lu_vec_cmplx(a, ipvt, b, err)
    -
    4041 complex(real64), intent(in), dimension(:,:) :: a
    -
    4042 integer(int32), intent(in), dimension(:) :: ipvt
    -
    4043 complex(real64), intent(inout), dimension(:) :: b
    -
    4044 class(errors), intent(inout), optional, target :: err
    -
    4045 end subroutine
    -
    4046
    -
    4076 module subroutine solve_qr_no_pivot_mtx(a, tau, b, work, olwork, err)
    -
    4077 real(real64), intent(inout), dimension(:,:) :: a, b
    -
    4078 real(real64), intent(in), dimension(:) :: tau
    -
    4079 real(real64), intent(out), target, optional, dimension(:) :: work
    -
    4080 integer(int32), intent(out), optional :: olwork
    -
    4081 class(errors), intent(inout), optional, target :: err
    -
    4082 end subroutine
    -
    4083
    -
    4113 module subroutine solve_qr_no_pivot_mtx_cmplx(a, tau, b, work, olwork, err)
    -
    4114 complex(real64), intent(inout), dimension(:,:) :: a, b
    -
    4115 complex(real64), intent(in), dimension(:) :: tau
    -
    4116 complex(real64), intent(out), target, optional, dimension(:) :: work
    -
    4117 integer(int32), intent(out), optional :: olwork
    -
    4118 class(errors), intent(inout), optional, target :: err
    -
    4119 end subroutine
    -
    4120
    -
    4150 module subroutine solve_qr_no_pivot_vec(a, tau, b, work, olwork, err)
    -
    4151 real(real64), intent(inout), dimension(:,:) :: a
    -
    4152 real(real64), intent(in), dimension(:) :: tau
    -
    4153 real(real64), intent(inout), dimension(:) :: b
    -
    4154 real(real64), intent(out), target, optional, dimension(:) :: work
    -
    4155 integer(int32), intent(out), optional :: olwork
    -
    4156 class(errors), intent(inout), optional, target :: err
    -
    4157 end subroutine
    -
    4158
    -
    4188 module subroutine solve_qr_no_pivot_vec_cmplx(a, tau, b, work, olwork, err)
    -
    4189 complex(real64), intent(inout), dimension(:,:) :: a
    -
    4190 complex(real64), intent(in), dimension(:) :: tau
    -
    4191 complex(real64), intent(inout), dimension(:) :: b
    -
    4192 complex(real64), intent(out), target, optional, dimension(:) :: work
    -
    4193 integer(int32), intent(out), optional :: olwork
    -
    4194 class(errors), intent(inout), optional, target :: err
    -
    4195 end subroutine
    -
    4196
    -
    4228 module subroutine solve_qr_pivot_mtx(a, tau, jpvt, b, work, olwork, err)
    -
    4229 real(real64), intent(inout), dimension(:,:) :: a
    -
    4230 real(real64), intent(in), dimension(:) :: tau
    -
    4231 integer(int32), intent(in), dimension(:) :: jpvt
    -
    4232 real(real64), intent(inout), dimension(:,:) :: b
    -
    4233 real(real64), intent(out), target, optional, dimension(:) :: work
    -
    4234 integer(int32), intent(out), optional :: olwork
    -
    4235 class(errors), intent(inout), optional, target :: err
    -
    4236 end subroutine
    -
    4237
    -
    4269 module subroutine solve_qr_pivot_mtx_cmplx(a, tau, jpvt, b, work, olwork, err)
    -
    4270 complex(real64), intent(inout), dimension(:,:) :: a
    -
    4271 complex(real64), intent(in), dimension(:) :: tau
    -
    4272 integer(int32), intent(in), dimension(:) :: jpvt
    -
    4273 complex(real64), intent(inout), dimension(:,:) :: b
    -
    4274 complex(real64), intent(out), target, optional, dimension(:) :: work
    -
    4275 integer(int32), intent(out), optional :: olwork
    -
    4276 class(errors), intent(inout), optional, target :: err
    -
    4277 end subroutine
    -
    4278
    -
    4310 module subroutine solve_qr_pivot_vec(a, tau, jpvt, b, work, olwork, err)
    -
    4311 real(real64), intent(inout), dimension(:,:) :: a
    -
    4312 real(real64), intent(in), dimension(:) :: tau
    -
    4313 integer(int32), intent(in), dimension(:) :: jpvt
    -
    4314 real(real64), intent(inout), dimension(:) :: b
    -
    4315 real(real64), intent(out), target, optional, dimension(:) :: work
    -
    4316 integer(int32), intent(out), optional :: olwork
    -
    4317 class(errors), intent(inout), optional, target :: err
    -
    4318 end subroutine
    -
    4319
    -
    4351 module subroutine solve_qr_pivot_vec_cmplx(a, tau, jpvt, b, work, olwork, err)
    -
    4352 complex(real64), intent(inout), dimension(:,:) :: a
    -
    4353 complex(real64), intent(in), dimension(:) :: tau
    -
    4354 integer(int32), intent(in), dimension(:) :: jpvt
    -
    4355 complex(real64), intent(inout), dimension(:) :: b
    -
    4356 complex(real64), intent(out), target, optional, dimension(:) :: work
    -
    4357 integer(int32), intent(out), optional :: olwork
    -
    4358 class(errors), intent(inout), optional, target :: err
    -
    4359 end subroutine
    -
    4360
    -
    4379 module subroutine solve_cholesky_mtx(upper, a, b, err)
    -
    4380 logical, intent(in) :: upper
    -
    4381 real(real64), intent(in), dimension(:,:) :: a
    -
    4382 real(real64), intent(inout), dimension(:,:) :: b
    -
    4383 class(errors), intent(inout), optional, target :: err
    -
    4384 end subroutine
    -
    4385
    -
    4404 module subroutine solve_cholesky_mtx_cmplx(upper, a, b, err)
    -
    4405 logical, intent(in) :: upper
    -
    4406 complex(real64), intent(in), dimension(:,:) :: a
    -
    4407 complex(real64), intent(inout), dimension(:,:) :: b
    -
    4408 class(errors), intent(inout), optional, target :: err
    -
    4409 end subroutine
    -
    4410
    -
    4429 module subroutine solve_cholesky_vec(upper, a, b, err)
    -
    4430 logical, intent(in) :: upper
    -
    4431 real(real64), intent(in), dimension(:,:) :: a
    -
    4432 real(real64), intent(inout), dimension(:) :: b
    -
    4433 class(errors), intent(inout), optional, target :: err
    -
    4434 end subroutine
    -
    4435
    -
    4454 module subroutine solve_cholesky_vec_cmplx(upper, a, b, err)
    -
    4455 logical, intent(in) :: upper
    -
    4456 complex(real64), intent(in), dimension(:,:) :: a
    -
    4457 complex(real64), intent(inout), dimension(:) :: b
    -
    4458 class(errors), intent(inout), optional, target :: err
    -
    4459 end subroutine
    -
    4460
    -
    4492 module subroutine solve_least_squares_mtx(a, b, work, olwork, err)
    -
    4493 real(real64), intent(inout), dimension(:,:) :: a, b
    -
    4494 real(real64), intent(out), target, optional, dimension(:) :: work
    -
    4495 integer(int32), intent(out), optional :: olwork
    -
    4496 class(errors), intent(inout), optional, target :: err
    -
    4497 end subroutine
    -
    4498
    -
    4530 module subroutine solve_least_squares_mtx_cmplx(a, b, work, olwork, err)
    -
    4531 complex(real64), intent(inout), dimension(:,:) :: a, b
    -
    4532 complex(real64), intent(out), target, optional, dimension(:) :: work
    -
    4533 integer(int32), intent(out), optional :: olwork
    -
    4534 class(errors), intent(inout), optional, target :: err
    -
    4535 end subroutine
    -
    4536
    -
    4568 module subroutine solve_least_squares_vec(a, b, work, olwork, err)
    -
    4569 real(real64), intent(inout), dimension(:,:) :: a
    -
    4570 real(real64), intent(inout), dimension(:) :: b
    -
    4571 real(real64), intent(out), target, optional, dimension(:) :: work
    -
    4572 integer(int32), intent(out), optional :: olwork
    -
    4573 class(errors), intent(inout), optional, target :: err
    -
    4574 end subroutine
    -
    4575
    -
    4607 module subroutine solve_least_squares_vec_cmplx(a, b, work, olwork, err)
    -
    4608 complex(real64), intent(inout), dimension(:,:) :: a
    -
    4609 complex(real64), intent(inout), dimension(:) :: b
    -
    4610 complex(real64), intent(out), target, optional, dimension(:) :: work
    +
    4055 module subroutine solve_qr_pivot_vec_cmplx(a, tau, jpvt, b, work, olwork, err)
    +
    4056 complex(real64), intent(inout), dimension(:,:) :: a
    +
    4057 complex(real64), intent(in), dimension(:) :: tau
    +
    4058 integer(int32), intent(in), dimension(:) :: jpvt
    +
    4059 complex(real64), intent(inout), dimension(:) :: b
    +
    4060 complex(real64), intent(out), target, optional, dimension(:) :: work
    +
    4061 integer(int32), intent(out), optional :: olwork
    +
    4062 class(errors), intent(inout), optional, target :: err
    +
    4063 end subroutine
    +
    4064
    +
    4083 module subroutine solve_cholesky_mtx(upper, a, b, err)
    +
    4084 logical, intent(in) :: upper
    +
    4085 real(real64), intent(in), dimension(:,:) :: a
    +
    4086 real(real64), intent(inout), dimension(:,:) :: b
    +
    4087 class(errors), intent(inout), optional, target :: err
    +
    4088 end subroutine
    +
    4089
    +
    4108 module subroutine solve_cholesky_mtx_cmplx(upper, a, b, err)
    +
    4109 logical, intent(in) :: upper
    +
    4110 complex(real64), intent(in), dimension(:,:) :: a
    +
    4111 complex(real64), intent(inout), dimension(:,:) :: b
    +
    4112 class(errors), intent(inout), optional, target :: err
    +
    4113 end subroutine
    +
    4114
    +
    4133 module subroutine solve_cholesky_vec(upper, a, b, err)
    +
    4134 logical, intent(in) :: upper
    +
    4135 real(real64), intent(in), dimension(:,:) :: a
    +
    4136 real(real64), intent(inout), dimension(:) :: b
    +
    4137 class(errors), intent(inout), optional, target :: err
    +
    4138 end subroutine
    +
    4139
    +
    4158 module subroutine solve_cholesky_vec_cmplx(upper, a, b, err)
    +
    4159 logical, intent(in) :: upper
    +
    4160 complex(real64), intent(in), dimension(:,:) :: a
    +
    4161 complex(real64), intent(inout), dimension(:) :: b
    +
    4162 class(errors), intent(inout), optional, target :: err
    +
    4163 end subroutine
    +
    4164
    +
    4196 module subroutine solve_least_squares_mtx(a, b, work, olwork, err)
    +
    4197 real(real64), intent(inout), dimension(:,:) :: a, b
    +
    4198 real(real64), intent(out), target, optional, dimension(:) :: work
    +
    4199 integer(int32), intent(out), optional :: olwork
    +
    4200 class(errors), intent(inout), optional, target :: err
    +
    4201 end subroutine
    +
    4202
    +
    4234 module subroutine solve_least_squares_mtx_cmplx(a, b, work, olwork, err)
    +
    4235 complex(real64), intent(inout), dimension(:,:) :: a, b
    +
    4236 complex(real64), intent(out), target, optional, dimension(:) :: work
    +
    4237 integer(int32), intent(out), optional :: olwork
    +
    4238 class(errors), intent(inout), optional, target :: err
    +
    4239 end subroutine
    +
    4240
    +
    4272 module subroutine solve_least_squares_vec(a, b, work, olwork, err)
    +
    4273 real(real64), intent(inout), dimension(:,:) :: a
    +
    4274 real(real64), intent(inout), dimension(:) :: b
    +
    4275 real(real64), intent(out), target, optional, dimension(:) :: work
    +
    4276 integer(int32), intent(out), optional :: olwork
    +
    4277 class(errors), intent(inout), optional, target :: err
    +
    4278 end subroutine
    +
    4279
    +
    4311 module subroutine solve_least_squares_vec_cmplx(a, b, work, olwork, err)
    +
    4312 complex(real64), intent(inout), dimension(:,:) :: a
    +
    4313 complex(real64), intent(inout), dimension(:) :: b
    +
    4314 complex(real64), intent(out), target, optional, dimension(:) :: work
    +
    4315 integer(int32), intent(out), optional :: olwork
    +
    4316 class(errors), intent(inout), optional, target :: err
    +
    4317 end subroutine
    +
    4318
    +
    4356 module subroutine solve_least_squares_mtx_pvt(a, b, ipvt, arnk, work, olwork, err)
    +
    4357 real(real64), intent(inout), dimension(:,:) :: a, b
    +
    4358 integer(int32), intent(inout), target, optional, dimension(:) :: ipvt
    +
    4359 integer(int32), intent(out), optional :: arnk
    +
    4360 real(real64), intent(out), target, optional, dimension(:) :: work
    +
    4361 integer(int32), intent(out), optional :: olwork
    +
    4362 class(errors), intent(inout), optional, target :: err
    +
    4363 end subroutine
    +
    4364
    +
    4406 module subroutine solve_least_squares_mtx_pvt_cmplx(a, b, ipvt, arnk, &
    +
    4407 work, olwork, rwork, err)
    +
    4408 complex(real64), intent(inout), dimension(:,:) :: a, b
    +
    4409 integer(int32), intent(inout), target, optional, dimension(:) :: ipvt
    +
    4410 integer(int32), intent(out), optional :: arnk
    +
    4411 complex(real64), intent(out), target, optional, dimension(:) :: work
    +
    4412 integer(int32), intent(out), optional :: olwork
    +
    4413 real(real64), intent(out), target, optional, dimension(:) :: rwork
    +
    4414 class(errors), intent(inout), optional, target :: err
    +
    4415 end subroutine
    +
    4416
    +
    4454 module subroutine solve_least_squares_vec_pvt(a, b, ipvt, arnk, work, olwork, err)
    +
    4455 real(real64), intent(inout), dimension(:,:) :: a
    +
    4456 real(real64), intent(inout), dimension(:) :: b
    +
    4457 integer(int32), intent(inout), target, optional, dimension(:) :: ipvt
    +
    4458 integer(int32), intent(out), optional :: arnk
    +
    4459 real(real64), intent(out), target, optional, dimension(:) :: work
    +
    4460 integer(int32), intent(out), optional :: olwork
    +
    4461 class(errors), intent(inout), optional, target :: err
    +
    4462 end subroutine
    +
    4463
    +
    4505 module subroutine solve_least_squares_vec_pvt_cmplx(a, b, ipvt, arnk, &
    +
    4506 work, olwork, rwork, err)
    +
    4507 complex(real64), intent(inout), dimension(:,:) :: a
    +
    4508 complex(real64), intent(inout), dimension(:) :: b
    +
    4509 integer(int32), intent(inout), target, optional, dimension(:) :: ipvt
    +
    4510 integer(int32), intent(out), optional :: arnk
    +
    4511 complex(real64), intent(out), target, optional, dimension(:) :: work
    +
    4512 integer(int32), intent(out), optional :: olwork
    +
    4513 real(real64), intent(out), target, optional, dimension(:) :: rwork
    +
    4514 class(errors), intent(inout), optional, target :: err
    +
    4515 end subroutine
    +
    4516
    +
    4555 module subroutine solve_least_squares_mtx_svd(a, b, s, arnk, work, olwork, err)
    +
    4556 real(real64), intent(inout), dimension(:,:) :: a, b
    +
    4557 integer(int32), intent(out), optional :: arnk
    +
    4558 real(real64), intent(out), target, optional, dimension(:) :: work, s
    +
    4559 integer(int32), intent(out), optional :: olwork
    +
    4560 class(errors), intent(inout), optional, target :: err
    +
    4561 end subroutine
    +
    4562
    +
    4605 module subroutine solve_least_squares_mtx_svd_cmplx(a, b, s, arnk, work, &
    +
    4606 olwork, rwork, err)
    +
    4607 complex(real64), intent(inout), dimension(:,:) :: a, b
    +
    4608 integer(int32), intent(out), optional :: arnk
    +
    4609 complex(real64), intent(out), target, optional, dimension(:) :: work
    +
    4610 real(real64), intent(out), target, optional, dimension(:) :: rwork, s
    4611 integer(int32), intent(out), optional :: olwork
    4612 class(errors), intent(inout), optional, target :: err
    4613 end subroutine
    4614
    -
    4652 module subroutine solve_least_squares_mtx_pvt(a, b, ipvt, arnk, work, olwork, err)
    -
    4653 real(real64), intent(inout), dimension(:,:) :: a, b
    -
    4654 integer(int32), intent(inout), target, optional, dimension(:) :: ipvt
    -
    4655 integer(int32), intent(out), optional :: arnk
    -
    4656 real(real64), intent(out), target, optional, dimension(:) :: work
    -
    4657 integer(int32), intent(out), optional :: olwork
    -
    4658 class(errors), intent(inout), optional, target :: err
    -
    4659 end subroutine
    -
    4660
    -
    4702 module subroutine solve_least_squares_mtx_pvt_cmplx(a, b, ipvt, arnk, &
    -
    4703 work, olwork, rwork, err)
    -
    4704 complex(real64), intent(inout), dimension(:,:) :: a, b
    -
    4705 integer(int32), intent(inout), target, optional, dimension(:) :: ipvt
    -
    4706 integer(int32), intent(out), optional :: arnk
    -
    4707 complex(real64), intent(out), target, optional, dimension(:) :: work
    -
    4708 integer(int32), intent(out), optional :: olwork
    -
    4709 real(real64), intent(out), target, optional, dimension(:) :: rwork
    -
    4710 class(errors), intent(inout), optional, target :: err
    -
    4711 end subroutine
    -
    4712
    -
    4750 module subroutine solve_least_squares_vec_pvt(a, b, ipvt, arnk, work, olwork, err)
    -
    4751 real(real64), intent(inout), dimension(:,:) :: a
    -
    4752 real(real64), intent(inout), dimension(:) :: b
    -
    4753 integer(int32), intent(inout), target, optional, dimension(:) :: ipvt
    -
    4754 integer(int32), intent(out), optional :: arnk
    -
    4755 real(real64), intent(out), target, optional, dimension(:) :: work
    -
    4756 integer(int32), intent(out), optional :: olwork
    -
    4757 class(errors), intent(inout), optional, target :: err
    -
    4758 end subroutine
    -
    4759
    -
    4801 module subroutine solve_least_squares_vec_pvt_cmplx(a, b, ipvt, arnk, &
    -
    4802 work, olwork, rwork, err)
    -
    4803 complex(real64), intent(inout), dimension(:,:) :: a
    -
    4804 complex(real64), intent(inout), dimension(:) :: b
    -
    4805 integer(int32), intent(inout), target, optional, dimension(:) :: ipvt
    -
    4806 integer(int32), intent(out), optional :: arnk
    -
    4807 complex(real64), intent(out), target, optional, dimension(:) :: work
    -
    4808 integer(int32), intent(out), optional :: olwork
    -
    4809 real(real64), intent(out), target, optional, dimension(:) :: rwork
    -
    4810 class(errors), intent(inout), optional, target :: err
    -
    4811 end subroutine
    -
    4812
    -
    4851 module subroutine solve_least_squares_mtx_svd(a, b, s, arnk, work, olwork, err)
    -
    4852 real(real64), intent(inout), dimension(:,:) :: a, b
    -
    4853 integer(int32), intent(out), optional :: arnk
    -
    4854 real(real64), intent(out), target, optional, dimension(:) :: work, s
    -
    4855 integer(int32), intent(out), optional :: olwork
    -
    4856 class(errors), intent(inout), optional, target :: err
    -
    4857 end subroutine
    -
    4858
    -
    4901 module subroutine solve_least_squares_mtx_svd_cmplx(a, b, s, arnk, work, &
    -
    4902 olwork, rwork, err)
    -
    4903 complex(real64), intent(inout), dimension(:,:) :: a, b
    -
    4904 integer(int32), intent(out), optional :: arnk
    -
    4905 complex(real64), intent(out), target, optional, dimension(:) :: work
    -
    4906 real(real64), intent(out), target, optional, dimension(:) :: rwork, s
    -
    4907 integer(int32), intent(out), optional :: olwork
    -
    4908 class(errors), intent(inout), optional, target :: err
    -
    4909 end subroutine
    -
    4910
    -
    4947 module subroutine solve_least_squares_vec_svd(a, b, s, arnk, work, olwork, err)
    -
    4948 real(real64), intent(inout), dimension(:,:) :: a
    -
    4949 real(real64), intent(inout), dimension(:) :: b
    -
    4950 integer(int32), intent(out), optional :: arnk
    -
    4951 real(real64), intent(out), target, optional, dimension(:) :: work, s
    -
    4952 integer(int32), intent(out), optional :: olwork
    -
    4953 class(errors), intent(inout), optional, target :: err
    -
    4954 end subroutine
    -
    4955
    -
    4996 module subroutine solve_least_squares_vec_svd_cmplx(a, b, s, arnk, work, &
    -
    4997 olwork, rwork, err)
    -
    4998 complex(real64), intent(inout), dimension(:,:) :: a
    -
    4999 complex(real64), intent(inout), dimension(:) :: b
    -
    5000 integer(int32), intent(out), optional :: arnk
    -
    5001 complex(real64), intent(out), target, optional, dimension(:) :: work
    -
    5002 real(real64), intent(out), target, optional, dimension(:) :: rwork, s
    -
    5003 integer(int32), intent(out), optional :: olwork
    -
    5004 class(errors), intent(inout), optional, target :: err
    -
    5005 end subroutine
    -
    5006
    -
    5038 module subroutine mtx_inverse_dbl(a, iwork, work, olwork, err)
    -
    5039 real(real64), intent(inout), dimension(:,:) :: a
    -
    5040 integer(int32), intent(out), target, optional, dimension(:) :: iwork
    -
    5041 real(real64), intent(out), target, optional, dimension(:) :: work
    -
    5042 integer(int32), intent(out), optional :: olwork
    -
    5043 class(errors), intent(inout), optional, target :: err
    -
    5044 end subroutine
    -
    5045
    -
    5077 module subroutine mtx_inverse_cmplx(a, iwork, work, olwork, err)
    -
    5078 complex(real64), intent(inout), dimension(:,:) :: a
    -
    5079 integer(int32), intent(out), target, optional, dimension(:) :: iwork
    -
    5080 complex(real64), intent(out), target, optional, dimension(:) :: work
    -
    5081 integer(int32), intent(out), optional :: olwork
    -
    5082 class(errors), intent(inout), optional, target :: err
    -
    5083 end subroutine
    -
    5084
    -
    5122 module subroutine mtx_pinverse_dbl(a, ainv, tol, work, olwork, err)
    -
    5123 real(real64), intent(inout), dimension(:,:) :: a
    -
    5124 real(real64), intent(out), dimension(:,:) :: ainv
    -
    5125 real(real64), intent(in), optional :: tol
    -
    5126 real(real64), intent(out), target, dimension(:), optional :: work
    -
    5127 integer(int32), intent(out), optional :: olwork
    -
    5128 class(errors), intent(inout), optional, target :: err
    -
    5129 end subroutine
    -
    5130
    -
    5172 module subroutine mtx_pinverse_cmplx(a, ainv, tol, work, olwork, rwork, err)
    -
    5173 complex(real64), intent(inout), dimension(:,:) :: a
    -
    5174 complex(real64), intent(out), dimension(:,:) :: ainv
    -
    5175 real(real64), intent(in), optional :: tol
    -
    5176 complex(real64), intent(out), target, dimension(:), optional :: work
    -
    5177 integer(int32), intent(out), optional :: olwork
    -
    5178 real(real64), intent(out), target, dimension(:), optional :: rwork
    -
    5179 class(errors), intent(inout), optional, target :: err
    -
    5180 end subroutine
    -
    5181
    -
    5182end interface
    -
    5183
    -
    5184! ******************************************************************************
    -
    5185! LINALG_EIGEN.F90
    -
    5186! ------------------------------------------------------------------------------
    -
    5187interface
    -
    5188
    -
    5220 module subroutine eigen_symm(vecs, a, vals, work, olwork, err)
    -
    5221 logical, intent(in) :: vecs
    -
    5222 real(real64), intent(inout), dimension(:,:) :: a
    -
    5223 real(real64), intent(out), dimension(:) :: vals
    -
    5224 real(real64), intent(out), pointer, optional, dimension(:) :: work
    -
    5225 integer(int32), intent(out), optional :: olwork
    +
    4651 module subroutine solve_least_squares_vec_svd(a, b, s, arnk, work, olwork, err)
    +
    4652 real(real64), intent(inout), dimension(:,:) :: a
    +
    4653 real(real64), intent(inout), dimension(:) :: b
    +
    4654 integer(int32), intent(out), optional :: arnk
    +
    4655 real(real64), intent(out), target, optional, dimension(:) :: work, s
    +
    4656 integer(int32), intent(out), optional :: olwork
    +
    4657 class(errors), intent(inout), optional, target :: err
    +
    4658 end subroutine
    +
    4659
    +
    4700 module subroutine solve_least_squares_vec_svd_cmplx(a, b, s, arnk, work, &
    +
    4701 olwork, rwork, err)
    +
    4702 complex(real64), intent(inout), dimension(:,:) :: a
    +
    4703 complex(real64), intent(inout), dimension(:) :: b
    +
    4704 integer(int32), intent(out), optional :: arnk
    +
    4705 complex(real64), intent(out), target, optional, dimension(:) :: work
    +
    4706 real(real64), intent(out), target, optional, dimension(:) :: rwork, s
    +
    4707 integer(int32), intent(out), optional :: olwork
    +
    4708 class(errors), intent(inout), optional, target :: err
    +
    4709 end subroutine
    +
    4710
    +
    4742 module subroutine mtx_inverse_dbl(a, iwork, work, olwork, err)
    +
    4743 real(real64), intent(inout), dimension(:,:) :: a
    +
    4744 integer(int32), intent(out), target, optional, dimension(:) :: iwork
    +
    4745 real(real64), intent(out), target, optional, dimension(:) :: work
    +
    4746 integer(int32), intent(out), optional :: olwork
    +
    4747 class(errors), intent(inout), optional, target :: err
    +
    4748 end subroutine
    +
    4749
    +
    4781 module subroutine mtx_inverse_cmplx(a, iwork, work, olwork, err)
    +
    4782 complex(real64), intent(inout), dimension(:,:) :: a
    +
    4783 integer(int32), intent(out), target, optional, dimension(:) :: iwork
    +
    4784 complex(real64), intent(out), target, optional, dimension(:) :: work
    +
    4785 integer(int32), intent(out), optional :: olwork
    +
    4786 class(errors), intent(inout), optional, target :: err
    +
    4787 end subroutine
    +
    4788
    +
    4826 module subroutine mtx_pinverse_dbl(a, ainv, tol, work, olwork, err)
    +
    4827 real(real64), intent(inout), dimension(:,:) :: a
    +
    4828 real(real64), intent(out), dimension(:,:) :: ainv
    +
    4829 real(real64), intent(in), optional :: tol
    +
    4830 real(real64), intent(out), target, dimension(:), optional :: work
    +
    4831 integer(int32), intent(out), optional :: olwork
    +
    4832 class(errors), intent(inout), optional, target :: err
    +
    4833 end subroutine
    +
    4834
    +
    4876 module subroutine mtx_pinverse_cmplx(a, ainv, tol, work, olwork, rwork, err)
    +
    4877 complex(real64), intent(inout), dimension(:,:) :: a
    +
    4878 complex(real64), intent(out), dimension(:,:) :: ainv
    +
    4879 real(real64), intent(in), optional :: tol
    +
    4880 complex(real64), intent(out), target, dimension(:), optional :: work
    +
    4881 integer(int32), intent(out), optional :: olwork
    +
    4882 real(real64), intent(out), target, dimension(:), optional :: rwork
    +
    4883 class(errors), intent(inout), optional, target :: err
    +
    4884 end subroutine
    +
    4885
    +
    4886end interface
    +
    4887
    +
    4888! ******************************************************************************
    +
    4889! LINALG_EIGEN.F90
    +
    4890! ------------------------------------------------------------------------------
    +
    4891interface
    +
    4892
    +
    4924 module subroutine eigen_symm(vecs, a, vals, work, olwork, err)
    +
    4925 logical, intent(in) :: vecs
    +
    4926 real(real64), intent(inout), dimension(:,:) :: a
    +
    4927 real(real64), intent(out), dimension(:) :: vals
    +
    4928 real(real64), intent(out), pointer, optional, dimension(:) :: work
    +
    4929 integer(int32), intent(out), optional :: olwork
    +
    4930 class(errors), intent(inout), optional, target :: err
    +
    4931 end subroutine
    +
    4932
    +
    4963 module subroutine eigen_asymm(a, vals, vecs, work, olwork, err)
    +
    4964 real(real64), intent(inout), dimension(:,:) :: a
    +
    4965 complex(real64), intent(out), dimension(:) :: vals
    +
    4966 complex(real64), intent(out), optional, dimension(:,:) :: vecs
    +
    4967 real(real64), intent(out), pointer, optional, dimension(:) :: work
    +
    4968 integer(int32), intent(out), optional :: olwork
    +
    4969 class(errors), intent(inout), optional, target :: err
    +
    4970 end subroutine
    +
    4971
    +
    5014 module subroutine eigen_gen(a, b, alpha, beta, vecs, work, olwork, err)
    +
    5015 real(real64), intent(inout), dimension(:,:) :: a, b
    +
    5016 complex(real64), intent(out), dimension(:) :: alpha
    +
    5017 real(real64), intent(out), optional, dimension(:) :: beta
    +
    5018 complex(real64), intent(out), optional, dimension(:,:) :: vecs
    +
    5019 real(real64), intent(out), optional, pointer, dimension(:) :: work
    +
    5020 integer(int32), intent(out), optional :: olwork
    +
    5021 class(errors), intent(inout), optional, target :: err
    +
    5022 end subroutine
    +
    5023
    +
    5054 module subroutine eigen_cmplx(a, vals, vecs, work, olwork, rwork, err)
    +
    5055 complex(real64), intent(inout), dimension(:,:) :: a
    +
    5056 complex(real64), intent(out), dimension(:) :: vals
    +
    5057 complex(real64), intent(out), optional, dimension(:,:) :: vecs
    +
    5058 complex(real64), intent(out), target, optional, dimension(:) :: work
    +
    5059 real(real64), intent(out), target, optional, dimension(:) :: rwork
    +
    5060 integer(int32), intent(out), optional :: olwork
    +
    5061 class(errors), intent(inout), optional, target :: err
    +
    5062 end subroutine
    +
    5063end interface
    +
    5064
    +
    5065! ******************************************************************************
    +
    5066! LINALG_SORTING.F90
    +
    5067! ------------------------------------------------------------------------------
    +
    5068interface
    +
    5069
    +
    5084 module subroutine sort_dbl_array(x, ascend)
    +
    5085 real(real64), intent(inout), dimension(:) :: x
    +
    5086 logical, intent(in), optional :: ascend
    +
    5087 end subroutine
    +
    5088
    +
    5113 module subroutine sort_dbl_array_ind(x, ind, ascend, err)
    +
    5114 real(real64), intent(inout), dimension(:) :: x
    +
    5115 integer(int32), intent(inout), dimension(:) :: ind
    +
    5116 logical, intent(in), optional :: ascend
    +
    5117 class(errors), intent(inout), optional, target :: err
    +
    5118 end subroutine
    +
    5119
    +
    5136 module subroutine sort_cmplx_array(x, ascend)
    +
    5137 complex(real64), intent(inout), dimension(:) :: x
    +
    5138 logical, intent(in), optional :: ascend
    +
    5139 end subroutine
    +
    5140
    +
    5170 module subroutine sort_cmplx_array_ind(x, ind, ascend, err)
    +
    5171 complex(real64), intent(inout), dimension(:) :: x
    +
    5172 integer(int32), intent(inout), dimension(:) :: ind
    +
    5173 logical, intent(in), optional :: ascend
    +
    5174 class(errors), intent(inout), optional, target :: err
    +
    5175 end subroutine
    +
    5176
    +
    5196 module subroutine sort_eigen_cmplx(vals, vecs, ascend, err)
    +
    5197 complex(real64), intent(inout), dimension(:) :: vals
    +
    5198 complex(real64), intent(inout), dimension(:,:) :: vecs
    +
    5199 logical, intent(in), optional :: ascend
    +
    5200 class(errors), intent(inout), optional, target :: err
    +
    5201 end subroutine
    +
    5202
    +
    5222 module subroutine sort_eigen_dbl(vals, vecs, ascend, err)
    +
    5223 real(real64), intent(inout), dimension(:) :: vals
    +
    5224 real(real64), intent(inout), dimension(:,:) :: vecs
    +
    5225 logical, intent(in), optional :: ascend
    5226 class(errors), intent(inout), optional, target :: err
    5227 end subroutine
    5228
    -
    5259 module subroutine eigen_asymm(a, vals, vecs, work, olwork, err)
    -
    5260 real(real64), intent(inout), dimension(:,:) :: a
    -
    5261 complex(real64), intent(out), dimension(:) :: vals
    -
    5262 complex(real64), intent(out), optional, dimension(:,:) :: vecs
    -
    5263 real(real64), intent(out), pointer, optional, dimension(:) :: work
    -
    5264 integer(int32), intent(out), optional :: olwork
    -
    5265 class(errors), intent(inout), optional, target :: err
    -
    5266 end subroutine
    -
    5267
    -
    5310 module subroutine eigen_gen(a, b, alpha, beta, vecs, work, olwork, err)
    -
    5311 real(real64), intent(inout), dimension(:,:) :: a, b
    -
    5312 complex(real64), intent(out), dimension(:) :: alpha
    -
    5313 real(real64), intent(out), optional, dimension(:) :: beta
    -
    5314 complex(real64), intent(out), optional, dimension(:,:) :: vecs
    -
    5315 real(real64), intent(out), optional, pointer, dimension(:) :: work
    -
    5316 integer(int32), intent(out), optional :: olwork
    -
    5317 class(errors), intent(inout), optional, target :: err
    -
    5318 end subroutine
    -
    5319
    -
    5350 module subroutine eigen_cmplx(a, vals, vecs, work, olwork, rwork, err)
    -
    5351 complex(real64), intent(inout), dimension(:,:) :: a
    -
    5352 complex(real64), intent(out), dimension(:) :: vals
    -
    5353 complex(real64), intent(out), optional, dimension(:,:) :: vecs
    -
    5354 complex(real64), intent(out), target, optional, dimension(:) :: work
    -
    5355 real(real64), intent(out), target, optional, dimension(:) :: rwork
    -
    5356 integer(int32), intent(out), optional :: olwork
    -
    5357 class(errors), intent(inout), optional, target :: err
    -
    5358 end subroutine
    -
    5359end interface
    -
    5360
    -
    5361! ******************************************************************************
    -
    5362! LINALG_SORTING.F90
    -
    5363! ------------------------------------------------------------------------------
    -
    5364interface
    -
    5365
    -
    5380 module subroutine sort_dbl_array(x, ascend)
    -
    5381 real(real64), intent(inout), dimension(:) :: x
    -
    5382 logical, intent(in), optional :: ascend
    -
    5383 end subroutine
    -
    5384
    -
    5409 module subroutine sort_dbl_array_ind(x, ind, ascend, err)
    -
    5410 real(real64), intent(inout), dimension(:) :: x
    -
    5411 integer(int32), intent(inout), dimension(:) :: ind
    -
    5412 logical, intent(in), optional :: ascend
    -
    5413 class(errors), intent(inout), optional, target :: err
    -
    5414 end subroutine
    -
    5415
    -
    5432 module subroutine sort_cmplx_array(x, ascend)
    -
    5433 complex(real64), intent(inout), dimension(:) :: x
    -
    5434 logical, intent(in), optional :: ascend
    -
    5435 end subroutine
    -
    5436
    -
    5466 module subroutine sort_cmplx_array_ind(x, ind, ascend, err)
    -
    5467 complex(real64), intent(inout), dimension(:) :: x
    -
    5468 integer(int32), intent(inout), dimension(:) :: ind
    -
    5469 logical, intent(in), optional :: ascend
    -
    5470 class(errors), intent(inout), optional, target :: err
    -
    5471 end subroutine
    -
    5472
    -
    5492 module subroutine sort_eigen_cmplx(vals, vecs, ascend, err)
    -
    5493 complex(real64), intent(inout), dimension(:) :: vals
    -
    5494 complex(real64), intent(inout), dimension(:,:) :: vecs
    -
    5495 logical, intent(in), optional :: ascend
    -
    5496 class(errors), intent(inout), optional, target :: err
    -
    5497 end subroutine
    -
    5498
    -
    5518 module subroutine sort_eigen_dbl(vals, vecs, ascend, err)
    -
    5519 real(real64), intent(inout), dimension(:) :: vals
    -
    5520 real(real64), intent(inout), dimension(:,:) :: vecs
    -
    5521 logical, intent(in), optional :: ascend
    -
    5522 class(errors), intent(inout), optional, target :: err
    -
    5523 end subroutine
    -
    5524
    -
    5525end interface
    -
    5526
    -
    5527end module
    -
    Computes the Cholesky factorization of a symmetric, positive definite matrix.
    -
    Computes the rank 1 downdate to a Cholesky factored matrix (upper triangular).
    -
    Computes the rank 1 update to a Cholesky factored matrix (upper triangular).
    -
    Computes the determinant of a square matrix.
    -
    Multiplies a diagonal matrix with another matrix or array.
    -
    Computes the eigenvalues, and optionally the eigenvectors, of a matrix.
    -
    Extracts the L and U matrices from the condensed [L\U] storage format used by the lu_factor.
    -
    Forms the full M-by-M orthogonal matrix Q from the elementary reflectors returned by the base QR fact...
    -
    Computes the LU factorization of an M-by-N matrix.
    -
    Computes the inverse of a square matrix.
    +
    5229end interface
    +
    5230
    +
    5231end module
    +
    Computes the Cholesky factorization of a symmetric, positive definite matrix.
    +
    Computes the rank 1 downdate to a Cholesky factored matrix (upper triangular).
    +
    Computes the rank 1 update to a Cholesky factored matrix (upper triangular).
    +
    Computes the determinant of a square matrix.
    +
    Multiplies a diagonal matrix with another matrix or array.
    +
    Computes the eigenvalues, and optionally the eigenvectors, of a matrix.
    +
    Extracts the L and U matrices from the condensed [L\U] storage format used by the lu_factor.
    +
    Forms the full M-by-M orthogonal matrix Q from the elementary reflectors returned by the base QR fact...
    +
    Computes the LU factorization of an M-by-N matrix.
    +
    Computes the inverse of a square matrix.
    Performs the matrix operation: .
    -
    Computes the Moore-Penrose pseudo-inverse of a M-by-N matrix using the singular value decomposition o...
    -
    Computes the rank of a matrix.
    -
    Multiplies a general matrix by the orthogonal matrix Q from a QR factorization.
    -
    Multiplies a general matrix by the orthogonal matrix Z from an RZ factorization.
    -
    Computes the QR factorization of an M-by-N matrix.
    -
    Computes the rank 1 update to an M-by-N QR factored matrix A (M >= N) where A = Q * R,...
    +
    Computes the Moore-Penrose pseudo-inverse of a M-by-N matrix using the singular value decomposition o...
    +
    Computes the rank of a matrix.
    +
    Multiplies a general matrix by the orthogonal matrix Q from a QR factorization.
    +
    Multiplies a general matrix by the orthogonal matrix Z from an RZ factorization.
    +
    Computes the QR factorization of an M-by-N matrix.
    +
    Computes the rank 1 update to an M-by-N QR factored matrix A (M >= N) where A = Q * R,...
    Performs the rank-1 update to matrix A such that: , where is an M-by-N matrix, is a scalar,...
    -
    Multiplies a vector by the reciprocal of a real scalar.
    -
    Factors an upper trapezoidal matrix by means of orthogonal transformations such that A = R * Z = (R 0...
    -
    Solves a system of Cholesky factored equations.
    -
    Solves the overdetermined or underdetermined system (A*X = B) of M equations of N unknowns,...
    -
    Solves the overdetermined or underdetermined system (A*X = B) of M equations of N unknowns using a si...
    -
    Solves the overdetermined or underdetermined system (A*X = B) of M equations of N unknowns.
    -
    Solves a system of LU-factored equations.
    -
    Solves a system of M QR-factored equations of N unknowns.
    -
    Solves a triangular system of equations.
    -
    Sorts an array.
    -
    Computes the singular value decomposition of a matrix A. The SVD is defined as: A = U * S * V**T,...
    -
    Swaps the contents of two arrays.
    -
    Computes the trace of a matrix (the sum of the main diagonal elements).
    -
    Computes the triangular matrix operation: B = alpha * A**T * A + beta * B, or B = alpha * A * A**T + ...
    +
    Multiplies a vector by the reciprocal of a real scalar.
    +
    Factors an upper trapezoidal matrix by means of orthogonal transformations such that A = R * Z = (R 0...
    +
    Solves a system of Cholesky factored equations.
    +
    Solves the overdetermined or underdetermined system (A*X = B) of M equations of N unknowns,...
    +
    Solves the overdetermined or underdetermined system (A*X = B) of M equations of N unknowns using a si...
    +
    Solves the overdetermined or underdetermined system (A*X = B) of M equations of N unknowns.
    +
    Solves a system of LU-factored equations.
    +
    Solves a system of M QR-factored equations of N unknowns.
    +
    Solves a triangular system of equations.
    +
    Sorts an array.
    +
    Computes the singular value decomposition of a matrix A. The SVD is defined as: A = U * S * V**T,...
    +
    Swaps the contents of two arrays.
    +
    Computes the trace of a matrix (the sum of the main diagonal elements).
    +
    Computes the triangular matrix operation: , or , where A is a triangular matrix.
    Provides a set of constants and error flags for the library.
    Provides a set of common linear algebra routines.
    Definition: linalg_core.f90:15
    diff --git a/doc/html/linalg__immutable_8f90_source.html b/doc/html/linalg__immutable_8f90_source.html index 938b7dc7..ed9f7e9d 100644 --- a/doc/html/linalg__immutable_8f90_source.html +++ b/doc/html/linalg__immutable_8f90_source.html @@ -845,23 +845,23 @@
    1030 end function
    1031
    1032end module
    -
    Computes the Cholesky factorization of a symmetric, positive definite matrix.
    -
    Computes the rank 1 downdate to a Cholesky factored matrix (upper triangular).
    -
    Computes the rank 1 update to a Cholesky factored matrix (upper triangular).
    -
    Computes the determinant of a square matrix.
    -
    Multiplies a diagonal matrix with another matrix or array.
    -
    Computes the eigenvalues, and optionally the eigenvectors, of a matrix.
    -
    Extracts the L and U matrices from the condensed [L\U] storage format used by the lu_factor.
    -
    Forms the full M-by-M orthogonal matrix Q from the elementary reflectors returned by the base QR fact...
    -
    Computes the LU factorization of an M-by-N matrix.
    -
    Computes the inverse of a square matrix.
    -
    Computes the Moore-Penrose pseudo-inverse of a M-by-N matrix using the singular value decomposition o...
    -
    Computes the QR factorization of an M-by-N matrix.
    -
    Computes the rank 1 update to an M-by-N QR factored matrix A (M >= N) where A = Q * R,...
    +
    Computes the Cholesky factorization of a symmetric, positive definite matrix.
    +
    Computes the rank 1 downdate to a Cholesky factored matrix (upper triangular).
    +
    Computes the rank 1 update to a Cholesky factored matrix (upper triangular).
    +
    Computes the determinant of a square matrix.
    +
    Multiplies a diagonal matrix with another matrix or array.
    +
    Computes the eigenvalues, and optionally the eigenvectors, of a matrix.
    +
    Extracts the L and U matrices from the condensed [L\U] storage format used by the lu_factor.
    +
    Forms the full M-by-M orthogonal matrix Q from the elementary reflectors returned by the base QR fact...
    +
    Computes the LU factorization of an M-by-N matrix.
    +
    Computes the inverse of a square matrix.
    +
    Computes the Moore-Penrose pseudo-inverse of a M-by-N matrix using the singular value decomposition o...
    +
    Computes the QR factorization of an M-by-N matrix.
    +
    Computes the rank 1 update to an M-by-N QR factored matrix A (M >= N) where A = Q * R,...
    Performs the rank-1 update to matrix A such that: , where is an M-by-N matrix, is a scalar,...
    -
    Solves a triangular system of equations.
    -
    Sorts an array.
    -
    Computes the singular value decomposition of a matrix A. The SVD is defined as: A = U * S * V**T,...
    +
    Solves a triangular system of equations.
    +
    Sorts an array.
    +
    Computes the singular value decomposition of a matrix A. The SVD is defined as: A = U * S * V**T,...
    Computes the eigenvalues and eigenvectors (right) of a general N-by-N matrix.
    Computes the LU factorization of a square matrix. Notice, partial row pivoting is utilized.
    Computes the matrix operation: C = A * B, where A is a diagonal matrix.
    diff --git a/doc/html/namespacelinalg__core.html b/doc/html/namespacelinalg__core.html index 0065f41b..762e0371 100644 --- a/doc/html/namespacelinalg__core.html +++ b/doc/html/namespacelinalg__core.html @@ -202,7 +202,7 @@
     Computes the trace of a matrix (the sum of the main diagonal elements). More...
     
    interface  tri_mtx_mult
     Computes the triangular matrix operation: B = alpha * A**T * A + beta * B, or B = alpha * A * A**T + beta * B, where A is a triangular matrix. More...
     Computes the triangular matrix operation: \( B = \alpha A^T A + \beta B \), or \( B = \alpha A A^T + \beta B \), where A is a triangular matrix. More...
     

    Detailed Description

    diff --git a/doc/html/namespaces.html b/doc/html/namespaces.html index c9685e12..7f01c29b 100644 --- a/doc/html/namespaces.html +++ b/doc/html/namespaces.html @@ -136,7 +136,7 @@  CsvdComputes the singular value decomposition of a matrix A. The SVD is defined as: A = U * S * V**T, where U is an M-by-M orthogonal matrix, S is an M-by-N diagonal matrix, and V is an N-by-N orthogonal matrix  CswapSwaps the contents of two arrays  CtraceComputes the trace of a matrix (the sum of the main diagonal elements) - Ctri_mtx_multComputes the triangular matrix operation: B = alpha * A**T * A + beta * B, or B = alpha * A * A**T + beta * B, where A is a triangular matrix + Ctri_mtx_multComputes the triangular matrix operation: \( B = \alpha A^T A + \beta B \), or \( B = \alpha A A^T + \beta B \), where A is a triangular matrix  Nlinalg_immutableProvides an immutable interface to many of the core linear algebra routines in this library. The intent is to allow for ease of use in situations where memory allocation, or absolute speed are of lesser importance to code readability  Ceigen_resultsDefines a container for the output of an Eigen analysis of a square matrix  Clu_resultsDefines a container for the output of an LU factorization diff --git a/src/linalg_core.f90 b/src/linalg_core.f90 index 65057c4a..3f3bf484 100644 --- a/src/linalg_core.f90 +++ b/src/linalg_core.f90 @@ -189,7 +189,7 @@ module linalg_core !! @param[in] beta A scalar multiplier. !! @param[in,out] c On input, the M-by-N matrix C. On output, the resulting !! M-by-N matrix. -!! @param[out] err An optional errors-based object that if provided can be +!! @param[in,out] err An optional errors-based object that if provided can be !! used to retrieve information relating to any errors encountered during !! execution. If not provided, a default implementation of the errors !! class is used internally to provide error handling. Possible errors and @@ -214,7 +214,7 @@ module linalg_core !! false, K = MIN(N,P). !! @param[in] b On input, the M-by-N matrix B. On output, the resulting !! M-by-N matrix. -!! @param[out] err An optional errors-based object that if provided can be +!! @param[in,out] err An optional errors-based object that if provided can be !! used to retrieve information relating to any errors encountered during !! execution. If not provided, a default implementation of the errors !! class is used internally to provide error handling. Possible errors and @@ -260,7 +260,7 @@ module linalg_core !! print *, vt(i,:) !! end do !! -!! ! Compute U * S * V**T, but first establish S in full form +!! ! Compute U * S * V**T !! call diag_mtx_mult(.true., 1.0d0, s, vt) ! Compute: VT = S * V**T !! ac = matmul(u(:,1:2), vt) !! print '(A)', "U * S * V**T =" @@ -300,6 +300,16 @@ module linalg_core ! ------------------------------------------------------------------------------ !> @brief Computes the trace of a matrix (the sum of the main diagonal !! elements). +!! +!! @par Syntax +!! @code{.f90} +!! real(real64) function trace(real(real64) x(:,:)) +!! complex(real64) function trace(complex(real64) x(:,:)) +!! @endcode +!! +!! @param[in] x The matrix on which to operate. +!! +!! @return The trace of @p x. interface trace module procedure :: trace_dbl module procedure :: trace_cmplx @@ -307,6 +317,47 @@ module linalg_core ! ------------------------------------------------------------------------------ !> @brief Computes the rank of a matrix. +!! +!! @par Syntax +!! @code{.f90} +!! integer(int32) function mtx_rank(real(real64) a(:,:), optional real(real64) tol, optional real(real64) work(:), optional integer(int32) olwork, optional class(errors) err) +!! integer(int32) function mtx_rank(complex(real64) a(:,:), optional real(real64) tol, optional complex(real64) work(:), optional integer(int32) olwork, optional real(real64) rwork(:), optional class(errors) err) +!! @endcode +!! +!! @param[in,out] a On input, the M-by-N matrix of interest. On output, the +!! contents of the matrix are overwritten. +!! @param[in] tol An optional input, that if supplied, overrides the default +!! tolerance on singular values such that singular values less than this +!! tolerance are treated as zero. The default tolerance is: +!! MAX(M, N) * EPS * MAX(S). If the supplied value is less than the +!! smallest value that causes an overflow if inverted, the tolerance +!! reverts back to its default value, and the operation continues; however, +!! a warning message is issued. +!! @param[out] work An optional input, that if provided, prevents any local +!! memory allocation. If not provided, the memory required is allocated +!! within. If provided, the length of the array must be at least +!! @p olwork. +!! @param[out] olwork An optional output used to determine workspace size. +!! If supplied, the routine determines the optimal size for @p work, and +!! returns without performing any actual calculations. +!! @param[out] rwork An optional input, that if provided, prevents any +!! local memory allocation for real-valued workspace arrays. If not +!! provided, the memory required is allocated within. If provided, the +!! length of the array must be at least 6 * MIN(M, N). +!! @param[in,out] err An optional errors-based object that if provided can be +!! used to retrieve information relating to any errors encountered during +!! execution. If not provided, a default implementation of the errors +!! class is used internally to provide error handling. Possible errors and +!! warning messages that may be encountered are as follows. +!! - LA_ARRAY_SIZE_ERROR: Occurs if any of the input arrays are not sized +!! appropriately. +!! - LA_OUT_OF_MEMORY_ERROR: Occurs if local memory must be allocated, and +!! there is insufficient memory available. +!! - LA_CONVERGENCE_ERROR: Occurs as a warning if the QR iteration process +!! could not converge to a zero value. +!! +!! @par See Also +!! - [Wolfram MathWorld](http://mathworld.wolfram.com/MatrixRank.html) interface mtx_rank module procedure :: mtx_rank_dbl module procedure :: mtx_rank_cmplx @@ -314,6 +365,32 @@ module linalg_core ! ------------------------------------------------------------------------------ !> @brief Computes the determinant of a square matrix. +!! +!! @par Syntax +!! @code{.f90} +!! real(real64) function det(real(real64) a(:,:), optional integer(int32) iwork(:), optional class(errors) err) +!! complex(real64) function det(complex(real64) a(:,:), optional integer(int32) iwork(:), optional class(errors) err) +!! @endcode +!! +!! +!! @param[in,out] a On input, the N-by-N matrix on which to operate. On +!! output the contents are overwritten by the LU factorization of the +!! original matrix. +!! @param[out] iwork An optional input, that if provided, prevents any local +!! memory allocation. If not provided, the memory required is allocated +!! within. If provided, the length of the array must be at least +!! N-elements. +!! @param[in,out] err An optional errors-based object that if provided can be +!! used to retrieve information relating to any errors encountered during +!! execution. If not provided, a default implementation of the errors +!! class is used internally to provide error handling. Possible errors and +!! warning messages that may be encountered are as follows. +!! - LA_ARRAY_SIZE_ERROR: Occurs if any of the input arrays are not sized +!! appropriately. +!! - LA_OUT_OF_MEMORY_ERROR: Occurs if local memory must be allocated, and +!! there is insufficient memory available. +!! +!! @return The determinant of @p a. interface det module procedure :: det_dbl module procedure :: det_cmplx @@ -321,6 +398,21 @@ module linalg_core ! ------------------------------------------------------------------------------ !> @brief Swaps the contents of two arrays. +!! +!! @par Syntax +!! @code{.f90} +!! subroutine swap(real(real64) x(:), real(real64) y(:), optional class(errors) err) +!! subroutine swap(complex(real64) x(:), complex(real64) y(:), optional class(errors) err) +!! @endcode +!! +!! @param[in,out] x One of the N-element arrays. +!! @param[in,out] y The other N-element array. +!! @param[in,out] err An optional errors-based object that if provided can be +!! used to retrieve information relating to any errors encountered during +!! execution. If not provided, a default implementation of the errors +!! class is used internally to provide error handling. Possible errors and +!! warning messages that may be encountered are as follows. +!! - LA_ARRAY_SIZE_ERROR: Occurs if @p x and @p y are not the same size. interface swap module procedure :: swap_dbl module procedure :: swap_cmplx @@ -328,14 +420,52 @@ module linalg_core ! ------------------------------------------------------------------------------ !> @brief Multiplies a vector by the reciprocal of a real scalar. +!! +!! @par Syntax +!! @code{.f90} +!! subroutine recip_mult_array(real(real64) a, real(real64) x(:)) +!! @endcode +!! +!! @param[in] a The scalar which is used to divide each component of @p X. +!! The value must be >= 0, or the subroutine will divide by zero. +!! @param[in,out] x The vector. +!! +!! @par Notes +!! This routine is based upon the LAPACK routine DRSCL. interface recip_mult_array module procedure :: recip_mult_array_dbl end interface ! ------------------------------------------------------------------------------ !> @brief Computes the triangular matrix operation: -!! B = alpha * A**T * A + beta * B, or B = alpha * A * A**T + beta * B, +!! \f$ B = \alpha A^T A + \beta B \f$, or \f$ B = \alpha A A^T + \beta B \f$, !! where A is a triangular matrix. +!! +!! @par Syntax +!! @code{.f90} +!! subroutine tri_mtx_mult(logical upper, real(real64) alpha, real(real64) a(:,:), real(real64) beta, real(real64) b(:,:), optional class(errors) err) +!! subroutine tri_mtx_mult(logical upper, complex(real64) alpha, complex(real64) a(:,:), complex(real64) beta, complex(real64) b(:,:), optional class(errors) err) +!! @endcode +!! +!! @param[in] upper Set to true if matrix A is upper triangular, and +!! \f$ B = \alpha A^T A + \beta B \f$ is to be calculated; else, set to false +!! if A is lower triangular, and \f$ B = \alpha A A^T + \beta B \f$ is to +!! be computed. +!! @param[in] alpha A scalar multiplier. +!! @param[in] a The N-by-N triangular matrix. Notice, if @p upper is true +!! only the upper triangular portion of this matrix is referenced; else, +!! if @p upper is false, only the lower triangular portion of this matrix +!! is referenced. +!! @param[in] beta A scalar multiplier. +!! @param[in,out] b On input, the N-by-N matrix B. On output, the N-by-N +!! solution matrix. +!! @param[in,out] err An optional errors-based object that if provided can be +!! used to retrieve information relating to any errors encountered during +!! execution. If not provided, a default implementation of the errors +!! class is used internally to provide error handling. Possible errors and +!! warning messages that may be encountered are as follows. +!! - LA_ARRAY_SIZE_ERROR: Occurs if any of the input arrays are not sized +!! appropriately. interface tri_mtx_mult module procedure :: tri_mtx_mult_dbl module procedure :: tri_mtx_mult_cmplx @@ -344,6 +474,34 @@ module linalg_core ! ------------------------------------------------------------------------------ !> @brief Computes the LU factorization of an M-by-N matrix. !! +!! @par Syntax +!! @code{.f90} +!! subroutine lu_factor(real(real64) a(:,:), integer(int32) ipvt(:), optional class(errors)) +!! subroutine lu_factor(complex(real64) a(:,:), integer(int32) ipvt(:), optional class(errors)) +!! @endcode +!! +!! @param[in,out] a On input, the M-by-N matrix on which to operate. On +!! output, the LU factored matrix in the form [L\\U] where the unit diagonal +!! elements of L are not stored. +!! @param[out] ipvt An MIN(M, N)-element array used to track row-pivot +!! operations. The array stored pivot information such that row I is +!! interchanged with row IPVT(I). +!! @param[in,out] err An optional errors-based object that if provided can be +!! used to retrieve information relating to any errors encountered during +!! execution. If not provided, a default implementation of the errors +!! class is used internally to provide error handling. Possible errors and +!! warning messages that may be encountered are as follows. +!! - LA_ARRAY_SIZE_ERROR: Occurs if @p ipvt is not sized appropriately. +!! - LA_SINGULAR_MATRIX_ERROR: Occurs as a warning if @p a is found to be +!! singular. +!! +!! @par Notes +!! This routine utilizes the LAPACK routine DGETRF. +!! +!! @par See Also +!! - [Wikipedia](https://en.wikipedia.org/wiki/LU_decomposition) +!! - [Wolfram MathWorld](http://mathworld.wolfram.com/LUDecomposition.html) +!! !! @par Usage !! To solve a system of 3 equations of 3 unknowns using LU factorization, !! the following code will suffice. @@ -402,6 +560,59 @@ module linalg_core !> @brief Extracts the L and U matrices from the condensed [L\\U] storage !! format used by the @ref lu_factor. !! +!! @par Syntax 1 +!! @code{.f90} +!! subroutine form_lu(real(real64) lu(:,:), integer(int32) ipvt(:), real(real64) u(:,:), real(real64) p(:,:), optional class(errors) err) +!! subroutine form_lu(complex(real64) lu(:,:), integer(int32) ipvt(:), complex(real64) u(:,:), real(real64) p(:,:), optional class(errors) err) +!! @endcode +!! +!! @param[in,out] lu On input, the N-by-N matrix as output by +!! @ref lu_factor. On output, the N-by-N lower triangular matrix L. +!! @param[in] ipvt The N-element pivot array as output by +!! @ref lu_factor. +!! @param[out] u An N-by-N matrix where the U matrix will be written. +!! @param[out] p An N-by-N matrix where the row permutation matrix will be +!! written. +!! @param[in,out] err An optional errors-based object that if provided can be +!! used to retrieve information relating to any errors encountered during +!! execution. If not provided, a default implementation of the errors +!! class is used internally to provide error handling. Possible errors and +!! warning messages that may be encountered are as follows. +!! - LA_ARRAY_SIZE_ERROR: Occurs if any of the input array sizes are +!! incorrect. +!! +!! @par Syntax 2 +!! @code{.f90} +!! subroutine form_lu(real(real64) lu(:,:), real(real64) u(:,:), optional class(errors) err) +!! subroutine form_lu(complex(real64) lu(:,:), complex(real64) u(:,:), optional class(errors) err) +!! @endcode +!! +!! @param[in,out] lu On input, the N-by-N matrix as output by +!! @ref lu_factor. On output, the N-by-N lower triangular matrix L. +!! @param[out] u An N-by-N matrix where the U matrix will be written. +!! @param[in,out] err An optional errors-based object that if provided can be +!! used to retrieve information relating to any errors encountered during +!! execution. If not provided, a default implementation of the errors +!! class is used internally to provide error handling. Possible errors and +!! warning messages that may be encountered are as follows. +!! - LA_ARRAY_SIZE_ERROR: Occurs if any of the input array sizes are +!! incorrect. +!! +!! @par Remarks +!! This routine allows extraction of the actual "L", "U", and "P" matrices +!! of the decomposition. To use these matrices to solve the system +!! \f$ A X = B \f$, the following approach is used. +!! +!! 1. First, solve the linear system: \f$ L Y = P B \f$ for \f$ Y \f$. +!! 2. Second, solve the linear system: \f$ U X = Y \f$ for \f$ X \f$. +!! +!! Notice, as both L and U are triangular in structure, the above equations +!! can be solved by forward and backward substitution. +!! +!! @par See Also +!! - [Wikipedia](https://en.wikipedia.org/wiki/LU_decomposition) +!! - [Wolfram MathWorld](http://mathworld.wolfram.com/LUDecomposition.html) +!! !! @par Usage !! The following example illustrates how to extract the L, U, and P matrices !! in order to solve a system of LU factored equations. @@ -1907,62 +2118,17 @@ module subroutine diag_mtx_mult_mtx2_mix(lside, alpha, a, b, err) complex(real64), intent(inout), dimension(:,:) :: b class(errors), intent(inout), optional, target :: err end subroutine - - - !> @brief Computes the trace of a matrix (the sum of the main diagonal - !! elements). - !! - !! @param[in] x The matrix on which to operate. - !! - !! @return The trace of @p x. + pure module function trace_dbl(x) result(y) real(real64), intent(in), dimension(:,:) :: x real(real64) :: y end function - - !> @brief Computes the trace of a matrix (the sum of the main diagonal - !! elements). - !! - !! @param[in] x The matrix on which to operate. - !! - !! @return The trace of @p x. + pure module function trace_cmplx(x) result(y) complex(real64), intent(in), dimension(:,:) :: x complex(real64) :: y end function - - !> @brief Computes the rank of a matrix. - !! - !! @param[in,out] a On input, the M-by-N matrix of interest. On output, the - !! contents of the matrix are overwritten. - !! @param[in] tol An optional input, that if supplied, overrides the default - !! tolerance on singular values such that singular values less than this - !! tolerance are treated as zero. The default tolerance is: - !! MAX(M, N) * EPS * MAX(S). If the supplied value is less than the - !! smallest value that causes an overflow if inverted, the tolerance - !! reverts back to its default value, and the operation continues; however, - !! a warning message is issued. - !! @param[out] work An optional input, that if provided, prevents any local - !! memory allocation. If not provided, the memory required is allocated - !! within. If provided, the length of the array must be at least - !! @p olwork. - !! @param[out] olwork An optional output used to determine workspace size. - !! If supplied, the routine determines the optimal size for @p work, and - !! returns without performing any actual calculations. - !! @param[out] err An optional errors-based object that if provided can be - !! used to retrieve information relating to any errors encountered during - !! execution. If not provided, a default implementation of the errors - !! class is used internally to provide error handling. Possible errors and - !! warning messages that may be encountered are as follows. - !! - LA_ARRAY_SIZE_ERROR: Occurs if any of the input arrays are not sized - !! appropriately. - !! - LA_OUT_OF_MEMORY_ERROR: Occurs if local memory must be allocated, and - !! there is insufficient memory available. - !! - LA_CONVERGENCE_ERROR: Occurs as a warning if the QR iteration process - !! could not converge to a zero value. - !! - !! @par See Also - !! - [Wolfram MathWorld](http://mathworld.wolfram.com/MatrixRank.html) + module function mtx_rank_dbl(a, tol, work, olwork, err) result(rnk) real(real64), intent(inout), dimension(:,:) :: a real(real64), intent(in), optional :: tol @@ -1972,42 +2138,6 @@ module function mtx_rank_dbl(a, tol, work, olwork, err) result(rnk) integer(int32) :: rnk end function - !> @brief Computes the rank of a matrix. - !! - !! @param[in,out] a On input, the M-by-N matrix of interest. On output, the - !! contents of the matrix are overwritten. - !! @param[in] tol An optional input, that if supplied, overrides the default - !! tolerance on singular values such that singular values less than this - !! tolerance are treated as zero. The default tolerance is: - !! MAX(M, N) * EPS * MAX(S). If the supplied value is less than the - !! smallest value that causes an overflow if inverted, the tolerance - !! reverts back to its default value, and the operation continues; however, - !! a warning message is issued. - !! @param[out] work An optional input, that if provided, prevents any local - !! memory allocation for complex-valued workspace arrays. If not provided, - !! the memory required is allocated within. If provided, the length of the - !! array must be at least @p olwork. - !! @param[out] olwork An optional output used to determine workspace size. - !! If supplied, the routine determines the optimal size for @p work, and - !! returns without performing any actual calculations. - !! @param[out] rwork An optional input, that if provided, prevents any - !! local memory allocation for real-valued workspace arrays. If not - !! provided, the memory required is allocated within. If provided, the - !! length of the array must be at least 6 * MIN(M, N). - !! @param[out] err An optional errors-based object that if provided can be - !! used to retrieve information relating to any errors encountered during - !! execution. If not provided, a default implementation of the errors - !! class is used internally to provide error handling. Possible errors and - !! warning messages that may be encountered are as follows. - !! - LA_ARRAY_SIZE_ERROR: Occurs if any of the input arrays are not sized - !! appropriately. - !! - LA_OUT_OF_MEMORY_ERROR: Occurs if local memory must be allocated, and - !! there is insufficient memory available. - !! - LA_CONVERGENCE_ERROR: Occurs as a warning if the QR iteration process - !! could not converge to a zero value. - !! - !! @par See Also - !! - [Wolfram MathWorld](http://mathworld.wolfram.com/MatrixRank.html) module function mtx_rank_cmplx(a, tol, work, olwork, rwork, err) result(rnk) complex(real64), intent(inout), dimension(:,:) :: a real(real64), intent(in), optional :: tol @@ -2017,127 +2147,36 @@ module function mtx_rank_cmplx(a, tol, work, olwork, rwork, err) result(rnk) class(errors), intent(inout), optional, target :: err integer(int32) :: rnk end function - - !> @brief Computes the determinant of a square matrix. - !! - !! @param[in,out] a On input, the N-by-N matrix on which to operate. On - !! output the contents are overwritten by the LU factorization of the - !! original matrix. - !! @param[out] iwork An optional input, that if provided, prevents any local - !! memory allocation. If not provided, the memory required is allocated - !! within. If provided, the length of the array must be at least - !! N-elements. - !! @param[out] err An optional errors-based object that if provided can be - !! used to retrieve information relating to any errors encountered during - !! execution. If not provided, a default implementation of the errors - !! class is used internally to provide error handling. Possible errors and - !! warning messages that may be encountered are as follows. - !! - LA_ARRAY_SIZE_ERROR: Occurs if any of the input arrays are not sized - !! appropriately. - !! - LA_OUT_OF_MEMORY_ERROR: Occurs if local memory must be allocated, and - !! there is insufficient memory available. - !! - !! @return The determinant of @p a. + module function det_dbl(a, iwork, err) result(x) real(real64), intent(inout), dimension(:,:) :: a integer(int32), intent(out), target, optional, dimension(:) :: iwork class(errors), intent(inout), optional, target :: err real(real64) :: x end function - - !> @brief Computes the determinant of a square matrix. - !! - !! @param[in,out] a On input, the N-by-N matrix on which to operate. On - !! output the contents are overwritten by the LU factorization of the - !! original matrix. - !! @param[out] iwork An optional input, that if provided, prevents any local - !! memory allocation. If not provided, the memory required is allocated - !! within. If provided, the length of the array must be at least - !! N-elements. - !! @param[out] err An optional errors-based object that if provided can be - !! used to retrieve information relating to any errors encountered during - !! execution. If not provided, a default implementation of the errors - !! class is used internally to provide error handling. Possible errors and - !! warning messages that may be encountered are as follows. - !! - LA_ARRAY_SIZE_ERROR: Occurs if any of the input arrays are not sized - !! appropriately. - !! - LA_OUT_OF_MEMORY_ERROR: Occurs if local memory must be allocated, and - !! there is insufficient memory available. - !! - !! @return The determinant of @p a. + module function det_cmplx(a, iwork, err) result(x) complex(real64), intent(inout), dimension(:,:) :: a integer(int32), intent(out), target, optional, dimension(:) :: iwork class(errors), intent(inout), optional, target :: err complex(real64) :: x end function - - !> @brief Swaps the contents of two arrays. - !! - !! @param[in,out] x One of the N-element arrays. - !! @param[in,out] y The other N-element array. - !! @param[out] err An optional errors-based object that if provided can be - !! used to retrieve information relating to any errors encountered during - !! execution. If not provided, a default implementation of the errors - !! class is used internally to provide error handling. Possible errors and - !! warning messages that may be encountered are as follows. - !! - LA_ARRAY_SIZE_ERROR: Occurs if @p x and @p y are not the same size. + module subroutine swap_dbl(x, y, err) real(real64), intent(inout), dimension(:) :: x, y class(errors), intent(inout), optional, target :: err end subroutine - - !> @brief Swaps the contents of two arrays. - !! - !! @param[in,out] x One of the N-element arrays. - !! @param[in,out] y The other N-element array. - !! @param[out] err An optional errors-based object that if provided can be - !! used to retrieve information relating to any errors encountered during - !! execution. If not provided, a default implementation of the errors - !! class is used internally to provide error handling. Possible errors and - !! warning messages that may be encountered are as follows. - !! - LA_ARRAY_SIZE_ERROR: Occurs if @p x and @p y are not the same size. + module subroutine swap_cmplx(x, y, err) complex(real64), intent(inout), dimension(:) :: x, y class(errors), intent(inout), optional, target :: err end subroutine - - !> @brief Multiplies a vector by the reciprocal of a real scalar. - !! - !! @param[in] a The scalar which is used to divide each component of @p X. - !! The value must be >= 0, or the subroutine will divide by zero. - !! @param[in,out] x The vector. - !! - !! @par Notes - !! This routine is based upon the LAPACK routine DRSCL. + module subroutine recip_mult_array_dbl(a, x) real(real64), intent(in) :: a real(real64), intent(inout), dimension(:) :: x end subroutine - - !> @brief Computes the triangular matrix operation: - !! B = alpha * A**T * A + beta * B, or B = alpha * A * A**T + beta * B, - !! where A is a triangular matrix. - !! - !! @param[in] upper Set to true if matrix A is upper triangular, and - !! B = alpha * A**T * A + beta * B is to be calculated; else, set to false - !! if A is lower triangular, and B = alpha * A * A**T + beta * B is to - !! be computed. - !! @param[in] alpha A scalar multiplier. - !! @param[in] a The N-by-N triangular matrix. Notice, if @p upper is true - !! only the upper triangular portion of this matrix is referenced; else, - !! if @p upper is false, only the lower triangular portion of this matrix - !! is referenced. - !! @param[in] beta A scalar multiplier. - !! @param[in,out] b On input, the N-by-N matrix B. On output, the N-by-N - !! solution matrix. - !! @param[out] err An optional errors-based object that if provided can be - !! used to retrieve information relating to any errors encountered during - !! execution. If not provided, a default implementation of the errors - !! class is used internally to provide error handling. Possible errors and - !! warning messages that may be encountered are as follows. - !! - LA_ARRAY_SIZE_ERROR: Occurs if any of the input arrays are not sized - !! appropriately. + module subroutine tri_mtx_mult_dbl(upper, alpha, a, beta, b, err) logical, intent(in) :: upper real(real64), intent(in) :: alpha, beta @@ -2146,29 +2185,6 @@ module subroutine tri_mtx_mult_dbl(upper, alpha, a, beta, b, err) class(errors), intent(inout), optional, target :: err end subroutine - !> @brief Computes the triangular matrix operation: - !! B = alpha * A**T * A + beta * B, or B = alpha * A * A**T + beta * B, - !! where A is a triangular matrix. - !! - !! @param[in] upper Set to true if matrix A is upper triangular, and - !! B = alpha * A**T * A + beta * B is to be calculated; else, set to false - !! if A is lower triangular, and B = alpha * A * A**T + beta * B is to - !! be computed. - !! @param[in] alpha A scalar multiplier. - !! @param[in] a The N-by-N triangular matrix. Notice, if @p upper is true - !! only the upper triangular portion of this matrix is referenced; else, - !! if @p upper is false, only the lower triangular portion of this matrix - !! is referenced. - !! @param[in] beta A scalar multiplier. - !! @param[in,out] b On input, the N-by-N matrix B. On output, the N-by-N - !! solution matrix. - !! @param[out] err An optional errors-based object that if provided can be - !! used to retrieve information relating to any errors encountered during - !! execution. If not provided, a default implementation of the errors - !! class is used internally to provide error handling. Possible errors and - !! warning messages that may be encountered are as follows. - !! - LA_ARRAY_SIZE_ERROR: Occurs if any of the input arrays are not sized - !! appropriately. module subroutine tri_mtx_mult_cmplx(upper, alpha, a, beta, b, err) logical, intent(in) :: upper complex(real64), intent(in) :: alpha, beta @@ -2183,135 +2199,25 @@ module subroutine tri_mtx_mult_cmplx(upper, alpha, a, beta, b, err) ! LINALG_FACTOR.F90 ! ------------------------------------------------------------------------------ interface - !> @brief Computes the LU factorization of an M-by-N matrix. - !! - !! @param[in,out] a On input, the M-by-N matrix on which to operate. On - !! output, the LU factored matrix in the form [L\\U] where the unit diagonal - !! elements of L are not stored. - !! @param[out] ipvt An MIN(M, N)-element array used to track row-pivot - !! operations. The array stored pivot information such that row I is - !! interchanged with row IPVT(I). - !! @param[out] err An optional errors-based object that if provided can be - !! used to retrieve information relating to any errors encountered during - !! execution. If not provided, a default implementation of the errors - !! class is used internally to provide error handling. Possible errors and - !! warning messages that may be encountered are as follows. - !! - LA_ARRAY_SIZE_ERROR: Occurs if @p ipvt is not sized appropriately. - !! - LA_SINGULAR_MATRIX_ERROR: Occurs as a warning if @p a is found to be - !! singular. - !! - !! @par Notes - !! This routine utilizes the LAPACK routine DGETRF. - !! - !! @par See Also - !! - [Wikipedia](https://en.wikipedia.org/wiki/LU_decomposition) - !! - [Wolfram MathWorld](http://mathworld.wolfram.com/LUDecomposition.html) module subroutine lu_factor_dbl(a, ipvt, err) real(real64), intent(inout), dimension(:,:) :: a integer(int32), intent(out), dimension(:) :: ipvt class(errors), intent(inout), optional, target :: err end subroutine - - !> @brief Computes the LU factorization of a complex-valued M-by-N matrix. - !! - !! @param[in,out] a On input, the M-by-N matrix on which to operate. On - !! output, the LU factored matrix in the form [L\\U] where the unit diagonal - !! elements of L are not stored. - !! @param[out] ipvt An MIN(M, N)-element array used to track row-pivot - !! operations. The array stored pivot information such that row I is - !! interchanged with row IPVT(I). - !! @param[out] err An optional errors-based object that if provided can be - !! used to retrieve information relating to any errors encountered during - !! execution. If not provided, a default implementation of the errors - !! class is used internally to provide error handling. Possible errors and - !! warning messages that may be encountered are as follows. - !! - LA_ARRAY_SIZE_ERROR: Occurs if @p ipvt is not sized appropriately. - !! - LA_SINGULAR_MATRIX_ERROR: Occurs as a warning if @p a is found to be - !! singular. - !! - !! @par Notes - !! This routine utilizes the LAPACK routine ZGETRF. - !! - !! @par See Also - !! - [Wikipedia](https://en.wikipedia.org/wiki/LU_decomposition) - !! - [Wolfram MathWorld](http://mathworld.wolfram.com/LUDecomposition.html) + module subroutine lu_factor_cmplx(a, ipvt, err) complex(real64), intent(inout), dimension(:,:) :: a integer(int32), intent(out), dimension(:) :: ipvt class(errors), intent(inout), optional, target :: err end subroutine - !> @brief Extracts the L, U, and P matrices from the output of the - !! @ref lu_factor routine. - !! - !! @param[in,out] lu On input, the N-by-N matrix as output by - !! @ref lu_factor. On output, the N-by-N lower triangular matrix L. - !! @param[in] ipvt The N-element pivot array as output by - !! @ref lu_factor. - !! @param[out] u An N-by-N matrix where the U matrix will be written. - !! @param[out] p An N-by-N matrix where the row permutation matrix will be - !! written. - !! @param[out] err An optional errors-based object that if provided can be - !! used to retrieve information relating to any errors encountered during - !! execution. If not provided, a default implementation of the errors - !! class is used internally to provide error handling. Possible errors and - !! warning messages that may be encountered are as follows. - !! - LA_ARRAY_SIZE_ERROR: Occurs if any of the input array sizes are - !! incorrect. - !! - !! @par Remarks - !! This routine allows extraction of the actual "L", "U", and "P" matrices - !! of the decomposition. To use these matrices to solve the system A*X = B, - !! the following approach is used. - !! - !! 1. First, solve the linear system: L*Y = P*B for Y. - !! 2. Second, solve the linear system: U*X = Y for X. - !! - !! Notice, as both L and U are triangular in structure, the above equations - !! can be solved by forward and backward substitution. - !! - !! @par See Also - !! - [Wikipedia](https://en.wikipedia.org/wiki/LU_decomposition) - !! - [Wolfram MathWorld](http://mathworld.wolfram.com/LUDecomposition.html) module subroutine form_lu_all(lu, ipvt, u, p, err) real(real64), intent(inout), dimension(:,:) :: lu integer(int32), intent(in), dimension(:) :: ipvt real(real64), intent(out), dimension(:,:) :: u, p class(errors), intent(inout), optional, target :: err end subroutine - - !> @brief Extracts the L, U, and P matrices from the output of the - !! @ref lu_factor routine. - !! - !! @param[in,out] lu On input, the N-by-N matrix as output by - !! @ref lu_factor. On output, the N-by-N lower triangular matrix L. - !! @param[in] ipvt The N-element pivot array as output by - !! @ref lu_factor. - !! @param[out] u An N-by-N matrix where the U matrix will be written. - !! @param[out] p An N-by-N matrix where the row permutation matrix will be - !! written. - !! @param[out] err An optional errors-based object that if provided can be - !! used to retrieve information relating to any errors encountered during - !! execution. If not provided, a default implementation of the errors - !! class is used internally to provide error handling. Possible errors and - !! warning messages that may be encountered are as follows. - !! - LA_ARRAY_SIZE_ERROR: Occurs if any of the input array sizes are - !! incorrect. - !! - !! @par Remarks - !! This routine allows extraction of the actual "L", "U", and "P" matrices - !! of the decomposition. To use these matrices to solve the system A*X = B, - !! the following approach is used. - !! - !! 1. First, solve the linear system: L*Y = P*B for Y. - !! 2. Second, solve the linear system: U*X = Y for X. - !! - !! Notice, as both L and U are triangular in structure, the above equations - !! can be solved by forward and backward substitution. - !! - !! @par See Also - !! - [Wikipedia](https://en.wikipedia.org/wiki/LU_decomposition) - !! - [Wolfram MathWorld](http://mathworld.wolfram.com/LUDecomposition.html) + module subroutine form_lu_all_cmplx(lu, ipvt, u, p, err) complex(real64), intent(inout), dimension(:,:) :: lu integer(int32), intent(in), dimension(:) :: ipvt @@ -2319,39 +2225,13 @@ module subroutine form_lu_all_cmplx(lu, ipvt, u, p, err) real(real64), intent(out), dimension(:,:) :: p class(errors), intent(inout), optional, target :: err end subroutine - - !> @brief Extracts the L, and U matrices from the output of the - !! @ref lu_factor routine. - !! - !! @param[in,out] lu On input, the N-by-N matrix as output by - !! @ref lu_factor. On output, the N-by-N lower triangular matrix L. - !! @param[out] u An N-by-N matrix where the U matrix will be written. - !! @param[out] err An optional errors-based object that if provided can be - !! used to retrieve information relating to any errors encountered during - !! execution. If not provided, a default implementation of the errors - !! class is used internally to provide error handling. Possible errors and - !! warning messages that may be encountered are as follows. - !! - LA_ARRAY_SIZE_ERROR: Occurs if any of the input array sizes are - !! incorrect. + module subroutine form_lu_only(lu, u, err) real(real64), intent(inout), dimension(:,:) :: lu real(real64), intent(out), dimension(:,:) :: u class(errors), intent(inout), optional, target :: err end subroutine - - !> @brief Extracts the L, and U matrices from the output of the - !! @ref lu_factor routine. - !! - !! @param[in,out] lu On input, the N-by-N matrix as output by - !! @ref lu_factor. On output, the N-by-N lower triangular matrix L. - !! @param[out] u An N-by-N matrix where the U matrix will be written. - !! @param[out] err An optional errors-based object that if provided can be - !! used to retrieve information relating to any errors encountered during - !! execution. If not provided, a default implementation of the errors - !! class is used internally to provide error handling. Possible errors and - !! warning messages that may be encountered are as follows. - !! - LA_ARRAY_SIZE_ERROR: Occurs if any of the input array sizes are - !! incorrect. + module subroutine form_lu_only_cmplx(lu, u, err) complex(real64), intent(inout), dimension(:,:) :: lu complex(real64), intent(out), dimension(:,:) :: u From 331b09d09da3d417ec8bbbe4c6bab648786600e3 Mon Sep 17 00:00:00 2001 From: jchristopherson Date: Tue, 13 Dec 2022 18:05:07 -0600 Subject: [PATCH 15/65] Update documentation --- ...rfacelinalg__core_1_1cholesky__factor.html | 8 +- ...lg__core_1_1cholesky__rank1__downdate.html | 6 +- ...nalg__core_1_1cholesky__rank1__update.html | 6 +- ...erfacelinalg__core_1_1diag__mtx__mult.html | 2 +- doc/html/interfacelinalg__core_1_1eigen.html | 4 +- .../interfacelinalg__core_1_1form__lu.html | 2 +- .../interfacelinalg__core_1_1form__qr.html | 8 +- .../interfacelinalg__core_1_1lu__factor.html | 2 +- ...interfacelinalg__core_1_1mtx__inverse.html | 4 +- ...nterfacelinalg__core_1_1mtx__pinverse.html | 4 +- .../interfacelinalg__core_1_1mult__qr.html | 8 +- .../interfacelinalg__core_1_1mult__rz.html | 2 +- .../interfacelinalg__core_1_1qr__factor.html | 45 +- ...facelinalg__core_1_1qr__rank1__update.html | 8 +- .../interfacelinalg__core_1_1rz__factor.html | 2 +- ...erfacelinalg__core_1_1solve__cholesky.html | 8 +- ...linalg__core_1_1solve__least__squares.html | 4 +- ...__core_1_1solve__least__squares__full.html | 4 +- ...g__core_1_1solve__least__squares__svd.html | 4 +- .../interfacelinalg__core_1_1solve__lu.html | 4 +- .../interfacelinalg__core_1_1solve__qr.html | 6 +- ...lg__core_1_1solve__triangular__system.html | 4 +- doc/html/interfacelinalg__core_1_1sort.html | 2 +- doc/html/interfacelinalg__core_1_1svd.html | 4 +- doc/html/linalg__c__api_8f90_source.html | 34 +- doc/html/linalg__core_8f90_source.html | 2102 ++++++++--------- doc/html/linalg__immutable_8f90_source.html | 24 +- src/linalg_core.f90 | 230 +- 28 files changed, 1262 insertions(+), 1279 deletions(-) diff --git a/doc/html/interfacelinalg__core_1_1cholesky__factor.html b/doc/html/interfacelinalg__core_1_1cholesky__factor.html index bd8fb746..6b2fa038 100644 --- a/doc/html/interfacelinalg__core_1_1cholesky__factor.html +++ b/doc/html/interfacelinalg__core_1_1cholesky__factor.html @@ -157,9 +157,9 @@
    print '(A)', "Cholesky Solution (Manual Approach): X = "
    print '(F8.4)', (bu(i), i = 1, size(bu))
    end program
    -
    Computes the Cholesky factorization of a symmetric, positive definite matrix.
    -
    Solves a system of Cholesky factored equations.
    -
    Solves a triangular system of equations.
    +
    Computes the Cholesky factorization of a symmetric, positive definite matrix.
    +
    Solves a system of Cholesky factored equations.
    +
    Solves a triangular system of equations.
    Provides a set of common linear algebra routines.
    Definition: linalg_core.f90:15
    The above program produces the following output.
    Cholesky Solution: X =
    239.5833
    @@ -171,7 +171,7 @@
    10.3333
    -

    Definition at line 1084 of file linalg_core.f90.

    +

    Definition at line 1168 of file linalg_core.f90.


    The documentation for this interface was generated from the following file: diff --git a/doc/html/interfacelinalg__core_1_1cholesky__rank1__downdate.html b/doc/html/interfacelinalg__core_1_1cholesky__rank1__downdate.html index 9fe4aa05..2997516d 100644 --- a/doc/html/interfacelinalg__core_1_1cholesky__rank1__downdate.html +++ b/doc/html/interfacelinalg__core_1_1cholesky__rank1__downdate.html @@ -154,8 +154,8 @@
    print *, ad(i,:)
    end do
    end program
    -
    Computes the Cholesky factorization of a symmetric, positive definite matrix.
    -
    Computes the rank 1 downdate to a Cholesky factored matrix (upper triangular).
    +
    Computes the Cholesky factorization of a symmetric, positive definite matrix.
    +
    Computes the rank 1 downdate to a Cholesky factored matrix (upper triangular).
    Performs the rank-1 update to matrix A such that: , where is an M-by-N matrix, is a scalar,...
    Provides a set of common linear algebra routines.
    Definition: linalg_core.f90:15
    The above program produces the following output.
    Downdating the Factored Form:
    @@ -168,7 +168,7 @@
    0.0000000000000000 0.0000000000000000 3.0000000000000000
    -

    Definition at line 1225 of file linalg_core.f90.

    +

    Definition at line 1309 of file linalg_core.f90.


    The documentation for this interface was generated from the following file: diff --git a/doc/html/interfacelinalg__core_1_1cholesky__rank1__update.html b/doc/html/interfacelinalg__core_1_1cholesky__rank1__update.html index 87910b5a..3c3f8ce1 100644 --- a/doc/html/interfacelinalg__core_1_1cholesky__rank1__update.html +++ b/doc/html/interfacelinalg__core_1_1cholesky__rank1__update.html @@ -150,8 +150,8 @@
    print *, au(i,:)
    end do
    end program
    -
    Computes the Cholesky factorization of a symmetric, positive definite matrix.
    -
    Computes the rank 1 update to a Cholesky factored matrix (upper triangular).
    +
    Computes the Cholesky factorization of a symmetric, positive definite matrix.
    +
    Computes the rank 1 update to a Cholesky factored matrix (upper triangular).
    Performs the rank-1 update to matrix A such that: , where is an M-by-N matrix, is a scalar,...
    Provides a set of common linear algebra routines.
    Definition: linalg_core.f90:15
    The above program produces the following output.
    Updating the Factored Form:
    @@ -164,7 +164,7 @@
    0.0000000000000000 0.0000000000000000 6.6989384530323557
    -

    Definition at line 1152 of file linalg_core.f90.

    +

    Definition at line 1236 of file linalg_core.f90.


    The documentation for this interface was generated from the following file: diff --git a/doc/html/interfacelinalg__core_1_1diag__mtx__mult.html b/doc/html/interfacelinalg__core_1_1diag__mtx__mult.html index 1962579e..723844dd 100644 --- a/doc/html/interfacelinalg__core_1_1diag__mtx__mult.html +++ b/doc/html/interfacelinalg__core_1_1diag__mtx__mult.html @@ -194,7 +194,7 @@
    end do
    end program
    Multiplies a diagonal matrix with another matrix or array.
    -
    Computes the singular value decomposition of a matrix A. The SVD is defined as: A = U * S * V**T,...
    +
    Computes the singular value decomposition of a matrix A. The SVD is defined as: A = U * S * V**T,...
    Provides a set of common linear algebra routines.
    Definition: linalg_core.f90:15
    The above program produces the following output.
    U =
    -0.47411577501825380 -0.81850539032073777 -0.32444284226152509
    diff --git a/doc/html/interfacelinalg__core_1_1eigen.html b/doc/html/interfacelinalg__core_1_1eigen.html index 5c12c180..73cfa2d0 100644 --- a/doc/html/interfacelinalg__core_1_1eigen.html +++ b/doc/html/interfacelinalg__core_1_1eigen.html @@ -164,7 +164,7 @@
    print '(F10.3)', (real(modeshapes(j,i)), j = 1, size(natfreq))
    end do
    end program
    -
    Computes the eigenvalues, and optionally the eigenvectors, of a matrix.
    +
    Computes the eigenvalues, and optionally the eigenvectors, of a matrix.
    Provides a set of common linear algebra routines.
    Definition: linalg_core.f90:15
    The above program produces the following output.
    Modal Information:
    Mode 1: (232.9225 Hz)
    @@ -187,7 +187,7 @@ -

    Definition at line 1979 of file linalg_core.f90.

    +

    Definition at line 2063 of file linalg_core.f90.


    The documentation for this interface was generated from the following file: diff --git a/doc/html/interfacelinalg__core_1_1form__lu.html b/doc/html/interfacelinalg__core_1_1form__lu.html index d593d969..24f72a0d 100644 --- a/doc/html/interfacelinalg__core_1_1form__lu.html +++ b/doc/html/interfacelinalg__core_1_1form__lu.html @@ -199,7 +199,7 @@
    end program
    Extracts the L and U matrices from the condensed [L\U] storage format used by the lu_factor.
    Computes the LU factorization of an M-by-N matrix.
    -
    Solves a triangular system of equations.
    +
    Solves a triangular system of equations.
    Provides a set of common linear algebra routines.
    Definition: linalg_core.f90:15
    The above program produces the following output.
    LU Solution: X =
    0.3333
    diff --git a/doc/html/interfacelinalg__core_1_1form__qr.html b/doc/html/interfacelinalg__core_1_1form__qr.html index 0dcff9e3..ded97157 100644 --- a/doc/html/interfacelinalg__core_1_1form__qr.html +++ b/doc/html/interfacelinalg__core_1_1form__qr.html @@ -162,9 +162,9 @@
    ! for by noting that Q * R = A * P, where P is an N-by-N matrix describing
    ! the column pivoting operations.
    end program
    -
    Forms the full M-by-M orthogonal matrix Q from the elementary reflectors returned by the base QR fact...
    -
    Computes the QR factorization of an M-by-N matrix.
    -
    Solves a triangular system of equations.
    +
    Forms the full M-by-M orthogonal matrix Q from the elementary reflectors returned by the base QR fact...
    +
    Computes the QR factorization of an M-by-N matrix.
    +
    Solves a triangular system of equations.
    Provides a set of common linear algebra routines.
    Definition: linalg_core.f90:15
    The above program produces the following output.
    QR Solution: X =
    0.3333
    @@ -177,7 +177,7 @@ -

    Definition at line 830 of file linalg_core.f90.

    +

    Definition at line 914 of file linalg_core.f90.


    The documentation for this interface was generated from the following file: diff --git a/doc/html/interfacelinalg__core_1_1lu__factor.html b/doc/html/interfacelinalg__core_1_1lu__factor.html index a245a729..288cda1e 100644 --- a/doc/html/interfacelinalg__core_1_1lu__factor.html +++ b/doc/html/interfacelinalg__core_1_1lu__factor.html @@ -167,7 +167,7 @@
    print '(F8.4)', (b(i), i = 1, size(b))
    end program
    Computes the LU factorization of an M-by-N matrix.
    -
    Solves a system of LU-factored equations.
    +
    Solves a system of LU-factored equations.
    Provides a set of common linear algebra routines.
    Definition: linalg_core.f90:15
    The program generates the following output.
    LU Solution: X =
    0.3333
    diff --git a/doc/html/interfacelinalg__core_1_1mtx__inverse.html b/doc/html/interfacelinalg__core_1_1mtx__inverse.html index 3cc41c50..83962158 100644 --- a/doc/html/interfacelinalg__core_1_1mtx__inverse.html +++ b/doc/html/interfacelinalg__core_1_1mtx__inverse.html @@ -143,7 +143,7 @@
    print *, c(i,:)
    end do
    end program
    -
    Computes the inverse of a square matrix.
    +
    Computes the inverse of a square matrix.
    Provides a set of common linear algebra routines.
    Definition: linalg_core.f90:15
    The above program produces the following output.
    Inverse:
    -1.7777777777777777 0.88888888888888884 -0.11111111111111110
    @@ -155,7 +155,7 @@
    1.7763568394002505E-015 -8.8817841970012523E-016 1.0000000000000000
    -

    Definition at line 1824 of file linalg_core.f90.

    +

    Definition at line 1908 of file linalg_core.f90.


    The documentation for this interface was generated from the following file: diff --git a/doc/html/interfacelinalg__core_1_1mtx__pinverse.html b/doc/html/interfacelinalg__core_1_1mtx__pinverse.html index eeadaa69..95baf7de 100644 --- a/doc/html/interfacelinalg__core_1_1mtx__pinverse.html +++ b/doc/html/interfacelinalg__core_1_1mtx__pinverse.html @@ -145,7 +145,7 @@
    print *, c(i,:)
    end do
    end program
    -
    Computes the Moore-Penrose pseudo-inverse of a M-by-N matrix using the singular value decomposition o...
    +
    Computes the Moore-Penrose pseudo-inverse of a M-by-N matrix using the singular value decomposition o...
    Provides a set of common linear algebra routines.
    Definition: linalg_core.f90:15
    The above program produces the following output.
    Inverse:
    1.0000000000000000 0.0000000000000000 0.0000000000000000
    @@ -155,7 +155,7 @@
    0.0000000000000000 0.99999999999999967
    -

    Definition at line 1885 of file linalg_core.f90.

    +

    Definition at line 1969 of file linalg_core.f90.


    The documentation for this interface was generated from the following file: diff --git a/doc/html/interfacelinalg__core_1_1mult__qr.html b/doc/html/interfacelinalg__core_1_1mult__qr.html index 87b79167..0d95169a 100644 --- a/doc/html/interfacelinalg__core_1_1mult__qr.html +++ b/doc/html/interfacelinalg__core_1_1mult__qr.html @@ -160,9 +160,9 @@
    ! for by noting that Q * R = A * P, where P is an N-by-N matrix describing
    ! the column pivoting operations.
    end program
    -
    Multiplies a general matrix by the orthogonal matrix Q from a QR factorization.
    -
    Computes the QR factorization of an M-by-N matrix.
    -
    Solves a triangular system of equations.
    +
    Multiplies a general matrix by the orthogonal matrix Q from a QR factorization.
    +
    Computes the QR factorization of an M-by-N matrix.
    +
    Solves a triangular system of equations.
    Provides a set of common linear algebra routines.
    Definition: linalg_core.f90:15
    The above program produces the following output.
    QR Solution: X =
    0.3333
    @@ -170,7 +170,7 @@
    0.0000
    -

    Definition at line 907 of file linalg_core.f90.

    +

    Definition at line 991 of file linalg_core.f90.


    The documentation for this interface was generated from the following file: diff --git a/doc/html/interfacelinalg__core_1_1mult__rz.html b/doc/html/interfacelinalg__core_1_1mult__rz.html index f07c99e2..56b2db82 100644 --- a/doc/html/interfacelinalg__core_1_1mult__rz.html +++ b/doc/html/interfacelinalg__core_1_1mult__rz.html @@ -108,7 +108,7 @@

    Detailed Description

    Multiplies a general matrix by the orthogonal matrix Z from an RZ factorization.

    -

    Definition at line 1243 of file linalg_core.f90.

    +

    Definition at line 1327 of file linalg_core.f90.


    The documentation for this interface was generated from the following file: diff --git a/doc/html/interfacelinalg__core_1_1qr__factor.html b/doc/html/interfacelinalg__core_1_1qr__factor.html index fc445a7f..35e87705 100644 --- a/doc/html/interfacelinalg__core_1_1qr__factor.html +++ b/doc/html/interfacelinalg__core_1_1qr__factor.html @@ -107,6 +107,45 @@ More...

    Detailed Description

    Computes the QR factorization of an M-by-N matrix.

    +
    Syntax 1
    subroutine qr_factor(real(real64) a(:,:), real(real64) tau(:), optional real(real64) work(:), optional integer(int32) olwork, optional class(errors) err)
    +
    subroutine qr_factor(complex(real64) a(:,:), complex(real64) tau(:), optional complex(real64) work(:), optional integer(int32) olwork, optional class(errors) err)
    +
    +
    Parameters
    + + + + + + +
    [in,out]aOn input, the M-by-N matrix to factor. On output, the elements on and above the diagonal contain the MIN(M, N)-by-N upper trapezoidal matrix R (R is upper triangular if M >= N). The elements below the diagonal, along with the array tau, represent the orthogonal matrix Q as a product of elementary reflectors.
    [out]tauA MIN(M, N)-element array used to store the scalar factors of the elementary reflectors.
    [out]workAn optional input, that if provided, prevents any local memory allocation. If not provided, the memory required is allocated within. If provided, the length of the array must be at least olwork.
    [out]olworkAn optional output used to determine workspace size. If supplied, the routine determines the optimal size for work, and returns without performing any actual calculations.
    [in,out]errAn optional errors-based object that if provided can be used to retrieve information relating to any errors encountered during execution. If not provided, a default implementation of the errors class is used internally to provide error handling. Possible errors and warning messages that may be encountered are as follows.
      +
    • LA_ARRAY_SIZE_ERROR: Occurs if tau or work are not sized appropriately.
    • +
    • LA_OUT_OF_MEMORY_ERROR: Occurs if local memory must be allocated, and there is insufficient memory available.
    • +
    +
    +
    +
    +
    Remarks
    QR factorization without pivoting is best suited to solving an overdetermined system in least-squares terms, or to solve a normally defined system. To solve an underdetermined system, it is recommended to use either LQ factorization, or a column-pivoting based QR factorization.
    +
    Notes
    This routine utilizes the LAPACK routine DGEQRF (ZGEQRF for the complex case).
    +
    Syntax 2
    Computes the QR factorization of an M-by-N matrix with column pivoting such that \( A P = Q R \).
    subroutine qr_factor(real(real64) a(:,:), real(real64) tau(:), integer(int32) jpvt(:), optional real(real64) work(:), optional integer(int32) olwork, optional class(errors) err)
    +
    subroutine qr_factor(complex(real64) a(:,:), complex(real64) tau(:), integer(int32) jpvt(:), optional complex(real64) work(:), optional integer(int32) olwork, optional real(real64) rwork(:), optional class(errors) err)
    +
    +
    Parameters
    + + + + + + + + +
    [in,out]aOn input, the M-by-N matrix to factor. On output, the elements on and above the diagonal contain the MIN(M, N)-by-N upper trapezoidal matrix R (R is upper triangular if M >= N). The elements below the diagonal, along with the array tau, represent the orthogonal matrix Q as a product of elementary reflectors.
    [out]tauA MIN(M, N)-element array used to store the scalar factors of the elementary reflectors.
    [in,out]jpvtOn input, an N-element array that if JPVT(I) .ne. 0, the I-th column of A is permuted to the front of A * P; if JPVT(I) = 0, the I-th column of A is a free column. On output, if JPVT(I) = K, then the I-th column of A * P was the K-th column of A.
    [out]workAn optional input, that if provided, prevents any local memory allocation. If not provided, the memory required is allocated within. If provided, the length of the array must be at least olwork.
    [out]olworkAn optional output used to determine workspace size. If supplied, the routine determines the optimal size for work, and returns without performing any actual calculations.
    [out]rworkAn optional input, that if provided, prevents any local allocate of real-valued memory. If not provided, the memory required is allocated within. If provided, the length of the array must be at least 2*N.
    [in,out]errAn optional errors-based object that if provided can be used to retrieve information relating to any errors encountered during execution. If not provided, a default implementation of the errors class is used internally to provide error handling. Possible errors and warning messages that may be encountered are as follows.
      +
    • LA_ARRAY_SIZE_ERROR: Occurs if any of the input arrays are not sized appropriately.
    • +
    • LA_OUT_OF_MEMORY_ERROR: Occurs if local memory must be allocated, and there is insufficient memory available.
    • +
    +
    +
    +
    +
    Notes
    This routine utilizes the LAPACK routine DGEQP3 (ZGEQP3 for the complex case).
    Usage
    The following example illustrates the solution of a system of equations using QR factorization.
    program example
    use iso_fortran_env, only : real64, int32
    @@ -150,8 +189,8 @@
    ! same manner. The only difference is to omit the PVT array (column pivot
    ! tracking array).
    end program
    -
    Computes the QR factorization of an M-by-N matrix.
    -
    Solves a system of M QR-factored equations of N unknowns.
    +
    Computes the QR factorization of an M-by-N matrix.
    +
    Solves a system of M QR-factored equations of N unknowns.
    Provides a set of common linear algebra routines.
    Definition: linalg_core.f90:15
    The above program produces the following output.
    QR Solution: X =
    0.3333
    @@ -165,7 +204,7 @@
    -

    Definition at line 747 of file linalg_core.f90.

    +

    Definition at line 831 of file linalg_core.f90.


    The documentation for this interface was generated from the following file: diff --git a/doc/html/interfacelinalg__core_1_1qr__rank1__update.html b/doc/html/interfacelinalg__core_1_1qr__rank1__update.html index a2413c9b..3960f6b8 100644 --- a/doc/html/interfacelinalg__core_1_1qr__rank1__update.html +++ b/doc/html/interfacelinalg__core_1_1qr__rank1__update.html @@ -171,9 +171,9 @@
    print *, a(i,:)
    end do
    end program
    -
    Forms the full M-by-M orthogonal matrix Q from the elementary reflectors returned by the base QR fact...
    -
    Computes the QR factorization of an M-by-N matrix.
    -
    Computes the rank 1 update to an M-by-N QR factored matrix A (M >= N) where A = Q * R,...
    +
    Forms the full M-by-M orthogonal matrix Q from the elementary reflectors returned by the base QR fact...
    +
    Computes the QR factorization of an M-by-N matrix.
    +
    Computes the rank 1 update to an M-by-N QR factored matrix A (M >= N) where A = Q * R,...
    Performs the rank-1 update to matrix A such that: , where is an M-by-N matrix, is a scalar,...
    Provides a set of common linear algebra routines.
    Definition: linalg_core.f90:15
    The above program produces the following output.
    Updating the Factored Form:
    @@ -196,7 +196,7 @@
    0.0000000000000000 0.0000000000000000 -5.2929341121113058
    -

    Definition at line 1009 of file linalg_core.f90.

    +

    Definition at line 1093 of file linalg_core.f90.


    The documentation for this interface was generated from the following file: diff --git a/doc/html/interfacelinalg__core_1_1rz__factor.html b/doc/html/interfacelinalg__core_1_1rz__factor.html index c347ff53..b9bbe0b4 100644 --- a/doc/html/interfacelinalg__core_1_1rz__factor.html +++ b/doc/html/interfacelinalg__core_1_1rz__factor.html @@ -108,7 +108,7 @@

    Detailed Description

    Factors an upper trapezoidal matrix by means of orthogonal transformations such that A = R * Z = (R 0) * Z. Z is an orthogonal matrix of dimension N-by-N, and R is an M-by-M upper triangular matrix.

    -

    Definition at line 1235 of file linalg_core.f90.

    +

    Definition at line 1319 of file linalg_core.f90.


    The documentation for this interface was generated from the following file: diff --git a/doc/html/interfacelinalg__core_1_1solve__cholesky.html b/doc/html/interfacelinalg__core_1_1solve__cholesky.html index c5c4daff..b2915021 100644 --- a/doc/html/interfacelinalg__core_1_1solve__cholesky.html +++ b/doc/html/interfacelinalg__core_1_1solve__cholesky.html @@ -157,9 +157,9 @@
    print '(A)', "Cholesky Solution (Manual Approach): X = "
    print '(F8.4)', (bu(i), i = 1, size(bu))
    end program
    -
    Computes the Cholesky factorization of a symmetric, positive definite matrix.
    -
    Solves a system of Cholesky factored equations.
    -
    Solves a triangular system of equations.
    +
    Computes the Cholesky factorization of a symmetric, positive definite matrix.
    +
    Solves a system of Cholesky factored equations.
    +
    Solves a triangular system of equations.
    Provides a set of common linear algebra routines.
    Definition: linalg_core.f90:15
    The above program produces the following output.
    Cholesky Solution: X =
    239.5833
    @@ -171,7 +171,7 @@
    10.3333
    -

    Definition at line 1601 of file linalg_core.f90.

    +

    Definition at line 1685 of file linalg_core.f90.


    The documentation for this interface was generated from the following file: diff --git a/doc/html/interfacelinalg__core_1_1solve__least__squares.html b/doc/html/interfacelinalg__core_1_1solve__least__squares.html index fc3522c2..c3aa08c4 100644 --- a/doc/html/interfacelinalg__core_1_1solve__least__squares.html +++ b/doc/html/interfacelinalg__core_1_1solve__least__squares.html @@ -139,14 +139,14 @@
    print '(A)', "Least Squares Solution: X = "
    print '(F9.5)', (b(i), i = 1, size(a, 2))
    end program
    -
    Solves the overdetermined or underdetermined system (A*X = B) of M equations of N unknowns.
    +
    Solves the overdetermined or underdetermined system (A*X = B) of M equations of N unknowns.
    Provides a set of common linear algebra routines.
    Definition: linalg_core.f90:15
    The above program produces the following output.
    Least Squares Solution: X =
    0.13158
    -0.57895
    -

    Definition at line 1655 of file linalg_core.f90.

    +

    Definition at line 1739 of file linalg_core.f90.


    The documentation for this interface was generated from the following file: diff --git a/doc/html/interfacelinalg__core_1_1solve__least__squares__full.html b/doc/html/interfacelinalg__core_1_1solve__least__squares__full.html index 0b901162..146975b4 100644 --- a/doc/html/interfacelinalg__core_1_1solve__least__squares__full.html +++ b/doc/html/interfacelinalg__core_1_1solve__least__squares__full.html @@ -139,14 +139,14 @@
    print '(A)', "Least Squares Solution: X = "
    print '(F9.5)', (b(i), i = 1, size(a, 2))
    end program
    -
    Solves the overdetermined or underdetermined system (A*X = B) of M equations of N unknowns,...
    +
    Solves the overdetermined or underdetermined system (A*X = B) of M equations of N unknowns,...
    Provides a set of common linear algebra routines.
    Definition: linalg_core.f90:15
    The above program produces the following output.
    Least Squares Solution: X =
    0.13158
    -0.57895
    -

    Definition at line 1710 of file linalg_core.f90.

    +

    Definition at line 1794 of file linalg_core.f90.


    The documentation for this interface was generated from the following file: diff --git a/doc/html/interfacelinalg__core_1_1solve__least__squares__svd.html b/doc/html/interfacelinalg__core_1_1solve__least__squares__svd.html index 347b574d..6dbb7853 100644 --- a/doc/html/interfacelinalg__core_1_1solve__least__squares__svd.html +++ b/doc/html/interfacelinalg__core_1_1solve__least__squares__svd.html @@ -139,14 +139,14 @@
    print '(A)', "Least Squares Solution: X = "
    print '(F9.5)', (b(i), i = 1, size(a, 2))
    end program
    -
    Solves the overdetermined or underdetermined system (A*X = B) of M equations of N unknowns using a si...
    +
    Solves the overdetermined or underdetermined system (A*X = B) of M equations of N unknowns using a si...
    Provides a set of common linear algebra routines.
    Definition: linalg_core.f90:15
    The above program produces the following output.
    Least Squares Solution: X =
    0.13158
    -0.57895
    -

    Definition at line 1765 of file linalg_core.f90.

    +

    Definition at line 1849 of file linalg_core.f90.


    The documentation for this interface was generated from the following file: diff --git a/doc/html/interfacelinalg__core_1_1solve__lu.html b/doc/html/interfacelinalg__core_1_1solve__lu.html index 93c2dd51..22189dc7 100644 --- a/doc/html/interfacelinalg__core_1_1solve__lu.html +++ b/doc/html/interfacelinalg__core_1_1solve__lu.html @@ -146,7 +146,7 @@
    print '(F8.4)', (b(i), i = 1, size(b))
    end program
    Computes the LU factorization of an M-by-N matrix.
    -
    Solves a system of LU-factored equations.
    +
    Solves a system of LU-factored equations.
    Provides a set of common linear algebra routines.
    Definition: linalg_core.f90:15
    The program generates the following output.
    LU Solution: X =
    0.3333
    @@ -159,7 +159,7 @@ -

    Definition at line 1452 of file linalg_core.f90.

    +

    Definition at line 1536 of file linalg_core.f90.


    The documentation for this interface was generated from the following file: diff --git a/doc/html/interfacelinalg__core_1_1solve__qr.html b/doc/html/interfacelinalg__core_1_1solve__qr.html index d5b326f0..54e807c3 100644 --- a/doc/html/interfacelinalg__core_1_1solve__qr.html +++ b/doc/html/interfacelinalg__core_1_1solve__qr.html @@ -150,8 +150,8 @@
    ! same manner. The only difference is to omit the PVT array (column pivot
    ! tracking array).
    end program
    -
    Computes the QR factorization of an M-by-N matrix.
    -
    Solves a system of M QR-factored equations of N unknowns.
    +
    Computes the QR factorization of an M-by-N matrix.
    +
    Solves a system of M QR-factored equations of N unknowns.
    Provides a set of common linear algebra routines.
    Definition: linalg_core.f90:15
    The above program produces the following output.
    QR Solution: X =
    0.3333
    @@ -164,7 +164,7 @@ -

    Definition at line 1521 of file linalg_core.f90.

    +

    Definition at line 1605 of file linalg_core.f90.


    The documentation for this interface was generated from the following file: diff --git a/doc/html/interfacelinalg__core_1_1solve__triangular__system.html b/doc/html/interfacelinalg__core_1_1solve__triangular__system.html index 5a9e5e8d..f841f39b 100644 --- a/doc/html/interfacelinalg__core_1_1solve__triangular__system.html +++ b/doc/html/interfacelinalg__core_1_1solve__triangular__system.html @@ -158,7 +158,7 @@
    end program
    Extracts the L and U matrices from the condensed [L\U] storage format used by the lu_factor.
    Computes the LU factorization of an M-by-N matrix.
    -
    Solves a triangular system of equations.
    +
    Solves a triangular system of equations.
    Provides a set of common linear algebra routines.
    Definition: linalg_core.f90:15
    The above program produces the following output.
    LU Solution: X =
    0.3333
    @@ -166,7 +166,7 @@
    0.0000
    -

    Definition at line 1388 of file linalg_core.f90.

    +

    Definition at line 1472 of file linalg_core.f90.


    The documentation for this interface was generated from the following file: diff --git a/doc/html/interfacelinalg__core_1_1sort.html b/doc/html/interfacelinalg__core_1_1sort.html index ac119609..1e884062 100644 --- a/doc/html/interfacelinalg__core_1_1sort.html +++ b/doc/html/interfacelinalg__core_1_1sort.html @@ -108,7 +108,7 @@

    Detailed Description

    Sorts an array.

    -

    Definition at line 1988 of file linalg_core.f90.

    +

    Definition at line 2072 of file linalg_core.f90.


    The documentation for this interface was generated from the following file: diff --git a/doc/html/interfacelinalg__core_1_1svd.html b/doc/html/interfacelinalg__core_1_1svd.html index 0d3541d1..4ba42620 100644 --- a/doc/html/interfacelinalg__core_1_1svd.html +++ b/doc/html/interfacelinalg__core_1_1svd.html @@ -149,7 +149,7 @@
    end do
    end program
    Multiplies a diagonal matrix with another matrix or array.
    -
    Computes the singular value decomposition of a matrix A. The SVD is defined as: A = U * S * V**T,...
    +
    Computes the singular value decomposition of a matrix A. The SVD is defined as: A = U * S * V**T,...
    Provides a set of common linear algebra routines.
    Definition: linalg_core.f90:15
    The above program produces the following output.
    U =
    -0.47411577501825380 -0.81850539032073777 -0.32444284226152509
    @@ -167,7 +167,7 @@
    -1.0000000000000000 0.99999999999999967
    -

    Definition at line 1319 of file linalg_core.f90.

    +

    Definition at line 1403 of file linalg_core.f90.


    The documentation for this interface was generated from the following file: diff --git a/doc/html/linalg__c__api_8f90_source.html b/doc/html/linalg__c__api_8f90_source.html index 70f7259c..53e9ea9a 100644 --- a/doc/html/linalg__c__api_8f90_source.html +++ b/doc/html/linalg__c__api_8f90_source.html @@ -2022,29 +2022,29 @@
    3159
    3160! ------------------------------------------------------------------------------
    3161end module
    -
    Computes the Cholesky factorization of a symmetric, positive definite matrix.
    -
    Computes the rank 1 downdate to a Cholesky factored matrix (upper triangular).
    -
    Computes the rank 1 update to a Cholesky factored matrix (upper triangular).
    +
    Computes the Cholesky factorization of a symmetric, positive definite matrix.
    +
    Computes the rank 1 downdate to a Cholesky factored matrix (upper triangular).
    +
    Computes the rank 1 update to a Cholesky factored matrix (upper triangular).
    Computes the determinant of a square matrix.
    Multiplies a diagonal matrix with another matrix or array.
    -
    Computes the eigenvalues, and optionally the eigenvectors, of a matrix.
    +
    Computes the eigenvalues, and optionally the eigenvectors, of a matrix.
    Extracts the L and U matrices from the condensed [L\U] storage format used by the lu_factor.
    -
    Forms the full M-by-M orthogonal matrix Q from the elementary reflectors returned by the base QR fact...
    +
    Forms the full M-by-M orthogonal matrix Q from the elementary reflectors returned by the base QR fact...
    Computes the LU factorization of an M-by-N matrix.
    -
    Computes the inverse of a square matrix.
    -
    Computes the Moore-Penrose pseudo-inverse of a M-by-N matrix using the singular value decomposition o...
    +
    Computes the inverse of a square matrix.
    +
    Computes the Moore-Penrose pseudo-inverse of a M-by-N matrix using the singular value decomposition o...
    Computes the rank of a matrix.
    -
    Multiplies a general matrix by the orthogonal matrix Q from a QR factorization.
    -
    Computes the QR factorization of an M-by-N matrix.
    -
    Computes the rank 1 update to an M-by-N QR factored matrix A (M >= N) where A = Q * R,...
    +
    Multiplies a general matrix by the orthogonal matrix Q from a QR factorization.
    +
    Computes the QR factorization of an M-by-N matrix.
    +
    Computes the rank 1 update to an M-by-N QR factored matrix A (M >= N) where A = Q * R,...
    Performs the rank-1 update to matrix A such that: , where is an M-by-N matrix, is a scalar,...
    -
    Solves a system of Cholesky factored equations.
    -
    Solves the overdetermined or underdetermined system (A*X = B) of M equations of N unknowns.
    -
    Solves a system of LU-factored equations.
    -
    Solves a system of M QR-factored equations of N unknowns.
    -
    Solves a triangular system of equations.
    -
    Sorts an array.
    -
    Computes the singular value decomposition of a matrix A. The SVD is defined as: A = U * S * V**T,...
    +
    Solves a system of Cholesky factored equations.
    +
    Solves the overdetermined or underdetermined system (A*X = B) of M equations of N unknowns.
    +
    Solves a system of LU-factored equations.
    +
    Solves a system of M QR-factored equations of N unknowns.
    +
    Solves a triangular system of equations.
    +
    Sorts an array.
    +
    Computes the singular value decomposition of a matrix A. The SVD is defined as: A = U * S * V**T,...
    Computes the trace of a matrix (the sum of the main diagonal elements).
    Computes the triangular matrix operation: , or , where A is a triangular matrix.
    Provides a C-friendly API to the LINALG library. Notice, all C-API LINALG routines begin with the pre...
    Definition: linalg_c_api.f90:5
    diff --git a/doc/html/linalg__core_8f90_source.html b/doc/html/linalg__core_8f90_source.html index 8551254c..1472212c 100644 --- a/doc/html/linalg__core_8f90_source.html +++ b/doc/html/linalg__core_8f90_source.html @@ -222,1081 +222,1081 @@
    682end interface
    683
    684! ------------------------------------------------------------------------------
    -
    747interface qr_factor
    -
    748 module procedure :: qr_factor_no_pivot
    -
    749 module procedure :: qr_factor_no_pivot_cmplx
    -
    750 module procedure :: qr_factor_pivot
    -
    751 module procedure :: qr_factor_pivot_cmplx
    -
    752end interface
    -
    753
    -
    754! ------------------------------------------------------------------------------
    -
    830interface form_qr
    -
    831 module procedure :: form_qr_no_pivot
    -
    832 module procedure :: form_qr_no_pivot_cmplx
    -
    833 module procedure :: form_qr_pivot
    -
    834 module procedure :: form_qr_pivot_cmplx
    -
    835end interface
    -
    836
    -
    837! ------------------------------------------------------------------------------
    -
    907interface mult_qr
    -
    908 module procedure :: mult_qr_mtx
    -
    909 module procedure :: mult_qr_mtx_cmplx
    -
    910 module procedure :: mult_qr_vec
    -
    911 module procedure :: mult_qr_vec_cmplx
    -
    912end interface
    -
    913
    -
    914! ------------------------------------------------------------------------------
    - -
    1010 module procedure :: qr_rank1_update_dbl
    -
    1011 module procedure :: qr_rank1_update_cmplx
    -
    1012end interface
    -
    1013
    -
    1014! ------------------------------------------------------------------------------
    - -
    1085 module procedure :: cholesky_factor_dbl
    -
    1086 module procedure :: cholesky_factor_cmplx
    -
    1087end interface
    -
    1088
    -
    1089! ------------------------------------------------------------------------------
    - -
    1153 module procedure :: cholesky_rank1_update_dbl
    -
    1154 module procedure :: cholesky_rank1_update_cmplx
    -
    1155end interface
    -
    1156
    -
    1157! ------------------------------------------------------------------------------
    - -
    1226 module procedure :: cholesky_rank1_downdate_dbl
    -
    1227 module procedure :: cholesky_rank1_downdate_cmplx
    -
    1228end interface
    -
    1229
    -
    1230! ------------------------------------------------------------------------------
    -
    1235interface rz_factor
    -
    1236 module procedure :: rz_factor_dbl
    -
    1237 module procedure :: rz_factor_cmplx
    -
    1238end interface
    -
    1239
    -
    1240! ------------------------------------------------------------------------------
    -
    1243interface mult_rz
    -
    1244 module procedure :: mult_rz_mtx
    -
    1245 module procedure :: mult_rz_mtx_cmplx
    -
    1246 module procedure :: mult_rz_vec
    -
    1247 module procedure :: mult_rz_vec_cmplx
    -
    1248end interface
    -
    1249
    -
    1250! ------------------------------------------------------------------------------
    -
    1319interface svd
    -
    1320 module procedure :: svd_dbl
    -
    1321 module procedure :: svd_cmplx
    +
    831interface qr_factor
    +
    832 module procedure :: qr_factor_no_pivot
    +
    833 module procedure :: qr_factor_no_pivot_cmplx
    +
    834 module procedure :: qr_factor_pivot
    +
    835 module procedure :: qr_factor_pivot_cmplx
    +
    836end interface
    +
    837
    +
    838! ------------------------------------------------------------------------------
    +
    914interface form_qr
    +
    915 module procedure :: form_qr_no_pivot
    +
    916 module procedure :: form_qr_no_pivot_cmplx
    +
    917 module procedure :: form_qr_pivot
    +
    918 module procedure :: form_qr_pivot_cmplx
    +
    919end interface
    +
    920
    +
    921! ------------------------------------------------------------------------------
    +
    991interface mult_qr
    +
    992 module procedure :: mult_qr_mtx
    +
    993 module procedure :: mult_qr_mtx_cmplx
    +
    994 module procedure :: mult_qr_vec
    +
    995 module procedure :: mult_qr_vec_cmplx
    +
    996end interface
    +
    997
    +
    998! ------------------------------------------------------------------------------
    + +
    1094 module procedure :: qr_rank1_update_dbl
    +
    1095 module procedure :: qr_rank1_update_cmplx
    +
    1096end interface
    +
    1097
    +
    1098! ------------------------------------------------------------------------------
    + +
    1169 module procedure :: cholesky_factor_dbl
    +
    1170 module procedure :: cholesky_factor_cmplx
    +
    1171end interface
    +
    1172
    +
    1173! ------------------------------------------------------------------------------
    + +
    1237 module procedure :: cholesky_rank1_update_dbl
    +
    1238 module procedure :: cholesky_rank1_update_cmplx
    +
    1239end interface
    +
    1240
    +
    1241! ------------------------------------------------------------------------------
    + +
    1310 module procedure :: cholesky_rank1_downdate_dbl
    +
    1311 module procedure :: cholesky_rank1_downdate_cmplx
    +
    1312end interface
    +
    1313
    +
    1314! ------------------------------------------------------------------------------
    +
    1319interface rz_factor
    +
    1320 module procedure :: rz_factor_dbl
    +
    1321 module procedure :: rz_factor_cmplx
    1322end interface
    1323
    1324! ------------------------------------------------------------------------------
    - -
    1389 module procedure :: solve_tri_mtx
    -
    1390 module procedure :: solve_tri_mtx_cmplx
    -
    1391 module procedure :: solve_tri_vec
    -
    1392 module procedure :: solve_tri_vec_cmplx
    -
    1393end interface
    -
    1394
    -
    1395! ------------------------------------------------------------------------------
    -
    1452interface solve_lu
    -
    1453 module procedure :: solve_lu_mtx
    -
    1454 module procedure :: solve_lu_mtx_cmplx
    -
    1455 module procedure :: solve_lu_vec
    -
    1456 module procedure :: solve_lu_vec_cmplx
    -
    1457end interface
    -
    1458
    -
    1459! ------------------------------------------------------------------------------
    -
    1521interface solve_qr
    -
    1522 module procedure :: solve_qr_no_pivot_mtx
    -
    1523 module procedure :: solve_qr_no_pivot_mtx_cmplx
    -
    1524 module procedure :: solve_qr_no_pivot_vec
    -
    1525 module procedure :: solve_qr_no_pivot_vec_cmplx
    -
    1526 module procedure :: solve_qr_pivot_mtx
    -
    1527 module procedure :: solve_qr_pivot_mtx_cmplx
    -
    1528 module procedure :: solve_qr_pivot_vec
    -
    1529 module procedure :: solve_qr_pivot_vec_cmplx
    -
    1530end interface
    -
    1531
    -
    1532! ------------------------------------------------------------------------------
    - -
    1602 module procedure :: solve_cholesky_mtx
    -
    1603 module procedure :: solve_cholesky_mtx_cmplx
    -
    1604 module procedure :: solve_cholesky_vec
    -
    1605 module procedure :: solve_cholesky_vec_cmplx
    -
    1606end interface
    -
    1607
    -
    1608! ------------------------------------------------------------------------------
    - -
    1656 module procedure :: solve_least_squares_mtx
    -
    1657 module procedure :: solve_least_squares_mtx_cmplx
    -
    1658 module procedure :: solve_least_squares_vec
    -
    1659 module procedure :: solve_least_squares_vec_cmplx
    -
    1660end interface
    -
    1661
    -
    1662! ------------------------------------------------------------------------------
    - -
    1711 module procedure :: solve_least_squares_mtx_pvt
    -
    1712 module procedure :: solve_least_squares_mtx_pvt_cmplx
    -
    1713 module procedure :: solve_least_squares_vec_pvt
    -
    1714 module procedure :: solve_least_squares_vec_pvt_cmplx
    -
    1715end interface
    -
    1716
    -
    1717! ------------------------------------------------------------------------------
    - -
    1766 module procedure :: solve_least_squares_mtx_svd
    -
    1767 module procedure :: solve_least_squares_vec_svd
    -
    1768end interface
    -
    1769
    -
    1770! ------------------------------------------------------------------------------
    - -
    1825 module procedure :: mtx_inverse_dbl
    -
    1826 module procedure :: mtx_inverse_cmplx
    -
    1827end interface
    -
    1828
    -
    1829! ------------------------------------------------------------------------------
    - -
    1886 module procedure :: mtx_pinverse_dbl
    -
    1887 module procedure :: mtx_pinverse_cmplx
    -
    1888end interface
    -
    1889
    -
    1890! ------------------------------------------------------------------------------
    -
    1979interface eigen
    -
    1980 module procedure :: eigen_symm
    -
    1981 module procedure :: eigen_asymm
    -
    1982 module procedure :: eigen_gen
    -
    1983 module procedure :: eigen_cmplx
    -
    1984end interface
    -
    1985
    -
    1986! ------------------------------------------------------------------------------
    -
    1988interface sort
    -
    1989 module procedure :: sort_dbl_array
    -
    1990 module procedure :: sort_dbl_array_ind
    -
    1991 module procedure :: sort_cmplx_array
    -
    1992 module procedure :: sort_cmplx_array_ind
    -
    1993 module procedure :: sort_eigen_cmplx
    -
    1994 module procedure :: sort_eigen_dbl
    -
    1995end interface
    -
    1996
    -
    1997
    -
    1998! ******************************************************************************
    -
    1999! LINALG_BASIC.F90
    -
    2000! ------------------------------------------------------------------------------
    -
    2001interface
    -
    2002 module subroutine mtx_mult_mtx(transa, transb, alpha, a, b, beta, c, err)
    -
    2003 logical, intent(in) :: transa, transb
    -
    2004 real(real64), intent(in) :: alpha, beta
    -
    2005 real(real64), intent(in), dimension(:,:) :: a, b
    -
    2006 real(real64), intent(inout), dimension(:,:) :: c
    -
    2007 class(errors), intent(inout), optional, target :: err
    -
    2008 end subroutine
    -
    2009
    -
    2010 module subroutine mtx_mult_vec(trans, alpha, a, b, beta, c, err)
    -
    2011 logical, intent(in) :: trans
    -
    2012 real(real64), intent(in) :: alpha, beta
    -
    2013 real(real64), intent(in), dimension(:,:) :: a
    -
    2014 real(real64), intent(in), dimension(:) :: b
    -
    2015 real(real64), intent(inout), dimension(:) :: c
    -
    2016 class(errors), intent(inout), optional, target :: err
    -
    2017 end subroutine
    -
    2018
    -
    2019 module subroutine cmtx_mult_mtx(opa, opb, alpha, a, b, beta, c, err)
    -
    2020 integer(int32), intent(in) :: opa, opb
    -
    2021 complex(real64), intent(in) :: alpha, beta
    -
    2022 complex(real64), intent(in), dimension(:,:) :: a, b
    -
    2023 complex(real64), intent(inout), dimension(:,:) :: c
    -
    2024 class(errors), intent(inout), optional, target :: err
    -
    2025 end subroutine
    -
    2026
    -
    2027 module subroutine cmtx_mult_vec(opa, alpha, a, b, beta, c, err)
    -
    2028 integer(int32), intent(in) :: opa
    -
    2029 complex(real64), intent(in) :: alpha, beta
    -
    2030 complex(real64), intent(in), dimension(:,:) :: a
    -
    2031 complex(real64), intent(in), dimension(:) :: b
    -
    2032 complex(real64), intent(inout), dimension(:) :: c
    -
    2033 class(errors), intent(inout), optional, target :: err
    -
    2034 end subroutine
    -
    2035
    -
    2036 module subroutine rank1_update_dbl(alpha, x, y, a, err)
    -
    2037 real(real64), intent(in) :: alpha
    -
    2038 real(real64), intent(in), dimension(:) :: x, y
    -
    2039 real(real64), intent(inout), dimension(:,:) :: a
    -
    2040 class(errors), intent(inout), optional, target :: err
    -
    2041 end subroutine
    -
    2042
    -
    2043 module subroutine rank1_update_cmplx(alpha, x, y, a, err)
    -
    2044 complex(real64), intent(in) :: alpha
    -
    2045 complex(real64), intent(in), dimension(:) :: x, y
    -
    2046 complex(real64), intent(inout), dimension(:,:) :: a
    -
    2047 class(errors), intent(inout), optional, target :: err
    -
    2048 end subroutine
    -
    2049
    -
    2050 module subroutine diag_mtx_mult_mtx(lside, trans, alpha, a, b, beta, c, err)
    -
    2051 logical, intent(in) :: lside, trans
    -
    2052 real(real64) :: alpha, beta
    -
    2053 real(real64), intent(in), dimension(:) :: a
    -
    2054 real(real64), intent(in), dimension(:,:) :: b
    -
    2055 real(real64), intent(inout), dimension(:,:) :: c
    -
    2056 class(errors), intent(inout), optional, target :: err
    -
    2057 end subroutine
    -
    2058
    -
    2059 module subroutine diag_mtx_mult_mtx2(lside, alpha, a, b, err)
    -
    2060 logical, intent(in) :: lside
    -
    2061 real(real64), intent(in) :: alpha
    -
    2062 real(real64), intent(in), dimension(:) :: a
    -
    2063 real(real64), intent(inout), dimension(:,:) :: b
    -
    2064 class(errors), intent(inout), optional, target :: err
    -
    2065 end subroutine
    -
    2066
    -
    2067 module subroutine diag_mtx_mult_mtx3(lside, trans, alpha, a, b, beta, c, err)
    -
    2068 logical, intent(in) :: lside, trans
    -
    2069 real(real64) :: alpha, beta
    -
    2070 complex(real64), intent(in), dimension(:) :: a
    -
    2071 real(real64), intent(in), dimension(:,:) :: b
    -
    2072 complex(real64), intent(inout), dimension(:,:) :: c
    -
    2073 class(errors), intent(inout), optional, target :: err
    -
    2074 end subroutine
    -
    2075
    -
    2076 module subroutine diag_mtx_mult_mtx4(lside, opb, alpha, a, b, beta, c, err)
    -
    2077 logical, intent(in) :: lside
    -
    2078 integer(int32), intent(in) :: opb
    -
    2079 real(real64) :: alpha, beta
    -
    2080 complex(real64), intent(in), dimension(:) :: a
    -
    2081 complex(real64), intent(in), dimension(:,:) :: b
    -
    2082 complex(real64), intent(inout), dimension(:,:) :: c
    -
    2083 class(errors), intent(inout), optional, target :: err
    -
    2084 end subroutine
    -
    2085
    -
    2086 module subroutine diag_mtx_mult_mtx_cmplx(lside, opb, alpha, a, b, beta, c, err)
    -
    2087 logical, intent(in) :: lside
    -
    2088 integer(int32), intent(in) :: opb
    -
    2089 complex(real64) :: alpha, beta
    -
    2090 complex(real64), intent(in), dimension(:) :: a
    -
    2091 complex(real64), intent(in), dimension(:,:) :: b
    -
    2092 complex(real64), intent(inout), dimension(:,:) :: c
    -
    2093 class(errors), intent(inout), optional, target :: err
    -
    2094 end subroutine
    -
    2095
    -
    2096 module subroutine diag_mtx_mult_mtx2_cmplx(lside, alpha, a, b, err)
    -
    2097 logical, intent(in) :: lside
    -
    2098 complex(real64), intent(in) :: alpha
    -
    2099 complex(real64), intent(in), dimension(:) :: a
    -
    2100 complex(real64), intent(inout), dimension(:,:) :: b
    -
    2101 class(errors), intent(inout), optional, target :: err
    -
    2102 end subroutine
    -
    2103
    -
    2104 module subroutine diag_mtx_mult_mtx_mix(lside, opb, alpha, a, b, beta, c, err)
    -
    2105 logical, intent(in) :: lside
    -
    2106 integer(int32), intent(in) :: opb
    -
    2107 complex(real64) :: alpha, beta
    -
    2108 real(real64), intent(in), dimension(:) :: a
    -
    2109 complex(real64), intent(in), dimension(:,:) :: b
    -
    2110 complex(real64), intent(inout), dimension(:,:) :: c
    -
    2111 class(errors), intent(inout), optional, target :: err
    -
    2112 end subroutine
    -
    2113
    -
    2114 module subroutine diag_mtx_mult_mtx2_mix(lside, alpha, a, b, err)
    -
    2115 logical, intent(in) :: lside
    -
    2116 complex(real64), intent(in) :: alpha
    -
    2117 real(real64), intent(in), dimension(:) :: a
    -
    2118 complex(real64), intent(inout), dimension(:,:) :: b
    -
    2119 class(errors), intent(inout), optional, target :: err
    -
    2120 end subroutine
    -
    2121
    -
    2122 pure module function trace_dbl(x) result(y)
    -
    2123 real(real64), intent(in), dimension(:,:) :: x
    -
    2124 real(real64) :: y
    -
    2125 end function
    +
    1327interface mult_rz
    +
    1328 module procedure :: mult_rz_mtx
    +
    1329 module procedure :: mult_rz_mtx_cmplx
    +
    1330 module procedure :: mult_rz_vec
    +
    1331 module procedure :: mult_rz_vec_cmplx
    +
    1332end interface
    +
    1333
    +
    1334! ------------------------------------------------------------------------------
    +
    1403interface svd
    +
    1404 module procedure :: svd_dbl
    +
    1405 module procedure :: svd_cmplx
    +
    1406end interface
    +
    1407
    +
    1408! ------------------------------------------------------------------------------
    + +
    1473 module procedure :: solve_tri_mtx
    +
    1474 module procedure :: solve_tri_mtx_cmplx
    +
    1475 module procedure :: solve_tri_vec
    +
    1476 module procedure :: solve_tri_vec_cmplx
    +
    1477end interface
    +
    1478
    +
    1479! ------------------------------------------------------------------------------
    +
    1536interface solve_lu
    +
    1537 module procedure :: solve_lu_mtx
    +
    1538 module procedure :: solve_lu_mtx_cmplx
    +
    1539 module procedure :: solve_lu_vec
    +
    1540 module procedure :: solve_lu_vec_cmplx
    +
    1541end interface
    +
    1542
    +
    1543! ------------------------------------------------------------------------------
    +
    1605interface solve_qr
    +
    1606 module procedure :: solve_qr_no_pivot_mtx
    +
    1607 module procedure :: solve_qr_no_pivot_mtx_cmplx
    +
    1608 module procedure :: solve_qr_no_pivot_vec
    +
    1609 module procedure :: solve_qr_no_pivot_vec_cmplx
    +
    1610 module procedure :: solve_qr_pivot_mtx
    +
    1611 module procedure :: solve_qr_pivot_mtx_cmplx
    +
    1612 module procedure :: solve_qr_pivot_vec
    +
    1613 module procedure :: solve_qr_pivot_vec_cmplx
    +
    1614end interface
    +
    1615
    +
    1616! ------------------------------------------------------------------------------
    + +
    1686 module procedure :: solve_cholesky_mtx
    +
    1687 module procedure :: solve_cholesky_mtx_cmplx
    +
    1688 module procedure :: solve_cholesky_vec
    +
    1689 module procedure :: solve_cholesky_vec_cmplx
    +
    1690end interface
    +
    1691
    +
    1692! ------------------------------------------------------------------------------
    + +
    1740 module procedure :: solve_least_squares_mtx
    +
    1741 module procedure :: solve_least_squares_mtx_cmplx
    +
    1742 module procedure :: solve_least_squares_vec
    +
    1743 module procedure :: solve_least_squares_vec_cmplx
    +
    1744end interface
    +
    1745
    +
    1746! ------------------------------------------------------------------------------
    + +
    1795 module procedure :: solve_least_squares_mtx_pvt
    +
    1796 module procedure :: solve_least_squares_mtx_pvt_cmplx
    +
    1797 module procedure :: solve_least_squares_vec_pvt
    +
    1798 module procedure :: solve_least_squares_vec_pvt_cmplx
    +
    1799end interface
    +
    1800
    +
    1801! ------------------------------------------------------------------------------
    + +
    1850 module procedure :: solve_least_squares_mtx_svd
    +
    1851 module procedure :: solve_least_squares_vec_svd
    +
    1852end interface
    +
    1853
    +
    1854! ------------------------------------------------------------------------------
    + +
    1909 module procedure :: mtx_inverse_dbl
    +
    1910 module procedure :: mtx_inverse_cmplx
    +
    1911end interface
    +
    1912
    +
    1913! ------------------------------------------------------------------------------
    + +
    1970 module procedure :: mtx_pinverse_dbl
    +
    1971 module procedure :: mtx_pinverse_cmplx
    +
    1972end interface
    +
    1973
    +
    1974! ------------------------------------------------------------------------------
    +
    2063interface eigen
    +
    2064 module procedure :: eigen_symm
    +
    2065 module procedure :: eigen_asymm
    +
    2066 module procedure :: eigen_gen
    +
    2067 module procedure :: eigen_cmplx
    +
    2068end interface
    +
    2069
    +
    2070! ------------------------------------------------------------------------------
    +
    2072interface sort
    +
    2073 module procedure :: sort_dbl_array
    +
    2074 module procedure :: sort_dbl_array_ind
    +
    2075 module procedure :: sort_cmplx_array
    +
    2076 module procedure :: sort_cmplx_array_ind
    +
    2077 module procedure :: sort_eigen_cmplx
    +
    2078 module procedure :: sort_eigen_dbl
    +
    2079end interface
    +
    2080
    +
    2081
    +
    2082! ******************************************************************************
    +
    2083! LINALG_BASIC.F90
    +
    2084! ------------------------------------------------------------------------------
    +
    2085interface
    +
    2086 module subroutine mtx_mult_mtx(transa, transb, alpha, a, b, beta, c, err)
    +
    2087 logical, intent(in) :: transa, transb
    +
    2088 real(real64), intent(in) :: alpha, beta
    +
    2089 real(real64), intent(in), dimension(:,:) :: a, b
    +
    2090 real(real64), intent(inout), dimension(:,:) :: c
    +
    2091 class(errors), intent(inout), optional, target :: err
    +
    2092 end subroutine
    +
    2093
    +
    2094 module subroutine mtx_mult_vec(trans, alpha, a, b, beta, c, err)
    +
    2095 logical, intent(in) :: trans
    +
    2096 real(real64), intent(in) :: alpha, beta
    +
    2097 real(real64), intent(in), dimension(:,:) :: a
    +
    2098 real(real64), intent(in), dimension(:) :: b
    +
    2099 real(real64), intent(inout), dimension(:) :: c
    +
    2100 class(errors), intent(inout), optional, target :: err
    +
    2101 end subroutine
    +
    2102
    +
    2103 module subroutine cmtx_mult_mtx(opa, opb, alpha, a, b, beta, c, err)
    +
    2104 integer(int32), intent(in) :: opa, opb
    +
    2105 complex(real64), intent(in) :: alpha, beta
    +
    2106 complex(real64), intent(in), dimension(:,:) :: a, b
    +
    2107 complex(real64), intent(inout), dimension(:,:) :: c
    +
    2108 class(errors), intent(inout), optional, target :: err
    +
    2109 end subroutine
    +
    2110
    +
    2111 module subroutine cmtx_mult_vec(opa, alpha, a, b, beta, c, err)
    +
    2112 integer(int32), intent(in) :: opa
    +
    2113 complex(real64), intent(in) :: alpha, beta
    +
    2114 complex(real64), intent(in), dimension(:,:) :: a
    +
    2115 complex(real64), intent(in), dimension(:) :: b
    +
    2116 complex(real64), intent(inout), dimension(:) :: c
    +
    2117 class(errors), intent(inout), optional, target :: err
    +
    2118 end subroutine
    +
    2119
    +
    2120 module subroutine rank1_update_dbl(alpha, x, y, a, err)
    +
    2121 real(real64), intent(in) :: alpha
    +
    2122 real(real64), intent(in), dimension(:) :: x, y
    +
    2123 real(real64), intent(inout), dimension(:,:) :: a
    +
    2124 class(errors), intent(inout), optional, target :: err
    +
    2125 end subroutine
    2126
    -
    2127 pure module function trace_cmplx(x) result(y)
    -
    2128 complex(real64), intent(in), dimension(:,:) :: x
    -
    2129 complex(real64) :: y
    -
    2130 end function
    -
    2131
    -
    2132 module function mtx_rank_dbl(a, tol, work, olwork, err) result(rnk)
    -
    2133 real(real64), intent(inout), dimension(:,:) :: a
    -
    2134 real(real64), intent(in), optional :: tol
    -
    2135 real(real64), intent(out), target, optional, dimension(:) :: work
    -
    2136 integer(int32), intent(out), optional :: olwork
    -
    2137 class(errors), intent(inout), optional, target :: err
    -
    2138 integer(int32) :: rnk
    -
    2139 end function
    -
    2140
    -
    2141 module function mtx_rank_cmplx(a, tol, work, olwork, rwork, err) result(rnk)
    -
    2142 complex(real64), intent(inout), dimension(:,:) :: a
    -
    2143 real(real64), intent(in), optional :: tol
    -
    2144 complex(real64), intent(out), target, optional, dimension(:) :: work
    -
    2145 integer(int32), intent(out), optional :: olwork
    -
    2146 real(real64), intent(out), target, optional, dimension(:) :: rwork
    -
    2147 class(errors), intent(inout), optional, target :: err
    -
    2148 integer(int32) :: rnk
    -
    2149 end function
    +
    2127 module subroutine rank1_update_cmplx(alpha, x, y, a, err)
    +
    2128 complex(real64), intent(in) :: alpha
    +
    2129 complex(real64), intent(in), dimension(:) :: x, y
    +
    2130 complex(real64), intent(inout), dimension(:,:) :: a
    +
    2131 class(errors), intent(inout), optional, target :: err
    +
    2132 end subroutine
    +
    2133
    +
    2134 module subroutine diag_mtx_mult_mtx(lside, trans, alpha, a, b, beta, c, err)
    +
    2135 logical, intent(in) :: lside, trans
    +
    2136 real(real64) :: alpha, beta
    +
    2137 real(real64), intent(in), dimension(:) :: a
    +
    2138 real(real64), intent(in), dimension(:,:) :: b
    +
    2139 real(real64), intent(inout), dimension(:,:) :: c
    +
    2140 class(errors), intent(inout), optional, target :: err
    +
    2141 end subroutine
    +
    2142
    +
    2143 module subroutine diag_mtx_mult_mtx2(lside, alpha, a, b, err)
    +
    2144 logical, intent(in) :: lside
    +
    2145 real(real64), intent(in) :: alpha
    +
    2146 real(real64), intent(in), dimension(:) :: a
    +
    2147 real(real64), intent(inout), dimension(:,:) :: b
    +
    2148 class(errors), intent(inout), optional, target :: err
    +
    2149 end subroutine
    2150
    -
    2151 module function det_dbl(a, iwork, err) result(x)
    -
    2152 real(real64), intent(inout), dimension(:,:) :: a
    -
    2153 integer(int32), intent(out), target, optional, dimension(:) :: iwork
    -
    2154 class(errors), intent(inout), optional, target :: err
    -
    2155 real(real64) :: x
    -
    2156 end function
    -
    2157
    -
    2158 module function det_cmplx(a, iwork, err) result(x)
    -
    2159 complex(real64), intent(inout), dimension(:,:) :: a
    -
    2160 integer(int32), intent(out), target, optional, dimension(:) :: iwork
    -
    2161 class(errors), intent(inout), optional, target :: err
    -
    2162 complex(real64) :: x
    -
    2163 end function
    -
    2164
    -
    2165 module subroutine swap_dbl(x, y, err)
    -
    2166 real(real64), intent(inout), dimension(:) :: x, y
    +
    2151 module subroutine diag_mtx_mult_mtx3(lside, trans, alpha, a, b, beta, c, err)
    +
    2152 logical, intent(in) :: lside, trans
    +
    2153 real(real64) :: alpha, beta
    +
    2154 complex(real64), intent(in), dimension(:) :: a
    +
    2155 real(real64), intent(in), dimension(:,:) :: b
    +
    2156 complex(real64), intent(inout), dimension(:,:) :: c
    +
    2157 class(errors), intent(inout), optional, target :: err
    +
    2158 end subroutine
    +
    2159
    +
    2160 module subroutine diag_mtx_mult_mtx4(lside, opb, alpha, a, b, beta, c, err)
    +
    2161 logical, intent(in) :: lside
    +
    2162 integer(int32), intent(in) :: opb
    +
    2163 real(real64) :: alpha, beta
    +
    2164 complex(real64), intent(in), dimension(:) :: a
    +
    2165 complex(real64), intent(in), dimension(:,:) :: b
    +
    2166 complex(real64), intent(inout), dimension(:,:) :: c
    2167 class(errors), intent(inout), optional, target :: err
    2168 end subroutine
    -
    2169
    -
    2170 module subroutine swap_cmplx(x, y, err)
    -
    2171 complex(real64), intent(inout), dimension(:) :: x, y
    -
    2172 class(errors), intent(inout), optional, target :: err
    -
    2173 end subroutine
    -
    2174
    -
    2175 module subroutine recip_mult_array_dbl(a, x)
    -
    2176 real(real64), intent(in) :: a
    -
    2177 real(real64), intent(inout), dimension(:) :: x
    +
    2169
    +
    2170 module subroutine diag_mtx_mult_mtx_cmplx(lside, opb, alpha, a, b, beta, c, err)
    +
    2171 logical, intent(in) :: lside
    +
    2172 integer(int32), intent(in) :: opb
    +
    2173 complex(real64) :: alpha, beta
    +
    2174 complex(real64), intent(in), dimension(:) :: a
    +
    2175 complex(real64), intent(in), dimension(:,:) :: b
    +
    2176 complex(real64), intent(inout), dimension(:,:) :: c
    +
    2177 class(errors), intent(inout), optional, target :: err
    2178 end subroutine
    -
    2179
    -
    2180 module subroutine tri_mtx_mult_dbl(upper, alpha, a, beta, b, err)
    -
    2181 logical, intent(in) :: upper
    -
    2182 real(real64), intent(in) :: alpha, beta
    -
    2183 real(real64), intent(in), dimension(:,:) :: a
    -
    2184 real(real64), intent(inout), dimension(:,:) :: b
    +
    2179
    +
    2180 module subroutine diag_mtx_mult_mtx2_cmplx(lside, alpha, a, b, err)
    +
    2181 logical, intent(in) :: lside
    +
    2182 complex(real64), intent(in) :: alpha
    +
    2183 complex(real64), intent(in), dimension(:) :: a
    +
    2184 complex(real64), intent(inout), dimension(:,:) :: b
    2185 class(errors), intent(inout), optional, target :: err
    2186 end subroutine
    -
    2187
    -
    2188 module subroutine tri_mtx_mult_cmplx(upper, alpha, a, beta, b, err)
    -
    2189 logical, intent(in) :: upper
    -
    2190 complex(real64), intent(in) :: alpha, beta
    -
    2191 complex(real64), intent(in), dimension(:,:) :: a
    -
    2192 complex(real64), intent(inout), dimension(:,:) :: b
    -
    2193 class(errors), intent(inout), optional, target :: err
    -
    2194 end subroutine
    -
    2195
    -
    2196end interface
    -
    2197
    -
    2198! ******************************************************************************
    -
    2199! LINALG_FACTOR.F90
    -
    2200! ------------------------------------------------------------------------------
    -
    2201interface
    -
    2202 module subroutine lu_factor_dbl(a, ipvt, err)
    -
    2203 real(real64), intent(inout), dimension(:,:) :: a
    -
    2204 integer(int32), intent(out), dimension(:) :: ipvt
    -
    2205 class(errors), intent(inout), optional, target :: err
    -
    2206 end subroutine
    -
    2207
    -
    2208 module subroutine lu_factor_cmplx(a, ipvt, err)
    -
    2209 complex(real64), intent(inout), dimension(:,:) :: a
    -
    2210 integer(int32), intent(out), dimension(:) :: ipvt
    -
    2211 class(errors), intent(inout), optional, target :: err
    -
    2212 end subroutine
    -
    2213
    -
    2214 module subroutine form_lu_all(lu, ipvt, u, p, err)
    -
    2215 real(real64), intent(inout), dimension(:,:) :: lu
    -
    2216 integer(int32), intent(in), dimension(:) :: ipvt
    -
    2217 real(real64), intent(out), dimension(:,:) :: u, p
    -
    2218 class(errors), intent(inout), optional, target :: err
    -
    2219 end subroutine
    -
    2220
    -
    2221 module subroutine form_lu_all_cmplx(lu, ipvt, u, p, err)
    -
    2222 complex(real64), intent(inout), dimension(:,:) :: lu
    -
    2223 integer(int32), intent(in), dimension(:) :: ipvt
    -
    2224 complex(real64), intent(out), dimension(:,:) :: u
    -
    2225 real(real64), intent(out), dimension(:,:) :: p
    -
    2226 class(errors), intent(inout), optional, target :: err
    -
    2227 end subroutine
    -
    2228
    -
    2229 module subroutine form_lu_only(lu, u, err)
    -
    2230 real(real64), intent(inout), dimension(:,:) :: lu
    -
    2231 real(real64), intent(out), dimension(:,:) :: u
    -
    2232 class(errors), intent(inout), optional, target :: err
    -
    2233 end subroutine
    +
    2187
    +
    2188 module subroutine diag_mtx_mult_mtx_mix(lside, opb, alpha, a, b, beta, c, err)
    +
    2189 logical, intent(in) :: lside
    +
    2190 integer(int32), intent(in) :: opb
    +
    2191 complex(real64) :: alpha, beta
    +
    2192 real(real64), intent(in), dimension(:) :: a
    +
    2193 complex(real64), intent(in), dimension(:,:) :: b
    +
    2194 complex(real64), intent(inout), dimension(:,:) :: c
    +
    2195 class(errors), intent(inout), optional, target :: err
    +
    2196 end subroutine
    +
    2197
    +
    2198 module subroutine diag_mtx_mult_mtx2_mix(lside, alpha, a, b, err)
    +
    2199 logical, intent(in) :: lside
    +
    2200 complex(real64), intent(in) :: alpha
    +
    2201 real(real64), intent(in), dimension(:) :: a
    +
    2202 complex(real64), intent(inout), dimension(:,:) :: b
    +
    2203 class(errors), intent(inout), optional, target :: err
    +
    2204 end subroutine
    +
    2205
    +
    2206 pure module function trace_dbl(x) result(y)
    +
    2207 real(real64), intent(in), dimension(:,:) :: x
    +
    2208 real(real64) :: y
    +
    2209 end function
    +
    2210
    +
    2211 pure module function trace_cmplx(x) result(y)
    +
    2212 complex(real64), intent(in), dimension(:,:) :: x
    +
    2213 complex(real64) :: y
    +
    2214 end function
    +
    2215
    +
    2216 module function mtx_rank_dbl(a, tol, work, olwork, err) result(rnk)
    +
    2217 real(real64), intent(inout), dimension(:,:) :: a
    +
    2218 real(real64), intent(in), optional :: tol
    +
    2219 real(real64), intent(out), target, optional, dimension(:) :: work
    +
    2220 integer(int32), intent(out), optional :: olwork
    +
    2221 class(errors), intent(inout), optional, target :: err
    +
    2222 integer(int32) :: rnk
    +
    2223 end function
    +
    2224
    +
    2225 module function mtx_rank_cmplx(a, tol, work, olwork, rwork, err) result(rnk)
    +
    2226 complex(real64), intent(inout), dimension(:,:) :: a
    +
    2227 real(real64), intent(in), optional :: tol
    +
    2228 complex(real64), intent(out), target, optional, dimension(:) :: work
    +
    2229 integer(int32), intent(out), optional :: olwork
    +
    2230 real(real64), intent(out), target, optional, dimension(:) :: rwork
    +
    2231 class(errors), intent(inout), optional, target :: err
    +
    2232 integer(int32) :: rnk
    +
    2233 end function
    2234
    -
    2235 module subroutine form_lu_only_cmplx(lu, u, err)
    -
    2236 complex(real64), intent(inout), dimension(:,:) :: lu
    -
    2237 complex(real64), intent(out), dimension(:,:) :: u
    +
    2235 module function det_dbl(a, iwork, err) result(x)
    +
    2236 real(real64), intent(inout), dimension(:,:) :: a
    +
    2237 integer(int32), intent(out), target, optional, dimension(:) :: iwork
    2238 class(errors), intent(inout), optional, target :: err
    -
    2239 end subroutine
    -
    2240
    -
    2276 module subroutine qr_factor_no_pivot(a, tau, work, olwork, err)
    -
    2277 real(real64), intent(inout), dimension(:,:) :: a
    -
    2278 real(real64), intent(out), dimension(:) :: tau
    -
    2279 real(real64), intent(out), target, dimension(:), optional :: work
    -
    2280 integer(int32), intent(out), optional :: olwork
    -
    2281 class(errors), intent(inout), optional, target :: err
    -
    2282 end subroutine
    -
    2283
    -
    2319 module subroutine qr_factor_no_pivot_cmplx(a, tau, work, olwork, err)
    -
    2320 complex(real64), intent(inout), dimension(:,:) :: a
    -
    2321 complex(real64), intent(out), dimension(:) :: tau
    -
    2322 complex(real64), intent(out), target, dimension(:), optional :: work
    -
    2323 integer(int32), intent(out), optional :: olwork
    -
    2324 class(errors), intent(inout), optional, target :: err
    -
    2325 end subroutine
    -
    2326
    -
    2360 module subroutine qr_factor_pivot(a, tau, jpvt, work, olwork, err)
    -
    2361 real(real64), intent(inout), dimension(:,:) :: a
    -
    2362 real(real64), intent(out), dimension(:) :: tau
    -
    2363 integer(int32), intent(inout), dimension(:) :: jpvt
    -
    2364 real(real64), intent(out), target, dimension(:), optional :: work
    -
    2365 integer(int32), intent(out), optional :: olwork
    -
    2366 class(errors), intent(inout), optional, target :: err
    -
    2367 end subroutine
    -
    2368
    -
    2406 module subroutine qr_factor_pivot_cmplx(a, tau, jpvt, work, olwork, rwork, &
    -
    2407 err)
    -
    2408 complex(real64), intent(inout), dimension(:,:) :: a
    -
    2409 complex(real64), intent(out), dimension(:) :: tau
    -
    2410 integer(int32), intent(inout), dimension(:) :: jpvt
    -
    2411 complex(real64), intent(out), target, dimension(:), optional :: work
    -
    2412 integer(int32), intent(out), optional :: olwork
    -
    2413 real(real64), intent(out), target, dimension(:), optional :: rwork
    -
    2414 class(errors), intent(inout), optional, target :: err
    -
    2415 end subroutine
    -
    2416
    -
    2450 module subroutine form_qr_no_pivot(r, tau, q, work, olwork, err)
    -
    2451 real(real64), intent(inout), dimension(:,:) :: r
    -
    2452 real(real64), intent(in), dimension(:) :: tau
    -
    2453 real(real64), intent(out), dimension(:,:) :: q
    -
    2454 real(real64), intent(out), target, dimension(:), optional :: work
    -
    2455 integer(int32), intent(out), optional :: olwork
    -
    2456 class(errors), intent(inout), optional, target :: err
    -
    2457 end subroutine
    -
    2458
    -
    2492 module subroutine form_qr_no_pivot_cmplx(r, tau, q, work, olwork, err)
    -
    2493 complex(real64), intent(inout), dimension(:,:) :: r
    -
    2494 complex(real64), intent(in), dimension(:) :: tau
    -
    2495 complex(real64), intent(out), dimension(:,:) :: q
    -
    2496 complex(real64), intent(out), target, dimension(:), optional :: work
    -
    2497 integer(int32), intent(out), optional :: olwork
    -
    2498 class(errors), intent(inout), optional, target :: err
    -
    2499 end subroutine
    -
    2500
    -
    2537 module subroutine form_qr_pivot(r, tau, pvt, q, p, work, olwork, err)
    -
    2538 real(real64), intent(inout), dimension(:,:) :: r
    -
    2539 real(real64), intent(in), dimension(:) :: tau
    -
    2540 integer(int32), intent(in), dimension(:) :: pvt
    -
    2541 real(real64), intent(out), dimension(:,:) :: q, p
    -
    2542 real(real64), intent(out), target, dimension(:), optional :: work
    -
    2543 integer(int32), intent(out), optional :: olwork
    -
    2544 class(errors), intent(inout), optional, target :: err
    -
    2545 end subroutine
    -
    2546
    -
    2583 module subroutine form_qr_pivot_cmplx(r, tau, pvt, q, p, work, olwork, err)
    -
    2584 complex(real64), intent(inout), dimension(:,:) :: r
    -
    2585 complex(real64), intent(in), dimension(:) :: tau
    -
    2586 integer(int32), intent(in), dimension(:) :: pvt
    -
    2587 complex(real64), intent(out), dimension(:,:) :: q, p
    -
    2588 complex(real64), intent(out), target, dimension(:), optional :: work
    -
    2589 integer(int32), intent(out), optional :: olwork
    -
    2590 class(errors), intent(inout), optional, target :: err
    -
    2591 end subroutine
    -
    2592
    -
    2627 module subroutine mult_qr_mtx(lside, trans, a, tau, c, work, olwork, err)
    -
    2628 logical, intent(in) :: lside, trans
    -
    2629 real(real64), intent(in), dimension(:) :: tau
    -
    2630 real(real64), intent(inout), dimension(:,:) :: a, c
    -
    2631 real(real64), intent(out), target, dimension(:), optional :: work
    -
    2632 integer(int32), intent(out), optional :: olwork
    -
    2633 class(errors), intent(inout), optional, target :: err
    -
    2634 end subroutine
    -
    2635
    -
    2670 module subroutine mult_qr_mtx_cmplx(lside, trans, a, tau, c, work, olwork, err)
    -
    2671 logical, intent(in) :: lside, trans
    -
    2672 complex(real64), intent(in), dimension(:) :: tau
    -
    2673 complex(real64), intent(inout), dimension(:,:) :: a, c
    -
    2674 complex(real64), intent(out), target, dimension(:), optional :: work
    -
    2675 integer(int32), intent(out), optional :: olwork
    -
    2676 class(errors), intent(inout), optional, target :: err
    -
    2677 end subroutine
    -
    2678
    -
    2709 module subroutine mult_qr_vec(trans, a, tau, c, work, olwork, err)
    -
    2710 logical, intent(in) :: trans
    -
    2711 real(real64), intent(inout), dimension(:,:) :: a
    -
    2712 real(real64), intent(in), dimension(:) :: tau
    -
    2713 real(real64), intent(inout), dimension(:) :: c
    -
    2714 real(real64), intent(out), target, dimension(:), optional :: work
    -
    2715 integer(int32), intent(out), optional :: olwork
    -
    2716 class(errors), intent(inout), optional, target :: err
    -
    2717 end subroutine
    -
    2718
    -
    2749 module subroutine mult_qr_vec_cmplx(trans, a, tau, c, work, olwork, err)
    -
    2750 logical, intent(in) :: trans
    -
    2751 complex(real64), intent(inout), dimension(:,:) :: a
    -
    2752 complex(real64), intent(in), dimension(:) :: tau
    -
    2753 complex(real64), intent(inout), dimension(:) :: c
    -
    2754 complex(real64), intent(out), target, dimension(:), optional :: work
    -
    2755 integer(int32), intent(out), optional :: olwork
    -
    2756 class(errors), intent(inout), optional, target :: err
    -
    2757 end subroutine
    -
    2758
    -
    2799 module subroutine qr_rank1_update_dbl(q, r, u, v, work, err)
    -
    2800 real(real64), intent(inout), dimension(:,:) :: q, r
    -
    2801 real(real64), intent(inout), dimension(:) :: u, v
    -
    2802 real(real64), intent(out), target, optional, dimension(:) :: work
    -
    2803 class(errors), intent(inout), optional, target :: err
    -
    2804 end subroutine
    -
    2805
    -
    2849 module subroutine qr_rank1_update_cmplx(q, r, u, v, work, rwork, err)
    -
    2850 complex(real64), intent(inout), dimension(:,:) :: q, r
    -
    2851 complex(real64), intent(inout), dimension(:) :: u, v
    -
    2852 complex(real64), intent(out), target, optional, dimension(:) :: work
    -
    2853 real(real64), intent(out), target, optional, dimension(:) :: rwork
    -
    2854 class(errors), intent(inout), optional, target :: err
    -
    2855 end subroutine
    -
    2856
    -
    2877 module subroutine cholesky_factor_dbl(a, upper, err)
    -
    2878 real(real64), intent(inout), dimension(:,:) :: a
    -
    2879 logical, intent(in), optional :: upper
    -
    2880 class(errors), intent(inout), optional, target :: err
    -
    2881 end subroutine
    -
    2882
    -
    2903 module subroutine cholesky_factor_cmplx(a, upper, err)
    -
    2904 complex(real64), intent(inout), dimension(:,:) :: a
    -
    2905 logical, intent(in), optional :: upper
    -
    2906 class(errors), intent(inout), optional, target :: err
    -
    2907 end subroutine
    -
    2908
    -
    2935 module subroutine cholesky_rank1_update_dbl(r, u, work, err)
    -
    2936 real(real64), intent(inout), dimension(:,:) :: r
    -
    2937 real(real64), intent(inout), dimension(:) :: u
    -
    2938 real(real64), intent(out), target, optional, dimension(:) :: work
    -
    2939 class(errors), intent(inout), optional, target :: err
    -
    2940 end subroutine
    -
    2941
    -
    2968 module subroutine cholesky_rank1_update_cmplx(r, u, work, err)
    -
    2969 complex(real64), intent(inout), dimension(:,:) :: r
    -
    2970 complex(real64), intent(inout), dimension(:) :: u
    -
    2971 real(real64), intent(out), target, optional, dimension(:) :: work
    -
    2972 class(errors), intent(inout), optional, target :: err
    -
    2973 end subroutine
    -
    2974
    -
    3004 module subroutine cholesky_rank1_downdate_dbl(r, u, work, err)
    -
    3005 real(real64), intent(inout), dimension(:,:) :: r
    -
    3006 real(real64), intent(inout), dimension(:) :: u
    -
    3007 real(real64), intent(out), target, optional, dimension(:) :: work
    -
    3008 class(errors), intent(inout), optional, target :: err
    -
    3009 end subroutine
    -
    3010
    -
    3040 module subroutine cholesky_rank1_downdate_cmplx(r, u, work, err)
    -
    3041 complex(real64), intent(inout), dimension(:,:) :: r
    -
    3042 complex(real64), intent(inout), dimension(:) :: u
    -
    3043 real(real64), intent(out), target, optional, dimension(:) :: work
    -
    3044 class(errors), intent(inout), optional, target :: err
    -
    3045 end subroutine
    -
    3046
    -
    3109 module subroutine rz_factor_dbl(a, tau, work, olwork, err)
    -
    3110 real(real64), intent(inout), dimension(:,:) :: a
    -
    3111 real(real64), intent(out), dimension(:) :: tau
    -
    3112 real(real64), intent(out), target, optional, dimension(:) :: work
    -
    3113 integer(int32), intent(out), optional :: olwork
    -
    3114 class(errors), intent(inout), optional, target :: err
    -
    3115 end subroutine
    -
    3116
    -
    3179 module subroutine rz_factor_cmplx(a, tau, work, olwork, err)
    -
    3180 complex(real64), intent(inout), dimension(:,:) :: a
    -
    3181 complex(real64), intent(out), dimension(:) :: tau
    -
    3182 complex(real64), intent(out), target, optional, dimension(:) :: work
    -
    3183 integer(int32), intent(out), optional :: olwork
    -
    3184 class(errors), intent(inout), optional, target :: err
    -
    3185 end subroutine
    -
    3186
    -
    3224 module subroutine mult_rz_mtx(lside, trans, l, a, tau, c, work, olwork, err)
    -
    3225 logical, intent(in) :: lside, trans
    -
    3226 integer(int32), intent(in) :: l
    -
    3227 real(real64), intent(inout), dimension(:,:) :: a, c
    -
    3228 real(real64), intent(in), dimension(:) :: tau
    -
    3229 real(real64), intent(out), target, optional, dimension(:) :: work
    -
    3230 integer(int32), intent(out), optional :: olwork
    -
    3231 class(errors), intent(inout), optional, target :: err
    -
    3232 end subroutine
    -
    3233
    -
    3271 module subroutine mult_rz_mtx_cmplx(lside, trans, l, a, tau, c, work, olwork, err)
    -
    3272 logical, intent(in) :: lside, trans
    -
    3273 integer(int32), intent(in) :: l
    -
    3274 complex(real64), intent(inout), dimension(:,:) :: a, c
    -
    3275 complex(real64), intent(in), dimension(:) :: tau
    -
    3276 complex(real64), intent(out), target, optional, dimension(:) :: work
    -
    3277 integer(int32), intent(out), optional :: olwork
    -
    3278 class(errors), intent(inout), optional, target :: err
    -
    3279 end subroutine
    -
    3280
    -
    3316 module subroutine mult_rz_vec(trans, l, a, tau, c, work, olwork, err)
    -
    3317 logical, intent(in) :: trans
    -
    3318 integer(int32), intent(in) :: l
    -
    3319 real(real64), intent(inout), dimension(:,:) :: a
    -
    3320 real(real64), intent(in), dimension(:) :: tau
    -
    3321 real(real64), intent(inout), dimension(:) :: c
    -
    3322 real(real64), intent(out), target, optional, dimension(:) :: work
    -
    3323 integer(int32), intent(out), optional :: olwork
    -
    3324 class(errors), intent(inout), optional, target :: err
    -
    3325 end subroutine
    -
    3326
    -
    3362 module subroutine mult_rz_vec_cmplx(trans, l, a, tau, c, work, olwork, err)
    -
    3363 logical, intent(in) :: trans
    -
    3364 integer(int32), intent(in) :: l
    -
    3365 complex(real64), intent(inout), dimension(:,:) :: a
    -
    3366 complex(real64), intent(in), dimension(:) :: tau
    -
    3367 complex(real64), intent(inout), dimension(:) :: c
    -
    3368 complex(real64), intent(out), target, optional, dimension(:) :: work
    -
    3369 integer(int32), intent(out), optional :: olwork
    -
    3370 class(errors), intent(inout), optional, target :: err
    -
    3371 end subroutine
    -
    3372
    -
    3415 module subroutine svd_dbl(a, s, u, vt, work, olwork, err)
    -
    3416 real(real64), intent(inout), dimension(:,:) :: a
    -
    3417 real(real64), intent(out), dimension(:) :: s
    -
    3418 real(real64), intent(out), optional, dimension(:,:) :: u, vt
    -
    3419 real(real64), intent(out), target, optional, dimension(:) :: work
    -
    3420 integer(int32), intent(out), optional :: olwork
    +
    2239 real(real64) :: x
    +
    2240 end function
    +
    2241
    +
    2242 module function det_cmplx(a, iwork, err) result(x)
    +
    2243 complex(real64), intent(inout), dimension(:,:) :: a
    +
    2244 integer(int32), intent(out), target, optional, dimension(:) :: iwork
    +
    2245 class(errors), intent(inout), optional, target :: err
    +
    2246 complex(real64) :: x
    +
    2247 end function
    +
    2248
    +
    2249 module subroutine swap_dbl(x, y, err)
    +
    2250 real(real64), intent(inout), dimension(:) :: x, y
    +
    2251 class(errors), intent(inout), optional, target :: err
    +
    2252 end subroutine
    +
    2253
    +
    2254 module subroutine swap_cmplx(x, y, err)
    +
    2255 complex(real64), intent(inout), dimension(:) :: x, y
    +
    2256 class(errors), intent(inout), optional, target :: err
    +
    2257 end subroutine
    +
    2258
    +
    2259 module subroutine recip_mult_array_dbl(a, x)
    +
    2260 real(real64), intent(in) :: a
    +
    2261 real(real64), intent(inout), dimension(:) :: x
    +
    2262 end subroutine
    +
    2263
    +
    2264 module subroutine tri_mtx_mult_dbl(upper, alpha, a, beta, b, err)
    +
    2265 logical, intent(in) :: upper
    +
    2266 real(real64), intent(in) :: alpha, beta
    +
    2267 real(real64), intent(in), dimension(:,:) :: a
    +
    2268 real(real64), intent(inout), dimension(:,:) :: b
    +
    2269 class(errors), intent(inout), optional, target :: err
    +
    2270 end subroutine
    +
    2271
    +
    2272 module subroutine tri_mtx_mult_cmplx(upper, alpha, a, beta, b, err)
    +
    2273 logical, intent(in) :: upper
    +
    2274 complex(real64), intent(in) :: alpha, beta
    +
    2275 complex(real64), intent(in), dimension(:,:) :: a
    +
    2276 complex(real64), intent(inout), dimension(:,:) :: b
    +
    2277 class(errors), intent(inout), optional, target :: err
    +
    2278 end subroutine
    +
    2279
    +
    2280end interface
    +
    2281
    +
    2282! ******************************************************************************
    +
    2283! LINALG_FACTOR.F90
    +
    2284! ------------------------------------------------------------------------------
    +
    2285interface
    +
    2286 module subroutine lu_factor_dbl(a, ipvt, err)
    +
    2287 real(real64), intent(inout), dimension(:,:) :: a
    +
    2288 integer(int32), intent(out), dimension(:) :: ipvt
    +
    2289 class(errors), intent(inout), optional, target :: err
    +
    2290 end subroutine
    +
    2291
    +
    2292 module subroutine lu_factor_cmplx(a, ipvt, err)
    +
    2293 complex(real64), intent(inout), dimension(:,:) :: a
    +
    2294 integer(int32), intent(out), dimension(:) :: ipvt
    +
    2295 class(errors), intent(inout), optional, target :: err
    +
    2296 end subroutine
    +
    2297
    +
    2298 module subroutine form_lu_all(lu, ipvt, u, p, err)
    +
    2299 real(real64), intent(inout), dimension(:,:) :: lu
    +
    2300 integer(int32), intent(in), dimension(:) :: ipvt
    +
    2301 real(real64), intent(out), dimension(:,:) :: u, p
    +
    2302 class(errors), intent(inout), optional, target :: err
    +
    2303 end subroutine
    +
    2304
    +
    2305 module subroutine form_lu_all_cmplx(lu, ipvt, u, p, err)
    +
    2306 complex(real64), intent(inout), dimension(:,:) :: lu
    +
    2307 integer(int32), intent(in), dimension(:) :: ipvt
    +
    2308 complex(real64), intent(out), dimension(:,:) :: u
    +
    2309 real(real64), intent(out), dimension(:,:) :: p
    +
    2310 class(errors), intent(inout), optional, target :: err
    +
    2311 end subroutine
    +
    2312
    +
    2313 module subroutine form_lu_only(lu, u, err)
    +
    2314 real(real64), intent(inout), dimension(:,:) :: lu
    +
    2315 real(real64), intent(out), dimension(:,:) :: u
    +
    2316 class(errors), intent(inout), optional, target :: err
    +
    2317 end subroutine
    +
    2318
    +
    2319 module subroutine form_lu_only_cmplx(lu, u, err)
    +
    2320 complex(real64), intent(inout), dimension(:,:) :: lu
    +
    2321 complex(real64), intent(out), dimension(:,:) :: u
    +
    2322 class(errors), intent(inout), optional, target :: err
    +
    2323 end subroutine
    +
    2324
    +
    2325 module subroutine qr_factor_no_pivot(a, tau, work, olwork, err)
    +
    2326 real(real64), intent(inout), dimension(:,:) :: a
    +
    2327 real(real64), intent(out), dimension(:) :: tau
    +
    2328 real(real64), intent(out), target, dimension(:), optional :: work
    +
    2329 integer(int32), intent(out), optional :: olwork
    +
    2330 class(errors), intent(inout), optional, target :: err
    +
    2331 end subroutine
    +
    2332
    +
    2333 module subroutine qr_factor_no_pivot_cmplx(a, tau, work, olwork, err)
    +
    2334 complex(real64), intent(inout), dimension(:,:) :: a
    +
    2335 complex(real64), intent(out), dimension(:) :: tau
    +
    2336 complex(real64), intent(out), target, dimension(:), optional :: work
    +
    2337 integer(int32), intent(out), optional :: olwork
    +
    2338 class(errors), intent(inout), optional, target :: err
    +
    2339 end subroutine
    +
    2340
    +
    2341 module subroutine qr_factor_pivot(a, tau, jpvt, work, olwork, err)
    +
    2342 real(real64), intent(inout), dimension(:,:) :: a
    +
    2343 real(real64), intent(out), dimension(:) :: tau
    +
    2344 integer(int32), intent(inout), dimension(:) :: jpvt
    +
    2345 real(real64), intent(out), target, dimension(:), optional :: work
    +
    2346 integer(int32), intent(out), optional :: olwork
    +
    2347 class(errors), intent(inout), optional, target :: err
    +
    2348 end subroutine
    +
    2349
    +
    2350 module subroutine qr_factor_pivot_cmplx(a, tau, jpvt, work, olwork, rwork, &
    +
    2351 err)
    +
    2352 complex(real64), intent(inout), dimension(:,:) :: a
    +
    2353 complex(real64), intent(out), dimension(:) :: tau
    +
    2354 integer(int32), intent(inout), dimension(:) :: jpvt
    +
    2355 complex(real64), intent(out), target, dimension(:), optional :: work
    +
    2356 integer(int32), intent(out), optional :: olwork
    +
    2357 real(real64), intent(out), target, dimension(:), optional :: rwork
    +
    2358 class(errors), intent(inout), optional, target :: err
    +
    2359 end subroutine
    +
    2360
    +
    2394 module subroutine form_qr_no_pivot(r, tau, q, work, olwork, err)
    +
    2395 real(real64), intent(inout), dimension(:,:) :: r
    +
    2396 real(real64), intent(in), dimension(:) :: tau
    +
    2397 real(real64), intent(out), dimension(:,:) :: q
    +
    2398 real(real64), intent(out), target, dimension(:), optional :: work
    +
    2399 integer(int32), intent(out), optional :: olwork
    +
    2400 class(errors), intent(inout), optional, target :: err
    +
    2401 end subroutine
    +
    2402
    +
    2436 module subroutine form_qr_no_pivot_cmplx(r, tau, q, work, olwork, err)
    +
    2437 complex(real64), intent(inout), dimension(:,:) :: r
    +
    2438 complex(real64), intent(in), dimension(:) :: tau
    +
    2439 complex(real64), intent(out), dimension(:,:) :: q
    +
    2440 complex(real64), intent(out), target, dimension(:), optional :: work
    +
    2441 integer(int32), intent(out), optional :: olwork
    +
    2442 class(errors), intent(inout), optional, target :: err
    +
    2443 end subroutine
    +
    2444
    +
    2481 module subroutine form_qr_pivot(r, tau, pvt, q, p, work, olwork, err)
    +
    2482 real(real64), intent(inout), dimension(:,:) :: r
    +
    2483 real(real64), intent(in), dimension(:) :: tau
    +
    2484 integer(int32), intent(in), dimension(:) :: pvt
    +
    2485 real(real64), intent(out), dimension(:,:) :: q, p
    +
    2486 real(real64), intent(out), target, dimension(:), optional :: work
    +
    2487 integer(int32), intent(out), optional :: olwork
    +
    2488 class(errors), intent(inout), optional, target :: err
    +
    2489 end subroutine
    +
    2490
    +
    2527 module subroutine form_qr_pivot_cmplx(r, tau, pvt, q, p, work, olwork, err)
    +
    2528 complex(real64), intent(inout), dimension(:,:) :: r
    +
    2529 complex(real64), intent(in), dimension(:) :: tau
    +
    2530 integer(int32), intent(in), dimension(:) :: pvt
    +
    2531 complex(real64), intent(out), dimension(:,:) :: q, p
    +
    2532 complex(real64), intent(out), target, dimension(:), optional :: work
    +
    2533 integer(int32), intent(out), optional :: olwork
    +
    2534 class(errors), intent(inout), optional, target :: err
    +
    2535 end subroutine
    +
    2536
    +
    2571 module subroutine mult_qr_mtx(lside, trans, a, tau, c, work, olwork, err)
    +
    2572 logical, intent(in) :: lside, trans
    +
    2573 real(real64), intent(in), dimension(:) :: tau
    +
    2574 real(real64), intent(inout), dimension(:,:) :: a, c
    +
    2575 real(real64), intent(out), target, dimension(:), optional :: work
    +
    2576 integer(int32), intent(out), optional :: olwork
    +
    2577 class(errors), intent(inout), optional, target :: err
    +
    2578 end subroutine
    +
    2579
    +
    2614 module subroutine mult_qr_mtx_cmplx(lside, trans, a, tau, c, work, olwork, err)
    +
    2615 logical, intent(in) :: lside, trans
    +
    2616 complex(real64), intent(in), dimension(:) :: tau
    +
    2617 complex(real64), intent(inout), dimension(:,:) :: a, c
    +
    2618 complex(real64), intent(out), target, dimension(:), optional :: work
    +
    2619 integer(int32), intent(out), optional :: olwork
    +
    2620 class(errors), intent(inout), optional, target :: err
    +
    2621 end subroutine
    +
    2622
    +
    2653 module subroutine mult_qr_vec(trans, a, tau, c, work, olwork, err)
    +
    2654 logical, intent(in) :: trans
    +
    2655 real(real64), intent(inout), dimension(:,:) :: a
    +
    2656 real(real64), intent(in), dimension(:) :: tau
    +
    2657 real(real64), intent(inout), dimension(:) :: c
    +
    2658 real(real64), intent(out), target, dimension(:), optional :: work
    +
    2659 integer(int32), intent(out), optional :: olwork
    +
    2660 class(errors), intent(inout), optional, target :: err
    +
    2661 end subroutine
    +
    2662
    +
    2693 module subroutine mult_qr_vec_cmplx(trans, a, tau, c, work, olwork, err)
    +
    2694 logical, intent(in) :: trans
    +
    2695 complex(real64), intent(inout), dimension(:,:) :: a
    +
    2696 complex(real64), intent(in), dimension(:) :: tau
    +
    2697 complex(real64), intent(inout), dimension(:) :: c
    +
    2698 complex(real64), intent(out), target, dimension(:), optional :: work
    +
    2699 integer(int32), intent(out), optional :: olwork
    +
    2700 class(errors), intent(inout), optional, target :: err
    +
    2701 end subroutine
    +
    2702
    +
    2743 module subroutine qr_rank1_update_dbl(q, r, u, v, work, err)
    +
    2744 real(real64), intent(inout), dimension(:,:) :: q, r
    +
    2745 real(real64), intent(inout), dimension(:) :: u, v
    +
    2746 real(real64), intent(out), target, optional, dimension(:) :: work
    +
    2747 class(errors), intent(inout), optional, target :: err
    +
    2748 end subroutine
    +
    2749
    +
    2793 module subroutine qr_rank1_update_cmplx(q, r, u, v, work, rwork, err)
    +
    2794 complex(real64), intent(inout), dimension(:,:) :: q, r
    +
    2795 complex(real64), intent(inout), dimension(:) :: u, v
    +
    2796 complex(real64), intent(out), target, optional, dimension(:) :: work
    +
    2797 real(real64), intent(out), target, optional, dimension(:) :: rwork
    +
    2798 class(errors), intent(inout), optional, target :: err
    +
    2799 end subroutine
    +
    2800
    +
    2821 module subroutine cholesky_factor_dbl(a, upper, err)
    +
    2822 real(real64), intent(inout), dimension(:,:) :: a
    +
    2823 logical, intent(in), optional :: upper
    +
    2824 class(errors), intent(inout), optional, target :: err
    +
    2825 end subroutine
    +
    2826
    +
    2847 module subroutine cholesky_factor_cmplx(a, upper, err)
    +
    2848 complex(real64), intent(inout), dimension(:,:) :: a
    +
    2849 logical, intent(in), optional :: upper
    +
    2850 class(errors), intent(inout), optional, target :: err
    +
    2851 end subroutine
    +
    2852
    +
    2879 module subroutine cholesky_rank1_update_dbl(r, u, work, err)
    +
    2880 real(real64), intent(inout), dimension(:,:) :: r
    +
    2881 real(real64), intent(inout), dimension(:) :: u
    +
    2882 real(real64), intent(out), target, optional, dimension(:) :: work
    +
    2883 class(errors), intent(inout), optional, target :: err
    +
    2884 end subroutine
    +
    2885
    +
    2912 module subroutine cholesky_rank1_update_cmplx(r, u, work, err)
    +
    2913 complex(real64), intent(inout), dimension(:,:) :: r
    +
    2914 complex(real64), intent(inout), dimension(:) :: u
    +
    2915 real(real64), intent(out), target, optional, dimension(:) :: work
    +
    2916 class(errors), intent(inout), optional, target :: err
    +
    2917 end subroutine
    +
    2918
    +
    2948 module subroutine cholesky_rank1_downdate_dbl(r, u, work, err)
    +
    2949 real(real64), intent(inout), dimension(:,:) :: r
    +
    2950 real(real64), intent(inout), dimension(:) :: u
    +
    2951 real(real64), intent(out), target, optional, dimension(:) :: work
    +
    2952 class(errors), intent(inout), optional, target :: err
    +
    2953 end subroutine
    +
    2954
    +
    2984 module subroutine cholesky_rank1_downdate_cmplx(r, u, work, err)
    +
    2985 complex(real64), intent(inout), dimension(:,:) :: r
    +
    2986 complex(real64), intent(inout), dimension(:) :: u
    +
    2987 real(real64), intent(out), target, optional, dimension(:) :: work
    +
    2988 class(errors), intent(inout), optional, target :: err
    +
    2989 end subroutine
    +
    2990
    +
    3053 module subroutine rz_factor_dbl(a, tau, work, olwork, err)
    +
    3054 real(real64), intent(inout), dimension(:,:) :: a
    +
    3055 real(real64), intent(out), dimension(:) :: tau
    +
    3056 real(real64), intent(out), target, optional, dimension(:) :: work
    +
    3057 integer(int32), intent(out), optional :: olwork
    +
    3058 class(errors), intent(inout), optional, target :: err
    +
    3059 end subroutine
    +
    3060
    +
    3123 module subroutine rz_factor_cmplx(a, tau, work, olwork, err)
    +
    3124 complex(real64), intent(inout), dimension(:,:) :: a
    +
    3125 complex(real64), intent(out), dimension(:) :: tau
    +
    3126 complex(real64), intent(out), target, optional, dimension(:) :: work
    +
    3127 integer(int32), intent(out), optional :: olwork
    +
    3128 class(errors), intent(inout), optional, target :: err
    +
    3129 end subroutine
    +
    3130
    +
    3168 module subroutine mult_rz_mtx(lside, trans, l, a, tau, c, work, olwork, err)
    +
    3169 logical, intent(in) :: lside, trans
    +
    3170 integer(int32), intent(in) :: l
    +
    3171 real(real64), intent(inout), dimension(:,:) :: a, c
    +
    3172 real(real64), intent(in), dimension(:) :: tau
    +
    3173 real(real64), intent(out), target, optional, dimension(:) :: work
    +
    3174 integer(int32), intent(out), optional :: olwork
    +
    3175 class(errors), intent(inout), optional, target :: err
    +
    3176 end subroutine
    +
    3177
    +
    3215 module subroutine mult_rz_mtx_cmplx(lside, trans, l, a, tau, c, work, olwork, err)
    +
    3216 logical, intent(in) :: lside, trans
    +
    3217 integer(int32), intent(in) :: l
    +
    3218 complex(real64), intent(inout), dimension(:,:) :: a, c
    +
    3219 complex(real64), intent(in), dimension(:) :: tau
    +
    3220 complex(real64), intent(out), target, optional, dimension(:) :: work
    +
    3221 integer(int32), intent(out), optional :: olwork
    +
    3222 class(errors), intent(inout), optional, target :: err
    +
    3223 end subroutine
    +
    3224
    +
    3260 module subroutine mult_rz_vec(trans, l, a, tau, c, work, olwork, err)
    +
    3261 logical, intent(in) :: trans
    +
    3262 integer(int32), intent(in) :: l
    +
    3263 real(real64), intent(inout), dimension(:,:) :: a
    +
    3264 real(real64), intent(in), dimension(:) :: tau
    +
    3265 real(real64), intent(inout), dimension(:) :: c
    +
    3266 real(real64), intent(out), target, optional, dimension(:) :: work
    +
    3267 integer(int32), intent(out), optional :: olwork
    +
    3268 class(errors), intent(inout), optional, target :: err
    +
    3269 end subroutine
    +
    3270
    +
    3306 module subroutine mult_rz_vec_cmplx(trans, l, a, tau, c, work, olwork, err)
    +
    3307 logical, intent(in) :: trans
    +
    3308 integer(int32), intent(in) :: l
    +
    3309 complex(real64), intent(inout), dimension(:,:) :: a
    +
    3310 complex(real64), intent(in), dimension(:) :: tau
    +
    3311 complex(real64), intent(inout), dimension(:) :: c
    +
    3312 complex(real64), intent(out), target, optional, dimension(:) :: work
    +
    3313 integer(int32), intent(out), optional :: olwork
    +
    3314 class(errors), intent(inout), optional, target :: err
    +
    3315 end subroutine
    +
    3316
    +
    3359 module subroutine svd_dbl(a, s, u, vt, work, olwork, err)
    +
    3360 real(real64), intent(inout), dimension(:,:) :: a
    +
    3361 real(real64), intent(out), dimension(:) :: s
    +
    3362 real(real64), intent(out), optional, dimension(:,:) :: u, vt
    +
    3363 real(real64), intent(out), target, optional, dimension(:) :: work
    +
    3364 integer(int32), intent(out), optional :: olwork
    +
    3365 class(errors), intent(inout), optional, target :: err
    +
    3366 end subroutine
    +
    3367
    +
    3414 module subroutine svd_cmplx(a, s, u, vt, work, olwork, rwork, err)
    +
    3415 complex(real64), intent(inout), dimension(:,:) :: a
    +
    3416 real(real64), intent(out), dimension(:) :: s
    +
    3417 complex(real64), intent(out), optional, dimension(:,:) :: u, vt
    +
    3418 complex(real64), intent(out), target, optional, dimension(:) :: work
    +
    3419 integer(int32), intent(out), optional :: olwork
    +
    3420 real(real64), intent(out), target, optional, dimension(:) :: rwork
    3421 class(errors), intent(inout), optional, target :: err
    3422 end subroutine
    -
    3423
    -
    3470 module subroutine svd_cmplx(a, s, u, vt, work, olwork, rwork, err)
    -
    3471 complex(real64), intent(inout), dimension(:,:) :: a
    -
    3472 real(real64), intent(out), dimension(:) :: s
    -
    3473 complex(real64), intent(out), optional, dimension(:,:) :: u, vt
    -
    3474 complex(real64), intent(out), target, optional, dimension(:) :: work
    -
    3475 integer(int32), intent(out), optional :: olwork
    -
    3476 real(real64), intent(out), target, optional, dimension(:) :: rwork
    -
    3477 class(errors), intent(inout), optional, target :: err
    -
    3478 end subroutine
    -
    3479end interface
    -
    3480
    -
    3481! ******************************************************************************
    -
    3482! LINALG_SOLVE.F90
    -
    3483! ------------------------------------------------------------------------------
    -
    3484interface
    -
    3485
    -
    3513 module subroutine solve_tri_mtx(lside, upper, trans, nounit, alpha, a, b, err)
    -
    3514 logical, intent(in) :: lside, upper, trans, nounit
    -
    3515 real(real64), intent(in) :: alpha
    -
    3516 real(real64), intent(in), dimension(:,:) :: a
    -
    3517 real(real64), intent(inout), dimension(:,:) :: b
    -
    3518 class(errors), intent(inout), optional, target :: err
    -
    3519 end subroutine
    -
    3520
    -
    3549 module subroutine solve_tri_mtx_cmplx(lside, upper, trans, nounit, alpha, a, b, err)
    -
    3550 logical, intent(in) :: lside, upper, trans, nounit
    -
    3551 complex(real64), intent(in) :: alpha
    -
    3552 complex(real64), intent(in), dimension(:,:) :: a
    -
    3553 complex(real64), intent(inout), dimension(:,:) :: b
    -
    3554 class(errors), intent(inout), optional, target :: err
    -
    3555 end subroutine
    -
    3556
    -
    3601 module subroutine solve_tri_vec(upper, trans, nounit, a, x, err)
    -
    3602 logical, intent(in) :: upper, trans, nounit
    -
    3603 real(real64), intent(in), dimension(:,:) :: a
    -
    3604 real(real64), intent(inout), dimension(:) :: x
    -
    3605 class(errors), intent(inout), optional, target :: err
    -
    3606 end subroutine
    -
    3607
    -
    3652 module subroutine solve_tri_vec_cmplx(upper, trans, nounit, a, x, err)
    -
    3653 logical, intent(in) :: upper, trans, nounit
    -
    3654 complex(real64), intent(in), dimension(:,:) :: a
    -
    3655 complex(real64), intent(inout), dimension(:) :: x
    -
    3656 class(errors), intent(inout), optional, target :: err
    -
    3657 end subroutine
    -
    3658
    -
    3675 module subroutine solve_lu_mtx(a, ipvt, b, err)
    -
    3676 real(real64), intent(in), dimension(:,:) :: a
    -
    3677 integer(int32), intent(in), dimension(:) :: ipvt
    -
    3678 real(real64), intent(inout), dimension(:,:) :: b
    -
    3679 class(errors), intent(inout), optional, target :: err
    -
    3680 end subroutine
    -
    3681
    -
    3698 module subroutine solve_lu_mtx_cmplx(a, ipvt, b, err)
    -
    3699 complex(real64), intent(in), dimension(:,:) :: a
    -
    3700 integer(int32), intent(in), dimension(:) :: ipvt
    -
    3701 complex(real64), intent(inout), dimension(:,:) :: b
    -
    3702 class(errors), intent(inout), optional, target :: err
    -
    3703 end subroutine
    -
    3704
    -
    3721 module subroutine solve_lu_vec(a, ipvt, b, err)
    -
    3722 real(real64), intent(in), dimension(:,:) :: a
    -
    3723 integer(int32), intent(in), dimension(:) :: ipvt
    -
    3724 real(real64), intent(inout), dimension(:) :: b
    -
    3725 class(errors), intent(inout), optional, target :: err
    -
    3726 end subroutine
    -
    3727
    -
    3744 module subroutine solve_lu_vec_cmplx(a, ipvt, b, err)
    -
    3745 complex(real64), intent(in), dimension(:,:) :: a
    -
    3746 integer(int32), intent(in), dimension(:) :: ipvt
    -
    3747 complex(real64), intent(inout), dimension(:) :: b
    -
    3748 class(errors), intent(inout), optional, target :: err
    -
    3749 end subroutine
    -
    3750
    -
    3780 module subroutine solve_qr_no_pivot_mtx(a, tau, b, work, olwork, err)
    -
    3781 real(real64), intent(inout), dimension(:,:) :: a, b
    -
    3782 real(real64), intent(in), dimension(:) :: tau
    -
    3783 real(real64), intent(out), target, optional, dimension(:) :: work
    -
    3784 integer(int32), intent(out), optional :: olwork
    -
    3785 class(errors), intent(inout), optional, target :: err
    -
    3786 end subroutine
    -
    3787
    -
    3817 module subroutine solve_qr_no_pivot_mtx_cmplx(a, tau, b, work, olwork, err)
    -
    3818 complex(real64), intent(inout), dimension(:,:) :: a, b
    -
    3819 complex(real64), intent(in), dimension(:) :: tau
    -
    3820 complex(real64), intent(out), target, optional, dimension(:) :: work
    -
    3821 integer(int32), intent(out), optional :: olwork
    -
    3822 class(errors), intent(inout), optional, target :: err
    -
    3823 end subroutine
    -
    3824
    -
    3854 module subroutine solve_qr_no_pivot_vec(a, tau, b, work, olwork, err)
    -
    3855 real(real64), intent(inout), dimension(:,:) :: a
    -
    3856 real(real64), intent(in), dimension(:) :: tau
    -
    3857 real(real64), intent(inout), dimension(:) :: b
    -
    3858 real(real64), intent(out), target, optional, dimension(:) :: work
    -
    3859 integer(int32), intent(out), optional :: olwork
    -
    3860 class(errors), intent(inout), optional, target :: err
    -
    3861 end subroutine
    -
    3862
    -
    3892 module subroutine solve_qr_no_pivot_vec_cmplx(a, tau, b, work, olwork, err)
    -
    3893 complex(real64), intent(inout), dimension(:,:) :: a
    -
    3894 complex(real64), intent(in), dimension(:) :: tau
    -
    3895 complex(real64), intent(inout), dimension(:) :: b
    -
    3896 complex(real64), intent(out), target, optional, dimension(:) :: work
    -
    3897 integer(int32), intent(out), optional :: olwork
    -
    3898 class(errors), intent(inout), optional, target :: err
    -
    3899 end subroutine
    -
    3900
    -
    3932 module subroutine solve_qr_pivot_mtx(a, tau, jpvt, b, work, olwork, err)
    -
    3933 real(real64), intent(inout), dimension(:,:) :: a
    -
    3934 real(real64), intent(in), dimension(:) :: tau
    -
    3935 integer(int32), intent(in), dimension(:) :: jpvt
    -
    3936 real(real64), intent(inout), dimension(:,:) :: b
    -
    3937 real(real64), intent(out), target, optional, dimension(:) :: work
    -
    3938 integer(int32), intent(out), optional :: olwork
    -
    3939 class(errors), intent(inout), optional, target :: err
    -
    3940 end subroutine
    -
    3941
    -
    3973 module subroutine solve_qr_pivot_mtx_cmplx(a, tau, jpvt, b, work, olwork, err)
    -
    3974 complex(real64), intent(inout), dimension(:,:) :: a
    -
    3975 complex(real64), intent(in), dimension(:) :: tau
    -
    3976 integer(int32), intent(in), dimension(:) :: jpvt
    -
    3977 complex(real64), intent(inout), dimension(:,:) :: b
    -
    3978 complex(real64), intent(out), target, optional, dimension(:) :: work
    -
    3979 integer(int32), intent(out), optional :: olwork
    -
    3980 class(errors), intent(inout), optional, target :: err
    -
    3981 end subroutine
    -
    3982
    -
    4014 module subroutine solve_qr_pivot_vec(a, tau, jpvt, b, work, olwork, err)
    -
    4015 real(real64), intent(inout), dimension(:,:) :: a
    -
    4016 real(real64), intent(in), dimension(:) :: tau
    -
    4017 integer(int32), intent(in), dimension(:) :: jpvt
    -
    4018 real(real64), intent(inout), dimension(:) :: b
    -
    4019 real(real64), intent(out), target, optional, dimension(:) :: work
    -
    4020 integer(int32), intent(out), optional :: olwork
    -
    4021 class(errors), intent(inout), optional, target :: err
    -
    4022 end subroutine
    -
    4023
    -
    4055 module subroutine solve_qr_pivot_vec_cmplx(a, tau, jpvt, b, work, olwork, err)
    -
    4056 complex(real64), intent(inout), dimension(:,:) :: a
    -
    4057 complex(real64), intent(in), dimension(:) :: tau
    -
    4058 integer(int32), intent(in), dimension(:) :: jpvt
    -
    4059 complex(real64), intent(inout), dimension(:) :: b
    -
    4060 complex(real64), intent(out), target, optional, dimension(:) :: work
    -
    4061 integer(int32), intent(out), optional :: olwork
    -
    4062 class(errors), intent(inout), optional, target :: err
    -
    4063 end subroutine
    -
    4064
    -
    4083 module subroutine solve_cholesky_mtx(upper, a, b, err)
    -
    4084 logical, intent(in) :: upper
    -
    4085 real(real64), intent(in), dimension(:,:) :: a
    -
    4086 real(real64), intent(inout), dimension(:,:) :: b
    -
    4087 class(errors), intent(inout), optional, target :: err
    -
    4088 end subroutine
    -
    4089
    -
    4108 module subroutine solve_cholesky_mtx_cmplx(upper, a, b, err)
    -
    4109 logical, intent(in) :: upper
    -
    4110 complex(real64), intent(in), dimension(:,:) :: a
    -
    4111 complex(real64), intent(inout), dimension(:,:) :: b
    -
    4112 class(errors), intent(inout), optional, target :: err
    -
    4113 end subroutine
    -
    4114
    -
    4133 module subroutine solve_cholesky_vec(upper, a, b, err)
    -
    4134 logical, intent(in) :: upper
    -
    4135 real(real64), intent(in), dimension(:,:) :: a
    -
    4136 real(real64), intent(inout), dimension(:) :: b
    -
    4137 class(errors), intent(inout), optional, target :: err
    -
    4138 end subroutine
    -
    4139
    -
    4158 module subroutine solve_cholesky_vec_cmplx(upper, a, b, err)
    -
    4159 logical, intent(in) :: upper
    -
    4160 complex(real64), intent(in), dimension(:,:) :: a
    -
    4161 complex(real64), intent(inout), dimension(:) :: b
    -
    4162 class(errors), intent(inout), optional, target :: err
    -
    4163 end subroutine
    -
    4164
    -
    4196 module subroutine solve_least_squares_mtx(a, b, work, olwork, err)
    -
    4197 real(real64), intent(inout), dimension(:,:) :: a, b
    -
    4198 real(real64), intent(out), target, optional, dimension(:) :: work
    -
    4199 integer(int32), intent(out), optional :: olwork
    -
    4200 class(errors), intent(inout), optional, target :: err
    -
    4201 end subroutine
    -
    4202
    -
    4234 module subroutine solve_least_squares_mtx_cmplx(a, b, work, olwork, err)
    -
    4235 complex(real64), intent(inout), dimension(:,:) :: a, b
    -
    4236 complex(real64), intent(out), target, optional, dimension(:) :: work
    -
    4237 integer(int32), intent(out), optional :: olwork
    -
    4238 class(errors), intent(inout), optional, target :: err
    -
    4239 end subroutine
    -
    4240
    -
    4272 module subroutine solve_least_squares_vec(a, b, work, olwork, err)
    -
    4273 real(real64), intent(inout), dimension(:,:) :: a
    -
    4274 real(real64), intent(inout), dimension(:) :: b
    -
    4275 real(real64), intent(out), target, optional, dimension(:) :: work
    -
    4276 integer(int32), intent(out), optional :: olwork
    -
    4277 class(errors), intent(inout), optional, target :: err
    -
    4278 end subroutine
    -
    4279
    -
    4311 module subroutine solve_least_squares_vec_cmplx(a, b, work, olwork, err)
    -
    4312 complex(real64), intent(inout), dimension(:,:) :: a
    -
    4313 complex(real64), intent(inout), dimension(:) :: b
    -
    4314 complex(real64), intent(out), target, optional, dimension(:) :: work
    -
    4315 integer(int32), intent(out), optional :: olwork
    -
    4316 class(errors), intent(inout), optional, target :: err
    -
    4317 end subroutine
    -
    4318
    -
    4356 module subroutine solve_least_squares_mtx_pvt(a, b, ipvt, arnk, work, olwork, err)
    -
    4357 real(real64), intent(inout), dimension(:,:) :: a, b
    -
    4358 integer(int32), intent(inout), target, optional, dimension(:) :: ipvt
    -
    4359 integer(int32), intent(out), optional :: arnk
    -
    4360 real(real64), intent(out), target, optional, dimension(:) :: work
    -
    4361 integer(int32), intent(out), optional :: olwork
    -
    4362 class(errors), intent(inout), optional, target :: err
    -
    4363 end subroutine
    -
    4364
    -
    4406 module subroutine solve_least_squares_mtx_pvt_cmplx(a, b, ipvt, arnk, &
    -
    4407 work, olwork, rwork, err)
    -
    4408 complex(real64), intent(inout), dimension(:,:) :: a, b
    -
    4409 integer(int32), intent(inout), target, optional, dimension(:) :: ipvt
    -
    4410 integer(int32), intent(out), optional :: arnk
    -
    4411 complex(real64), intent(out), target, optional, dimension(:) :: work
    -
    4412 integer(int32), intent(out), optional :: olwork
    -
    4413 real(real64), intent(out), target, optional, dimension(:) :: rwork
    -
    4414 class(errors), intent(inout), optional, target :: err
    -
    4415 end subroutine
    -
    4416
    -
    4454 module subroutine solve_least_squares_vec_pvt(a, b, ipvt, arnk, work, olwork, err)
    -
    4455 real(real64), intent(inout), dimension(:,:) :: a
    -
    4456 real(real64), intent(inout), dimension(:) :: b
    -
    4457 integer(int32), intent(inout), target, optional, dimension(:) :: ipvt
    -
    4458 integer(int32), intent(out), optional :: arnk
    -
    4459 real(real64), intent(out), target, optional, dimension(:) :: work
    -
    4460 integer(int32), intent(out), optional :: olwork
    -
    4461 class(errors), intent(inout), optional, target :: err
    -
    4462 end subroutine
    -
    4463
    -
    4505 module subroutine solve_least_squares_vec_pvt_cmplx(a, b, ipvt, arnk, &
    -
    4506 work, olwork, rwork, err)
    -
    4507 complex(real64), intent(inout), dimension(:,:) :: a
    -
    4508 complex(real64), intent(inout), dimension(:) :: b
    -
    4509 integer(int32), intent(inout), target, optional, dimension(:) :: ipvt
    -
    4510 integer(int32), intent(out), optional :: arnk
    -
    4511 complex(real64), intent(out), target, optional, dimension(:) :: work
    -
    4512 integer(int32), intent(out), optional :: olwork
    -
    4513 real(real64), intent(out), target, optional, dimension(:) :: rwork
    -
    4514 class(errors), intent(inout), optional, target :: err
    -
    4515 end subroutine
    -
    4516
    -
    4555 module subroutine solve_least_squares_mtx_svd(a, b, s, arnk, work, olwork, err)
    -
    4556 real(real64), intent(inout), dimension(:,:) :: a, b
    -
    4557 integer(int32), intent(out), optional :: arnk
    -
    4558 real(real64), intent(out), target, optional, dimension(:) :: work, s
    -
    4559 integer(int32), intent(out), optional :: olwork
    -
    4560 class(errors), intent(inout), optional, target :: err
    -
    4561 end subroutine
    -
    4562
    -
    4605 module subroutine solve_least_squares_mtx_svd_cmplx(a, b, s, arnk, work, &
    -
    4606 olwork, rwork, err)
    -
    4607 complex(real64), intent(inout), dimension(:,:) :: a, b
    -
    4608 integer(int32), intent(out), optional :: arnk
    -
    4609 complex(real64), intent(out), target, optional, dimension(:) :: work
    -
    4610 real(real64), intent(out), target, optional, dimension(:) :: rwork, s
    -
    4611 integer(int32), intent(out), optional :: olwork
    -
    4612 class(errors), intent(inout), optional, target :: err
    -
    4613 end subroutine
    -
    4614
    -
    4651 module subroutine solve_least_squares_vec_svd(a, b, s, arnk, work, olwork, err)
    -
    4652 real(real64), intent(inout), dimension(:,:) :: a
    -
    4653 real(real64), intent(inout), dimension(:) :: b
    -
    4654 integer(int32), intent(out), optional :: arnk
    -
    4655 real(real64), intent(out), target, optional, dimension(:) :: work, s
    -
    4656 integer(int32), intent(out), optional :: olwork
    -
    4657 class(errors), intent(inout), optional, target :: err
    -
    4658 end subroutine
    -
    4659
    -
    4700 module subroutine solve_least_squares_vec_svd_cmplx(a, b, s, arnk, work, &
    -
    4701 olwork, rwork, err)
    -
    4702 complex(real64), intent(inout), dimension(:,:) :: a
    -
    4703 complex(real64), intent(inout), dimension(:) :: b
    -
    4704 integer(int32), intent(out), optional :: arnk
    -
    4705 complex(real64), intent(out), target, optional, dimension(:) :: work
    -
    4706 real(real64), intent(out), target, optional, dimension(:) :: rwork, s
    -
    4707 integer(int32), intent(out), optional :: olwork
    -
    4708 class(errors), intent(inout), optional, target :: err
    -
    4709 end subroutine
    -
    4710
    -
    4742 module subroutine mtx_inverse_dbl(a, iwork, work, olwork, err)
    -
    4743 real(real64), intent(inout), dimension(:,:) :: a
    -
    4744 integer(int32), intent(out), target, optional, dimension(:) :: iwork
    -
    4745 real(real64), intent(out), target, optional, dimension(:) :: work
    -
    4746 integer(int32), intent(out), optional :: olwork
    -
    4747 class(errors), intent(inout), optional, target :: err
    -
    4748 end subroutine
    -
    4749
    -
    4781 module subroutine mtx_inverse_cmplx(a, iwork, work, olwork, err)
    -
    4782 complex(real64), intent(inout), dimension(:,:) :: a
    -
    4783 integer(int32), intent(out), target, optional, dimension(:) :: iwork
    -
    4784 complex(real64), intent(out), target, optional, dimension(:) :: work
    -
    4785 integer(int32), intent(out), optional :: olwork
    -
    4786 class(errors), intent(inout), optional, target :: err
    -
    4787 end subroutine
    -
    4788
    -
    4826 module subroutine mtx_pinverse_dbl(a, ainv, tol, work, olwork, err)
    -
    4827 real(real64), intent(inout), dimension(:,:) :: a
    -
    4828 real(real64), intent(out), dimension(:,:) :: ainv
    -
    4829 real(real64), intent(in), optional :: tol
    -
    4830 real(real64), intent(out), target, dimension(:), optional :: work
    -
    4831 integer(int32), intent(out), optional :: olwork
    -
    4832 class(errors), intent(inout), optional, target :: err
    -
    4833 end subroutine
    -
    4834
    -
    4876 module subroutine mtx_pinverse_cmplx(a, ainv, tol, work, olwork, rwork, err)
    -
    4877 complex(real64), intent(inout), dimension(:,:) :: a
    -
    4878 complex(real64), intent(out), dimension(:,:) :: ainv
    -
    4879 real(real64), intent(in), optional :: tol
    -
    4880 complex(real64), intent(out), target, dimension(:), optional :: work
    -
    4881 integer(int32), intent(out), optional :: olwork
    -
    4882 real(real64), intent(out), target, dimension(:), optional :: rwork
    -
    4883 class(errors), intent(inout), optional, target :: err
    -
    4884 end subroutine
    -
    4885
    -
    4886end interface
    -
    4887
    -
    4888! ******************************************************************************
    -
    4889! LINALG_EIGEN.F90
    -
    4890! ------------------------------------------------------------------------------
    -
    4891interface
    -
    4892
    -
    4924 module subroutine eigen_symm(vecs, a, vals, work, olwork, err)
    -
    4925 logical, intent(in) :: vecs
    -
    4926 real(real64), intent(inout), dimension(:,:) :: a
    -
    4927 real(real64), intent(out), dimension(:) :: vals
    -
    4928 real(real64), intent(out), pointer, optional, dimension(:) :: work
    -
    4929 integer(int32), intent(out), optional :: olwork
    -
    4930 class(errors), intent(inout), optional, target :: err
    -
    4931 end subroutine
    -
    4932
    -
    4963 module subroutine eigen_asymm(a, vals, vecs, work, olwork, err)
    -
    4964 real(real64), intent(inout), dimension(:,:) :: a
    -
    4965 complex(real64), intent(out), dimension(:) :: vals
    -
    4966 complex(real64), intent(out), optional, dimension(:,:) :: vecs
    -
    4967 real(real64), intent(out), pointer, optional, dimension(:) :: work
    -
    4968 integer(int32), intent(out), optional :: olwork
    -
    4969 class(errors), intent(inout), optional, target :: err
    -
    4970 end subroutine
    -
    4971
    -
    5014 module subroutine eigen_gen(a, b, alpha, beta, vecs, work, olwork, err)
    -
    5015 real(real64), intent(inout), dimension(:,:) :: a, b
    -
    5016 complex(real64), intent(out), dimension(:) :: alpha
    -
    5017 real(real64), intent(out), optional, dimension(:) :: beta
    -
    5018 complex(real64), intent(out), optional, dimension(:,:) :: vecs
    -
    5019 real(real64), intent(out), optional, pointer, dimension(:) :: work
    -
    5020 integer(int32), intent(out), optional :: olwork
    -
    5021 class(errors), intent(inout), optional, target :: err
    -
    5022 end subroutine
    -
    5023
    -
    5054 module subroutine eigen_cmplx(a, vals, vecs, work, olwork, rwork, err)
    -
    5055 complex(real64), intent(inout), dimension(:,:) :: a
    -
    5056 complex(real64), intent(out), dimension(:) :: vals
    -
    5057 complex(real64), intent(out), optional, dimension(:,:) :: vecs
    -
    5058 complex(real64), intent(out), target, optional, dimension(:) :: work
    -
    5059 real(real64), intent(out), target, optional, dimension(:) :: rwork
    -
    5060 integer(int32), intent(out), optional :: olwork
    +
    3423end interface
    +
    3424
    +
    3425! ******************************************************************************
    +
    3426! LINALG_SOLVE.F90
    +
    3427! ------------------------------------------------------------------------------
    +
    3428interface
    +
    3429
    +
    3457 module subroutine solve_tri_mtx(lside, upper, trans, nounit, alpha, a, b, err)
    +
    3458 logical, intent(in) :: lside, upper, trans, nounit
    +
    3459 real(real64), intent(in) :: alpha
    +
    3460 real(real64), intent(in), dimension(:,:) :: a
    +
    3461 real(real64), intent(inout), dimension(:,:) :: b
    +
    3462 class(errors), intent(inout), optional, target :: err
    +
    3463 end subroutine
    +
    3464
    +
    3493 module subroutine solve_tri_mtx_cmplx(lside, upper, trans, nounit, alpha, a, b, err)
    +
    3494 logical, intent(in) :: lside, upper, trans, nounit
    +
    3495 complex(real64), intent(in) :: alpha
    +
    3496 complex(real64), intent(in), dimension(:,:) :: a
    +
    3497 complex(real64), intent(inout), dimension(:,:) :: b
    +
    3498 class(errors), intent(inout), optional, target :: err
    +
    3499 end subroutine
    +
    3500
    +
    3545 module subroutine solve_tri_vec(upper, trans, nounit, a, x, err)
    +
    3546 logical, intent(in) :: upper, trans, nounit
    +
    3547 real(real64), intent(in), dimension(:,:) :: a
    +
    3548 real(real64), intent(inout), dimension(:) :: x
    +
    3549 class(errors), intent(inout), optional, target :: err
    +
    3550 end subroutine
    +
    3551
    +
    3596 module subroutine solve_tri_vec_cmplx(upper, trans, nounit, a, x, err)
    +
    3597 logical, intent(in) :: upper, trans, nounit
    +
    3598 complex(real64), intent(in), dimension(:,:) :: a
    +
    3599 complex(real64), intent(inout), dimension(:) :: x
    +
    3600 class(errors), intent(inout), optional, target :: err
    +
    3601 end subroutine
    +
    3602
    +
    3619 module subroutine solve_lu_mtx(a, ipvt, b, err)
    +
    3620 real(real64), intent(in), dimension(:,:) :: a
    +
    3621 integer(int32), intent(in), dimension(:) :: ipvt
    +
    3622 real(real64), intent(inout), dimension(:,:) :: b
    +
    3623 class(errors), intent(inout), optional, target :: err
    +
    3624 end subroutine
    +
    3625
    +
    3642 module subroutine solve_lu_mtx_cmplx(a, ipvt, b, err)
    +
    3643 complex(real64), intent(in), dimension(:,:) :: a
    +
    3644 integer(int32), intent(in), dimension(:) :: ipvt
    +
    3645 complex(real64), intent(inout), dimension(:,:) :: b
    +
    3646 class(errors), intent(inout), optional, target :: err
    +
    3647 end subroutine
    +
    3648
    +
    3665 module subroutine solve_lu_vec(a, ipvt, b, err)
    +
    3666 real(real64), intent(in), dimension(:,:) :: a
    +
    3667 integer(int32), intent(in), dimension(:) :: ipvt
    +
    3668 real(real64), intent(inout), dimension(:) :: b
    +
    3669 class(errors), intent(inout), optional, target :: err
    +
    3670 end subroutine
    +
    3671
    +
    3688 module subroutine solve_lu_vec_cmplx(a, ipvt, b, err)
    +
    3689 complex(real64), intent(in), dimension(:,:) :: a
    +
    3690 integer(int32), intent(in), dimension(:) :: ipvt
    +
    3691 complex(real64), intent(inout), dimension(:) :: b
    +
    3692 class(errors), intent(inout), optional, target :: err
    +
    3693 end subroutine
    +
    3694
    +
    3724 module subroutine solve_qr_no_pivot_mtx(a, tau, b, work, olwork, err)
    +
    3725 real(real64), intent(inout), dimension(:,:) :: a, b
    +
    3726 real(real64), intent(in), dimension(:) :: tau
    +
    3727 real(real64), intent(out), target, optional, dimension(:) :: work
    +
    3728 integer(int32), intent(out), optional :: olwork
    +
    3729 class(errors), intent(inout), optional, target :: err
    +
    3730 end subroutine
    +
    3731
    +
    3761 module subroutine solve_qr_no_pivot_mtx_cmplx(a, tau, b, work, olwork, err)
    +
    3762 complex(real64), intent(inout), dimension(:,:) :: a, b
    +
    3763 complex(real64), intent(in), dimension(:) :: tau
    +
    3764 complex(real64), intent(out), target, optional, dimension(:) :: work
    +
    3765 integer(int32), intent(out), optional :: olwork
    +
    3766 class(errors), intent(inout), optional, target :: err
    +
    3767 end subroutine
    +
    3768
    +
    3798 module subroutine solve_qr_no_pivot_vec(a, tau, b, work, olwork, err)
    +
    3799 real(real64), intent(inout), dimension(:,:) :: a
    +
    3800 real(real64), intent(in), dimension(:) :: tau
    +
    3801 real(real64), intent(inout), dimension(:) :: b
    +
    3802 real(real64), intent(out), target, optional, dimension(:) :: work
    +
    3803 integer(int32), intent(out), optional :: olwork
    +
    3804 class(errors), intent(inout), optional, target :: err
    +
    3805 end subroutine
    +
    3806
    +
    3836 module subroutine solve_qr_no_pivot_vec_cmplx(a, tau, b, work, olwork, err)
    +
    3837 complex(real64), intent(inout), dimension(:,:) :: a
    +
    3838 complex(real64), intent(in), dimension(:) :: tau
    +
    3839 complex(real64), intent(inout), dimension(:) :: b
    +
    3840 complex(real64), intent(out), target, optional, dimension(:) :: work
    +
    3841 integer(int32), intent(out), optional :: olwork
    +
    3842 class(errors), intent(inout), optional, target :: err
    +
    3843 end subroutine
    +
    3844
    +
    3876 module subroutine solve_qr_pivot_mtx(a, tau, jpvt, b, work, olwork, err)
    +
    3877 real(real64), intent(inout), dimension(:,:) :: a
    +
    3878 real(real64), intent(in), dimension(:) :: tau
    +
    3879 integer(int32), intent(in), dimension(:) :: jpvt
    +
    3880 real(real64), intent(inout), dimension(:,:) :: b
    +
    3881 real(real64), intent(out), target, optional, dimension(:) :: work
    +
    3882 integer(int32), intent(out), optional :: olwork
    +
    3883 class(errors), intent(inout), optional, target :: err
    +
    3884 end subroutine
    +
    3885
    +
    3917 module subroutine solve_qr_pivot_mtx_cmplx(a, tau, jpvt, b, work, olwork, err)
    +
    3918 complex(real64), intent(inout), dimension(:,:) :: a
    +
    3919 complex(real64), intent(in), dimension(:) :: tau
    +
    3920 integer(int32), intent(in), dimension(:) :: jpvt
    +
    3921 complex(real64), intent(inout), dimension(:,:) :: b
    +
    3922 complex(real64), intent(out), target, optional, dimension(:) :: work
    +
    3923 integer(int32), intent(out), optional :: olwork
    +
    3924 class(errors), intent(inout), optional, target :: err
    +
    3925 end subroutine
    +
    3926
    +
    3958 module subroutine solve_qr_pivot_vec(a, tau, jpvt, b, work, olwork, err)
    +
    3959 real(real64), intent(inout), dimension(:,:) :: a
    +
    3960 real(real64), intent(in), dimension(:) :: tau
    +
    3961 integer(int32), intent(in), dimension(:) :: jpvt
    +
    3962 real(real64), intent(inout), dimension(:) :: b
    +
    3963 real(real64), intent(out), target, optional, dimension(:) :: work
    +
    3964 integer(int32), intent(out), optional :: olwork
    +
    3965 class(errors), intent(inout), optional, target :: err
    +
    3966 end subroutine
    +
    3967
    +
    3999 module subroutine solve_qr_pivot_vec_cmplx(a, tau, jpvt, b, work, olwork, err)
    +
    4000 complex(real64), intent(inout), dimension(:,:) :: a
    +
    4001 complex(real64), intent(in), dimension(:) :: tau
    +
    4002 integer(int32), intent(in), dimension(:) :: jpvt
    +
    4003 complex(real64), intent(inout), dimension(:) :: b
    +
    4004 complex(real64), intent(out), target, optional, dimension(:) :: work
    +
    4005 integer(int32), intent(out), optional :: olwork
    +
    4006 class(errors), intent(inout), optional, target :: err
    +
    4007 end subroutine
    +
    4008
    +
    4027 module subroutine solve_cholesky_mtx(upper, a, b, err)
    +
    4028 logical, intent(in) :: upper
    +
    4029 real(real64), intent(in), dimension(:,:) :: a
    +
    4030 real(real64), intent(inout), dimension(:,:) :: b
    +
    4031 class(errors), intent(inout), optional, target :: err
    +
    4032 end subroutine
    +
    4033
    +
    4052 module subroutine solve_cholesky_mtx_cmplx(upper, a, b, err)
    +
    4053 logical, intent(in) :: upper
    +
    4054 complex(real64), intent(in), dimension(:,:) :: a
    +
    4055 complex(real64), intent(inout), dimension(:,:) :: b
    +
    4056 class(errors), intent(inout), optional, target :: err
    +
    4057 end subroutine
    +
    4058
    +
    4077 module subroutine solve_cholesky_vec(upper, a, b, err)
    +
    4078 logical, intent(in) :: upper
    +
    4079 real(real64), intent(in), dimension(:,:) :: a
    +
    4080 real(real64), intent(inout), dimension(:) :: b
    +
    4081 class(errors), intent(inout), optional, target :: err
    +
    4082 end subroutine
    +
    4083
    +
    4102 module subroutine solve_cholesky_vec_cmplx(upper, a, b, err)
    +
    4103 logical, intent(in) :: upper
    +
    4104 complex(real64), intent(in), dimension(:,:) :: a
    +
    4105 complex(real64), intent(inout), dimension(:) :: b
    +
    4106 class(errors), intent(inout), optional, target :: err
    +
    4107 end subroutine
    +
    4108
    +
    4140 module subroutine solve_least_squares_mtx(a, b, work, olwork, err)
    +
    4141 real(real64), intent(inout), dimension(:,:) :: a, b
    +
    4142 real(real64), intent(out), target, optional, dimension(:) :: work
    +
    4143 integer(int32), intent(out), optional :: olwork
    +
    4144 class(errors), intent(inout), optional, target :: err
    +
    4145 end subroutine
    +
    4146
    +
    4178 module subroutine solve_least_squares_mtx_cmplx(a, b, work, olwork, err)
    +
    4179 complex(real64), intent(inout), dimension(:,:) :: a, b
    +
    4180 complex(real64), intent(out), target, optional, dimension(:) :: work
    +
    4181 integer(int32), intent(out), optional :: olwork
    +
    4182 class(errors), intent(inout), optional, target :: err
    +
    4183 end subroutine
    +
    4184
    +
    4216 module subroutine solve_least_squares_vec(a, b, work, olwork, err)
    +
    4217 real(real64), intent(inout), dimension(:,:) :: a
    +
    4218 real(real64), intent(inout), dimension(:) :: b
    +
    4219 real(real64), intent(out), target, optional, dimension(:) :: work
    +
    4220 integer(int32), intent(out), optional :: olwork
    +
    4221 class(errors), intent(inout), optional, target :: err
    +
    4222 end subroutine
    +
    4223
    +
    4255 module subroutine solve_least_squares_vec_cmplx(a, b, work, olwork, err)
    +
    4256 complex(real64), intent(inout), dimension(:,:) :: a
    +
    4257 complex(real64), intent(inout), dimension(:) :: b
    +
    4258 complex(real64), intent(out), target, optional, dimension(:) :: work
    +
    4259 integer(int32), intent(out), optional :: olwork
    +
    4260 class(errors), intent(inout), optional, target :: err
    +
    4261 end subroutine
    +
    4262
    +
    4300 module subroutine solve_least_squares_mtx_pvt(a, b, ipvt, arnk, work, olwork, err)
    +
    4301 real(real64), intent(inout), dimension(:,:) :: a, b
    +
    4302 integer(int32), intent(inout), target, optional, dimension(:) :: ipvt
    +
    4303 integer(int32), intent(out), optional :: arnk
    +
    4304 real(real64), intent(out), target, optional, dimension(:) :: work
    +
    4305 integer(int32), intent(out), optional :: olwork
    +
    4306 class(errors), intent(inout), optional, target :: err
    +
    4307 end subroutine
    +
    4308
    +
    4350 module subroutine solve_least_squares_mtx_pvt_cmplx(a, b, ipvt, arnk, &
    +
    4351 work, olwork, rwork, err)
    +
    4352 complex(real64), intent(inout), dimension(:,:) :: a, b
    +
    4353 integer(int32), intent(inout), target, optional, dimension(:) :: ipvt
    +
    4354 integer(int32), intent(out), optional :: arnk
    +
    4355 complex(real64), intent(out), target, optional, dimension(:) :: work
    +
    4356 integer(int32), intent(out), optional :: olwork
    +
    4357 real(real64), intent(out), target, optional, dimension(:) :: rwork
    +
    4358 class(errors), intent(inout), optional, target :: err
    +
    4359 end subroutine
    +
    4360
    +
    4398 module subroutine solve_least_squares_vec_pvt(a, b, ipvt, arnk, work, olwork, err)
    +
    4399 real(real64), intent(inout), dimension(:,:) :: a
    +
    4400 real(real64), intent(inout), dimension(:) :: b
    +
    4401 integer(int32), intent(inout), target, optional, dimension(:) :: ipvt
    +
    4402 integer(int32), intent(out), optional :: arnk
    +
    4403 real(real64), intent(out), target, optional, dimension(:) :: work
    +
    4404 integer(int32), intent(out), optional :: olwork
    +
    4405 class(errors), intent(inout), optional, target :: err
    +
    4406 end subroutine
    +
    4407
    +
    4449 module subroutine solve_least_squares_vec_pvt_cmplx(a, b, ipvt, arnk, &
    +
    4450 work, olwork, rwork, err)
    +
    4451 complex(real64), intent(inout), dimension(:,:) :: a
    +
    4452 complex(real64), intent(inout), dimension(:) :: b
    +
    4453 integer(int32), intent(inout), target, optional, dimension(:) :: ipvt
    +
    4454 integer(int32), intent(out), optional :: arnk
    +
    4455 complex(real64), intent(out), target, optional, dimension(:) :: work
    +
    4456 integer(int32), intent(out), optional :: olwork
    +
    4457 real(real64), intent(out), target, optional, dimension(:) :: rwork
    +
    4458 class(errors), intent(inout), optional, target :: err
    +
    4459 end subroutine
    +
    4460
    +
    4499 module subroutine solve_least_squares_mtx_svd(a, b, s, arnk, work, olwork, err)
    +
    4500 real(real64), intent(inout), dimension(:,:) :: a, b
    +
    4501 integer(int32), intent(out), optional :: arnk
    +
    4502 real(real64), intent(out), target, optional, dimension(:) :: work, s
    +
    4503 integer(int32), intent(out), optional :: olwork
    +
    4504 class(errors), intent(inout), optional, target :: err
    +
    4505 end subroutine
    +
    4506
    +
    4549 module subroutine solve_least_squares_mtx_svd_cmplx(a, b, s, arnk, work, &
    +
    4550 olwork, rwork, err)
    +
    4551 complex(real64), intent(inout), dimension(:,:) :: a, b
    +
    4552 integer(int32), intent(out), optional :: arnk
    +
    4553 complex(real64), intent(out), target, optional, dimension(:) :: work
    +
    4554 real(real64), intent(out), target, optional, dimension(:) :: rwork, s
    +
    4555 integer(int32), intent(out), optional :: olwork
    +
    4556 class(errors), intent(inout), optional, target :: err
    +
    4557 end subroutine
    +
    4558
    +
    4595 module subroutine solve_least_squares_vec_svd(a, b, s, arnk, work, olwork, err)
    +
    4596 real(real64), intent(inout), dimension(:,:) :: a
    +
    4597 real(real64), intent(inout), dimension(:) :: b
    +
    4598 integer(int32), intent(out), optional :: arnk
    +
    4599 real(real64), intent(out), target, optional, dimension(:) :: work, s
    +
    4600 integer(int32), intent(out), optional :: olwork
    +
    4601 class(errors), intent(inout), optional, target :: err
    +
    4602 end subroutine
    +
    4603
    +
    4644 module subroutine solve_least_squares_vec_svd_cmplx(a, b, s, arnk, work, &
    +
    4645 olwork, rwork, err)
    +
    4646 complex(real64), intent(inout), dimension(:,:) :: a
    +
    4647 complex(real64), intent(inout), dimension(:) :: b
    +
    4648 integer(int32), intent(out), optional :: arnk
    +
    4649 complex(real64), intent(out), target, optional, dimension(:) :: work
    +
    4650 real(real64), intent(out), target, optional, dimension(:) :: rwork, s
    +
    4651 integer(int32), intent(out), optional :: olwork
    +
    4652 class(errors), intent(inout), optional, target :: err
    +
    4653 end subroutine
    +
    4654
    +
    4686 module subroutine mtx_inverse_dbl(a, iwork, work, olwork, err)
    +
    4687 real(real64), intent(inout), dimension(:,:) :: a
    +
    4688 integer(int32), intent(out), target, optional, dimension(:) :: iwork
    +
    4689 real(real64), intent(out), target, optional, dimension(:) :: work
    +
    4690 integer(int32), intent(out), optional :: olwork
    +
    4691 class(errors), intent(inout), optional, target :: err
    +
    4692 end subroutine
    +
    4693
    +
    4725 module subroutine mtx_inverse_cmplx(a, iwork, work, olwork, err)
    +
    4726 complex(real64), intent(inout), dimension(:,:) :: a
    +
    4727 integer(int32), intent(out), target, optional, dimension(:) :: iwork
    +
    4728 complex(real64), intent(out), target, optional, dimension(:) :: work
    +
    4729 integer(int32), intent(out), optional :: olwork
    +
    4730 class(errors), intent(inout), optional, target :: err
    +
    4731 end subroutine
    +
    4732
    +
    4770 module subroutine mtx_pinverse_dbl(a, ainv, tol, work, olwork, err)
    +
    4771 real(real64), intent(inout), dimension(:,:) :: a
    +
    4772 real(real64), intent(out), dimension(:,:) :: ainv
    +
    4773 real(real64), intent(in), optional :: tol
    +
    4774 real(real64), intent(out), target, dimension(:), optional :: work
    +
    4775 integer(int32), intent(out), optional :: olwork
    +
    4776 class(errors), intent(inout), optional, target :: err
    +
    4777 end subroutine
    +
    4778
    +
    4820 module subroutine mtx_pinverse_cmplx(a, ainv, tol, work, olwork, rwork, err)
    +
    4821 complex(real64), intent(inout), dimension(:,:) :: a
    +
    4822 complex(real64), intent(out), dimension(:,:) :: ainv
    +
    4823 real(real64), intent(in), optional :: tol
    +
    4824 complex(real64), intent(out), target, dimension(:), optional :: work
    +
    4825 integer(int32), intent(out), optional :: olwork
    +
    4826 real(real64), intent(out), target, dimension(:), optional :: rwork
    +
    4827 class(errors), intent(inout), optional, target :: err
    +
    4828 end subroutine
    +
    4829
    +
    4830end interface
    +
    4831
    +
    4832! ******************************************************************************
    +
    4833! LINALG_EIGEN.F90
    +
    4834! ------------------------------------------------------------------------------
    +
    4835interface
    +
    4836
    +
    4868 module subroutine eigen_symm(vecs, a, vals, work, olwork, err)
    +
    4869 logical, intent(in) :: vecs
    +
    4870 real(real64), intent(inout), dimension(:,:) :: a
    +
    4871 real(real64), intent(out), dimension(:) :: vals
    +
    4872 real(real64), intent(out), pointer, optional, dimension(:) :: work
    +
    4873 integer(int32), intent(out), optional :: olwork
    +
    4874 class(errors), intent(inout), optional, target :: err
    +
    4875 end subroutine
    +
    4876
    +
    4907 module subroutine eigen_asymm(a, vals, vecs, work, olwork, err)
    +
    4908 real(real64), intent(inout), dimension(:,:) :: a
    +
    4909 complex(real64), intent(out), dimension(:) :: vals
    +
    4910 complex(real64), intent(out), optional, dimension(:,:) :: vecs
    +
    4911 real(real64), intent(out), pointer, optional, dimension(:) :: work
    +
    4912 integer(int32), intent(out), optional :: olwork
    +
    4913 class(errors), intent(inout), optional, target :: err
    +
    4914 end subroutine
    +
    4915
    +
    4958 module subroutine eigen_gen(a, b, alpha, beta, vecs, work, olwork, err)
    +
    4959 real(real64), intent(inout), dimension(:,:) :: a, b
    +
    4960 complex(real64), intent(out), dimension(:) :: alpha
    +
    4961 real(real64), intent(out), optional, dimension(:) :: beta
    +
    4962 complex(real64), intent(out), optional, dimension(:,:) :: vecs
    +
    4963 real(real64), intent(out), optional, pointer, dimension(:) :: work
    +
    4964 integer(int32), intent(out), optional :: olwork
    +
    4965 class(errors), intent(inout), optional, target :: err
    +
    4966 end subroutine
    +
    4967
    +
    4998 module subroutine eigen_cmplx(a, vals, vecs, work, olwork, rwork, err)
    +
    4999 complex(real64), intent(inout), dimension(:,:) :: a
    +
    5000 complex(real64), intent(out), dimension(:) :: vals
    +
    5001 complex(real64), intent(out), optional, dimension(:,:) :: vecs
    +
    5002 complex(real64), intent(out), target, optional, dimension(:) :: work
    +
    5003 real(real64), intent(out), target, optional, dimension(:) :: rwork
    +
    5004 integer(int32), intent(out), optional :: olwork
    +
    5005 class(errors), intent(inout), optional, target :: err
    +
    5006 end subroutine
    +
    5007end interface
    +
    5008
    +
    5009! ******************************************************************************
    +
    5010! LINALG_SORTING.F90
    +
    5011! ------------------------------------------------------------------------------
    +
    5012interface
    +
    5013
    +
    5028 module subroutine sort_dbl_array(x, ascend)
    +
    5029 real(real64), intent(inout), dimension(:) :: x
    +
    5030 logical, intent(in), optional :: ascend
    +
    5031 end subroutine
    +
    5032
    +
    5057 module subroutine sort_dbl_array_ind(x, ind, ascend, err)
    +
    5058 real(real64), intent(inout), dimension(:) :: x
    +
    5059 integer(int32), intent(inout), dimension(:) :: ind
    +
    5060 logical, intent(in), optional :: ascend
    5061 class(errors), intent(inout), optional, target :: err
    5062 end subroutine
    -
    5063end interface
    -
    5064
    -
    5065! ******************************************************************************
    -
    5066! LINALG_SORTING.F90
    -
    5067! ------------------------------------------------------------------------------
    -
    5068interface
    -
    5069
    -
    5084 module subroutine sort_dbl_array(x, ascend)
    -
    5085 real(real64), intent(inout), dimension(:) :: x
    -
    5086 logical, intent(in), optional :: ascend
    -
    5087 end subroutine
    -
    5088
    -
    5113 module subroutine sort_dbl_array_ind(x, ind, ascend, err)
    -
    5114 real(real64), intent(inout), dimension(:) :: x
    -
    5115 integer(int32), intent(inout), dimension(:) :: ind
    -
    5116 logical, intent(in), optional :: ascend
    -
    5117 class(errors), intent(inout), optional, target :: err
    -
    5118 end subroutine
    -
    5119
    -
    5136 module subroutine sort_cmplx_array(x, ascend)
    -
    5137 complex(real64), intent(inout), dimension(:) :: x
    -
    5138 logical, intent(in), optional :: ascend
    -
    5139 end subroutine
    -
    5140
    -
    5170 module subroutine sort_cmplx_array_ind(x, ind, ascend, err)
    -
    5171 complex(real64), intent(inout), dimension(:) :: x
    -
    5172 integer(int32), intent(inout), dimension(:) :: ind
    -
    5173 logical, intent(in), optional :: ascend
    -
    5174 class(errors), intent(inout), optional, target :: err
    -
    5175 end subroutine
    -
    5176
    -
    5196 module subroutine sort_eigen_cmplx(vals, vecs, ascend, err)
    -
    5197 complex(real64), intent(inout), dimension(:) :: vals
    -
    5198 complex(real64), intent(inout), dimension(:,:) :: vecs
    -
    5199 logical, intent(in), optional :: ascend
    -
    5200 class(errors), intent(inout), optional, target :: err
    -
    5201 end subroutine
    -
    5202
    -
    5222 module subroutine sort_eigen_dbl(vals, vecs, ascend, err)
    -
    5223 real(real64), intent(inout), dimension(:) :: vals
    -
    5224 real(real64), intent(inout), dimension(:,:) :: vecs
    -
    5225 logical, intent(in), optional :: ascend
    -
    5226 class(errors), intent(inout), optional, target :: err
    -
    5227 end subroutine
    -
    5228
    -
    5229end interface
    -
    5230
    -
    5231end module
    -
    Computes the Cholesky factorization of a symmetric, positive definite matrix.
    -
    Computes the rank 1 downdate to a Cholesky factored matrix (upper triangular).
    -
    Computes the rank 1 update to a Cholesky factored matrix (upper triangular).
    +
    5063
    +
    5080 module subroutine sort_cmplx_array(x, ascend)
    +
    5081 complex(real64), intent(inout), dimension(:) :: x
    +
    5082 logical, intent(in), optional :: ascend
    +
    5083 end subroutine
    +
    5084
    +
    5114 module subroutine sort_cmplx_array_ind(x, ind, ascend, err)
    +
    5115 complex(real64), intent(inout), dimension(:) :: x
    +
    5116 integer(int32), intent(inout), dimension(:) :: ind
    +
    5117 logical, intent(in), optional :: ascend
    +
    5118 class(errors), intent(inout), optional, target :: err
    +
    5119 end subroutine
    +
    5120
    +
    5140 module subroutine sort_eigen_cmplx(vals, vecs, ascend, err)
    +
    5141 complex(real64), intent(inout), dimension(:) :: vals
    +
    5142 complex(real64), intent(inout), dimension(:,:) :: vecs
    +
    5143 logical, intent(in), optional :: ascend
    +
    5144 class(errors), intent(inout), optional, target :: err
    +
    5145 end subroutine
    +
    5146
    +
    5166 module subroutine sort_eigen_dbl(vals, vecs, ascend, err)
    +
    5167 real(real64), intent(inout), dimension(:) :: vals
    +
    5168 real(real64), intent(inout), dimension(:,:) :: vecs
    +
    5169 logical, intent(in), optional :: ascend
    +
    5170 class(errors), intent(inout), optional, target :: err
    +
    5171 end subroutine
    +
    5172
    +
    5173end interface
    +
    5174
    +
    5175end module
    +
    Computes the Cholesky factorization of a symmetric, positive definite matrix.
    +
    Computes the rank 1 downdate to a Cholesky factored matrix (upper triangular).
    +
    Computes the rank 1 update to a Cholesky factored matrix (upper triangular).
    Computes the determinant of a square matrix.
    Multiplies a diagonal matrix with another matrix or array.
    -
    Computes the eigenvalues, and optionally the eigenvectors, of a matrix.
    +
    Computes the eigenvalues, and optionally the eigenvectors, of a matrix.
    Extracts the L and U matrices from the condensed [L\U] storage format used by the lu_factor.
    -
    Forms the full M-by-M orthogonal matrix Q from the elementary reflectors returned by the base QR fact...
    +
    Forms the full M-by-M orthogonal matrix Q from the elementary reflectors returned by the base QR fact...
    Computes the LU factorization of an M-by-N matrix.
    -
    Computes the inverse of a square matrix.
    +
    Computes the inverse of a square matrix.
    Performs the matrix operation: .
    -
    Computes the Moore-Penrose pseudo-inverse of a M-by-N matrix using the singular value decomposition o...
    +
    Computes the Moore-Penrose pseudo-inverse of a M-by-N matrix using the singular value decomposition o...
    Computes the rank of a matrix.
    -
    Multiplies a general matrix by the orthogonal matrix Q from a QR factorization.
    -
    Multiplies a general matrix by the orthogonal matrix Z from an RZ factorization.
    -
    Computes the QR factorization of an M-by-N matrix.
    -
    Computes the rank 1 update to an M-by-N QR factored matrix A (M >= N) where A = Q * R,...
    +
    Multiplies a general matrix by the orthogonal matrix Q from a QR factorization.
    +
    Multiplies a general matrix by the orthogonal matrix Z from an RZ factorization.
    +
    Computes the QR factorization of an M-by-N matrix.
    +
    Computes the rank 1 update to an M-by-N QR factored matrix A (M >= N) where A = Q * R,...
    Performs the rank-1 update to matrix A such that: , where is an M-by-N matrix, is a scalar,...
    Multiplies a vector by the reciprocal of a real scalar.
    -
    Factors an upper trapezoidal matrix by means of orthogonal transformations such that A = R * Z = (R 0...
    -
    Solves a system of Cholesky factored equations.
    -
    Solves the overdetermined or underdetermined system (A*X = B) of M equations of N unknowns,...
    -
    Solves the overdetermined or underdetermined system (A*X = B) of M equations of N unknowns using a si...
    -
    Solves the overdetermined or underdetermined system (A*X = B) of M equations of N unknowns.
    -
    Solves a system of LU-factored equations.
    -
    Solves a system of M QR-factored equations of N unknowns.
    -
    Solves a triangular system of equations.
    -
    Sorts an array.
    -
    Computes the singular value decomposition of a matrix A. The SVD is defined as: A = U * S * V**T,...
    +
    Factors an upper trapezoidal matrix by means of orthogonal transformations such that A = R * Z = (R 0...
    +
    Solves a system of Cholesky factored equations.
    +
    Solves the overdetermined or underdetermined system (A*X = B) of M equations of N unknowns,...
    +
    Solves the overdetermined or underdetermined system (A*X = B) of M equations of N unknowns using a si...
    +
    Solves the overdetermined or underdetermined system (A*X = B) of M equations of N unknowns.
    +
    Solves a system of LU-factored equations.
    +
    Solves a system of M QR-factored equations of N unknowns.
    +
    Solves a triangular system of equations.
    +
    Sorts an array.
    +
    Computes the singular value decomposition of a matrix A. The SVD is defined as: A = U * S * V**T,...
    Swaps the contents of two arrays.
    Computes the trace of a matrix (the sum of the main diagonal elements).
    Computes the triangular matrix operation: , or , where A is a triangular matrix.
    diff --git a/doc/html/linalg__immutable_8f90_source.html b/doc/html/linalg__immutable_8f90_source.html index ed9f7e9d..f14704de 100644 --- a/doc/html/linalg__immutable_8f90_source.html +++ b/doc/html/linalg__immutable_8f90_source.html @@ -845,23 +845,23 @@
    1030 end function
    1031
    1032end module
    -
    Computes the Cholesky factorization of a symmetric, positive definite matrix.
    -
    Computes the rank 1 downdate to a Cholesky factored matrix (upper triangular).
    -
    Computes the rank 1 update to a Cholesky factored matrix (upper triangular).
    +
    Computes the Cholesky factorization of a symmetric, positive definite matrix.
    +
    Computes the rank 1 downdate to a Cholesky factored matrix (upper triangular).
    +
    Computes the rank 1 update to a Cholesky factored matrix (upper triangular).
    Computes the determinant of a square matrix.
    Multiplies a diagonal matrix with another matrix or array.
    -
    Computes the eigenvalues, and optionally the eigenvectors, of a matrix.
    +
    Computes the eigenvalues, and optionally the eigenvectors, of a matrix.
    Extracts the L and U matrices from the condensed [L\U] storage format used by the lu_factor.
    -
    Forms the full M-by-M orthogonal matrix Q from the elementary reflectors returned by the base QR fact...
    +
    Forms the full M-by-M orthogonal matrix Q from the elementary reflectors returned by the base QR fact...
    Computes the LU factorization of an M-by-N matrix.
    -
    Computes the inverse of a square matrix.
    -
    Computes the Moore-Penrose pseudo-inverse of a M-by-N matrix using the singular value decomposition o...
    -
    Computes the QR factorization of an M-by-N matrix.
    -
    Computes the rank 1 update to an M-by-N QR factored matrix A (M >= N) where A = Q * R,...
    +
    Computes the inverse of a square matrix.
    +
    Computes the Moore-Penrose pseudo-inverse of a M-by-N matrix using the singular value decomposition o...
    +
    Computes the QR factorization of an M-by-N matrix.
    +
    Computes the rank 1 update to an M-by-N QR factored matrix A (M >= N) where A = Q * R,...
    Performs the rank-1 update to matrix A such that: , where is an M-by-N matrix, is a scalar,...
    -
    Solves a triangular system of equations.
    -
    Sorts an array.
    -
    Computes the singular value decomposition of a matrix A. The SVD is defined as: A = U * S * V**T,...
    +
    Solves a triangular system of equations.
    +
    Sorts an array.
    +
    Computes the singular value decomposition of a matrix A. The SVD is defined as: A = U * S * V**T,...
    Computes the eigenvalues and eigenvectors (right) of a general N-by-N matrix.
    Computes the LU factorization of a square matrix. Notice, partial row pivoting is utilized.
    Computes the matrix operation: C = A * B, where A is a diagonal matrix.
    diff --git a/src/linalg_core.f90 b/src/linalg_core.f90 index 3f3bf484..dd94296a 100644 --- a/src/linalg_core.f90 +++ b/src/linalg_core.f90 @@ -684,6 +684,90 @@ module linalg_core ! ------------------------------------------------------------------------------ !> @brief Computes the QR factorization of an M-by-N matrix. !! +!! @par Syntax 1 +!! @code{.f90} +!! subroutine qr_factor(real(real64) a(:,:), real(real64) tau(:), optional real(real64) work(:), optional integer(int32) olwork, optional class(errors) err) +!! subroutine qr_factor(complex(real64) a(:,:), complex(real64) tau(:), optional complex(real64) work(:), optional integer(int32) olwork, optional class(errors) err) +!! @endcode +!! +!! @param[in,out] a On input, the M-by-N matrix to factor. On output, the +!! elements on and above the diagonal contain the MIN(M, N)-by-N upper +!! trapezoidal matrix R (R is upper triangular if M >= N). The elements +!! below the diagonal, along with the array @p tau, represent the +!! orthogonal matrix Q as a product of elementary reflectors. +!! @param[out] tau A MIN(M, N)-element array used to store the scalar +!! factors of the elementary reflectors. +!! @param[out] work An optional input, that if provided, prevents any local +!! memory allocation. If not provided, the memory required is allocated +!! within. If provided, the length of the array must be at least +!! @p olwork. +!! @param[out] olwork An optional output used to determine workspace size. +!! If supplied, the routine determines the optimal size for @p work, and +!! returns without performing any actual calculations. +!! @param[in,out] err An optional errors-based object that if provided can be +!! used to retrieve information relating to any errors encountered during +!! execution. If not provided, a default implementation of the errors +!! class is used internally to provide error handling. Possible errors and +!! warning messages that may be encountered are as follows. +!! - LA_ARRAY_SIZE_ERROR: Occurs if @p tau or @p work are not sized +!! appropriately. +!! - LA_OUT_OF_MEMORY_ERROR: Occurs if local memory must be allocated, and +!! there is insufficient memory available. +!! +!! @remarks +!! QR factorization without pivoting is best suited to solving an +!! overdetermined system in least-squares terms, or to solve a normally +!! defined system. To solve an underdetermined system, it is recommended to +!! use either LQ factorization, or a column-pivoting based QR factorization. +!! +!! @par Notes +!! This routine utilizes the LAPACK routine DGEQRF (ZGEQRF for the complex +!! case). +!! +!! @par Syntax 2 +!! Computes the QR factorization of an M-by-N matrix with column +!! pivoting such that \f$ A P = Q R \f$. +!! @code{.f90} +!! subroutine qr_factor(real(real64) a(:,:), real(real64) tau(:), integer(int32) jpvt(:), optional real(real64) work(:), optional integer(int32) olwork, optional class(errors) err) +!! subroutine qr_factor(complex(real64) a(:,:), complex(real64) tau(:), integer(int32) jpvt(:), optional complex(real64) work(:), optional integer(int32) olwork, optional real(real64) rwork(:), optional class(errors) err) +!! @endcode +!! +!! @param[in,out] a On input, the M-by-N matrix to factor. On output, the +!! elements on and above the diagonal contain the MIN(M, N)-by-N upper +!! trapezoidal matrix R (R is upper triangular if M >= N). The elements +!! below the diagonal, along with the array @p tau, represent the +!! orthogonal matrix Q as a product of elementary reflectors. +!! @param[out] tau A MIN(M, N)-element array used to store the scalar +!! factors of the elementary reflectors. +!! @param[in,out] jpvt On input, an N-element array that if JPVT(I) .ne. 0, +!! the I-th column of A is permuted to the front of A * P; if JPVT(I) = 0, +!! the I-th column of A is a free column. On output, if JPVT(I) = K, then +!! the I-th column of A * P was the K-th column of A. +!! @param[out] work An optional input, that if provided, prevents any local +!! memory allocation. If not provided, the memory required is allocated +!! within. If provided, the length of the array must be at least +!! @p olwork. +!! @param[out] olwork An optional output used to determine workspace size. +!! If supplied, the routine determines the optimal size for @p work, and +!! returns without performing any actual calculations. +!! @param[out] rwork An optional input, that if provided, prevents any local +!! allocate of real-valued memory. If not provided, the memory required +!! is allocated within. If provided, the length of the array must be at +!! least 2*N. +!! @param[in,out] err An optional errors-based object that if provided can be +!! used to retrieve information relating to any errors encountered during +!! execution. If not provided, a default implementation of the errors +!! class is used internally to provide error handling. Possible errors and +!! warning messages that may be encountered are as follows. +!! - LA_ARRAY_SIZE_ERROR: Occurs if any of the input arrays are not sized +!! appropriately. +!! - LA_OUT_OF_MEMORY_ERROR: Occurs if local memory must be allocated, and +!! there is insufficient memory available. +!! +!! @par Notes +!! This routine utilizes the LAPACK routine DGEQP3 (ZGEQP3 for the complex +!! case). +!! !! @par Usage !! The following example illustrates the solution of a system of equations !! using QR factorization. @@ -2237,42 +2321,7 @@ module subroutine form_lu_only_cmplx(lu, u, err) complex(real64), intent(out), dimension(:,:) :: u class(errors), intent(inout), optional, target :: err end subroutine - - !> @brief Computes the QR factorization of an M-by-N matrix without - !! pivoting. - !! - !! @param[in,out] a On input, the M-by-N matrix to factor. On output, the - !! elements on and above the diagonal contain the MIN(M, N)-by-N upper - !! trapezoidal matrix R (R is upper triangular if M >= N). The elements - !! below the diagonal, along with the array @p tau, represent the - !! orthogonal matrix Q as a product of elementary reflectors. - !! @param[out] tau A MIN(M, N)-element array used to store the scalar - !! factors of the elementary reflectors. - !! @param[out] work An optional input, that if provided, prevents any local - !! memory allocation. If not provided, the memory required is allocated - !! within. If provided, the length of the array must be at least - !! @p olwork. - !! @param[out] olwork An optional output used to determine workspace size. - !! If supplied, the routine determines the optimal size for @p work, and - !! returns without performing any actual calculations. - !! @param[out] err An optional errors-based object that if provided can be - !! used to retrieve information relating to any errors encountered during - !! execution. If not provided, a default implementation of the errors - !! class is used internally to provide error handling. Possible errors and - !! warning messages that may be encountered are as follows. - !! - LA_ARRAY_SIZE_ERROR: Occurs if @p tau or @p work are not sized - !! appropriately. - !! - LA_OUT_OF_MEMORY_ERROR: Occurs if local memory must be allocated, and - !! there is insufficient memory available. - !! - !! @remarks - !! QR factorization without pivoting is best suited to solving an - !! overdetermined system in least-squares terms, or to solve a normally - !! defined system. To solve an underdetermined system, it is recommended to - !! use either LQ factorization, or a column-pivoting based QR factorization. - !! - !! @par Notes - !! This routine utilizes the LAPACK routine DGEQRF. + module subroutine qr_factor_no_pivot(a, tau, work, olwork, err) real(real64), intent(inout), dimension(:,:) :: a real(real64), intent(out), dimension(:) :: tau @@ -2281,41 +2330,6 @@ module subroutine qr_factor_no_pivot(a, tau, work, olwork, err) class(errors), intent(inout), optional, target :: err end subroutine - !> @brief Computes the QR factorization of an M-by-N matrix without - !! pivoting. - !! - !! @param[in,out] a On input, the M-by-N matrix to factor. On output, the - !! elements on and above the diagonal contain the MIN(M, N)-by-N upper - !! trapezoidal matrix R (R is upper triangular if M >= N). The elements - !! below the diagonal, along with the array @p tau, represent the - !! orthogonal matrix Q as a product of elementary reflectors. - !! @param[out] tau A MIN(M, N)-element array used to store the scalar - !! factors of the elementary reflectors. - !! @param[out] work An optional input, that if provided, prevents any local - !! memory allocation. If not provided, the memory required is allocated - !! within. If provided, the length of the array must be at least - !! @p olwork. - !! @param[out] olwork An optional output used to determine workspace size. - !! If supplied, the routine determines the optimal size for @p work, and - !! returns without performing any actual calculations. - !! @param[out] err An optional errors-based object that if provided can be - !! used to retrieve information relating to any errors encountered during - !! execution. If not provided, a default implementation of the errors - !! class is used internally to provide error handling. Possible errors and - !! warning messages that may be encountered are as follows. - !! - LA_ARRAY_SIZE_ERROR: Occurs if @p tau or @p work are not sized - !! appropriately. - !! - LA_OUT_OF_MEMORY_ERROR: Occurs if local memory must be allocated, and - !! there is insufficient memory available. - !! - !! @remarks - !! QR factorization without pivoting is best suited to solving an - !! overdetermined system in least-squares terms, or to solve a normally - !! defined system. To solve an underdetermined system, it is recommended to - !! use either LQ factorization, or a column-pivoting based QR factorization. - !! - !! @par Notes - !! This routine utilizes the LAPACK routine ZGEQRF. module subroutine qr_factor_no_pivot_cmplx(a, tau, work, olwork, err) complex(real64), intent(inout), dimension(:,:) :: a complex(real64), intent(out), dimension(:) :: tau @@ -2323,40 +2337,7 @@ module subroutine qr_factor_no_pivot_cmplx(a, tau, work, olwork, err) integer(int32), intent(out), optional :: olwork class(errors), intent(inout), optional, target :: err end subroutine - - !> @brief Computes the QR factorization of an M-by-N matrix with column - !! pivoting such that A * P = Q * R. - !! - !! @param[in,out] a On input, the M-by-N matrix to factor. On output, the - !! elements on and above the diagonal contain the MIN(M, N)-by-N upper - !! trapezoidal matrix R (R is upper triangular if M >= N). The elements - !! below the diagonal, along with the array @p tau, represent the - !! orthogonal matrix Q as a product of elementary reflectors. - !! @param[out] tau A MIN(M, N)-element array used to store the scalar - !! factors of the elementary reflectors. - !! @param[in,out] jpvt On input, an N-element array that if JPVT(I) .ne. 0, - !! the I-th column of A is permuted to the front of A * P; if JPVT(I) = 0, - !! the I-th column of A is a free column. On output, if JPVT(I) = K, then - !! the I-th column of A * P was the K-th column of A. - !! @param[out] work An optional input, that if provided, prevents any local - !! memory allocation. If not provided, the memory required is allocated - !! within. If provided, the length of the array must be at least - !! @p olwork. - !! @param[out] olwork An optional output used to determine workspace size. - !! If supplied, the routine determines the optimal size for @p work, and - !! returns without performing any actual calculations. - !! @param[out] err An optional errors-based object that if provided can be - !! used to retrieve information relating to any errors encountered during - !! execution. If not provided, a default implementation of the errors - !! class is used internally to provide error handling. Possible errors and - !! warning messages that may be encountered are as follows. - !! - LA_ARRAY_SIZE_ERROR: Occurs if any of the input arrays are not sized - !! appropriately. - !! - LA_OUT_OF_MEMORY_ERROR: Occurs if local memory must be allocated, and - !! there is insufficient memory available. - !! - !! @par Notes - !! This routine utilizes the LAPACK routine DGEQP3. + module subroutine qr_factor_pivot(a, tau, jpvt, work, olwork, err) real(real64), intent(inout), dimension(:,:) :: a real(real64), intent(out), dimension(:) :: tau @@ -2365,44 +2346,7 @@ module subroutine qr_factor_pivot(a, tau, jpvt, work, olwork, err) integer(int32), intent(out), optional :: olwork class(errors), intent(inout), optional, target :: err end subroutine - - !> @brief Computes the QR factorization of an M-by-N matrix with column - !! pivoting such that A * P = Q * R. - !! - !! @param[in,out] a On input, the M-by-N matrix to factor. On output, the - !! elements on and above the diagonal contain the MIN(M, N)-by-N upper - !! trapezoidal matrix R (R is upper triangular if M >= N). The elements - !! below the diagonal, along with the array @p tau, represent the - !! orthogonal matrix Q as a product of elementary reflectors. - !! @param[out] tau A MIN(M, N)-element array used to store the scalar - !! factors of the elementary reflectors. - !! @param[in,out] jpvt On input, an N-element array that if JPVT(I) .ne. 0, - !! the I-th column of A is permuted to the front of A * P; if JPVT(I) = 0, - !! the I-th column of A is a free column. On output, if JPVT(I) = K, then - !! the I-th column of A * P was the K-th column of A. - !! @param[out] work An optional input, that if provided, prevents any local - !! memory allocation. If not provided, the memory required is allocated - !! within. If provided, the length of the array must be at least - !! @p olwork. - !! @param[out] olwork An optional output used to determine workspace size. - !! If supplied, the routine determines the optimal size for @p work, and - !! returns without performing any actual calculations. - !! @param[out] rwork An optional input, that if provided, prevents any local - !! allocate of real-valued memory. If not provided, the memory required - !! is allocated within. If provided, the length of the array must be at - !! least 2*N. - !! @param[out] err An optional errors-based object that if provided can be - !! used to retrieve information relating to any errors encountered during - !! execution. If not provided, a default implementation of the errors - !! class is used internally to provide error handling. Possible errors and - !! warning messages that may be encountered are as follows. - !! - LA_ARRAY_SIZE_ERROR: Occurs if any of the input arrays are not sized - !! appropriately. - !! - LA_OUT_OF_MEMORY_ERROR: Occurs if local memory must be allocated, and - !! there is insufficient memory available. - !! - !! @par Notes - !! This routine utilizes the LAPACK routine ZGEQP3. + module subroutine qr_factor_pivot_cmplx(a, tau, jpvt, work, olwork, rwork, & err) complex(real64), intent(inout), dimension(:,:) :: a From e9c2a2778371ec28e8c9221a0c2177c945657e71 Mon Sep 17 00:00:00 2001 From: jchristopherson Date: Tue, 13 Dec 2022 21:52:10 -0600 Subject: [PATCH 16/65] Update documentation --- ...rfacelinalg__core_1_1cholesky__factor.html | 8 +- ...lg__core_1_1cholesky__rank1__downdate.html | 6 +- ...nalg__core_1_1cholesky__rank1__update.html | 6 +- ...erfacelinalg__core_1_1diag__mtx__mult.html | 4 +- doc/html/interfacelinalg__core_1_1eigen.html | 4 +- .../interfacelinalg__core_1_1form__lu.html | 2 +- .../interfacelinalg__core_1_1form__qr.html | 46 +- .../interfacelinalg__core_1_1lu__factor.html | 2 +- ...interfacelinalg__core_1_1mtx__inverse.html | 4 +- ...nterfacelinalg__core_1_1mtx__pinverse.html | 4 +- .../interfacelinalg__core_1_1mult__qr.html | 49 +- .../interfacelinalg__core_1_1mult__rz.html | 2 +- .../interfacelinalg__core_1_1qr__factor.html | 2 +- ...facelinalg__core_1_1qr__rank1__update.html | 6 +- .../interfacelinalg__core_1_1rz__factor.html | 2 +- ...erfacelinalg__core_1_1solve__cholesky.html | 8 +- ...linalg__core_1_1solve__least__squares.html | 4 +- ...__core_1_1solve__least__squares__full.html | 4 +- ...g__core_1_1solve__least__squares__svd.html | 4 +- .../interfacelinalg__core_1_1solve__lu.html | 4 +- .../interfacelinalg__core_1_1solve__qr.html | 4 +- ...lg__core_1_1solve__triangular__system.html | 4 +- doc/html/interfacelinalg__core_1_1sort.html | 2 +- doc/html/interfacelinalg__core_1_1svd.html | 4 +- doc/html/linalg__c__api_8f90_source.html | 32 +- doc/html/linalg__core_8f90_source.html | 2094 ++++++++--------- doc/html/linalg__immutable_8f90_source.html | 22 +- src/linalg_core.f90 | 440 ++-- 28 files changed, 1371 insertions(+), 1402 deletions(-) diff --git a/doc/html/interfacelinalg__core_1_1cholesky__factor.html b/doc/html/interfacelinalg__core_1_1cholesky__factor.html index 6b2fa038..a554e194 100644 --- a/doc/html/interfacelinalg__core_1_1cholesky__factor.html +++ b/doc/html/interfacelinalg__core_1_1cholesky__factor.html @@ -157,9 +157,9 @@
    print '(A)', "Cholesky Solution (Manual Approach): X = "
    print '(F8.4)', (bu(i), i = 1, size(bu))
    end program
    -
    Computes the Cholesky factorization of a symmetric, positive definite matrix.
    -
    Solves a system of Cholesky factored equations.
    -
    Solves a triangular system of equations.
    +
    Computes the Cholesky factorization of a symmetric, positive definite matrix.
    +
    Solves a system of Cholesky factored equations.
    +
    Solves a triangular system of equations.
    Provides a set of common linear algebra routines.
    Definition: linalg_core.f90:15
    The above program produces the following output.
    Cholesky Solution: X =
    239.5833
    @@ -171,7 +171,7 @@
    10.3333
    -

    Definition at line 1168 of file linalg_core.f90.

    +

    Definition at line 1322 of file linalg_core.f90.


    The documentation for this interface was generated from the following file: diff --git a/doc/html/interfacelinalg__core_1_1cholesky__rank1__downdate.html b/doc/html/interfacelinalg__core_1_1cholesky__rank1__downdate.html index 2997516d..31c03bfe 100644 --- a/doc/html/interfacelinalg__core_1_1cholesky__rank1__downdate.html +++ b/doc/html/interfacelinalg__core_1_1cholesky__rank1__downdate.html @@ -154,8 +154,8 @@
    print *, ad(i,:)
    end do
    end program
    -
    Computes the Cholesky factorization of a symmetric, positive definite matrix.
    -
    Computes the rank 1 downdate to a Cholesky factored matrix (upper triangular).
    +
    Computes the Cholesky factorization of a symmetric, positive definite matrix.
    +
    Computes the rank 1 downdate to a Cholesky factored matrix (upper triangular).
    Performs the rank-1 update to matrix A such that: , where is an M-by-N matrix, is a scalar,...
    Provides a set of common linear algebra routines.
    Definition: linalg_core.f90:15
    The above program produces the following output.
    Downdating the Factored Form:
    @@ -168,7 +168,7 @@
    0.0000000000000000 0.0000000000000000 3.0000000000000000
    -

    Definition at line 1309 of file linalg_core.f90.

    +

    Definition at line 1463 of file linalg_core.f90.


    The documentation for this interface was generated from the following file: diff --git a/doc/html/interfacelinalg__core_1_1cholesky__rank1__update.html b/doc/html/interfacelinalg__core_1_1cholesky__rank1__update.html index 3c3f8ce1..78bb7648 100644 --- a/doc/html/interfacelinalg__core_1_1cholesky__rank1__update.html +++ b/doc/html/interfacelinalg__core_1_1cholesky__rank1__update.html @@ -150,8 +150,8 @@
    print *, au(i,:)
    end do
    end program
    -
    Computes the Cholesky factorization of a symmetric, positive definite matrix.
    -
    Computes the rank 1 update to a Cholesky factored matrix (upper triangular).
    +
    Computes the Cholesky factorization of a symmetric, positive definite matrix.
    +
    Computes the rank 1 update to a Cholesky factored matrix (upper triangular).
    Performs the rank-1 update to matrix A such that: , where is an M-by-N matrix, is a scalar,...
    Provides a set of common linear algebra routines.
    Definition: linalg_core.f90:15
    The above program produces the following output.
    Updating the Factored Form:
    @@ -164,7 +164,7 @@
    0.0000000000000000 0.0000000000000000 6.6989384530323557
    -

    Definition at line 1236 of file linalg_core.f90.

    +

    Definition at line 1390 of file linalg_core.f90.


    The documentation for this interface was generated from the following file: diff --git a/doc/html/interfacelinalg__core_1_1diag__mtx__mult.html b/doc/html/interfacelinalg__core_1_1diag__mtx__mult.html index 723844dd..1c150469 100644 --- a/doc/html/interfacelinalg__core_1_1diag__mtx__mult.html +++ b/doc/html/interfacelinalg__core_1_1diag__mtx__mult.html @@ -152,7 +152,7 @@ -
    Usage
    The following example illustrates the use of the diagonal matrix multiplication routine to compute the S * V**T component of a singular value decomposition.
    program example
    +
    Usage
    The following example illustrates the use of the diagonal matrix multiplication routine to compute the \( S V^T \) component of a singular value decomposition.
    program example
    use iso_fortran_env, only : int32, real64
    implicit none
    @@ -194,7 +194,7 @@
    end do
    end program
    Multiplies a diagonal matrix with another matrix or array.
    -
    Computes the singular value decomposition of a matrix A. The SVD is defined as: A = U * S * V**T,...
    +
    Computes the singular value decomposition of a matrix A. The SVD is defined as: A = U * S * V**T,...
    Provides a set of common linear algebra routines.
    Definition: linalg_core.f90:15
    The above program produces the following output.
    U =
    -0.47411577501825380 -0.81850539032073777 -0.32444284226152509
    diff --git a/doc/html/interfacelinalg__core_1_1eigen.html b/doc/html/interfacelinalg__core_1_1eigen.html index 73cfa2d0..57ad2e95 100644 --- a/doc/html/interfacelinalg__core_1_1eigen.html +++ b/doc/html/interfacelinalg__core_1_1eigen.html @@ -164,7 +164,7 @@
    print '(F10.3)', (real(modeshapes(j,i)), j = 1, size(natfreq))
    end do
    end program
    -
    Computes the eigenvalues, and optionally the eigenvectors, of a matrix.
    +
    Computes the eigenvalues, and optionally the eigenvectors, of a matrix.
    Provides a set of common linear algebra routines.
    Definition: linalg_core.f90:15
    The above program produces the following output.
    Modal Information:
    Mode 1: (232.9225 Hz)
    @@ -187,7 +187,7 @@
    -

    Definition at line 2063 of file linalg_core.f90.

    +

    Definition at line 2217 of file linalg_core.f90.


    The documentation for this interface was generated from the following file: diff --git a/doc/html/interfacelinalg__core_1_1form__lu.html b/doc/html/interfacelinalg__core_1_1form__lu.html index 24f72a0d..171399d0 100644 --- a/doc/html/interfacelinalg__core_1_1form__lu.html +++ b/doc/html/interfacelinalg__core_1_1form__lu.html @@ -199,7 +199,7 @@
    end program
    Extracts the L and U matrices from the condensed [L\U] storage format used by the lu_factor.
    Computes the LU factorization of an M-by-N matrix.
    -
    Solves a triangular system of equations.
    +
    Solves a triangular system of equations.
    Provides a set of common linear algebra routines.
    Definition: linalg_core.f90:15
    The above program produces the following output.
    LU Solution: X =
    0.3333
    diff --git a/doc/html/interfacelinalg__core_1_1form__qr.html b/doc/html/interfacelinalg__core_1_1form__qr.html index ded97157..37412277 100644 --- a/doc/html/interfacelinalg__core_1_1form__qr.html +++ b/doc/html/interfacelinalg__core_1_1form__qr.html @@ -107,6 +107,46 @@ More...

    Detailed Description

    Forms the full M-by-M orthogonal matrix Q from the elementary reflectors returned by the base QR factorization algorithm.

    +
    Syntax 1
    subroutine form_qr(real(real64) r(:,:), real(real64) tau(:), real(real64) q(:,:), optional real(real64) work(:), optional integer(int32) olwork, optional class(errors) err)
    +
    subroutine form_qr(complex(real64) r(:,:), complex(real64) tau(:), complex(real64) q(:,:), optional complex(real64) work(:), optional integer(int32) olwork, optional class(errors) err)
    +
    +
    Parameters
    + + + + + + + +
    [in,out]rOn input, an M-by-N matrix where the elements below the diagonal contain the elementary reflectors generated from the QR factorization. On and above the diagonal, the matrix contains the matrix R. On output, the elements below the diagonal are zeroed such that the remaining matrix is simply the M-by-N matrix R.
    [in]tauA MIN(M, N)-element array containing the scalar factors of each elementary reflector defined in r.
    [out]qAn M-by-M matrix where the full orthogonal matrix Q will be written. In the event that M > N, Q may be supplied as M-by-N, and therefore only return the useful submatrix Q1 (Q = [Q1, Q2]) as the factorization can be written as Q * R = [Q1, Q2] * [R1; 0].
    [out]workAn optional input, that if provided, prevents any local memory allocation. If not provided, the memory required is allocated within. If provided, the length of the array must be at least olwork.
    [out]olworkAn optional output used to determine workspace size. If supplied, the routine determines the optimal size for work, and returns without performing any actual calculations.
    [in,out]errAn optional errors-based object that if provided can be used to retrieve information relating to any errors encountered during execution. If not provided, a default implementation of the errors class is used internally to provide error handling. Possible errors and warning messages that may be encountered are as follows.
      +
    • LA_ARRAY_SIZE_ERROR: Occurs if any of the input arrays are not sized appropriately.
    • +
    • LA_OUT_OF_MEMORY_ERROR: Occurs if local memory must be allocated, and there is insufficient memory available.
    • +
    +
    +
    +
    +
    Notes
    This routine utilizes the LAPACK routine DORGQR (ZUNQR in the complex case).
    +
    Syntax 2
    subroutine form_qr(real(real64) r(:,:), real(real64) tau(:), integer(int32) pvt(:), real(real64) q(:,:), real(real64) p(:,:), optional real(real64) work(:), optional integer(int32) olwork, optional class(errors) err)
    +
    subroutine form_qr(complex(real64) r(:,:), complex(real64) tau(:), integer(int32) pvt(:), complex(real64) q(:,:), complex(real64) p(:,:), optional complex(real64) work(:), optional integer(int32) olwork, optional class(errors) err)
    +
    +
    Parameters
    + + + + + + + + + +
    [in,out]rOn input, an M-by-N matrix where the elements below the diagonal contain the elementary reflectors generated from the QR factorization. On and above the diagonal, the matrix contains the matrix R. On output, the elements below the diagonal are zeroed such that the remaining matrix is simply the M-by-N matrix R.
    [in]tauA MIN(M, N)-element array containing the scalar factors of each elementary reflector defined in r.
    [in]pvtAn N-element column pivot array as returned by the QR factorization.
    [out]qAn M-by-M matrix where the full orthogonal matrix Q will be written. In the event that M > N, Q may be supplied as M-by-N, and therefore only return the useful submatrix Q1 (Q = [Q1, Q2]) as the factorization can be written as Q * R = [Q1, Q2] * [R1; 0].
    [out]pAn N-by-N matrix where the pivot matrix will be written.
    [out]workAn optional input, that if provided, prevents any local memory allocation. If not provided, the memory required is allocated within. If provided, the length of the array must be at least olwork.
    [out]olworkAn optional output used to determine workspace size. If supplied, the routine determines the optimal size for work, and returns without performing any actual calculations.
    [in,out]errAn optional errors-based object that if provided can be used to retrieve information relating to any errors encountered during execution. If not provided, a default implementation of the errors class is used internally to provide error handling. Possible errors and warning messages that may be encountered are as follows.
      +
    • LA_ARRAY_SIZE_ERROR: Occurs if any of the input arrays are not sized appropriately.
    • +
    • LA_OUT_OF_MEMORY_ERROR: Occurs if local memory must be allocated, and there is insufficient memory available.
    • +
    +
    +
    +
    +
    Notes
    This routine utilizes the LAPACK routine DORGQR (ZUNQR in the complex case).
    Usage
    The following example illustrates how to explicitly form the Q and R matrices from the output of qr_factor, and then use the resulting matrices to solve a system of linear equations.
    program example
    use iso_fortran_env, only : real64, int32
    @@ -162,9 +202,9 @@
    ! for by noting that Q * R = A * P, where P is an N-by-N matrix describing
    ! the column pivoting operations.
    end program
    -
    Forms the full M-by-M orthogonal matrix Q from the elementary reflectors returned by the base QR fact...
    +
    Forms the full M-by-M orthogonal matrix Q from the elementary reflectors returned by the base QR fact...
    Computes the QR factorization of an M-by-N matrix.
    -
    Solves a triangular system of equations.
    +
    Solves a triangular system of equations.
    Provides a set of common linear algebra routines.
    Definition: linalg_core.f90:15
    The above program produces the following output.
    QR Solution: X =
    0.3333
    @@ -177,7 +217,7 @@
    -

    Definition at line 914 of file linalg_core.f90.

    +

    Definition at line 991 of file linalg_core.f90.


    The documentation for this interface was generated from the following file: diff --git a/doc/html/interfacelinalg__core_1_1lu__factor.html b/doc/html/interfacelinalg__core_1_1lu__factor.html index 288cda1e..bf3cc919 100644 --- a/doc/html/interfacelinalg__core_1_1lu__factor.html +++ b/doc/html/interfacelinalg__core_1_1lu__factor.html @@ -167,7 +167,7 @@
    print '(F8.4)', (b(i), i = 1, size(b))
    end program
    Computes the LU factorization of an M-by-N matrix.
    -
    Solves a system of LU-factored equations.
    +
    Solves a system of LU-factored equations.
    Provides a set of common linear algebra routines.
    Definition: linalg_core.f90:15
    The program generates the following output.
    LU Solution: X =
    0.3333
    diff --git a/doc/html/interfacelinalg__core_1_1mtx__inverse.html b/doc/html/interfacelinalg__core_1_1mtx__inverse.html index 83962158..99d60057 100644 --- a/doc/html/interfacelinalg__core_1_1mtx__inverse.html +++ b/doc/html/interfacelinalg__core_1_1mtx__inverse.html @@ -143,7 +143,7 @@
    print *, c(i,:)
    end do
    end program
    -
    Computes the inverse of a square matrix.
    +
    Computes the inverse of a square matrix.
    Provides a set of common linear algebra routines.
    Definition: linalg_core.f90:15
    The above program produces the following output.
    Inverse:
    -1.7777777777777777 0.88888888888888884 -0.11111111111111110
    @@ -155,7 +155,7 @@
    1.7763568394002505E-015 -8.8817841970012523E-016 1.0000000000000000
    -

    Definition at line 1908 of file linalg_core.f90.

    +

    Definition at line 2062 of file linalg_core.f90.


    The documentation for this interface was generated from the following file: diff --git a/doc/html/interfacelinalg__core_1_1mtx__pinverse.html b/doc/html/interfacelinalg__core_1_1mtx__pinverse.html index 95baf7de..a4684f0c 100644 --- a/doc/html/interfacelinalg__core_1_1mtx__pinverse.html +++ b/doc/html/interfacelinalg__core_1_1mtx__pinverse.html @@ -145,7 +145,7 @@
    print *, c(i,:)
    end do
    end program
    -
    Computes the Moore-Penrose pseudo-inverse of a M-by-N matrix using the singular value decomposition o...
    +
    Computes the Moore-Penrose pseudo-inverse of a M-by-N matrix using the singular value decomposition o...
    Provides a set of common linear algebra routines.
    Definition: linalg_core.f90:15
    The above program produces the following output.
    Inverse:
    1.0000000000000000 0.0000000000000000 0.0000000000000000
    @@ -155,7 +155,7 @@
    0.0000000000000000 0.99999999999999967
    -

    Definition at line 1969 of file linalg_core.f90.

    +

    Definition at line 2123 of file linalg_core.f90.


    The documentation for this interface was generated from the following file: diff --git a/doc/html/interfacelinalg__core_1_1mult__qr.html b/doc/html/interfacelinalg__core_1_1mult__qr.html index 0d95169a..e6dce07c 100644 --- a/doc/html/interfacelinalg__core_1_1mult__qr.html +++ b/doc/html/interfacelinalg__core_1_1mult__qr.html @@ -107,7 +107,48 @@ More...

    Detailed Description

    Multiplies a general matrix by the orthogonal matrix Q from a QR factorization.

    -
    Usage
    The following example illustrates how to perform the multiplication Q**T * B when solving a system of QR factored equations without explicitly forming the matrix Q.
    program example
    +
    Syntax 1
    Multiplies a general matrix by the orthogonal matrix \( Q \) from a QR factorization such that: \( C = op(Q) C \), or \( C = C op(Q) \).
    subroutine mult_qr(logical lside, logical trans, real(real64) a(:,:), real(real64) tau(:), real(real64) c(:,:), optional real(real64) work(:), optional integer(int32) olwork, optional class(errors) err)
    +
    subroutine mult_qr(logical lside, logical trans, complex(real64) a(:,:), complex(real64) tau(:), complex(real64) c(:,:), optional complex(real64) work(:), optional integer(int32) olwork, optional class(errors) err)
    +
    +
    Parameters
    + + + + + + + + + +
    [in]lsideSet to true to apply \( Q \) or \( Q^T \) from the left; else, set to false to apply \( Q \) or \( Q^T \) from the right.
    [in]transSet to true to apply \( Q^T \); else, set to false.
    [in]aOn input, an LDA-by-K matrix containing the elementary reflectors output from the QR factorization. If lside is set to true, LDA = M, and M >= K >= 0; else, if lside is set to false, LDA = N, and N >= K >= 0. Notice, the contents of this matrix are restored on exit.
    [in]tauA K-element array containing the scalar factors of each elementary reflector defined in a.
    [in,out]cOn input, the M-by-N matrix C. On output, the product of the orthogonal matrix Q and the original matrix C.
    [out]workAn optional input, that if provided, prevents any local memory allocation. If not provided, the memory required is allocated within. If provided, the length of the array must be at least olwork.
    [in,out]olworkAn optional output used to determine workspace size. If supplied, the routine determines the optimal size for work, and returns without performing any actual calculations.
    [out]errAn optional errors-based object that if provided can be used to retrieve information relating to any errors encountered during execution. If not provided, a default implementation of the errors class is used internally to provide error handling. Possible errors and warning messages that may be encountered are as follows.
      +
    • LA_ARRAY_SIZE_ERROR: Occurs if any of the input arrays are not sized appropriately.
    • +
    • LA_OUT_OF_MEMORY_ERROR: Occurs if local memory must be allocated, and there is insufficient memory available.
    • +
    +
    +
    +
    +
    Notes
    This routine utilizes the LAPACK routine DORMQR (ZUNMQR in the complex case).
    +
    Syntax 2
    Multiplies a vector by the orthogonal matrix \( Q \) from a QR factorization such that: \( C = op(Q) C\).
    subroutine mult_qr(logical trans, real(real64) a(:,:), real(real64) tau(:), real(real64) c(:), optional real(real64) work(:), optional integer(int32) olwork, optional class(errors) err)
    +
    subroutine mult_qr(logical trans, complex(real64) a(:,:), complex(real64) tau(:), complex(real64) c(:), optional complex(real64) work(:), optional integer(int32) olwork, optional class(errors) err)
    +
    +
    Parameters
    + + + + + + + + +
    [in]transSet to true to apply \( Q^T \); else, set to false.
    [in]aOn input, an M-by-K matrix containing the elementary reflectors output from the QR factorization. Notice, the contents of this matrix are restored on exit.
    [in]tauA K-element array containing the scalar factors of each elementary reflector defined in a.
    [in,out]cOn input, the M-element vector C. On output, the product of the orthogonal matrix Q and the original vector C.
    [out]workAn optional input, that if provided, prevents any local memory allocation. If not provided, the memory required is allocated within. If provided, the length of the array must be at least olwork.
    [out]olworkAn optional output used to determine workspace size. If supplied, the routine determines the optimal size for work, and returns without performing any actual calculations.
    [in,out]errAn optional errors-based object that if provided can be used to retrieve information relating to any errors encountered during execution. If not provided, a default implementation of the errors class is used internally to provide error handling. Possible errors and warning messages that may be encountered are as follows.
      +
    • LA_ARRAY_SIZE_ERROR: Occurs if any of the input arrays are not sized appropriately.
    • +
    • LA_OUT_OF_MEMORY_ERROR: Occurs if local memory must be allocated, and there is insufficient memory available.
    • +
    +
    +
    +
    +
    Notes
    This routine utilizes the LAPACK routine DORMQR (ZUNMQR in the complex case).
    +
    Usage
    The following example illustrates how to perform the multiplication \( Q^T B \) when solving a system of QR factored equations without explicitly forming the matrix \( Q \).
    program example
    use iso_fortran_env, only : real64, int32
    implicit none
    @@ -160,9 +201,9 @@
    ! for by noting that Q * R = A * P, where P is an N-by-N matrix describing
    ! the column pivoting operations.
    end program
    -
    Multiplies a general matrix by the orthogonal matrix Q from a QR factorization.
    +
    Multiplies a general matrix by the orthogonal matrix Q from a QR factorization.
    Computes the QR factorization of an M-by-N matrix.
    -
    Solves a triangular system of equations.
    +
    Solves a triangular system of equations.
    Provides a set of common linear algebra routines.
    Definition: linalg_core.f90:15
    The above program produces the following output.
    QR Solution: X =
    0.3333
    @@ -170,7 +211,7 @@
    0.0000
    -

    Definition at line 991 of file linalg_core.f90.

    +

    Definition at line 1145 of file linalg_core.f90.


    The documentation for this interface was generated from the following file: diff --git a/doc/html/interfacelinalg__core_1_1mult__rz.html b/doc/html/interfacelinalg__core_1_1mult__rz.html index 56b2db82..71e08607 100644 --- a/doc/html/interfacelinalg__core_1_1mult__rz.html +++ b/doc/html/interfacelinalg__core_1_1mult__rz.html @@ -108,7 +108,7 @@

    Detailed Description

    Multiplies a general matrix by the orthogonal matrix Z from an RZ factorization.

    -

    Definition at line 1327 of file linalg_core.f90.

    +

    Definition at line 1481 of file linalg_core.f90.


    The documentation for this interface was generated from the following file: diff --git a/doc/html/interfacelinalg__core_1_1qr__factor.html b/doc/html/interfacelinalg__core_1_1qr__factor.html index 35e87705..f89ff6ee 100644 --- a/doc/html/interfacelinalg__core_1_1qr__factor.html +++ b/doc/html/interfacelinalg__core_1_1qr__factor.html @@ -190,7 +190,7 @@
    ! tracking array).
    end program
    Computes the QR factorization of an M-by-N matrix.
    -
    Solves a system of M QR-factored equations of N unknowns.
    +
    Solves a system of M QR-factored equations of N unknowns.
    Provides a set of common linear algebra routines.
    Definition: linalg_core.f90:15
    The above program produces the following output.
    QR Solution: X =
    0.3333
    diff --git a/doc/html/interfacelinalg__core_1_1qr__rank1__update.html b/doc/html/interfacelinalg__core_1_1qr__rank1__update.html index 3960f6b8..2832d52b 100644 --- a/doc/html/interfacelinalg__core_1_1qr__rank1__update.html +++ b/doc/html/interfacelinalg__core_1_1qr__rank1__update.html @@ -171,9 +171,9 @@
    print *, a(i,:)
    end do
    end program
    -
    Forms the full M-by-M orthogonal matrix Q from the elementary reflectors returned by the base QR fact...
    +
    Forms the full M-by-M orthogonal matrix Q from the elementary reflectors returned by the base QR fact...
    Computes the QR factorization of an M-by-N matrix.
    -
    Computes the rank 1 update to an M-by-N QR factored matrix A (M >= N) where A = Q * R,...
    +
    Computes the rank 1 update to an M-by-N QR factored matrix A (M >= N) where A = Q * R,...
    Performs the rank-1 update to matrix A such that: , where is an M-by-N matrix, is a scalar,...
    Provides a set of common linear algebra routines.
    Definition: linalg_core.f90:15
    The above program produces the following output.
    Updating the Factored Form:
    @@ -196,7 +196,7 @@
    0.0000000000000000 0.0000000000000000 -5.2929341121113058
    -

    Definition at line 1093 of file linalg_core.f90.

    +

    Definition at line 1247 of file linalg_core.f90.


    The documentation for this interface was generated from the following file: diff --git a/doc/html/interfacelinalg__core_1_1rz__factor.html b/doc/html/interfacelinalg__core_1_1rz__factor.html index b9bbe0b4..9069624a 100644 --- a/doc/html/interfacelinalg__core_1_1rz__factor.html +++ b/doc/html/interfacelinalg__core_1_1rz__factor.html @@ -108,7 +108,7 @@

    Detailed Description

    Factors an upper trapezoidal matrix by means of orthogonal transformations such that A = R * Z = (R 0) * Z. Z is an orthogonal matrix of dimension N-by-N, and R is an M-by-M upper triangular matrix.

    -

    Definition at line 1319 of file linalg_core.f90.

    +

    Definition at line 1473 of file linalg_core.f90.


    The documentation for this interface was generated from the following file: diff --git a/doc/html/interfacelinalg__core_1_1solve__cholesky.html b/doc/html/interfacelinalg__core_1_1solve__cholesky.html index b2915021..014017c0 100644 --- a/doc/html/interfacelinalg__core_1_1solve__cholesky.html +++ b/doc/html/interfacelinalg__core_1_1solve__cholesky.html @@ -157,9 +157,9 @@
    print '(A)', "Cholesky Solution (Manual Approach): X = "
    print '(F8.4)', (bu(i), i = 1, size(bu))
    end program
    -
    Computes the Cholesky factorization of a symmetric, positive definite matrix.
    -
    Solves a system of Cholesky factored equations.
    -
    Solves a triangular system of equations.
    +
    Computes the Cholesky factorization of a symmetric, positive definite matrix.
    +
    Solves a system of Cholesky factored equations.
    +
    Solves a triangular system of equations.
    Provides a set of common linear algebra routines.
    Definition: linalg_core.f90:15
    The above program produces the following output.
    Cholesky Solution: X =
    239.5833
    @@ -171,7 +171,7 @@
    10.3333
    -

    Definition at line 1685 of file linalg_core.f90.

    +

    Definition at line 1839 of file linalg_core.f90.


    The documentation for this interface was generated from the following file: diff --git a/doc/html/interfacelinalg__core_1_1solve__least__squares.html b/doc/html/interfacelinalg__core_1_1solve__least__squares.html index c3aa08c4..2b76ceed 100644 --- a/doc/html/interfacelinalg__core_1_1solve__least__squares.html +++ b/doc/html/interfacelinalg__core_1_1solve__least__squares.html @@ -139,14 +139,14 @@
    print '(A)', "Least Squares Solution: X = "
    print '(F9.5)', (b(i), i = 1, size(a, 2))
    end program
    -
    Solves the overdetermined or underdetermined system (A*X = B) of M equations of N unknowns.
    +
    Solves the overdetermined or underdetermined system (A*X = B) of M equations of N unknowns.
    Provides a set of common linear algebra routines.
    Definition: linalg_core.f90:15
    The above program produces the following output.
    Least Squares Solution: X =
    0.13158
    -0.57895
    -

    Definition at line 1739 of file linalg_core.f90.

    +

    Definition at line 1893 of file linalg_core.f90.


    The documentation for this interface was generated from the following file: diff --git a/doc/html/interfacelinalg__core_1_1solve__least__squares__full.html b/doc/html/interfacelinalg__core_1_1solve__least__squares__full.html index 146975b4..9f618cc4 100644 --- a/doc/html/interfacelinalg__core_1_1solve__least__squares__full.html +++ b/doc/html/interfacelinalg__core_1_1solve__least__squares__full.html @@ -139,14 +139,14 @@
    print '(A)', "Least Squares Solution: X = "
    print '(F9.5)', (b(i), i = 1, size(a, 2))
    end program
    -
    Solves the overdetermined or underdetermined system (A*X = B) of M equations of N unknowns,...
    +
    Solves the overdetermined or underdetermined system (A*X = B) of M equations of N unknowns,...
    Provides a set of common linear algebra routines.
    Definition: linalg_core.f90:15
    The above program produces the following output.
    Least Squares Solution: X =
    0.13158
    -0.57895
    -

    Definition at line 1794 of file linalg_core.f90.

    +

    Definition at line 1948 of file linalg_core.f90.


    The documentation for this interface was generated from the following file: diff --git a/doc/html/interfacelinalg__core_1_1solve__least__squares__svd.html b/doc/html/interfacelinalg__core_1_1solve__least__squares__svd.html index 6dbb7853..a69a04d5 100644 --- a/doc/html/interfacelinalg__core_1_1solve__least__squares__svd.html +++ b/doc/html/interfacelinalg__core_1_1solve__least__squares__svd.html @@ -139,14 +139,14 @@
    print '(A)', "Least Squares Solution: X = "
    print '(F9.5)', (b(i), i = 1, size(a, 2))
    end program
    -
    Solves the overdetermined or underdetermined system (A*X = B) of M equations of N unknowns using a si...
    +
    Solves the overdetermined or underdetermined system (A*X = B) of M equations of N unknowns using a si...
    Provides a set of common linear algebra routines.
    Definition: linalg_core.f90:15
    The above program produces the following output.
    Least Squares Solution: X =
    0.13158
    -0.57895
    -

    Definition at line 1849 of file linalg_core.f90.

    +

    Definition at line 2003 of file linalg_core.f90.


    The documentation for this interface was generated from the following file: diff --git a/doc/html/interfacelinalg__core_1_1solve__lu.html b/doc/html/interfacelinalg__core_1_1solve__lu.html index 22189dc7..d330743b 100644 --- a/doc/html/interfacelinalg__core_1_1solve__lu.html +++ b/doc/html/interfacelinalg__core_1_1solve__lu.html @@ -146,7 +146,7 @@
    print '(F8.4)', (b(i), i = 1, size(b))
    end program
    Computes the LU factorization of an M-by-N matrix.
    -
    Solves a system of LU-factored equations.
    +
    Solves a system of LU-factored equations.
    Provides a set of common linear algebra routines.
    Definition: linalg_core.f90:15
    The program generates the following output.
    LU Solution: X =
    0.3333
    @@ -159,7 +159,7 @@ -

    Definition at line 1536 of file linalg_core.f90.

    +

    Definition at line 1690 of file linalg_core.f90.


    The documentation for this interface was generated from the following file: diff --git a/doc/html/interfacelinalg__core_1_1solve__qr.html b/doc/html/interfacelinalg__core_1_1solve__qr.html index 54e807c3..5c4c8909 100644 --- a/doc/html/interfacelinalg__core_1_1solve__qr.html +++ b/doc/html/interfacelinalg__core_1_1solve__qr.html @@ -151,7 +151,7 @@
    ! tracking array).
    end program
    Computes the QR factorization of an M-by-N matrix.
    -
    Solves a system of M QR-factored equations of N unknowns.
    +
    Solves a system of M QR-factored equations of N unknowns.
    Provides a set of common linear algebra routines.
    Definition: linalg_core.f90:15
    The above program produces the following output.
    QR Solution: X =
    0.3333
    @@ -164,7 +164,7 @@ -

    Definition at line 1605 of file linalg_core.f90.

    +

    Definition at line 1759 of file linalg_core.f90.


    The documentation for this interface was generated from the following file: diff --git a/doc/html/interfacelinalg__core_1_1solve__triangular__system.html b/doc/html/interfacelinalg__core_1_1solve__triangular__system.html index f841f39b..5186ec60 100644 --- a/doc/html/interfacelinalg__core_1_1solve__triangular__system.html +++ b/doc/html/interfacelinalg__core_1_1solve__triangular__system.html @@ -158,7 +158,7 @@
    end program
    Extracts the L and U matrices from the condensed [L\U] storage format used by the lu_factor.
    Computes the LU factorization of an M-by-N matrix.
    -
    Solves a triangular system of equations.
    +
    Solves a triangular system of equations.
    Provides a set of common linear algebra routines.
    Definition: linalg_core.f90:15
    The above program produces the following output.
    LU Solution: X =
    0.3333
    @@ -166,7 +166,7 @@
    0.0000
    -

    Definition at line 1472 of file linalg_core.f90.

    +

    Definition at line 1626 of file linalg_core.f90.


    The documentation for this interface was generated from the following file: diff --git a/doc/html/interfacelinalg__core_1_1sort.html b/doc/html/interfacelinalg__core_1_1sort.html index 1e884062..1daf8324 100644 --- a/doc/html/interfacelinalg__core_1_1sort.html +++ b/doc/html/interfacelinalg__core_1_1sort.html @@ -108,7 +108,7 @@

    Detailed Description

    Sorts an array.

    -

    Definition at line 2072 of file linalg_core.f90.

    +

    Definition at line 2226 of file linalg_core.f90.


    The documentation for this interface was generated from the following file: diff --git a/doc/html/interfacelinalg__core_1_1svd.html b/doc/html/interfacelinalg__core_1_1svd.html index 4ba42620..d07b34d5 100644 --- a/doc/html/interfacelinalg__core_1_1svd.html +++ b/doc/html/interfacelinalg__core_1_1svd.html @@ -149,7 +149,7 @@
    end do
    end program
    Multiplies a diagonal matrix with another matrix or array.
    -
    Computes the singular value decomposition of a matrix A. The SVD is defined as: A = U * S * V**T,...
    +
    Computes the singular value decomposition of a matrix A. The SVD is defined as: A = U * S * V**T,...
    Provides a set of common linear algebra routines.
    Definition: linalg_core.f90:15
    The above program produces the following output.
    U =
    -0.47411577501825380 -0.81850539032073777 -0.32444284226152509
    @@ -167,7 +167,7 @@
    -1.0000000000000000 0.99999999999999967
    -

    Definition at line 1403 of file linalg_core.f90.

    +

    Definition at line 1557 of file linalg_core.f90.


    The documentation for this interface was generated from the following file: diff --git a/doc/html/linalg__c__api_8f90_source.html b/doc/html/linalg__c__api_8f90_source.html index 53e9ea9a..edb723e7 100644 --- a/doc/html/linalg__c__api_8f90_source.html +++ b/doc/html/linalg__c__api_8f90_source.html @@ -2022,29 +2022,29 @@
    3159
    3160! ------------------------------------------------------------------------------
    3161end module
    -
    Computes the Cholesky factorization of a symmetric, positive definite matrix.
    -
    Computes the rank 1 downdate to a Cholesky factored matrix (upper triangular).
    -
    Computes the rank 1 update to a Cholesky factored matrix (upper triangular).
    +
    Computes the Cholesky factorization of a symmetric, positive definite matrix.
    +
    Computes the rank 1 downdate to a Cholesky factored matrix (upper triangular).
    +
    Computes the rank 1 update to a Cholesky factored matrix (upper triangular).
    Computes the determinant of a square matrix.
    Multiplies a diagonal matrix with another matrix or array.
    -
    Computes the eigenvalues, and optionally the eigenvectors, of a matrix.
    +
    Computes the eigenvalues, and optionally the eigenvectors, of a matrix.
    Extracts the L and U matrices from the condensed [L\U] storage format used by the lu_factor.
    -
    Forms the full M-by-M orthogonal matrix Q from the elementary reflectors returned by the base QR fact...
    +
    Forms the full M-by-M orthogonal matrix Q from the elementary reflectors returned by the base QR fact...
    Computes the LU factorization of an M-by-N matrix.
    -
    Computes the inverse of a square matrix.
    -
    Computes the Moore-Penrose pseudo-inverse of a M-by-N matrix using the singular value decomposition o...
    +
    Computes the inverse of a square matrix.
    +
    Computes the Moore-Penrose pseudo-inverse of a M-by-N matrix using the singular value decomposition o...
    Computes the rank of a matrix.
    -
    Multiplies a general matrix by the orthogonal matrix Q from a QR factorization.
    +
    Multiplies a general matrix by the orthogonal matrix Q from a QR factorization.
    Computes the QR factorization of an M-by-N matrix.
    -
    Computes the rank 1 update to an M-by-N QR factored matrix A (M >= N) where A = Q * R,...
    +
    Computes the rank 1 update to an M-by-N QR factored matrix A (M >= N) where A = Q * R,...
    Performs the rank-1 update to matrix A such that: , where is an M-by-N matrix, is a scalar,...
    -
    Solves a system of Cholesky factored equations.
    -
    Solves the overdetermined or underdetermined system (A*X = B) of M equations of N unknowns.
    -
    Solves a system of LU-factored equations.
    -
    Solves a system of M QR-factored equations of N unknowns.
    -
    Solves a triangular system of equations.
    -
    Sorts an array.
    -
    Computes the singular value decomposition of a matrix A. The SVD is defined as: A = U * S * V**T,...
    +
    Solves a system of Cholesky factored equations.
    +
    Solves the overdetermined or underdetermined system (A*X = B) of M equations of N unknowns.
    +
    Solves a system of LU-factored equations.
    +
    Solves a system of M QR-factored equations of N unknowns.
    +
    Solves a triangular system of equations.
    +
    Sorts an array.
    +
    Computes the singular value decomposition of a matrix A. The SVD is defined as: A = U * S * V**T,...
    Computes the trace of a matrix (the sum of the main diagonal elements).
    Computes the triangular matrix operation: , or , where A is a triangular matrix.
    Provides a C-friendly API to the LINALG library. Notice, all C-API LINALG routines begin with the pre...
    Definition: linalg_c_api.f90:5
    diff --git a/doc/html/linalg__core_8f90_source.html b/doc/html/linalg__core_8f90_source.html index 1472212c..ee7a106d 100644 --- a/doc/html/linalg__core_8f90_source.html +++ b/doc/html/linalg__core_8f90_source.html @@ -230,1073 +230,1073 @@
    836end interface
    837
    838! ------------------------------------------------------------------------------
    -
    914interface form_qr
    -
    915 module procedure :: form_qr_no_pivot
    -
    916 module procedure :: form_qr_no_pivot_cmplx
    -
    917 module procedure :: form_qr_pivot
    -
    918 module procedure :: form_qr_pivot_cmplx
    -
    919end interface
    -
    920
    -
    921! ------------------------------------------------------------------------------
    -
    991interface mult_qr
    -
    992 module procedure :: mult_qr_mtx
    -
    993 module procedure :: mult_qr_mtx_cmplx
    -
    994 module procedure :: mult_qr_vec
    -
    995 module procedure :: mult_qr_vec_cmplx
    +
    991interface form_qr
    +
    992 module procedure :: form_qr_no_pivot
    +
    993 module procedure :: form_qr_no_pivot_cmplx
    +
    994 module procedure :: form_qr_pivot
    +
    995 module procedure :: form_qr_pivot_cmplx
    996end interface
    997
    998! ------------------------------------------------------------------------------
    - -
    1094 module procedure :: qr_rank1_update_dbl
    -
    1095 module procedure :: qr_rank1_update_cmplx
    -
    1096end interface
    -
    1097
    -
    1098! ------------------------------------------------------------------------------
    - -
    1169 module procedure :: cholesky_factor_dbl
    -
    1170 module procedure :: cholesky_factor_cmplx
    -
    1171end interface
    -
    1172
    -
    1173! ------------------------------------------------------------------------------
    - -
    1237 module procedure :: cholesky_rank1_update_dbl
    -
    1238 module procedure :: cholesky_rank1_update_cmplx
    -
    1239end interface
    -
    1240
    -
    1241! ------------------------------------------------------------------------------
    - -
    1310 module procedure :: cholesky_rank1_downdate_dbl
    -
    1311 module procedure :: cholesky_rank1_downdate_cmplx
    -
    1312end interface
    -
    1313
    -
    1314! ------------------------------------------------------------------------------
    -
    1319interface rz_factor
    -
    1320 module procedure :: rz_factor_dbl
    -
    1321 module procedure :: rz_factor_cmplx
    -
    1322end interface
    -
    1323
    -
    1324! ------------------------------------------------------------------------------
    -
    1327interface mult_rz
    -
    1328 module procedure :: mult_rz_mtx
    -
    1329 module procedure :: mult_rz_mtx_cmplx
    -
    1330 module procedure :: mult_rz_vec
    -
    1331 module procedure :: mult_rz_vec_cmplx
    -
    1332end interface
    -
    1333
    -
    1334! ------------------------------------------------------------------------------
    -
    1403interface svd
    -
    1404 module procedure :: svd_dbl
    -
    1405 module procedure :: svd_cmplx
    -
    1406end interface
    -
    1407
    -
    1408! ------------------------------------------------------------------------------
    - -
    1473 module procedure :: solve_tri_mtx
    -
    1474 module procedure :: solve_tri_mtx_cmplx
    -
    1475 module procedure :: solve_tri_vec
    -
    1476 module procedure :: solve_tri_vec_cmplx
    -
    1477end interface
    -
    1478
    -
    1479! ------------------------------------------------------------------------------
    -
    1536interface solve_lu
    -
    1537 module procedure :: solve_lu_mtx
    -
    1538 module procedure :: solve_lu_mtx_cmplx
    -
    1539 module procedure :: solve_lu_vec
    -
    1540 module procedure :: solve_lu_vec_cmplx
    -
    1541end interface
    -
    1542
    -
    1543! ------------------------------------------------------------------------------
    -
    1605interface solve_qr
    -
    1606 module procedure :: solve_qr_no_pivot_mtx
    -
    1607 module procedure :: solve_qr_no_pivot_mtx_cmplx
    -
    1608 module procedure :: solve_qr_no_pivot_vec
    -
    1609 module procedure :: solve_qr_no_pivot_vec_cmplx
    -
    1610 module procedure :: solve_qr_pivot_mtx
    -
    1611 module procedure :: solve_qr_pivot_mtx_cmplx
    -
    1612 module procedure :: solve_qr_pivot_vec
    -
    1613 module procedure :: solve_qr_pivot_vec_cmplx
    -
    1614end interface
    -
    1615
    -
    1616! ------------------------------------------------------------------------------
    - -
    1686 module procedure :: solve_cholesky_mtx
    -
    1687 module procedure :: solve_cholesky_mtx_cmplx
    -
    1688 module procedure :: solve_cholesky_vec
    -
    1689 module procedure :: solve_cholesky_vec_cmplx
    -
    1690end interface
    -
    1691
    -
    1692! ------------------------------------------------------------------------------
    - -
    1740 module procedure :: solve_least_squares_mtx
    -
    1741 module procedure :: solve_least_squares_mtx_cmplx
    -
    1742 module procedure :: solve_least_squares_vec
    -
    1743 module procedure :: solve_least_squares_vec_cmplx
    -
    1744end interface
    -
    1745
    -
    1746! ------------------------------------------------------------------------------
    - -
    1795 module procedure :: solve_least_squares_mtx_pvt
    -
    1796 module procedure :: solve_least_squares_mtx_pvt_cmplx
    -
    1797 module procedure :: solve_least_squares_vec_pvt
    -
    1798 module procedure :: solve_least_squares_vec_pvt_cmplx
    -
    1799end interface
    -
    1800
    -
    1801! ------------------------------------------------------------------------------
    - -
    1850 module procedure :: solve_least_squares_mtx_svd
    -
    1851 module procedure :: solve_least_squares_vec_svd
    -
    1852end interface
    -
    1853
    -
    1854! ------------------------------------------------------------------------------
    - -
    1909 module procedure :: mtx_inverse_dbl
    -
    1910 module procedure :: mtx_inverse_cmplx
    -
    1911end interface
    -
    1912
    -
    1913! ------------------------------------------------------------------------------
    - -
    1970 module procedure :: mtx_pinverse_dbl
    -
    1971 module procedure :: mtx_pinverse_cmplx
    -
    1972end interface
    -
    1973
    -
    1974! ------------------------------------------------------------------------------
    -
    2063interface eigen
    -
    2064 module procedure :: eigen_symm
    -
    2065 module procedure :: eigen_asymm
    -
    2066 module procedure :: eigen_gen
    -
    2067 module procedure :: eigen_cmplx
    -
    2068end interface
    -
    2069
    -
    2070! ------------------------------------------------------------------------------
    -
    2072interface sort
    -
    2073 module procedure :: sort_dbl_array
    -
    2074 module procedure :: sort_dbl_array_ind
    -
    2075 module procedure :: sort_cmplx_array
    -
    2076 module procedure :: sort_cmplx_array_ind
    -
    2077 module procedure :: sort_eigen_cmplx
    -
    2078 module procedure :: sort_eigen_dbl
    -
    2079end interface
    -
    2080
    -
    2081
    -
    2082! ******************************************************************************
    -
    2083! LINALG_BASIC.F90
    -
    2084! ------------------------------------------------------------------------------
    -
    2085interface
    -
    2086 module subroutine mtx_mult_mtx(transa, transb, alpha, a, b, beta, c, err)
    -
    2087 logical, intent(in) :: transa, transb
    -
    2088 real(real64), intent(in) :: alpha, beta
    -
    2089 real(real64), intent(in), dimension(:,:) :: a, b
    -
    2090 real(real64), intent(inout), dimension(:,:) :: c
    -
    2091 class(errors), intent(inout), optional, target :: err
    -
    2092 end subroutine
    -
    2093
    -
    2094 module subroutine mtx_mult_vec(trans, alpha, a, b, beta, c, err)
    -
    2095 logical, intent(in) :: trans
    -
    2096 real(real64), intent(in) :: alpha, beta
    -
    2097 real(real64), intent(in), dimension(:,:) :: a
    -
    2098 real(real64), intent(in), dimension(:) :: b
    -
    2099 real(real64), intent(inout), dimension(:) :: c
    -
    2100 class(errors), intent(inout), optional, target :: err
    -
    2101 end subroutine
    -
    2102
    -
    2103 module subroutine cmtx_mult_mtx(opa, opb, alpha, a, b, beta, c, err)
    -
    2104 integer(int32), intent(in) :: opa, opb
    -
    2105 complex(real64), intent(in) :: alpha, beta
    -
    2106 complex(real64), intent(in), dimension(:,:) :: a, b
    -
    2107 complex(real64), intent(inout), dimension(:,:) :: c
    -
    2108 class(errors), intent(inout), optional, target :: err
    -
    2109 end subroutine
    -
    2110
    -
    2111 module subroutine cmtx_mult_vec(opa, alpha, a, b, beta, c, err)
    -
    2112 integer(int32), intent(in) :: opa
    -
    2113 complex(real64), intent(in) :: alpha, beta
    -
    2114 complex(real64), intent(in), dimension(:,:) :: a
    -
    2115 complex(real64), intent(in), dimension(:) :: b
    -
    2116 complex(real64), intent(inout), dimension(:) :: c
    -
    2117 class(errors), intent(inout), optional, target :: err
    -
    2118 end subroutine
    -
    2119
    -
    2120 module subroutine rank1_update_dbl(alpha, x, y, a, err)
    -
    2121 real(real64), intent(in) :: alpha
    -
    2122 real(real64), intent(in), dimension(:) :: x, y
    -
    2123 real(real64), intent(inout), dimension(:,:) :: a
    -
    2124 class(errors), intent(inout), optional, target :: err
    -
    2125 end subroutine
    -
    2126
    -
    2127 module subroutine rank1_update_cmplx(alpha, x, y, a, err)
    -
    2128 complex(real64), intent(in) :: alpha
    -
    2129 complex(real64), intent(in), dimension(:) :: x, y
    -
    2130 complex(real64), intent(inout), dimension(:,:) :: a
    -
    2131 class(errors), intent(inout), optional, target :: err
    -
    2132 end subroutine
    -
    2133
    -
    2134 module subroutine diag_mtx_mult_mtx(lside, trans, alpha, a, b, beta, c, err)
    -
    2135 logical, intent(in) :: lside, trans
    -
    2136 real(real64) :: alpha, beta
    -
    2137 real(real64), intent(in), dimension(:) :: a
    -
    2138 real(real64), intent(in), dimension(:,:) :: b
    -
    2139 real(real64), intent(inout), dimension(:,:) :: c
    -
    2140 class(errors), intent(inout), optional, target :: err
    -
    2141 end subroutine
    -
    2142
    -
    2143 module subroutine diag_mtx_mult_mtx2(lside, alpha, a, b, err)
    -
    2144 logical, intent(in) :: lside
    -
    2145 real(real64), intent(in) :: alpha
    -
    2146 real(real64), intent(in), dimension(:) :: a
    -
    2147 real(real64), intent(inout), dimension(:,:) :: b
    -
    2148 class(errors), intent(inout), optional, target :: err
    -
    2149 end subroutine
    -
    2150
    -
    2151 module subroutine diag_mtx_mult_mtx3(lside, trans, alpha, a, b, beta, c, err)
    -
    2152 logical, intent(in) :: lside, trans
    -
    2153 real(real64) :: alpha, beta
    -
    2154 complex(real64), intent(in), dimension(:) :: a
    -
    2155 real(real64), intent(in), dimension(:,:) :: b
    -
    2156 complex(real64), intent(inout), dimension(:,:) :: c
    -
    2157 class(errors), intent(inout), optional, target :: err
    -
    2158 end subroutine
    -
    2159
    -
    2160 module subroutine diag_mtx_mult_mtx4(lside, opb, alpha, a, b, beta, c, err)
    -
    2161 logical, intent(in) :: lside
    -
    2162 integer(int32), intent(in) :: opb
    -
    2163 real(real64) :: alpha, beta
    -
    2164 complex(real64), intent(in), dimension(:) :: a
    -
    2165 complex(real64), intent(in), dimension(:,:) :: b
    -
    2166 complex(real64), intent(inout), dimension(:,:) :: c
    -
    2167 class(errors), intent(inout), optional, target :: err
    -
    2168 end subroutine
    -
    2169
    -
    2170 module subroutine diag_mtx_mult_mtx_cmplx(lside, opb, alpha, a, b, beta, c, err)
    -
    2171 logical, intent(in) :: lside
    -
    2172 integer(int32), intent(in) :: opb
    -
    2173 complex(real64) :: alpha, beta
    -
    2174 complex(real64), intent(in), dimension(:) :: a
    -
    2175 complex(real64), intent(in), dimension(:,:) :: b
    -
    2176 complex(real64), intent(inout), dimension(:,:) :: c
    -
    2177 class(errors), intent(inout), optional, target :: err
    -
    2178 end subroutine
    -
    2179
    -
    2180 module subroutine diag_mtx_mult_mtx2_cmplx(lside, alpha, a, b, err)
    -
    2181 logical, intent(in) :: lside
    -
    2182 complex(real64), intent(in) :: alpha
    -
    2183 complex(real64), intent(in), dimension(:) :: a
    -
    2184 complex(real64), intent(inout), dimension(:,:) :: b
    -
    2185 class(errors), intent(inout), optional, target :: err
    -
    2186 end subroutine
    -
    2187
    -
    2188 module subroutine diag_mtx_mult_mtx_mix(lside, opb, alpha, a, b, beta, c, err)
    -
    2189 logical, intent(in) :: lside
    -
    2190 integer(int32), intent(in) :: opb
    -
    2191 complex(real64) :: alpha, beta
    -
    2192 real(real64), intent(in), dimension(:) :: a
    -
    2193 complex(real64), intent(in), dimension(:,:) :: b
    -
    2194 complex(real64), intent(inout), dimension(:,:) :: c
    -
    2195 class(errors), intent(inout), optional, target :: err
    -
    2196 end subroutine
    -
    2197
    -
    2198 module subroutine diag_mtx_mult_mtx2_mix(lside, alpha, a, b, err)
    -
    2199 logical, intent(in) :: lside
    -
    2200 complex(real64), intent(in) :: alpha
    -
    2201 real(real64), intent(in), dimension(:) :: a
    -
    2202 complex(real64), intent(inout), dimension(:,:) :: b
    -
    2203 class(errors), intent(inout), optional, target :: err
    -
    2204 end subroutine
    -
    2205
    -
    2206 pure module function trace_dbl(x) result(y)
    -
    2207 real(real64), intent(in), dimension(:,:) :: x
    -
    2208 real(real64) :: y
    -
    2209 end function
    -
    2210
    -
    2211 pure module function trace_cmplx(x) result(y)
    -
    2212 complex(real64), intent(in), dimension(:,:) :: x
    -
    2213 complex(real64) :: y
    -
    2214 end function
    -
    2215
    -
    2216 module function mtx_rank_dbl(a, tol, work, olwork, err) result(rnk)
    -
    2217 real(real64), intent(inout), dimension(:,:) :: a
    -
    2218 real(real64), intent(in), optional :: tol
    -
    2219 real(real64), intent(out), target, optional, dimension(:) :: work
    -
    2220 integer(int32), intent(out), optional :: olwork
    -
    2221 class(errors), intent(inout), optional, target :: err
    -
    2222 integer(int32) :: rnk
    -
    2223 end function
    -
    2224
    -
    2225 module function mtx_rank_cmplx(a, tol, work, olwork, rwork, err) result(rnk)
    -
    2226 complex(real64), intent(inout), dimension(:,:) :: a
    -
    2227 real(real64), intent(in), optional :: tol
    -
    2228 complex(real64), intent(out), target, optional, dimension(:) :: work
    -
    2229 integer(int32), intent(out), optional :: olwork
    -
    2230 real(real64), intent(out), target, optional, dimension(:) :: rwork
    -
    2231 class(errors), intent(inout), optional, target :: err
    -
    2232 integer(int32) :: rnk
    -
    2233 end function
    -
    2234
    -
    2235 module function det_dbl(a, iwork, err) result(x)
    -
    2236 real(real64), intent(inout), dimension(:,:) :: a
    -
    2237 integer(int32), intent(out), target, optional, dimension(:) :: iwork
    -
    2238 class(errors), intent(inout), optional, target :: err
    -
    2239 real(real64) :: x
    -
    2240 end function
    -
    2241
    -
    2242 module function det_cmplx(a, iwork, err) result(x)
    -
    2243 complex(real64), intent(inout), dimension(:,:) :: a
    -
    2244 integer(int32), intent(out), target, optional, dimension(:) :: iwork
    +
    1145interface mult_qr
    +
    1146 module procedure :: mult_qr_mtx
    +
    1147 module procedure :: mult_qr_mtx_cmplx
    +
    1148 module procedure :: mult_qr_vec
    +
    1149 module procedure :: mult_qr_vec_cmplx
    +
    1150end interface
    +
    1151
    +
    1152! ------------------------------------------------------------------------------
    + +
    1248 module procedure :: qr_rank1_update_dbl
    +
    1249 module procedure :: qr_rank1_update_cmplx
    +
    1250end interface
    +
    1251
    +
    1252! ------------------------------------------------------------------------------
    + +
    1323 module procedure :: cholesky_factor_dbl
    +
    1324 module procedure :: cholesky_factor_cmplx
    +
    1325end interface
    +
    1326
    +
    1327! ------------------------------------------------------------------------------
    + +
    1391 module procedure :: cholesky_rank1_update_dbl
    +
    1392 module procedure :: cholesky_rank1_update_cmplx
    +
    1393end interface
    +
    1394
    +
    1395! ------------------------------------------------------------------------------
    + +
    1464 module procedure :: cholesky_rank1_downdate_dbl
    +
    1465 module procedure :: cholesky_rank1_downdate_cmplx
    +
    1466end interface
    +
    1467
    +
    1468! ------------------------------------------------------------------------------
    +
    1473interface rz_factor
    +
    1474 module procedure :: rz_factor_dbl
    +
    1475 module procedure :: rz_factor_cmplx
    +
    1476end interface
    +
    1477
    +
    1478! ------------------------------------------------------------------------------
    +
    1481interface mult_rz
    +
    1482 module procedure :: mult_rz_mtx
    +
    1483 module procedure :: mult_rz_mtx_cmplx
    +
    1484 module procedure :: mult_rz_vec
    +
    1485 module procedure :: mult_rz_vec_cmplx
    +
    1486end interface
    +
    1487
    +
    1488! ------------------------------------------------------------------------------
    +
    1557interface svd
    +
    1558 module procedure :: svd_dbl
    +
    1559 module procedure :: svd_cmplx
    +
    1560end interface
    +
    1561
    +
    1562! ------------------------------------------------------------------------------
    + +
    1627 module procedure :: solve_tri_mtx
    +
    1628 module procedure :: solve_tri_mtx_cmplx
    +
    1629 module procedure :: solve_tri_vec
    +
    1630 module procedure :: solve_tri_vec_cmplx
    +
    1631end interface
    +
    1632
    +
    1633! ------------------------------------------------------------------------------
    +
    1690interface solve_lu
    +
    1691 module procedure :: solve_lu_mtx
    +
    1692 module procedure :: solve_lu_mtx_cmplx
    +
    1693 module procedure :: solve_lu_vec
    +
    1694 module procedure :: solve_lu_vec_cmplx
    +
    1695end interface
    +
    1696
    +
    1697! ------------------------------------------------------------------------------
    +
    1759interface solve_qr
    +
    1760 module procedure :: solve_qr_no_pivot_mtx
    +
    1761 module procedure :: solve_qr_no_pivot_mtx_cmplx
    +
    1762 module procedure :: solve_qr_no_pivot_vec
    +
    1763 module procedure :: solve_qr_no_pivot_vec_cmplx
    +
    1764 module procedure :: solve_qr_pivot_mtx
    +
    1765 module procedure :: solve_qr_pivot_mtx_cmplx
    +
    1766 module procedure :: solve_qr_pivot_vec
    +
    1767 module procedure :: solve_qr_pivot_vec_cmplx
    +
    1768end interface
    +
    1769
    +
    1770! ------------------------------------------------------------------------------
    + +
    1840 module procedure :: solve_cholesky_mtx
    +
    1841 module procedure :: solve_cholesky_mtx_cmplx
    +
    1842 module procedure :: solve_cholesky_vec
    +
    1843 module procedure :: solve_cholesky_vec_cmplx
    +
    1844end interface
    +
    1845
    +
    1846! ------------------------------------------------------------------------------
    + +
    1894 module procedure :: solve_least_squares_mtx
    +
    1895 module procedure :: solve_least_squares_mtx_cmplx
    +
    1896 module procedure :: solve_least_squares_vec
    +
    1897 module procedure :: solve_least_squares_vec_cmplx
    +
    1898end interface
    +
    1899
    +
    1900! ------------------------------------------------------------------------------
    + +
    1949 module procedure :: solve_least_squares_mtx_pvt
    +
    1950 module procedure :: solve_least_squares_mtx_pvt_cmplx
    +
    1951 module procedure :: solve_least_squares_vec_pvt
    +
    1952 module procedure :: solve_least_squares_vec_pvt_cmplx
    +
    1953end interface
    +
    1954
    +
    1955! ------------------------------------------------------------------------------
    + +
    2004 module procedure :: solve_least_squares_mtx_svd
    +
    2005 module procedure :: solve_least_squares_vec_svd
    +
    2006end interface
    +
    2007
    +
    2008! ------------------------------------------------------------------------------
    + +
    2063 module procedure :: mtx_inverse_dbl
    +
    2064 module procedure :: mtx_inverse_cmplx
    +
    2065end interface
    +
    2066
    +
    2067! ------------------------------------------------------------------------------
    + +
    2124 module procedure :: mtx_pinverse_dbl
    +
    2125 module procedure :: mtx_pinverse_cmplx
    +
    2126end interface
    +
    2127
    +
    2128! ------------------------------------------------------------------------------
    +
    2217interface eigen
    +
    2218 module procedure :: eigen_symm
    +
    2219 module procedure :: eigen_asymm
    +
    2220 module procedure :: eigen_gen
    +
    2221 module procedure :: eigen_cmplx
    +
    2222end interface
    +
    2223
    +
    2224! ------------------------------------------------------------------------------
    +
    2226interface sort
    +
    2227 module procedure :: sort_dbl_array
    +
    2228 module procedure :: sort_dbl_array_ind
    +
    2229 module procedure :: sort_cmplx_array
    +
    2230 module procedure :: sort_cmplx_array_ind
    +
    2231 module procedure :: sort_eigen_cmplx
    +
    2232 module procedure :: sort_eigen_dbl
    +
    2233end interface
    +
    2234
    +
    2235
    +
    2236! ******************************************************************************
    +
    2237! LINALG_BASIC.F90
    +
    2238! ------------------------------------------------------------------------------
    +
    2239interface
    +
    2240 module subroutine mtx_mult_mtx(transa, transb, alpha, a, b, beta, c, err)
    +
    2241 logical, intent(in) :: transa, transb
    +
    2242 real(real64), intent(in) :: alpha, beta
    +
    2243 real(real64), intent(in), dimension(:,:) :: a, b
    +
    2244 real(real64), intent(inout), dimension(:,:) :: c
    2245 class(errors), intent(inout), optional, target :: err
    -
    2246 complex(real64) :: x
    -
    2247 end function
    -
    2248
    -
    2249 module subroutine swap_dbl(x, y, err)
    -
    2250 real(real64), intent(inout), dimension(:) :: x, y
    -
    2251 class(errors), intent(inout), optional, target :: err
    -
    2252 end subroutine
    -
    2253
    -
    2254 module subroutine swap_cmplx(x, y, err)
    -
    2255 complex(real64), intent(inout), dimension(:) :: x, y
    -
    2256 class(errors), intent(inout), optional, target :: err
    -
    2257 end subroutine
    -
    2258
    -
    2259 module subroutine recip_mult_array_dbl(a, x)
    -
    2260 real(real64), intent(in) :: a
    -
    2261 real(real64), intent(inout), dimension(:) :: x
    -
    2262 end subroutine
    -
    2263
    -
    2264 module subroutine tri_mtx_mult_dbl(upper, alpha, a, beta, b, err)
    -
    2265 logical, intent(in) :: upper
    -
    2266 real(real64), intent(in) :: alpha, beta
    -
    2267 real(real64), intent(in), dimension(:,:) :: a
    -
    2268 real(real64), intent(inout), dimension(:,:) :: b
    -
    2269 class(errors), intent(inout), optional, target :: err
    -
    2270 end subroutine
    -
    2271
    -
    2272 module subroutine tri_mtx_mult_cmplx(upper, alpha, a, beta, b, err)
    -
    2273 logical, intent(in) :: upper
    -
    2274 complex(real64), intent(in) :: alpha, beta
    -
    2275 complex(real64), intent(in), dimension(:,:) :: a
    -
    2276 complex(real64), intent(inout), dimension(:,:) :: b
    -
    2277 class(errors), intent(inout), optional, target :: err
    -
    2278 end subroutine
    -
    2279
    -
    2280end interface
    -
    2281
    -
    2282! ******************************************************************************
    -
    2283! LINALG_FACTOR.F90
    -
    2284! ------------------------------------------------------------------------------
    -
    2285interface
    -
    2286 module subroutine lu_factor_dbl(a, ipvt, err)
    -
    2287 real(real64), intent(inout), dimension(:,:) :: a
    -
    2288 integer(int32), intent(out), dimension(:) :: ipvt
    -
    2289 class(errors), intent(inout), optional, target :: err
    -
    2290 end subroutine
    -
    2291
    -
    2292 module subroutine lu_factor_cmplx(a, ipvt, err)
    -
    2293 complex(real64), intent(inout), dimension(:,:) :: a
    -
    2294 integer(int32), intent(out), dimension(:) :: ipvt
    -
    2295 class(errors), intent(inout), optional, target :: err
    -
    2296 end subroutine
    -
    2297
    -
    2298 module subroutine form_lu_all(lu, ipvt, u, p, err)
    -
    2299 real(real64), intent(inout), dimension(:,:) :: lu
    -
    2300 integer(int32), intent(in), dimension(:) :: ipvt
    -
    2301 real(real64), intent(out), dimension(:,:) :: u, p
    +
    2246 end subroutine
    +
    2247
    +
    2248 module subroutine mtx_mult_vec(trans, alpha, a, b, beta, c, err)
    +
    2249 logical, intent(in) :: trans
    +
    2250 real(real64), intent(in) :: alpha, beta
    +
    2251 real(real64), intent(in), dimension(:,:) :: a
    +
    2252 real(real64), intent(in), dimension(:) :: b
    +
    2253 real(real64), intent(inout), dimension(:) :: c
    +
    2254 class(errors), intent(inout), optional, target :: err
    +
    2255 end subroutine
    +
    2256
    +
    2257 module subroutine cmtx_mult_mtx(opa, opb, alpha, a, b, beta, c, err)
    +
    2258 integer(int32), intent(in) :: opa, opb
    +
    2259 complex(real64), intent(in) :: alpha, beta
    +
    2260 complex(real64), intent(in), dimension(:,:) :: a, b
    +
    2261 complex(real64), intent(inout), dimension(:,:) :: c
    +
    2262 class(errors), intent(inout), optional, target :: err
    +
    2263 end subroutine
    +
    2264
    +
    2265 module subroutine cmtx_mult_vec(opa, alpha, a, b, beta, c, err)
    +
    2266 integer(int32), intent(in) :: opa
    +
    2267 complex(real64), intent(in) :: alpha, beta
    +
    2268 complex(real64), intent(in), dimension(:,:) :: a
    +
    2269 complex(real64), intent(in), dimension(:) :: b
    +
    2270 complex(real64), intent(inout), dimension(:) :: c
    +
    2271 class(errors), intent(inout), optional, target :: err
    +
    2272 end subroutine
    +
    2273
    +
    2274 module subroutine rank1_update_dbl(alpha, x, y, a, err)
    +
    2275 real(real64), intent(in) :: alpha
    +
    2276 real(real64), intent(in), dimension(:) :: x, y
    +
    2277 real(real64), intent(inout), dimension(:,:) :: a
    +
    2278 class(errors), intent(inout), optional, target :: err
    +
    2279 end subroutine
    +
    2280
    +
    2281 module subroutine rank1_update_cmplx(alpha, x, y, a, err)
    +
    2282 complex(real64), intent(in) :: alpha
    +
    2283 complex(real64), intent(in), dimension(:) :: x, y
    +
    2284 complex(real64), intent(inout), dimension(:,:) :: a
    +
    2285 class(errors), intent(inout), optional, target :: err
    +
    2286 end subroutine
    +
    2287
    +
    2288 module subroutine diag_mtx_mult_mtx(lside, trans, alpha, a, b, beta, c, err)
    +
    2289 logical, intent(in) :: lside, trans
    +
    2290 real(real64) :: alpha, beta
    +
    2291 real(real64), intent(in), dimension(:) :: a
    +
    2292 real(real64), intent(in), dimension(:,:) :: b
    +
    2293 real(real64), intent(inout), dimension(:,:) :: c
    +
    2294 class(errors), intent(inout), optional, target :: err
    +
    2295 end subroutine
    +
    2296
    +
    2297 module subroutine diag_mtx_mult_mtx2(lside, alpha, a, b, err)
    +
    2298 logical, intent(in) :: lside
    +
    2299 real(real64), intent(in) :: alpha
    +
    2300 real(real64), intent(in), dimension(:) :: a
    +
    2301 real(real64), intent(inout), dimension(:,:) :: b
    2302 class(errors), intent(inout), optional, target :: err
    2303 end subroutine
    2304
    -
    2305 module subroutine form_lu_all_cmplx(lu, ipvt, u, p, err)
    -
    2306 complex(real64), intent(inout), dimension(:,:) :: lu
    -
    2307 integer(int32), intent(in), dimension(:) :: ipvt
    -
    2308 complex(real64), intent(out), dimension(:,:) :: u
    -
    2309 real(real64), intent(out), dimension(:,:) :: p
    -
    2310 class(errors), intent(inout), optional, target :: err
    -
    2311 end subroutine
    -
    2312
    -
    2313 module subroutine form_lu_only(lu, u, err)
    -
    2314 real(real64), intent(inout), dimension(:,:) :: lu
    -
    2315 real(real64), intent(out), dimension(:,:) :: u
    -
    2316 class(errors), intent(inout), optional, target :: err
    -
    2317 end subroutine
    -
    2318
    -
    2319 module subroutine form_lu_only_cmplx(lu, u, err)
    -
    2320 complex(real64), intent(inout), dimension(:,:) :: lu
    -
    2321 complex(real64), intent(out), dimension(:,:) :: u
    -
    2322 class(errors), intent(inout), optional, target :: err
    -
    2323 end subroutine
    -
    2324
    -
    2325 module subroutine qr_factor_no_pivot(a, tau, work, olwork, err)
    -
    2326 real(real64), intent(inout), dimension(:,:) :: a
    -
    2327 real(real64), intent(out), dimension(:) :: tau
    -
    2328 real(real64), intent(out), target, dimension(:), optional :: work
    -
    2329 integer(int32), intent(out), optional :: olwork
    -
    2330 class(errors), intent(inout), optional, target :: err
    -
    2331 end subroutine
    -
    2332
    -
    2333 module subroutine qr_factor_no_pivot_cmplx(a, tau, work, olwork, err)
    -
    2334 complex(real64), intent(inout), dimension(:,:) :: a
    -
    2335 complex(real64), intent(out), dimension(:) :: tau
    -
    2336 complex(real64), intent(out), target, dimension(:), optional :: work
    -
    2337 integer(int32), intent(out), optional :: olwork
    -
    2338 class(errors), intent(inout), optional, target :: err
    -
    2339 end subroutine
    -
    2340
    -
    2341 module subroutine qr_factor_pivot(a, tau, jpvt, work, olwork, err)
    -
    2342 real(real64), intent(inout), dimension(:,:) :: a
    -
    2343 real(real64), intent(out), dimension(:) :: tau
    -
    2344 integer(int32), intent(inout), dimension(:) :: jpvt
    -
    2345 real(real64), intent(out), target, dimension(:), optional :: work
    -
    2346 integer(int32), intent(out), optional :: olwork
    -
    2347 class(errors), intent(inout), optional, target :: err
    -
    2348 end subroutine
    -
    2349
    -
    2350 module subroutine qr_factor_pivot_cmplx(a, tau, jpvt, work, olwork, rwork, &
    -
    2351 err)
    -
    2352 complex(real64), intent(inout), dimension(:,:) :: a
    -
    2353 complex(real64), intent(out), dimension(:) :: tau
    -
    2354 integer(int32), intent(inout), dimension(:) :: jpvt
    -
    2355 complex(real64), intent(out), target, dimension(:), optional :: work
    -
    2356 integer(int32), intent(out), optional :: olwork
    -
    2357 real(real64), intent(out), target, dimension(:), optional :: rwork
    -
    2358 class(errors), intent(inout), optional, target :: err
    -
    2359 end subroutine
    -
    2360
    -
    2394 module subroutine form_qr_no_pivot(r, tau, q, work, olwork, err)
    -
    2395 real(real64), intent(inout), dimension(:,:) :: r
    -
    2396 real(real64), intent(in), dimension(:) :: tau
    -
    2397 real(real64), intent(out), dimension(:,:) :: q
    -
    2398 real(real64), intent(out), target, dimension(:), optional :: work
    -
    2399 integer(int32), intent(out), optional :: olwork
    -
    2400 class(errors), intent(inout), optional, target :: err
    -
    2401 end subroutine
    -
    2402
    -
    2436 module subroutine form_qr_no_pivot_cmplx(r, tau, q, work, olwork, err)
    -
    2437 complex(real64), intent(inout), dimension(:,:) :: r
    -
    2438 complex(real64), intent(in), dimension(:) :: tau
    -
    2439 complex(real64), intent(out), dimension(:,:) :: q
    -
    2440 complex(real64), intent(out), target, dimension(:), optional :: work
    -
    2441 integer(int32), intent(out), optional :: olwork
    -
    2442 class(errors), intent(inout), optional, target :: err
    -
    2443 end subroutine
    -
    2444
    -
    2481 module subroutine form_qr_pivot(r, tau, pvt, q, p, work, olwork, err)
    -
    2482 real(real64), intent(inout), dimension(:,:) :: r
    -
    2483 real(real64), intent(in), dimension(:) :: tau
    -
    2484 integer(int32), intent(in), dimension(:) :: pvt
    -
    2485 real(real64), intent(out), dimension(:,:) :: q, p
    -
    2486 real(real64), intent(out), target, dimension(:), optional :: work
    -
    2487 integer(int32), intent(out), optional :: olwork
    -
    2488 class(errors), intent(inout), optional, target :: err
    -
    2489 end subroutine
    -
    2490
    -
    2527 module subroutine form_qr_pivot_cmplx(r, tau, pvt, q, p, work, olwork, err)
    -
    2528 complex(real64), intent(inout), dimension(:,:) :: r
    -
    2529 complex(real64), intent(in), dimension(:) :: tau
    -
    2530 integer(int32), intent(in), dimension(:) :: pvt
    -
    2531 complex(real64), intent(out), dimension(:,:) :: q, p
    -
    2532 complex(real64), intent(out), target, dimension(:), optional :: work
    -
    2533 integer(int32), intent(out), optional :: olwork
    -
    2534 class(errors), intent(inout), optional, target :: err
    -
    2535 end subroutine
    -
    2536
    -
    2571 module subroutine mult_qr_mtx(lside, trans, a, tau, c, work, olwork, err)
    -
    2572 logical, intent(in) :: lside, trans
    -
    2573 real(real64), intent(in), dimension(:) :: tau
    -
    2574 real(real64), intent(inout), dimension(:,:) :: a, c
    -
    2575 real(real64), intent(out), target, dimension(:), optional :: work
    -
    2576 integer(int32), intent(out), optional :: olwork
    -
    2577 class(errors), intent(inout), optional, target :: err
    -
    2578 end subroutine
    -
    2579
    -
    2614 module subroutine mult_qr_mtx_cmplx(lside, trans, a, tau, c, work, olwork, err)
    -
    2615 logical, intent(in) :: lside, trans
    -
    2616 complex(real64), intent(in), dimension(:) :: tau
    -
    2617 complex(real64), intent(inout), dimension(:,:) :: a, c
    -
    2618 complex(real64), intent(out), target, dimension(:), optional :: work
    -
    2619 integer(int32), intent(out), optional :: olwork
    -
    2620 class(errors), intent(inout), optional, target :: err
    -
    2621 end subroutine
    -
    2622
    -
    2653 module subroutine mult_qr_vec(trans, a, tau, c, work, olwork, err)
    -
    2654 logical, intent(in) :: trans
    -
    2655 real(real64), intent(inout), dimension(:,:) :: a
    -
    2656 real(real64), intent(in), dimension(:) :: tau
    -
    2657 real(real64), intent(inout), dimension(:) :: c
    -
    2658 real(real64), intent(out), target, dimension(:), optional :: work
    -
    2659 integer(int32), intent(out), optional :: olwork
    -
    2660 class(errors), intent(inout), optional, target :: err
    -
    2661 end subroutine
    -
    2662
    -
    2693 module subroutine mult_qr_vec_cmplx(trans, a, tau, c, work, olwork, err)
    -
    2694 logical, intent(in) :: trans
    -
    2695 complex(real64), intent(inout), dimension(:,:) :: a
    -
    2696 complex(real64), intent(in), dimension(:) :: tau
    -
    2697 complex(real64), intent(inout), dimension(:) :: c
    -
    2698 complex(real64), intent(out), target, dimension(:), optional :: work
    -
    2699 integer(int32), intent(out), optional :: olwork
    -
    2700 class(errors), intent(inout), optional, target :: err
    -
    2701 end subroutine
    -
    2702
    -
    2743 module subroutine qr_rank1_update_dbl(q, r, u, v, work, err)
    -
    2744 real(real64), intent(inout), dimension(:,:) :: q, r
    -
    2745 real(real64), intent(inout), dimension(:) :: u, v
    -
    2746 real(real64), intent(out), target, optional, dimension(:) :: work
    -
    2747 class(errors), intent(inout), optional, target :: err
    -
    2748 end subroutine
    -
    2749
    -
    2793 module subroutine qr_rank1_update_cmplx(q, r, u, v, work, rwork, err)
    -
    2794 complex(real64), intent(inout), dimension(:,:) :: q, r
    -
    2795 complex(real64), intent(inout), dimension(:) :: u, v
    -
    2796 complex(real64), intent(out), target, optional, dimension(:) :: work
    -
    2797 real(real64), intent(out), target, optional, dimension(:) :: rwork
    -
    2798 class(errors), intent(inout), optional, target :: err
    -
    2799 end subroutine
    -
    2800
    -
    2821 module subroutine cholesky_factor_dbl(a, upper, err)
    -
    2822 real(real64), intent(inout), dimension(:,:) :: a
    -
    2823 logical, intent(in), optional :: upper
    -
    2824 class(errors), intent(inout), optional, target :: err
    -
    2825 end subroutine
    -
    2826
    -
    2847 module subroutine cholesky_factor_cmplx(a, upper, err)
    -
    2848 complex(real64), intent(inout), dimension(:,:) :: a
    -
    2849 logical, intent(in), optional :: upper
    -
    2850 class(errors), intent(inout), optional, target :: err
    -
    2851 end subroutine
    -
    2852
    -
    2879 module subroutine cholesky_rank1_update_dbl(r, u, work, err)
    -
    2880 real(real64), intent(inout), dimension(:,:) :: r
    -
    2881 real(real64), intent(inout), dimension(:) :: u
    -
    2882 real(real64), intent(out), target, optional, dimension(:) :: work
    -
    2883 class(errors), intent(inout), optional, target :: err
    -
    2884 end subroutine
    -
    2885
    -
    2912 module subroutine cholesky_rank1_update_cmplx(r, u, work, err)
    -
    2913 complex(real64), intent(inout), dimension(:,:) :: r
    -
    2914 complex(real64), intent(inout), dimension(:) :: u
    -
    2915 real(real64), intent(out), target, optional, dimension(:) :: work
    -
    2916 class(errors), intent(inout), optional, target :: err
    -
    2917 end subroutine
    -
    2918
    -
    2948 module subroutine cholesky_rank1_downdate_dbl(r, u, work, err)
    -
    2949 real(real64), intent(inout), dimension(:,:) :: r
    -
    2950 real(real64), intent(inout), dimension(:) :: u
    -
    2951 real(real64), intent(out), target, optional, dimension(:) :: work
    -
    2952 class(errors), intent(inout), optional, target :: err
    -
    2953 end subroutine
    -
    2954
    -
    2984 module subroutine cholesky_rank1_downdate_cmplx(r, u, work, err)
    -
    2985 complex(real64), intent(inout), dimension(:,:) :: r
    -
    2986 complex(real64), intent(inout), dimension(:) :: u
    -
    2987 real(real64), intent(out), target, optional, dimension(:) :: work
    -
    2988 class(errors), intent(inout), optional, target :: err
    -
    2989 end subroutine
    -
    2990
    -
    3053 module subroutine rz_factor_dbl(a, tau, work, olwork, err)
    -
    3054 real(real64), intent(inout), dimension(:,:) :: a
    -
    3055 real(real64), intent(out), dimension(:) :: tau
    -
    3056 real(real64), intent(out), target, optional, dimension(:) :: work
    -
    3057 integer(int32), intent(out), optional :: olwork
    -
    3058 class(errors), intent(inout), optional, target :: err
    -
    3059 end subroutine
    -
    3060
    -
    3123 module subroutine rz_factor_cmplx(a, tau, work, olwork, err)
    -
    3124 complex(real64), intent(inout), dimension(:,:) :: a
    -
    3125 complex(real64), intent(out), dimension(:) :: tau
    -
    3126 complex(real64), intent(out), target, optional, dimension(:) :: work
    -
    3127 integer(int32), intent(out), optional :: olwork
    -
    3128 class(errors), intent(inout), optional, target :: err
    -
    3129 end subroutine
    -
    3130
    -
    3168 module subroutine mult_rz_mtx(lside, trans, l, a, tau, c, work, olwork, err)
    -
    3169 logical, intent(in) :: lside, trans
    -
    3170 integer(int32), intent(in) :: l
    -
    3171 real(real64), intent(inout), dimension(:,:) :: a, c
    -
    3172 real(real64), intent(in), dimension(:) :: tau
    -
    3173 real(real64), intent(out), target, optional, dimension(:) :: work
    -
    3174 integer(int32), intent(out), optional :: olwork
    -
    3175 class(errors), intent(inout), optional, target :: err
    -
    3176 end subroutine
    -
    3177
    -
    3215 module subroutine mult_rz_mtx_cmplx(lside, trans, l, a, tau, c, work, olwork, err)
    -
    3216 logical, intent(in) :: lside, trans
    -
    3217 integer(int32), intent(in) :: l
    -
    3218 complex(real64), intent(inout), dimension(:,:) :: a, c
    -
    3219 complex(real64), intent(in), dimension(:) :: tau
    -
    3220 complex(real64), intent(out), target, optional, dimension(:) :: work
    -
    3221 integer(int32), intent(out), optional :: olwork
    -
    3222 class(errors), intent(inout), optional, target :: err
    -
    3223 end subroutine
    -
    3224
    -
    3260 module subroutine mult_rz_vec(trans, l, a, tau, c, work, olwork, err)
    -
    3261 logical, intent(in) :: trans
    -
    3262 integer(int32), intent(in) :: l
    -
    3263 real(real64), intent(inout), dimension(:,:) :: a
    -
    3264 real(real64), intent(in), dimension(:) :: tau
    -
    3265 real(real64), intent(inout), dimension(:) :: c
    -
    3266 real(real64), intent(out), target, optional, dimension(:) :: work
    -
    3267 integer(int32), intent(out), optional :: olwork
    -
    3268 class(errors), intent(inout), optional, target :: err
    -
    3269 end subroutine
    -
    3270
    -
    3306 module subroutine mult_rz_vec_cmplx(trans, l, a, tau, c, work, olwork, err)
    -
    3307 logical, intent(in) :: trans
    -
    3308 integer(int32), intent(in) :: l
    -
    3309 complex(real64), intent(inout), dimension(:,:) :: a
    -
    3310 complex(real64), intent(in), dimension(:) :: tau
    -
    3311 complex(real64), intent(inout), dimension(:) :: c
    -
    3312 complex(real64), intent(out), target, optional, dimension(:) :: work
    -
    3313 integer(int32), intent(out), optional :: olwork
    -
    3314 class(errors), intent(inout), optional, target :: err
    -
    3315 end subroutine
    -
    3316
    -
    3359 module subroutine svd_dbl(a, s, u, vt, work, olwork, err)
    -
    3360 real(real64), intent(inout), dimension(:,:) :: a
    -
    3361 real(real64), intent(out), dimension(:) :: s
    -
    3362 real(real64), intent(out), optional, dimension(:,:) :: u, vt
    -
    3363 real(real64), intent(out), target, optional, dimension(:) :: work
    -
    3364 integer(int32), intent(out), optional :: olwork
    -
    3365 class(errors), intent(inout), optional, target :: err
    -
    3366 end subroutine
    -
    3367
    -
    3414 module subroutine svd_cmplx(a, s, u, vt, work, olwork, rwork, err)
    -
    3415 complex(real64), intent(inout), dimension(:,:) :: a
    -
    3416 real(real64), intent(out), dimension(:) :: s
    -
    3417 complex(real64), intent(out), optional, dimension(:,:) :: u, vt
    -
    3418 complex(real64), intent(out), target, optional, dimension(:) :: work
    -
    3419 integer(int32), intent(out), optional :: olwork
    -
    3420 real(real64), intent(out), target, optional, dimension(:) :: rwork
    -
    3421 class(errors), intent(inout), optional, target :: err
    -
    3422 end subroutine
    -
    3423end interface
    -
    3424
    -
    3425! ******************************************************************************
    -
    3426! LINALG_SOLVE.F90
    -
    3427! ------------------------------------------------------------------------------
    -
    3428interface
    -
    3429
    -
    3457 module subroutine solve_tri_mtx(lside, upper, trans, nounit, alpha, a, b, err)
    -
    3458 logical, intent(in) :: lside, upper, trans, nounit
    -
    3459 real(real64), intent(in) :: alpha
    -
    3460 real(real64), intent(in), dimension(:,:) :: a
    -
    3461 real(real64), intent(inout), dimension(:,:) :: b
    -
    3462 class(errors), intent(inout), optional, target :: err
    -
    3463 end subroutine
    -
    3464
    -
    3493 module subroutine solve_tri_mtx_cmplx(lside, upper, trans, nounit, alpha, a, b, err)
    -
    3494 logical, intent(in) :: lside, upper, trans, nounit
    -
    3495 complex(real64), intent(in) :: alpha
    -
    3496 complex(real64), intent(in), dimension(:,:) :: a
    -
    3497 complex(real64), intent(inout), dimension(:,:) :: b
    -
    3498 class(errors), intent(inout), optional, target :: err
    -
    3499 end subroutine
    -
    3500
    -
    3545 module subroutine solve_tri_vec(upper, trans, nounit, a, x, err)
    -
    3546 logical, intent(in) :: upper, trans, nounit
    -
    3547 real(real64), intent(in), dimension(:,:) :: a
    -
    3548 real(real64), intent(inout), dimension(:) :: x
    -
    3549 class(errors), intent(inout), optional, target :: err
    -
    3550 end subroutine
    -
    3551
    -
    3596 module subroutine solve_tri_vec_cmplx(upper, trans, nounit, a, x, err)
    -
    3597 logical, intent(in) :: upper, trans, nounit
    -
    3598 complex(real64), intent(in), dimension(:,:) :: a
    -
    3599 complex(real64), intent(inout), dimension(:) :: x
    -
    3600 class(errors), intent(inout), optional, target :: err
    -
    3601 end subroutine
    -
    3602
    -
    3619 module subroutine solve_lu_mtx(a, ipvt, b, err)
    -
    3620 real(real64), intent(in), dimension(:,:) :: a
    -
    3621 integer(int32), intent(in), dimension(:) :: ipvt
    -
    3622 real(real64), intent(inout), dimension(:,:) :: b
    -
    3623 class(errors), intent(inout), optional, target :: err
    -
    3624 end subroutine
    -
    3625
    -
    3642 module subroutine solve_lu_mtx_cmplx(a, ipvt, b, err)
    -
    3643 complex(real64), intent(in), dimension(:,:) :: a
    -
    3644 integer(int32), intent(in), dimension(:) :: ipvt
    -
    3645 complex(real64), intent(inout), dimension(:,:) :: b
    -
    3646 class(errors), intent(inout), optional, target :: err
    -
    3647 end subroutine
    -
    3648
    -
    3665 module subroutine solve_lu_vec(a, ipvt, b, err)
    -
    3666 real(real64), intent(in), dimension(:,:) :: a
    -
    3667 integer(int32), intent(in), dimension(:) :: ipvt
    -
    3668 real(real64), intent(inout), dimension(:) :: b
    -
    3669 class(errors), intent(inout), optional, target :: err
    -
    3670 end subroutine
    -
    3671
    -
    3688 module subroutine solve_lu_vec_cmplx(a, ipvt, b, err)
    -
    3689 complex(real64), intent(in), dimension(:,:) :: a
    -
    3690 integer(int32), intent(in), dimension(:) :: ipvt
    -
    3691 complex(real64), intent(inout), dimension(:) :: b
    +
    2305 module subroutine diag_mtx_mult_mtx3(lside, trans, alpha, a, b, beta, c, err)
    +
    2306 logical, intent(in) :: lside, trans
    +
    2307 real(real64) :: alpha, beta
    +
    2308 complex(real64), intent(in), dimension(:) :: a
    +
    2309 real(real64), intent(in), dimension(:,:) :: b
    +
    2310 complex(real64), intent(inout), dimension(:,:) :: c
    +
    2311 class(errors), intent(inout), optional, target :: err
    +
    2312 end subroutine
    +
    2313
    +
    2314 module subroutine diag_mtx_mult_mtx4(lside, opb, alpha, a, b, beta, c, err)
    +
    2315 logical, intent(in) :: lside
    +
    2316 integer(int32), intent(in) :: opb
    +
    2317 real(real64) :: alpha, beta
    +
    2318 complex(real64), intent(in), dimension(:) :: a
    +
    2319 complex(real64), intent(in), dimension(:,:) :: b
    +
    2320 complex(real64), intent(inout), dimension(:,:) :: c
    +
    2321 class(errors), intent(inout), optional, target :: err
    +
    2322 end subroutine
    +
    2323
    +
    2324 module subroutine diag_mtx_mult_mtx_cmplx(lside, opb, alpha, a, b, beta, c, err)
    +
    2325 logical, intent(in) :: lside
    +
    2326 integer(int32), intent(in) :: opb
    +
    2327 complex(real64) :: alpha, beta
    +
    2328 complex(real64), intent(in), dimension(:) :: a
    +
    2329 complex(real64), intent(in), dimension(:,:) :: b
    +
    2330 complex(real64), intent(inout), dimension(:,:) :: c
    +
    2331 class(errors), intent(inout), optional, target :: err
    +
    2332 end subroutine
    +
    2333
    +
    2334 module subroutine diag_mtx_mult_mtx2_cmplx(lside, alpha, a, b, err)
    +
    2335 logical, intent(in) :: lside
    +
    2336 complex(real64), intent(in) :: alpha
    +
    2337 complex(real64), intent(in), dimension(:) :: a
    +
    2338 complex(real64), intent(inout), dimension(:,:) :: b
    +
    2339 class(errors), intent(inout), optional, target :: err
    +
    2340 end subroutine
    +
    2341
    +
    2342 module subroutine diag_mtx_mult_mtx_mix(lside, opb, alpha, a, b, beta, c, err)
    +
    2343 logical, intent(in) :: lside
    +
    2344 integer(int32), intent(in) :: opb
    +
    2345 complex(real64) :: alpha, beta
    +
    2346 real(real64), intent(in), dimension(:) :: a
    +
    2347 complex(real64), intent(in), dimension(:,:) :: b
    +
    2348 complex(real64), intent(inout), dimension(:,:) :: c
    +
    2349 class(errors), intent(inout), optional, target :: err
    +
    2350 end subroutine
    +
    2351
    +
    2352 module subroutine diag_mtx_mult_mtx2_mix(lside, alpha, a, b, err)
    +
    2353 logical, intent(in) :: lside
    +
    2354 complex(real64), intent(in) :: alpha
    +
    2355 real(real64), intent(in), dimension(:) :: a
    +
    2356 complex(real64), intent(inout), dimension(:,:) :: b
    +
    2357 class(errors), intent(inout), optional, target :: err
    +
    2358 end subroutine
    +
    2359
    +
    2360 pure module function trace_dbl(x) result(y)
    +
    2361 real(real64), intent(in), dimension(:,:) :: x
    +
    2362 real(real64) :: y
    +
    2363 end function
    +
    2364
    +
    2365 pure module function trace_cmplx(x) result(y)
    +
    2366 complex(real64), intent(in), dimension(:,:) :: x
    +
    2367 complex(real64) :: y
    +
    2368 end function
    +
    2369
    +
    2370 module function mtx_rank_dbl(a, tol, work, olwork, err) result(rnk)
    +
    2371 real(real64), intent(inout), dimension(:,:) :: a
    +
    2372 real(real64), intent(in), optional :: tol
    +
    2373 real(real64), intent(out), target, optional, dimension(:) :: work
    +
    2374 integer(int32), intent(out), optional :: olwork
    +
    2375 class(errors), intent(inout), optional, target :: err
    +
    2376 integer(int32) :: rnk
    +
    2377 end function
    +
    2378
    +
    2379 module function mtx_rank_cmplx(a, tol, work, olwork, rwork, err) result(rnk)
    +
    2380 complex(real64), intent(inout), dimension(:,:) :: a
    +
    2381 real(real64), intent(in), optional :: tol
    +
    2382 complex(real64), intent(out), target, optional, dimension(:) :: work
    +
    2383 integer(int32), intent(out), optional :: olwork
    +
    2384 real(real64), intent(out), target, optional, dimension(:) :: rwork
    +
    2385 class(errors), intent(inout), optional, target :: err
    +
    2386 integer(int32) :: rnk
    +
    2387 end function
    +
    2388
    +
    2389 module function det_dbl(a, iwork, err) result(x)
    +
    2390 real(real64), intent(inout), dimension(:,:) :: a
    +
    2391 integer(int32), intent(out), target, optional, dimension(:) :: iwork
    +
    2392 class(errors), intent(inout), optional, target :: err
    +
    2393 real(real64) :: x
    +
    2394 end function
    +
    2395
    +
    2396 module function det_cmplx(a, iwork, err) result(x)
    +
    2397 complex(real64), intent(inout), dimension(:,:) :: a
    +
    2398 integer(int32), intent(out), target, optional, dimension(:) :: iwork
    +
    2399 class(errors), intent(inout), optional, target :: err
    +
    2400 complex(real64) :: x
    +
    2401 end function
    +
    2402
    +
    2403 module subroutine swap_dbl(x, y, err)
    +
    2404 real(real64), intent(inout), dimension(:) :: x, y
    +
    2405 class(errors), intent(inout), optional, target :: err
    +
    2406 end subroutine
    +
    2407
    +
    2408 module subroutine swap_cmplx(x, y, err)
    +
    2409 complex(real64), intent(inout), dimension(:) :: x, y
    +
    2410 class(errors), intent(inout), optional, target :: err
    +
    2411 end subroutine
    +
    2412
    +
    2413 module subroutine recip_mult_array_dbl(a, x)
    +
    2414 real(real64), intent(in) :: a
    +
    2415 real(real64), intent(inout), dimension(:) :: x
    +
    2416 end subroutine
    +
    2417
    +
    2418 module subroutine tri_mtx_mult_dbl(upper, alpha, a, beta, b, err)
    +
    2419 logical, intent(in) :: upper
    +
    2420 real(real64), intent(in) :: alpha, beta
    +
    2421 real(real64), intent(in), dimension(:,:) :: a
    +
    2422 real(real64), intent(inout), dimension(:,:) :: b
    +
    2423 class(errors), intent(inout), optional, target :: err
    +
    2424 end subroutine
    +
    2425
    +
    2426 module subroutine tri_mtx_mult_cmplx(upper, alpha, a, beta, b, err)
    +
    2427 logical, intent(in) :: upper
    +
    2428 complex(real64), intent(in) :: alpha, beta
    +
    2429 complex(real64), intent(in), dimension(:,:) :: a
    +
    2430 complex(real64), intent(inout), dimension(:,:) :: b
    +
    2431 class(errors), intent(inout), optional, target :: err
    +
    2432 end subroutine
    +
    2433
    +
    2434end interface
    +
    2435
    +
    2436! ******************************************************************************
    +
    2437! LINALG_FACTOR.F90
    +
    2438! ------------------------------------------------------------------------------
    +
    2439interface
    +
    2440 module subroutine lu_factor_dbl(a, ipvt, err)
    +
    2441 real(real64), intent(inout), dimension(:,:) :: a
    +
    2442 integer(int32), intent(out), dimension(:) :: ipvt
    +
    2443 class(errors), intent(inout), optional, target :: err
    +
    2444 end subroutine
    +
    2445
    +
    2446 module subroutine lu_factor_cmplx(a, ipvt, err)
    +
    2447 complex(real64), intent(inout), dimension(:,:) :: a
    +
    2448 integer(int32), intent(out), dimension(:) :: ipvt
    +
    2449 class(errors), intent(inout), optional, target :: err
    +
    2450 end subroutine
    +
    2451
    +
    2452 module subroutine form_lu_all(lu, ipvt, u, p, err)
    +
    2453 real(real64), intent(inout), dimension(:,:) :: lu
    +
    2454 integer(int32), intent(in), dimension(:) :: ipvt
    +
    2455 real(real64), intent(out), dimension(:,:) :: u, p
    +
    2456 class(errors), intent(inout), optional, target :: err
    +
    2457 end subroutine
    +
    2458
    +
    2459 module subroutine form_lu_all_cmplx(lu, ipvt, u, p, err)
    +
    2460 complex(real64), intent(inout), dimension(:,:) :: lu
    +
    2461 integer(int32), intent(in), dimension(:) :: ipvt
    +
    2462 complex(real64), intent(out), dimension(:,:) :: u
    +
    2463 real(real64), intent(out), dimension(:,:) :: p
    +
    2464 class(errors), intent(inout), optional, target :: err
    +
    2465 end subroutine
    +
    2466
    +
    2467 module subroutine form_lu_only(lu, u, err)
    +
    2468 real(real64), intent(inout), dimension(:,:) :: lu
    +
    2469 real(real64), intent(out), dimension(:,:) :: u
    +
    2470 class(errors), intent(inout), optional, target :: err
    +
    2471 end subroutine
    +
    2472
    +
    2473 module subroutine form_lu_only_cmplx(lu, u, err)
    +
    2474 complex(real64), intent(inout), dimension(:,:) :: lu
    +
    2475 complex(real64), intent(out), dimension(:,:) :: u
    +
    2476 class(errors), intent(inout), optional, target :: err
    +
    2477 end subroutine
    +
    2478
    +
    2479 module subroutine qr_factor_no_pivot(a, tau, work, olwork, err)
    +
    2480 real(real64), intent(inout), dimension(:,:) :: a
    +
    2481 real(real64), intent(out), dimension(:) :: tau
    +
    2482 real(real64), intent(out), target, dimension(:), optional :: work
    +
    2483 integer(int32), intent(out), optional :: olwork
    +
    2484 class(errors), intent(inout), optional, target :: err
    +
    2485 end subroutine
    +
    2486
    +
    2487 module subroutine qr_factor_no_pivot_cmplx(a, tau, work, olwork, err)
    +
    2488 complex(real64), intent(inout), dimension(:,:) :: a
    +
    2489 complex(real64), intent(out), dimension(:) :: tau
    +
    2490 complex(real64), intent(out), target, dimension(:), optional :: work
    +
    2491 integer(int32), intent(out), optional :: olwork
    +
    2492 class(errors), intent(inout), optional, target :: err
    +
    2493 end subroutine
    +
    2494
    +
    2495 module subroutine qr_factor_pivot(a, tau, jpvt, work, olwork, err)
    +
    2496 real(real64), intent(inout), dimension(:,:) :: a
    +
    2497 real(real64), intent(out), dimension(:) :: tau
    +
    2498 integer(int32), intent(inout), dimension(:) :: jpvt
    +
    2499 real(real64), intent(out), target, dimension(:), optional :: work
    +
    2500 integer(int32), intent(out), optional :: olwork
    +
    2501 class(errors), intent(inout), optional, target :: err
    +
    2502 end subroutine
    +
    2503
    +
    2504 module subroutine qr_factor_pivot_cmplx(a, tau, jpvt, work, olwork, rwork, &
    +
    2505 err)
    +
    2506 complex(real64), intent(inout), dimension(:,:) :: a
    +
    2507 complex(real64), intent(out), dimension(:) :: tau
    +
    2508 integer(int32), intent(inout), dimension(:) :: jpvt
    +
    2509 complex(real64), intent(out), target, dimension(:), optional :: work
    +
    2510 integer(int32), intent(out), optional :: olwork
    +
    2511 real(real64), intent(out), target, dimension(:), optional :: rwork
    +
    2512 class(errors), intent(inout), optional, target :: err
    +
    2513 end subroutine
    +
    2514
    +
    2515 module subroutine form_qr_no_pivot(r, tau, q, work, olwork, err)
    +
    2516 real(real64), intent(inout), dimension(:,:) :: r
    +
    2517 real(real64), intent(in), dimension(:) :: tau
    +
    2518 real(real64), intent(out), dimension(:,:) :: q
    +
    2519 real(real64), intent(out), target, dimension(:), optional :: work
    +
    2520 integer(int32), intent(out), optional :: olwork
    +
    2521 class(errors), intent(inout), optional, target :: err
    +
    2522 end subroutine
    +
    2523
    +
    2524 module subroutine form_qr_no_pivot_cmplx(r, tau, q, work, olwork, err)
    +
    2525 complex(real64), intent(inout), dimension(:,:) :: r
    +
    2526 complex(real64), intent(in), dimension(:) :: tau
    +
    2527 complex(real64), intent(out), dimension(:,:) :: q
    +
    2528 complex(real64), intent(out), target, dimension(:), optional :: work
    +
    2529 integer(int32), intent(out), optional :: olwork
    +
    2530 class(errors), intent(inout), optional, target :: err
    +
    2531 end subroutine
    +
    2532
    +
    2533 module subroutine form_qr_pivot(r, tau, pvt, q, p, work, olwork, err)
    +
    2534 real(real64), intent(inout), dimension(:,:) :: r
    +
    2535 real(real64), intent(in), dimension(:) :: tau
    +
    2536 integer(int32), intent(in), dimension(:) :: pvt
    +
    2537 real(real64), intent(out), dimension(:,:) :: q, p
    +
    2538 real(real64), intent(out), target, dimension(:), optional :: work
    +
    2539 integer(int32), intent(out), optional :: olwork
    +
    2540 class(errors), intent(inout), optional, target :: err
    +
    2541 end subroutine
    +
    2542
    +
    2543 module subroutine form_qr_pivot_cmplx(r, tau, pvt, q, p, work, olwork, err)
    +
    2544 complex(real64), intent(inout), dimension(:,:) :: r
    +
    2545 complex(real64), intent(in), dimension(:) :: tau
    +
    2546 integer(int32), intent(in), dimension(:) :: pvt
    +
    2547 complex(real64), intent(out), dimension(:,:) :: q, p
    +
    2548 complex(real64), intent(out), target, dimension(:), optional :: work
    +
    2549 integer(int32), intent(out), optional :: olwork
    +
    2550 class(errors), intent(inout), optional, target :: err
    +
    2551 end subroutine
    +
    2552
    +
    2553 module subroutine mult_qr_mtx(lside, trans, a, tau, c, work, olwork, err)
    +
    2554 logical, intent(in) :: lside, trans
    +
    2555 real(real64), intent(in), dimension(:) :: tau
    +
    2556 real(real64), intent(inout), dimension(:,:) :: a, c
    +
    2557 real(real64), intent(out), target, dimension(:), optional :: work
    +
    2558 integer(int32), intent(out), optional :: olwork
    +
    2559 class(errors), intent(inout), optional, target :: err
    +
    2560 end subroutine
    +
    2561
    +
    2562 module subroutine mult_qr_mtx_cmplx(lside, trans, a, tau, c, work, olwork, err)
    +
    2563 logical, intent(in) :: lside, trans
    +
    2564 complex(real64), intent(in), dimension(:) :: tau
    +
    2565 complex(real64), intent(inout), dimension(:,:) :: a, c
    +
    2566 complex(real64), intent(out), target, dimension(:), optional :: work
    +
    2567 integer(int32), intent(out), optional :: olwork
    +
    2568 class(errors), intent(inout), optional, target :: err
    +
    2569 end subroutine
    +
    2570
    +
    2571 module subroutine mult_qr_vec(trans, a, tau, c, work, olwork, err)
    +
    2572 logical, intent(in) :: trans
    +
    2573 real(real64), intent(inout), dimension(:,:) :: a
    +
    2574 real(real64), intent(in), dimension(:) :: tau
    +
    2575 real(real64), intent(inout), dimension(:) :: c
    +
    2576 real(real64), intent(out), target, dimension(:), optional :: work
    +
    2577 integer(int32), intent(out), optional :: olwork
    +
    2578 class(errors), intent(inout), optional, target :: err
    +
    2579 end subroutine
    +
    2580
    +
    2581 module subroutine mult_qr_vec_cmplx(trans, a, tau, c, work, olwork, err)
    +
    2582 logical, intent(in) :: trans
    +
    2583 complex(real64), intent(inout), dimension(:,:) :: a
    +
    2584 complex(real64), intent(in), dimension(:) :: tau
    +
    2585 complex(real64), intent(inout), dimension(:) :: c
    +
    2586 complex(real64), intent(out), target, dimension(:), optional :: work
    +
    2587 integer(int32), intent(out), optional :: olwork
    +
    2588 class(errors), intent(inout), optional, target :: err
    +
    2589 end subroutine
    +
    2590
    +
    2631 module subroutine qr_rank1_update_dbl(q, r, u, v, work, err)
    +
    2632 real(real64), intent(inout), dimension(:,:) :: q, r
    +
    2633 real(real64), intent(inout), dimension(:) :: u, v
    +
    2634 real(real64), intent(out), target, optional, dimension(:) :: work
    +
    2635 class(errors), intent(inout), optional, target :: err
    +
    2636 end subroutine
    +
    2637
    +
    2681 module subroutine qr_rank1_update_cmplx(q, r, u, v, work, rwork, err)
    +
    2682 complex(real64), intent(inout), dimension(:,:) :: q, r
    +
    2683 complex(real64), intent(inout), dimension(:) :: u, v
    +
    2684 complex(real64), intent(out), target, optional, dimension(:) :: work
    +
    2685 real(real64), intent(out), target, optional, dimension(:) :: rwork
    +
    2686 class(errors), intent(inout), optional, target :: err
    +
    2687 end subroutine
    +
    2688
    +
    2709 module subroutine cholesky_factor_dbl(a, upper, err)
    +
    2710 real(real64), intent(inout), dimension(:,:) :: a
    +
    2711 logical, intent(in), optional :: upper
    +
    2712 class(errors), intent(inout), optional, target :: err
    +
    2713 end subroutine
    +
    2714
    +
    2735 module subroutine cholesky_factor_cmplx(a, upper, err)
    +
    2736 complex(real64), intent(inout), dimension(:,:) :: a
    +
    2737 logical, intent(in), optional :: upper
    +
    2738 class(errors), intent(inout), optional, target :: err
    +
    2739 end subroutine
    +
    2740
    +
    2767 module subroutine cholesky_rank1_update_dbl(r, u, work, err)
    +
    2768 real(real64), intent(inout), dimension(:,:) :: r
    +
    2769 real(real64), intent(inout), dimension(:) :: u
    +
    2770 real(real64), intent(out), target, optional, dimension(:) :: work
    +
    2771 class(errors), intent(inout), optional, target :: err
    +
    2772 end subroutine
    +
    2773
    +
    2800 module subroutine cholesky_rank1_update_cmplx(r, u, work, err)
    +
    2801 complex(real64), intent(inout), dimension(:,:) :: r
    +
    2802 complex(real64), intent(inout), dimension(:) :: u
    +
    2803 real(real64), intent(out), target, optional, dimension(:) :: work
    +
    2804 class(errors), intent(inout), optional, target :: err
    +
    2805 end subroutine
    +
    2806
    +
    2836 module subroutine cholesky_rank1_downdate_dbl(r, u, work, err)
    +
    2837 real(real64), intent(inout), dimension(:,:) :: r
    +
    2838 real(real64), intent(inout), dimension(:) :: u
    +
    2839 real(real64), intent(out), target, optional, dimension(:) :: work
    +
    2840 class(errors), intent(inout), optional, target :: err
    +
    2841 end subroutine
    +
    2842
    +
    2872 module subroutine cholesky_rank1_downdate_cmplx(r, u, work, err)
    +
    2873 complex(real64), intent(inout), dimension(:,:) :: r
    +
    2874 complex(real64), intent(inout), dimension(:) :: u
    +
    2875 real(real64), intent(out), target, optional, dimension(:) :: work
    +
    2876 class(errors), intent(inout), optional, target :: err
    +
    2877 end subroutine
    +
    2878
    +
    2941 module subroutine rz_factor_dbl(a, tau, work, olwork, err)
    +
    2942 real(real64), intent(inout), dimension(:,:) :: a
    +
    2943 real(real64), intent(out), dimension(:) :: tau
    +
    2944 real(real64), intent(out), target, optional, dimension(:) :: work
    +
    2945 integer(int32), intent(out), optional :: olwork
    +
    2946 class(errors), intent(inout), optional, target :: err
    +
    2947 end subroutine
    +
    2948
    +
    3011 module subroutine rz_factor_cmplx(a, tau, work, olwork, err)
    +
    3012 complex(real64), intent(inout), dimension(:,:) :: a
    +
    3013 complex(real64), intent(out), dimension(:) :: tau
    +
    3014 complex(real64), intent(out), target, optional, dimension(:) :: work
    +
    3015 integer(int32), intent(out), optional :: olwork
    +
    3016 class(errors), intent(inout), optional, target :: err
    +
    3017 end subroutine
    +
    3018
    +
    3056 module subroutine mult_rz_mtx(lside, trans, l, a, tau, c, work, olwork, err)
    +
    3057 logical, intent(in) :: lside, trans
    +
    3058 integer(int32), intent(in) :: l
    +
    3059 real(real64), intent(inout), dimension(:,:) :: a, c
    +
    3060 real(real64), intent(in), dimension(:) :: tau
    +
    3061 real(real64), intent(out), target, optional, dimension(:) :: work
    +
    3062 integer(int32), intent(out), optional :: olwork
    +
    3063 class(errors), intent(inout), optional, target :: err
    +
    3064 end subroutine
    +
    3065
    +
    3103 module subroutine mult_rz_mtx_cmplx(lside, trans, l, a, tau, c, work, olwork, err)
    +
    3104 logical, intent(in) :: lside, trans
    +
    3105 integer(int32), intent(in) :: l
    +
    3106 complex(real64), intent(inout), dimension(:,:) :: a, c
    +
    3107 complex(real64), intent(in), dimension(:) :: tau
    +
    3108 complex(real64), intent(out), target, optional, dimension(:) :: work
    +
    3109 integer(int32), intent(out), optional :: olwork
    +
    3110 class(errors), intent(inout), optional, target :: err
    +
    3111 end subroutine
    +
    3112
    +
    3148 module subroutine mult_rz_vec(trans, l, a, tau, c, work, olwork, err)
    +
    3149 logical, intent(in) :: trans
    +
    3150 integer(int32), intent(in) :: l
    +
    3151 real(real64), intent(inout), dimension(:,:) :: a
    +
    3152 real(real64), intent(in), dimension(:) :: tau
    +
    3153 real(real64), intent(inout), dimension(:) :: c
    +
    3154 real(real64), intent(out), target, optional, dimension(:) :: work
    +
    3155 integer(int32), intent(out), optional :: olwork
    +
    3156 class(errors), intent(inout), optional, target :: err
    +
    3157 end subroutine
    +
    3158
    +
    3194 module subroutine mult_rz_vec_cmplx(trans, l, a, tau, c, work, olwork, err)
    +
    3195 logical, intent(in) :: trans
    +
    3196 integer(int32), intent(in) :: l
    +
    3197 complex(real64), intent(inout), dimension(:,:) :: a
    +
    3198 complex(real64), intent(in), dimension(:) :: tau
    +
    3199 complex(real64), intent(inout), dimension(:) :: c
    +
    3200 complex(real64), intent(out), target, optional, dimension(:) :: work
    +
    3201 integer(int32), intent(out), optional :: olwork
    +
    3202 class(errors), intent(inout), optional, target :: err
    +
    3203 end subroutine
    +
    3204
    +
    3247 module subroutine svd_dbl(a, s, u, vt, work, olwork, err)
    +
    3248 real(real64), intent(inout), dimension(:,:) :: a
    +
    3249 real(real64), intent(out), dimension(:) :: s
    +
    3250 real(real64), intent(out), optional, dimension(:,:) :: u, vt
    +
    3251 real(real64), intent(out), target, optional, dimension(:) :: work
    +
    3252 integer(int32), intent(out), optional :: olwork
    +
    3253 class(errors), intent(inout), optional, target :: err
    +
    3254 end subroutine
    +
    3255
    +
    3302 module subroutine svd_cmplx(a, s, u, vt, work, olwork, rwork, err)
    +
    3303 complex(real64), intent(inout), dimension(:,:) :: a
    +
    3304 real(real64), intent(out), dimension(:) :: s
    +
    3305 complex(real64), intent(out), optional, dimension(:,:) :: u, vt
    +
    3306 complex(real64), intent(out), target, optional, dimension(:) :: work
    +
    3307 integer(int32), intent(out), optional :: olwork
    +
    3308 real(real64), intent(out), target, optional, dimension(:) :: rwork
    +
    3309 class(errors), intent(inout), optional, target :: err
    +
    3310 end subroutine
    +
    3311end interface
    +
    3312
    +
    3313! ******************************************************************************
    +
    3314! LINALG_SOLVE.F90
    +
    3315! ------------------------------------------------------------------------------
    +
    3316interface
    +
    3317
    +
    3345 module subroutine solve_tri_mtx(lside, upper, trans, nounit, alpha, a, b, err)
    +
    3346 logical, intent(in) :: lside, upper, trans, nounit
    +
    3347 real(real64), intent(in) :: alpha
    +
    3348 real(real64), intent(in), dimension(:,:) :: a
    +
    3349 real(real64), intent(inout), dimension(:,:) :: b
    +
    3350 class(errors), intent(inout), optional, target :: err
    +
    3351 end subroutine
    +
    3352
    +
    3381 module subroutine solve_tri_mtx_cmplx(lside, upper, trans, nounit, alpha, a, b, err)
    +
    3382 logical, intent(in) :: lside, upper, trans, nounit
    +
    3383 complex(real64), intent(in) :: alpha
    +
    3384 complex(real64), intent(in), dimension(:,:) :: a
    +
    3385 complex(real64), intent(inout), dimension(:,:) :: b
    +
    3386 class(errors), intent(inout), optional, target :: err
    +
    3387 end subroutine
    +
    3388
    +
    3433 module subroutine solve_tri_vec(upper, trans, nounit, a, x, err)
    +
    3434 logical, intent(in) :: upper, trans, nounit
    +
    3435 real(real64), intent(in), dimension(:,:) :: a
    +
    3436 real(real64), intent(inout), dimension(:) :: x
    +
    3437 class(errors), intent(inout), optional, target :: err
    +
    3438 end subroutine
    +
    3439
    +
    3484 module subroutine solve_tri_vec_cmplx(upper, trans, nounit, a, x, err)
    +
    3485 logical, intent(in) :: upper, trans, nounit
    +
    3486 complex(real64), intent(in), dimension(:,:) :: a
    +
    3487 complex(real64), intent(inout), dimension(:) :: x
    +
    3488 class(errors), intent(inout), optional, target :: err
    +
    3489 end subroutine
    +
    3490
    +
    3507 module subroutine solve_lu_mtx(a, ipvt, b, err)
    +
    3508 real(real64), intent(in), dimension(:,:) :: a
    +
    3509 integer(int32), intent(in), dimension(:) :: ipvt
    +
    3510 real(real64), intent(inout), dimension(:,:) :: b
    +
    3511 class(errors), intent(inout), optional, target :: err
    +
    3512 end subroutine
    +
    3513
    +
    3530 module subroutine solve_lu_mtx_cmplx(a, ipvt, b, err)
    +
    3531 complex(real64), intent(in), dimension(:,:) :: a
    +
    3532 integer(int32), intent(in), dimension(:) :: ipvt
    +
    3533 complex(real64), intent(inout), dimension(:,:) :: b
    +
    3534 class(errors), intent(inout), optional, target :: err
    +
    3535 end subroutine
    +
    3536
    +
    3553 module subroutine solve_lu_vec(a, ipvt, b, err)
    +
    3554 real(real64), intent(in), dimension(:,:) :: a
    +
    3555 integer(int32), intent(in), dimension(:) :: ipvt
    +
    3556 real(real64), intent(inout), dimension(:) :: b
    +
    3557 class(errors), intent(inout), optional, target :: err
    +
    3558 end subroutine
    +
    3559
    +
    3576 module subroutine solve_lu_vec_cmplx(a, ipvt, b, err)
    +
    3577 complex(real64), intent(in), dimension(:,:) :: a
    +
    3578 integer(int32), intent(in), dimension(:) :: ipvt
    +
    3579 complex(real64), intent(inout), dimension(:) :: b
    +
    3580 class(errors), intent(inout), optional, target :: err
    +
    3581 end subroutine
    +
    3582
    +
    3612 module subroutine solve_qr_no_pivot_mtx(a, tau, b, work, olwork, err)
    +
    3613 real(real64), intent(inout), dimension(:,:) :: a, b
    +
    3614 real(real64), intent(in), dimension(:) :: tau
    +
    3615 real(real64), intent(out), target, optional, dimension(:) :: work
    +
    3616 integer(int32), intent(out), optional :: olwork
    +
    3617 class(errors), intent(inout), optional, target :: err
    +
    3618 end subroutine
    +
    3619
    +
    3649 module subroutine solve_qr_no_pivot_mtx_cmplx(a, tau, b, work, olwork, err)
    +
    3650 complex(real64), intent(inout), dimension(:,:) :: a, b
    +
    3651 complex(real64), intent(in), dimension(:) :: tau
    +
    3652 complex(real64), intent(out), target, optional, dimension(:) :: work
    +
    3653 integer(int32), intent(out), optional :: olwork
    +
    3654 class(errors), intent(inout), optional, target :: err
    +
    3655 end subroutine
    +
    3656
    +
    3686 module subroutine solve_qr_no_pivot_vec(a, tau, b, work, olwork, err)
    +
    3687 real(real64), intent(inout), dimension(:,:) :: a
    +
    3688 real(real64), intent(in), dimension(:) :: tau
    +
    3689 real(real64), intent(inout), dimension(:) :: b
    +
    3690 real(real64), intent(out), target, optional, dimension(:) :: work
    +
    3691 integer(int32), intent(out), optional :: olwork
    3692 class(errors), intent(inout), optional, target :: err
    3693 end subroutine
    3694
    -
    3724 module subroutine solve_qr_no_pivot_mtx(a, tau, b, work, olwork, err)
    -
    3725 real(real64), intent(inout), dimension(:,:) :: a, b
    -
    3726 real(real64), intent(in), dimension(:) :: tau
    -
    3727 real(real64), intent(out), target, optional, dimension(:) :: work
    -
    3728 integer(int32), intent(out), optional :: olwork
    -
    3729 class(errors), intent(inout), optional, target :: err
    -
    3730 end subroutine
    -
    3731
    -
    3761 module subroutine solve_qr_no_pivot_mtx_cmplx(a, tau, b, work, olwork, err)
    -
    3762 complex(real64), intent(inout), dimension(:,:) :: a, b
    -
    3763 complex(real64), intent(in), dimension(:) :: tau
    -
    3764 complex(real64), intent(out), target, optional, dimension(:) :: work
    -
    3765 integer(int32), intent(out), optional :: olwork
    -
    3766 class(errors), intent(inout), optional, target :: err
    -
    3767 end subroutine
    -
    3768
    -
    3798 module subroutine solve_qr_no_pivot_vec(a, tau, b, work, olwork, err)
    -
    3799 real(real64), intent(inout), dimension(:,:) :: a
    -
    3800 real(real64), intent(in), dimension(:) :: tau
    -
    3801 real(real64), intent(inout), dimension(:) :: b
    -
    3802 real(real64), intent(out), target, optional, dimension(:) :: work
    -
    3803 integer(int32), intent(out), optional :: olwork
    -
    3804 class(errors), intent(inout), optional, target :: err
    -
    3805 end subroutine
    -
    3806
    -
    3836 module subroutine solve_qr_no_pivot_vec_cmplx(a, tau, b, work, olwork, err)
    -
    3837 complex(real64), intent(inout), dimension(:,:) :: a
    -
    3838 complex(real64), intent(in), dimension(:) :: tau
    -
    3839 complex(real64), intent(inout), dimension(:) :: b
    -
    3840 complex(real64), intent(out), target, optional, dimension(:) :: work
    -
    3841 integer(int32), intent(out), optional :: olwork
    -
    3842 class(errors), intent(inout), optional, target :: err
    -
    3843 end subroutine
    -
    3844
    -
    3876 module subroutine solve_qr_pivot_mtx(a, tau, jpvt, b, work, olwork, err)
    -
    3877 real(real64), intent(inout), dimension(:,:) :: a
    -
    3878 real(real64), intent(in), dimension(:) :: tau
    -
    3879 integer(int32), intent(in), dimension(:) :: jpvt
    -
    3880 real(real64), intent(inout), dimension(:,:) :: b
    -
    3881 real(real64), intent(out), target, optional, dimension(:) :: work
    -
    3882 integer(int32), intent(out), optional :: olwork
    -
    3883 class(errors), intent(inout), optional, target :: err
    -
    3884 end subroutine
    -
    3885
    -
    3917 module subroutine solve_qr_pivot_mtx_cmplx(a, tau, jpvt, b, work, olwork, err)
    -
    3918 complex(real64), intent(inout), dimension(:,:) :: a
    -
    3919 complex(real64), intent(in), dimension(:) :: tau
    -
    3920 integer(int32), intent(in), dimension(:) :: jpvt
    -
    3921 complex(real64), intent(inout), dimension(:,:) :: b
    -
    3922 complex(real64), intent(out), target, optional, dimension(:) :: work
    -
    3923 integer(int32), intent(out), optional :: olwork
    -
    3924 class(errors), intent(inout), optional, target :: err
    -
    3925 end subroutine
    -
    3926
    -
    3958 module subroutine solve_qr_pivot_vec(a, tau, jpvt, b, work, olwork, err)
    -
    3959 real(real64), intent(inout), dimension(:,:) :: a
    -
    3960 real(real64), intent(in), dimension(:) :: tau
    -
    3961 integer(int32), intent(in), dimension(:) :: jpvt
    -
    3962 real(real64), intent(inout), dimension(:) :: b
    -
    3963 real(real64), intent(out), target, optional, dimension(:) :: work
    -
    3964 integer(int32), intent(out), optional :: olwork
    -
    3965 class(errors), intent(inout), optional, target :: err
    -
    3966 end subroutine
    -
    3967
    -
    3999 module subroutine solve_qr_pivot_vec_cmplx(a, tau, jpvt, b, work, olwork, err)
    -
    4000 complex(real64), intent(inout), dimension(:,:) :: a
    -
    4001 complex(real64), intent(in), dimension(:) :: tau
    -
    4002 integer(int32), intent(in), dimension(:) :: jpvt
    -
    4003 complex(real64), intent(inout), dimension(:) :: b
    -
    4004 complex(real64), intent(out), target, optional, dimension(:) :: work
    -
    4005 integer(int32), intent(out), optional :: olwork
    -
    4006 class(errors), intent(inout), optional, target :: err
    -
    4007 end subroutine
    -
    4008
    -
    4027 module subroutine solve_cholesky_mtx(upper, a, b, err)
    -
    4028 logical, intent(in) :: upper
    -
    4029 real(real64), intent(in), dimension(:,:) :: a
    -
    4030 real(real64), intent(inout), dimension(:,:) :: b
    -
    4031 class(errors), intent(inout), optional, target :: err
    -
    4032 end subroutine
    -
    4033
    -
    4052 module subroutine solve_cholesky_mtx_cmplx(upper, a, b, err)
    -
    4053 logical, intent(in) :: upper
    -
    4054 complex(real64), intent(in), dimension(:,:) :: a
    -
    4055 complex(real64), intent(inout), dimension(:,:) :: b
    -
    4056 class(errors), intent(inout), optional, target :: err
    -
    4057 end subroutine
    -
    4058
    -
    4077 module subroutine solve_cholesky_vec(upper, a, b, err)
    -
    4078 logical, intent(in) :: upper
    -
    4079 real(real64), intent(in), dimension(:,:) :: a
    -
    4080 real(real64), intent(inout), dimension(:) :: b
    -
    4081 class(errors), intent(inout), optional, target :: err
    -
    4082 end subroutine
    -
    4083
    -
    4102 module subroutine solve_cholesky_vec_cmplx(upper, a, b, err)
    -
    4103 logical, intent(in) :: upper
    -
    4104 complex(real64), intent(in), dimension(:,:) :: a
    -
    4105 complex(real64), intent(inout), dimension(:) :: b
    -
    4106 class(errors), intent(inout), optional, target :: err
    -
    4107 end subroutine
    -
    4108
    -
    4140 module subroutine solve_least_squares_mtx(a, b, work, olwork, err)
    -
    4141 real(real64), intent(inout), dimension(:,:) :: a, b
    -
    4142 real(real64), intent(out), target, optional, dimension(:) :: work
    -
    4143 integer(int32), intent(out), optional :: olwork
    -
    4144 class(errors), intent(inout), optional, target :: err
    -
    4145 end subroutine
    -
    4146
    -
    4178 module subroutine solve_least_squares_mtx_cmplx(a, b, work, olwork, err)
    -
    4179 complex(real64), intent(inout), dimension(:,:) :: a, b
    -
    4180 complex(real64), intent(out), target, optional, dimension(:) :: work
    -
    4181 integer(int32), intent(out), optional :: olwork
    -
    4182 class(errors), intent(inout), optional, target :: err
    -
    4183 end subroutine
    -
    4184
    -
    4216 module subroutine solve_least_squares_vec(a, b, work, olwork, err)
    -
    4217 real(real64), intent(inout), dimension(:,:) :: a
    -
    4218 real(real64), intent(inout), dimension(:) :: b
    -
    4219 real(real64), intent(out), target, optional, dimension(:) :: work
    -
    4220 integer(int32), intent(out), optional :: olwork
    -
    4221 class(errors), intent(inout), optional, target :: err
    -
    4222 end subroutine
    -
    4223
    -
    4255 module subroutine solve_least_squares_vec_cmplx(a, b, work, olwork, err)
    -
    4256 complex(real64), intent(inout), dimension(:,:) :: a
    -
    4257 complex(real64), intent(inout), dimension(:) :: b
    -
    4258 complex(real64), intent(out), target, optional, dimension(:) :: work
    -
    4259 integer(int32), intent(out), optional :: olwork
    -
    4260 class(errors), intent(inout), optional, target :: err
    -
    4261 end subroutine
    -
    4262
    -
    4300 module subroutine solve_least_squares_mtx_pvt(a, b, ipvt, arnk, work, olwork, err)
    -
    4301 real(real64), intent(inout), dimension(:,:) :: a, b
    -
    4302 integer(int32), intent(inout), target, optional, dimension(:) :: ipvt
    -
    4303 integer(int32), intent(out), optional :: arnk
    -
    4304 real(real64), intent(out), target, optional, dimension(:) :: work
    -
    4305 integer(int32), intent(out), optional :: olwork
    -
    4306 class(errors), intent(inout), optional, target :: err
    -
    4307 end subroutine
    -
    4308
    -
    4350 module subroutine solve_least_squares_mtx_pvt_cmplx(a, b, ipvt, arnk, &
    -
    4351 work, olwork, rwork, err)
    -
    4352 complex(real64), intent(inout), dimension(:,:) :: a, b
    -
    4353 integer(int32), intent(inout), target, optional, dimension(:) :: ipvt
    -
    4354 integer(int32), intent(out), optional :: arnk
    -
    4355 complex(real64), intent(out), target, optional, dimension(:) :: work
    -
    4356 integer(int32), intent(out), optional :: olwork
    -
    4357 real(real64), intent(out), target, optional, dimension(:) :: rwork
    -
    4358 class(errors), intent(inout), optional, target :: err
    -
    4359 end subroutine
    -
    4360
    -
    4398 module subroutine solve_least_squares_vec_pvt(a, b, ipvt, arnk, work, olwork, err)
    -
    4399 real(real64), intent(inout), dimension(:,:) :: a
    -
    4400 real(real64), intent(inout), dimension(:) :: b
    -
    4401 integer(int32), intent(inout), target, optional, dimension(:) :: ipvt
    -
    4402 integer(int32), intent(out), optional :: arnk
    -
    4403 real(real64), intent(out), target, optional, dimension(:) :: work
    -
    4404 integer(int32), intent(out), optional :: olwork
    -
    4405 class(errors), intent(inout), optional, target :: err
    -
    4406 end subroutine
    -
    4407
    -
    4449 module subroutine solve_least_squares_vec_pvt_cmplx(a, b, ipvt, arnk, &
    -
    4450 work, olwork, rwork, err)
    -
    4451 complex(real64), intent(inout), dimension(:,:) :: a
    -
    4452 complex(real64), intent(inout), dimension(:) :: b
    -
    4453 integer(int32), intent(inout), target, optional, dimension(:) :: ipvt
    -
    4454 integer(int32), intent(out), optional :: arnk
    -
    4455 complex(real64), intent(out), target, optional, dimension(:) :: work
    -
    4456 integer(int32), intent(out), optional :: olwork
    -
    4457 real(real64), intent(out), target, optional, dimension(:) :: rwork
    -
    4458 class(errors), intent(inout), optional, target :: err
    -
    4459 end subroutine
    -
    4460
    -
    4499 module subroutine solve_least_squares_mtx_svd(a, b, s, arnk, work, olwork, err)
    -
    4500 real(real64), intent(inout), dimension(:,:) :: a, b
    -
    4501 integer(int32), intent(out), optional :: arnk
    -
    4502 real(real64), intent(out), target, optional, dimension(:) :: work, s
    -
    4503 integer(int32), intent(out), optional :: olwork
    -
    4504 class(errors), intent(inout), optional, target :: err
    -
    4505 end subroutine
    -
    4506
    -
    4549 module subroutine solve_least_squares_mtx_svd_cmplx(a, b, s, arnk, work, &
    -
    4550 olwork, rwork, err)
    -
    4551 complex(real64), intent(inout), dimension(:,:) :: a, b
    -
    4552 integer(int32), intent(out), optional :: arnk
    -
    4553 complex(real64), intent(out), target, optional, dimension(:) :: work
    -
    4554 real(real64), intent(out), target, optional, dimension(:) :: rwork, s
    -
    4555 integer(int32), intent(out), optional :: olwork
    -
    4556 class(errors), intent(inout), optional, target :: err
    -
    4557 end subroutine
    -
    4558
    -
    4595 module subroutine solve_least_squares_vec_svd(a, b, s, arnk, work, olwork, err)
    -
    4596 real(real64), intent(inout), dimension(:,:) :: a
    -
    4597 real(real64), intent(inout), dimension(:) :: b
    -
    4598 integer(int32), intent(out), optional :: arnk
    -
    4599 real(real64), intent(out), target, optional, dimension(:) :: work, s
    -
    4600 integer(int32), intent(out), optional :: olwork
    -
    4601 class(errors), intent(inout), optional, target :: err
    -
    4602 end subroutine
    -
    4603
    -
    4644 module subroutine solve_least_squares_vec_svd_cmplx(a, b, s, arnk, work, &
    -
    4645 olwork, rwork, err)
    -
    4646 complex(real64), intent(inout), dimension(:,:) :: a
    -
    4647 complex(real64), intent(inout), dimension(:) :: b
    -
    4648 integer(int32), intent(out), optional :: arnk
    -
    4649 complex(real64), intent(out), target, optional, dimension(:) :: work
    -
    4650 real(real64), intent(out), target, optional, dimension(:) :: rwork, s
    -
    4651 integer(int32), intent(out), optional :: olwork
    -
    4652 class(errors), intent(inout), optional, target :: err
    -
    4653 end subroutine
    -
    4654
    -
    4686 module subroutine mtx_inverse_dbl(a, iwork, work, olwork, err)
    -
    4687 real(real64), intent(inout), dimension(:,:) :: a
    -
    4688 integer(int32), intent(out), target, optional, dimension(:) :: iwork
    -
    4689 real(real64), intent(out), target, optional, dimension(:) :: work
    -
    4690 integer(int32), intent(out), optional :: olwork
    -
    4691 class(errors), intent(inout), optional, target :: err
    -
    4692 end subroutine
    -
    4693
    -
    4725 module subroutine mtx_inverse_cmplx(a, iwork, work, olwork, err)
    -
    4726 complex(real64), intent(inout), dimension(:,:) :: a
    -
    4727 integer(int32), intent(out), target, optional, dimension(:) :: iwork
    -
    4728 complex(real64), intent(out), target, optional, dimension(:) :: work
    -
    4729 integer(int32), intent(out), optional :: olwork
    -
    4730 class(errors), intent(inout), optional, target :: err
    -
    4731 end subroutine
    -
    4732
    -
    4770 module subroutine mtx_pinverse_dbl(a, ainv, tol, work, olwork, err)
    -
    4771 real(real64), intent(inout), dimension(:,:) :: a
    -
    4772 real(real64), intent(out), dimension(:,:) :: ainv
    -
    4773 real(real64), intent(in), optional :: tol
    -
    4774 real(real64), intent(out), target, dimension(:), optional :: work
    -
    4775 integer(int32), intent(out), optional :: olwork
    -
    4776 class(errors), intent(inout), optional, target :: err
    -
    4777 end subroutine
    -
    4778
    -
    4820 module subroutine mtx_pinverse_cmplx(a, ainv, tol, work, olwork, rwork, err)
    -
    4821 complex(real64), intent(inout), dimension(:,:) :: a
    -
    4822 complex(real64), intent(out), dimension(:,:) :: ainv
    -
    4823 real(real64), intent(in), optional :: tol
    -
    4824 complex(real64), intent(out), target, dimension(:), optional :: work
    -
    4825 integer(int32), intent(out), optional :: olwork
    -
    4826 real(real64), intent(out), target, dimension(:), optional :: rwork
    -
    4827 class(errors), intent(inout), optional, target :: err
    -
    4828 end subroutine
    -
    4829
    -
    4830end interface
    -
    4831
    -
    4832! ******************************************************************************
    -
    4833! LINALG_EIGEN.F90
    -
    4834! ------------------------------------------------------------------------------
    -
    4835interface
    -
    4836
    -
    4868 module subroutine eigen_symm(vecs, a, vals, work, olwork, err)
    -
    4869 logical, intent(in) :: vecs
    -
    4870 real(real64), intent(inout), dimension(:,:) :: a
    -
    4871 real(real64), intent(out), dimension(:) :: vals
    -
    4872 real(real64), intent(out), pointer, optional, dimension(:) :: work
    -
    4873 integer(int32), intent(out), optional :: olwork
    -
    4874 class(errors), intent(inout), optional, target :: err
    -
    4875 end subroutine
    -
    4876
    -
    4907 module subroutine eigen_asymm(a, vals, vecs, work, olwork, err)
    -
    4908 real(real64), intent(inout), dimension(:,:) :: a
    -
    4909 complex(real64), intent(out), dimension(:) :: vals
    -
    4910 complex(real64), intent(out), optional, dimension(:,:) :: vecs
    -
    4911 real(real64), intent(out), pointer, optional, dimension(:) :: work
    -
    4912 integer(int32), intent(out), optional :: olwork
    -
    4913 class(errors), intent(inout), optional, target :: err
    -
    4914 end subroutine
    -
    4915
    -
    4958 module subroutine eigen_gen(a, b, alpha, beta, vecs, work, olwork, err)
    -
    4959 real(real64), intent(inout), dimension(:,:) :: a, b
    -
    4960 complex(real64), intent(out), dimension(:) :: alpha
    -
    4961 real(real64), intent(out), optional, dimension(:) :: beta
    -
    4962 complex(real64), intent(out), optional, dimension(:,:) :: vecs
    -
    4963 real(real64), intent(out), optional, pointer, dimension(:) :: work
    -
    4964 integer(int32), intent(out), optional :: olwork
    -
    4965 class(errors), intent(inout), optional, target :: err
    -
    4966 end subroutine
    -
    4967
    -
    4998 module subroutine eigen_cmplx(a, vals, vecs, work, olwork, rwork, err)
    -
    4999 complex(real64), intent(inout), dimension(:,:) :: a
    -
    5000 complex(real64), intent(out), dimension(:) :: vals
    -
    5001 complex(real64), intent(out), optional, dimension(:,:) :: vecs
    -
    5002 complex(real64), intent(out), target, optional, dimension(:) :: work
    -
    5003 real(real64), intent(out), target, optional, dimension(:) :: rwork
    -
    5004 integer(int32), intent(out), optional :: olwork
    -
    5005 class(errors), intent(inout), optional, target :: err
    -
    5006 end subroutine
    -
    5007end interface
    +
    3724 module subroutine solve_qr_no_pivot_vec_cmplx(a, tau, b, work, olwork, err)
    +
    3725 complex(real64), intent(inout), dimension(:,:) :: a
    +
    3726 complex(real64), intent(in), dimension(:) :: tau
    +
    3727 complex(real64), intent(inout), dimension(:) :: b
    +
    3728 complex(real64), intent(out), target, optional, dimension(:) :: work
    +
    3729 integer(int32), intent(out), optional :: olwork
    +
    3730 class(errors), intent(inout), optional, target :: err
    +
    3731 end subroutine
    +
    3732
    +
    3764 module subroutine solve_qr_pivot_mtx(a, tau, jpvt, b, work, olwork, err)
    +
    3765 real(real64), intent(inout), dimension(:,:) :: a
    +
    3766 real(real64), intent(in), dimension(:) :: tau
    +
    3767 integer(int32), intent(in), dimension(:) :: jpvt
    +
    3768 real(real64), intent(inout), dimension(:,:) :: b
    +
    3769 real(real64), intent(out), target, optional, dimension(:) :: work
    +
    3770 integer(int32), intent(out), optional :: olwork
    +
    3771 class(errors), intent(inout), optional, target :: err
    +
    3772 end subroutine
    +
    3773
    +
    3805 module subroutine solve_qr_pivot_mtx_cmplx(a, tau, jpvt, b, work, olwork, err)
    +
    3806 complex(real64), intent(inout), dimension(:,:) :: a
    +
    3807 complex(real64), intent(in), dimension(:) :: tau
    +
    3808 integer(int32), intent(in), dimension(:) :: jpvt
    +
    3809 complex(real64), intent(inout), dimension(:,:) :: b
    +
    3810 complex(real64), intent(out), target, optional, dimension(:) :: work
    +
    3811 integer(int32), intent(out), optional :: olwork
    +
    3812 class(errors), intent(inout), optional, target :: err
    +
    3813 end subroutine
    +
    3814
    +
    3846 module subroutine solve_qr_pivot_vec(a, tau, jpvt, b, work, olwork, err)
    +
    3847 real(real64), intent(inout), dimension(:,:) :: a
    +
    3848 real(real64), intent(in), dimension(:) :: tau
    +
    3849 integer(int32), intent(in), dimension(:) :: jpvt
    +
    3850 real(real64), intent(inout), dimension(:) :: b
    +
    3851 real(real64), intent(out), target, optional, dimension(:) :: work
    +
    3852 integer(int32), intent(out), optional :: olwork
    +
    3853 class(errors), intent(inout), optional, target :: err
    +
    3854 end subroutine
    +
    3855
    +
    3887 module subroutine solve_qr_pivot_vec_cmplx(a, tau, jpvt, b, work, olwork, err)
    +
    3888 complex(real64), intent(inout), dimension(:,:) :: a
    +
    3889 complex(real64), intent(in), dimension(:) :: tau
    +
    3890 integer(int32), intent(in), dimension(:) :: jpvt
    +
    3891 complex(real64), intent(inout), dimension(:) :: b
    +
    3892 complex(real64), intent(out), target, optional, dimension(:) :: work
    +
    3893 integer(int32), intent(out), optional :: olwork
    +
    3894 class(errors), intent(inout), optional, target :: err
    +
    3895 end subroutine
    +
    3896
    +
    3915 module subroutine solve_cholesky_mtx(upper, a, b, err)
    +
    3916 logical, intent(in) :: upper
    +
    3917 real(real64), intent(in), dimension(:,:) :: a
    +
    3918 real(real64), intent(inout), dimension(:,:) :: b
    +
    3919 class(errors), intent(inout), optional, target :: err
    +
    3920 end subroutine
    +
    3921
    +
    3940 module subroutine solve_cholesky_mtx_cmplx(upper, a, b, err)
    +
    3941 logical, intent(in) :: upper
    +
    3942 complex(real64), intent(in), dimension(:,:) :: a
    +
    3943 complex(real64), intent(inout), dimension(:,:) :: b
    +
    3944 class(errors), intent(inout), optional, target :: err
    +
    3945 end subroutine
    +
    3946
    +
    3965 module subroutine solve_cholesky_vec(upper, a, b, err)
    +
    3966 logical, intent(in) :: upper
    +
    3967 real(real64), intent(in), dimension(:,:) :: a
    +
    3968 real(real64), intent(inout), dimension(:) :: b
    +
    3969 class(errors), intent(inout), optional, target :: err
    +
    3970 end subroutine
    +
    3971
    +
    3990 module subroutine solve_cholesky_vec_cmplx(upper, a, b, err)
    +
    3991 logical, intent(in) :: upper
    +
    3992 complex(real64), intent(in), dimension(:,:) :: a
    +
    3993 complex(real64), intent(inout), dimension(:) :: b
    +
    3994 class(errors), intent(inout), optional, target :: err
    +
    3995 end subroutine
    +
    3996
    +
    4028 module subroutine solve_least_squares_mtx(a, b, work, olwork, err)
    +
    4029 real(real64), intent(inout), dimension(:,:) :: a, b
    +
    4030 real(real64), intent(out), target, optional, dimension(:) :: work
    +
    4031 integer(int32), intent(out), optional :: olwork
    +
    4032 class(errors), intent(inout), optional, target :: err
    +
    4033 end subroutine
    +
    4034
    +
    4066 module subroutine solve_least_squares_mtx_cmplx(a, b, work, olwork, err)
    +
    4067 complex(real64), intent(inout), dimension(:,:) :: a, b
    +
    4068 complex(real64), intent(out), target, optional, dimension(:) :: work
    +
    4069 integer(int32), intent(out), optional :: olwork
    +
    4070 class(errors), intent(inout), optional, target :: err
    +
    4071 end subroutine
    +
    4072
    +
    4104 module subroutine solve_least_squares_vec(a, b, work, olwork, err)
    +
    4105 real(real64), intent(inout), dimension(:,:) :: a
    +
    4106 real(real64), intent(inout), dimension(:) :: b
    +
    4107 real(real64), intent(out), target, optional, dimension(:) :: work
    +
    4108 integer(int32), intent(out), optional :: olwork
    +
    4109 class(errors), intent(inout), optional, target :: err
    +
    4110 end subroutine
    +
    4111
    +
    4143 module subroutine solve_least_squares_vec_cmplx(a, b, work, olwork, err)
    +
    4144 complex(real64), intent(inout), dimension(:,:) :: a
    +
    4145 complex(real64), intent(inout), dimension(:) :: b
    +
    4146 complex(real64), intent(out), target, optional, dimension(:) :: work
    +
    4147 integer(int32), intent(out), optional :: olwork
    +
    4148 class(errors), intent(inout), optional, target :: err
    +
    4149 end subroutine
    +
    4150
    +
    4188 module subroutine solve_least_squares_mtx_pvt(a, b, ipvt, arnk, work, olwork, err)
    +
    4189 real(real64), intent(inout), dimension(:,:) :: a, b
    +
    4190 integer(int32), intent(inout), target, optional, dimension(:) :: ipvt
    +
    4191 integer(int32), intent(out), optional :: arnk
    +
    4192 real(real64), intent(out), target, optional, dimension(:) :: work
    +
    4193 integer(int32), intent(out), optional :: olwork
    +
    4194 class(errors), intent(inout), optional, target :: err
    +
    4195 end subroutine
    +
    4196
    +
    4238 module subroutine solve_least_squares_mtx_pvt_cmplx(a, b, ipvt, arnk, &
    +
    4239 work, olwork, rwork, err)
    +
    4240 complex(real64), intent(inout), dimension(:,:) :: a, b
    +
    4241 integer(int32), intent(inout), target, optional, dimension(:) :: ipvt
    +
    4242 integer(int32), intent(out), optional :: arnk
    +
    4243 complex(real64), intent(out), target, optional, dimension(:) :: work
    +
    4244 integer(int32), intent(out), optional :: olwork
    +
    4245 real(real64), intent(out), target, optional, dimension(:) :: rwork
    +
    4246 class(errors), intent(inout), optional, target :: err
    +
    4247 end subroutine
    +
    4248
    +
    4286 module subroutine solve_least_squares_vec_pvt(a, b, ipvt, arnk, work, olwork, err)
    +
    4287 real(real64), intent(inout), dimension(:,:) :: a
    +
    4288 real(real64), intent(inout), dimension(:) :: b
    +
    4289 integer(int32), intent(inout), target, optional, dimension(:) :: ipvt
    +
    4290 integer(int32), intent(out), optional :: arnk
    +
    4291 real(real64), intent(out), target, optional, dimension(:) :: work
    +
    4292 integer(int32), intent(out), optional :: olwork
    +
    4293 class(errors), intent(inout), optional, target :: err
    +
    4294 end subroutine
    +
    4295
    +
    4337 module subroutine solve_least_squares_vec_pvt_cmplx(a, b, ipvt, arnk, &
    +
    4338 work, olwork, rwork, err)
    +
    4339 complex(real64), intent(inout), dimension(:,:) :: a
    +
    4340 complex(real64), intent(inout), dimension(:) :: b
    +
    4341 integer(int32), intent(inout), target, optional, dimension(:) :: ipvt
    +
    4342 integer(int32), intent(out), optional :: arnk
    +
    4343 complex(real64), intent(out), target, optional, dimension(:) :: work
    +
    4344 integer(int32), intent(out), optional :: olwork
    +
    4345 real(real64), intent(out), target, optional, dimension(:) :: rwork
    +
    4346 class(errors), intent(inout), optional, target :: err
    +
    4347 end subroutine
    +
    4348
    +
    4387 module subroutine solve_least_squares_mtx_svd(a, b, s, arnk, work, olwork, err)
    +
    4388 real(real64), intent(inout), dimension(:,:) :: a, b
    +
    4389 integer(int32), intent(out), optional :: arnk
    +
    4390 real(real64), intent(out), target, optional, dimension(:) :: work, s
    +
    4391 integer(int32), intent(out), optional :: olwork
    +
    4392 class(errors), intent(inout), optional, target :: err
    +
    4393 end subroutine
    +
    4394
    +
    4437 module subroutine solve_least_squares_mtx_svd_cmplx(a, b, s, arnk, work, &
    +
    4438 olwork, rwork, err)
    +
    4439 complex(real64), intent(inout), dimension(:,:) :: a, b
    +
    4440 integer(int32), intent(out), optional :: arnk
    +
    4441 complex(real64), intent(out), target, optional, dimension(:) :: work
    +
    4442 real(real64), intent(out), target, optional, dimension(:) :: rwork, s
    +
    4443 integer(int32), intent(out), optional :: olwork
    +
    4444 class(errors), intent(inout), optional, target :: err
    +
    4445 end subroutine
    +
    4446
    +
    4483 module subroutine solve_least_squares_vec_svd(a, b, s, arnk, work, olwork, err)
    +
    4484 real(real64), intent(inout), dimension(:,:) :: a
    +
    4485 real(real64), intent(inout), dimension(:) :: b
    +
    4486 integer(int32), intent(out), optional :: arnk
    +
    4487 real(real64), intent(out), target, optional, dimension(:) :: work, s
    +
    4488 integer(int32), intent(out), optional :: olwork
    +
    4489 class(errors), intent(inout), optional, target :: err
    +
    4490 end subroutine
    +
    4491
    +
    4532 module subroutine solve_least_squares_vec_svd_cmplx(a, b, s, arnk, work, &
    +
    4533 olwork, rwork, err)
    +
    4534 complex(real64), intent(inout), dimension(:,:) :: a
    +
    4535 complex(real64), intent(inout), dimension(:) :: b
    +
    4536 integer(int32), intent(out), optional :: arnk
    +
    4537 complex(real64), intent(out), target, optional, dimension(:) :: work
    +
    4538 real(real64), intent(out), target, optional, dimension(:) :: rwork, s
    +
    4539 integer(int32), intent(out), optional :: olwork
    +
    4540 class(errors), intent(inout), optional, target :: err
    +
    4541 end subroutine
    +
    4542
    +
    4574 module subroutine mtx_inverse_dbl(a, iwork, work, olwork, err)
    +
    4575 real(real64), intent(inout), dimension(:,:) :: a
    +
    4576 integer(int32), intent(out), target, optional, dimension(:) :: iwork
    +
    4577 real(real64), intent(out), target, optional, dimension(:) :: work
    +
    4578 integer(int32), intent(out), optional :: olwork
    +
    4579 class(errors), intent(inout), optional, target :: err
    +
    4580 end subroutine
    +
    4581
    +
    4613 module subroutine mtx_inverse_cmplx(a, iwork, work, olwork, err)
    +
    4614 complex(real64), intent(inout), dimension(:,:) :: a
    +
    4615 integer(int32), intent(out), target, optional, dimension(:) :: iwork
    +
    4616 complex(real64), intent(out), target, optional, dimension(:) :: work
    +
    4617 integer(int32), intent(out), optional :: olwork
    +
    4618 class(errors), intent(inout), optional, target :: err
    +
    4619 end subroutine
    +
    4620
    +
    4658 module subroutine mtx_pinverse_dbl(a, ainv, tol, work, olwork, err)
    +
    4659 real(real64), intent(inout), dimension(:,:) :: a
    +
    4660 real(real64), intent(out), dimension(:,:) :: ainv
    +
    4661 real(real64), intent(in), optional :: tol
    +
    4662 real(real64), intent(out), target, dimension(:), optional :: work
    +
    4663 integer(int32), intent(out), optional :: olwork
    +
    4664 class(errors), intent(inout), optional, target :: err
    +
    4665 end subroutine
    +
    4666
    +
    4708 module subroutine mtx_pinverse_cmplx(a, ainv, tol, work, olwork, rwork, err)
    +
    4709 complex(real64), intent(inout), dimension(:,:) :: a
    +
    4710 complex(real64), intent(out), dimension(:,:) :: ainv
    +
    4711 real(real64), intent(in), optional :: tol
    +
    4712 complex(real64), intent(out), target, dimension(:), optional :: work
    +
    4713 integer(int32), intent(out), optional :: olwork
    +
    4714 real(real64), intent(out), target, dimension(:), optional :: rwork
    +
    4715 class(errors), intent(inout), optional, target :: err
    +
    4716 end subroutine
    +
    4717
    +
    4718end interface
    +
    4719
    +
    4720! ******************************************************************************
    +
    4721! LINALG_EIGEN.F90
    +
    4722! ------------------------------------------------------------------------------
    +
    4723interface
    +
    4724
    +
    4756 module subroutine eigen_symm(vecs, a, vals, work, olwork, err)
    +
    4757 logical, intent(in) :: vecs
    +
    4758 real(real64), intent(inout), dimension(:,:) :: a
    +
    4759 real(real64), intent(out), dimension(:) :: vals
    +
    4760 real(real64), intent(out), pointer, optional, dimension(:) :: work
    +
    4761 integer(int32), intent(out), optional :: olwork
    +
    4762 class(errors), intent(inout), optional, target :: err
    +
    4763 end subroutine
    +
    4764
    +
    4795 module subroutine eigen_asymm(a, vals, vecs, work, olwork, err)
    +
    4796 real(real64), intent(inout), dimension(:,:) :: a
    +
    4797 complex(real64), intent(out), dimension(:) :: vals
    +
    4798 complex(real64), intent(out), optional, dimension(:,:) :: vecs
    +
    4799 real(real64), intent(out), pointer, optional, dimension(:) :: work
    +
    4800 integer(int32), intent(out), optional :: olwork
    +
    4801 class(errors), intent(inout), optional, target :: err
    +
    4802 end subroutine
    +
    4803
    +
    4846 module subroutine eigen_gen(a, b, alpha, beta, vecs, work, olwork, err)
    +
    4847 real(real64), intent(inout), dimension(:,:) :: a, b
    +
    4848 complex(real64), intent(out), dimension(:) :: alpha
    +
    4849 real(real64), intent(out), optional, dimension(:) :: beta
    +
    4850 complex(real64), intent(out), optional, dimension(:,:) :: vecs
    +
    4851 real(real64), intent(out), optional, pointer, dimension(:) :: work
    +
    4852 integer(int32), intent(out), optional :: olwork
    +
    4853 class(errors), intent(inout), optional, target :: err
    +
    4854 end subroutine
    +
    4855
    +
    4886 module subroutine eigen_cmplx(a, vals, vecs, work, olwork, rwork, err)
    +
    4887 complex(real64), intent(inout), dimension(:,:) :: a
    +
    4888 complex(real64), intent(out), dimension(:) :: vals
    +
    4889 complex(real64), intent(out), optional, dimension(:,:) :: vecs
    +
    4890 complex(real64), intent(out), target, optional, dimension(:) :: work
    +
    4891 real(real64), intent(out), target, optional, dimension(:) :: rwork
    +
    4892 integer(int32), intent(out), optional :: olwork
    +
    4893 class(errors), intent(inout), optional, target :: err
    +
    4894 end subroutine
    +
    4895end interface
    +
    4896
    +
    4897! ******************************************************************************
    +
    4898! LINALG_SORTING.F90
    +
    4899! ------------------------------------------------------------------------------
    +
    4900interface
    +
    4901
    +
    4916 module subroutine sort_dbl_array(x, ascend)
    +
    4917 real(real64), intent(inout), dimension(:) :: x
    +
    4918 logical, intent(in), optional :: ascend
    +
    4919 end subroutine
    +
    4920
    +
    4945 module subroutine sort_dbl_array_ind(x, ind, ascend, err)
    +
    4946 real(real64), intent(inout), dimension(:) :: x
    +
    4947 integer(int32), intent(inout), dimension(:) :: ind
    +
    4948 logical, intent(in), optional :: ascend
    +
    4949 class(errors), intent(inout), optional, target :: err
    +
    4950 end subroutine
    +
    4951
    +
    4968 module subroutine sort_cmplx_array(x, ascend)
    +
    4969 complex(real64), intent(inout), dimension(:) :: x
    +
    4970 logical, intent(in), optional :: ascend
    +
    4971 end subroutine
    +
    4972
    +
    5002 module subroutine sort_cmplx_array_ind(x, ind, ascend, err)
    +
    5003 complex(real64), intent(inout), dimension(:) :: x
    +
    5004 integer(int32), intent(inout), dimension(:) :: ind
    +
    5005 logical, intent(in), optional :: ascend
    +
    5006 class(errors), intent(inout), optional, target :: err
    +
    5007 end subroutine
    5008
    -
    5009! ******************************************************************************
    -
    5010! LINALG_SORTING.F90
    -
    5011! ------------------------------------------------------------------------------
    -
    5012interface
    -
    5013
    -
    5028 module subroutine sort_dbl_array(x, ascend)
    -
    5029 real(real64), intent(inout), dimension(:) :: x
    -
    5030 logical, intent(in), optional :: ascend
    -
    5031 end subroutine
    -
    5032
    -
    5057 module subroutine sort_dbl_array_ind(x, ind, ascend, err)
    -
    5058 real(real64), intent(inout), dimension(:) :: x
    -
    5059 integer(int32), intent(inout), dimension(:) :: ind
    -
    5060 logical, intent(in), optional :: ascend
    -
    5061 class(errors), intent(inout), optional, target :: err
    -
    5062 end subroutine
    -
    5063
    -
    5080 module subroutine sort_cmplx_array(x, ascend)
    -
    5081 complex(real64), intent(inout), dimension(:) :: x
    -
    5082 logical, intent(in), optional :: ascend
    -
    5083 end subroutine
    -
    5084
    -
    5114 module subroutine sort_cmplx_array_ind(x, ind, ascend, err)
    -
    5115 complex(real64), intent(inout), dimension(:) :: x
    -
    5116 integer(int32), intent(inout), dimension(:) :: ind
    -
    5117 logical, intent(in), optional :: ascend
    -
    5118 class(errors), intent(inout), optional, target :: err
    -
    5119 end subroutine
    -
    5120
    -
    5140 module subroutine sort_eigen_cmplx(vals, vecs, ascend, err)
    -
    5141 complex(real64), intent(inout), dimension(:) :: vals
    -
    5142 complex(real64), intent(inout), dimension(:,:) :: vecs
    -
    5143 logical, intent(in), optional :: ascend
    -
    5144 class(errors), intent(inout), optional, target :: err
    -
    5145 end subroutine
    -
    5146
    -
    5166 module subroutine sort_eigen_dbl(vals, vecs, ascend, err)
    -
    5167 real(real64), intent(inout), dimension(:) :: vals
    -
    5168 real(real64), intent(inout), dimension(:,:) :: vecs
    -
    5169 logical, intent(in), optional :: ascend
    -
    5170 class(errors), intent(inout), optional, target :: err
    -
    5171 end subroutine
    -
    5172
    -
    5173end interface
    -
    5174
    -
    5175end module
    -
    Computes the Cholesky factorization of a symmetric, positive definite matrix.
    -
    Computes the rank 1 downdate to a Cholesky factored matrix (upper triangular).
    -
    Computes the rank 1 update to a Cholesky factored matrix (upper triangular).
    +
    5028 module subroutine sort_eigen_cmplx(vals, vecs, ascend, err)
    +
    5029 complex(real64), intent(inout), dimension(:) :: vals
    +
    5030 complex(real64), intent(inout), dimension(:,:) :: vecs
    +
    5031 logical, intent(in), optional :: ascend
    +
    5032 class(errors), intent(inout), optional, target :: err
    +
    5033 end subroutine
    +
    5034
    +
    5054 module subroutine sort_eigen_dbl(vals, vecs, ascend, err)
    +
    5055 real(real64), intent(inout), dimension(:) :: vals
    +
    5056 real(real64), intent(inout), dimension(:,:) :: vecs
    +
    5057 logical, intent(in), optional :: ascend
    +
    5058 class(errors), intent(inout), optional, target :: err
    +
    5059 end subroutine
    +
    5060
    +
    5061end interface
    +
    5062
    +
    5063end module
    +
    Computes the Cholesky factorization of a symmetric, positive definite matrix.
    +
    Computes the rank 1 downdate to a Cholesky factored matrix (upper triangular).
    +
    Computes the rank 1 update to a Cholesky factored matrix (upper triangular).
    Computes the determinant of a square matrix.
    Multiplies a diagonal matrix with another matrix or array.
    -
    Computes the eigenvalues, and optionally the eigenvectors, of a matrix.
    +
    Computes the eigenvalues, and optionally the eigenvectors, of a matrix.
    Extracts the L and U matrices from the condensed [L\U] storage format used by the lu_factor.
    -
    Forms the full M-by-M orthogonal matrix Q from the elementary reflectors returned by the base QR fact...
    +
    Forms the full M-by-M orthogonal matrix Q from the elementary reflectors returned by the base QR fact...
    Computes the LU factorization of an M-by-N matrix.
    -
    Computes the inverse of a square matrix.
    +
    Computes the inverse of a square matrix.
    Performs the matrix operation: .
    -
    Computes the Moore-Penrose pseudo-inverse of a M-by-N matrix using the singular value decomposition o...
    +
    Computes the Moore-Penrose pseudo-inverse of a M-by-N matrix using the singular value decomposition o...
    Computes the rank of a matrix.
    -
    Multiplies a general matrix by the orthogonal matrix Q from a QR factorization.
    -
    Multiplies a general matrix by the orthogonal matrix Z from an RZ factorization.
    +
    Multiplies a general matrix by the orthogonal matrix Q from a QR factorization.
    +
    Multiplies a general matrix by the orthogonal matrix Z from an RZ factorization.
    Computes the QR factorization of an M-by-N matrix.
    -
    Computes the rank 1 update to an M-by-N QR factored matrix A (M >= N) where A = Q * R,...
    +
    Computes the rank 1 update to an M-by-N QR factored matrix A (M >= N) where A = Q * R,...
    Performs the rank-1 update to matrix A such that: , where is an M-by-N matrix, is a scalar,...
    Multiplies a vector by the reciprocal of a real scalar.
    -
    Factors an upper trapezoidal matrix by means of orthogonal transformations such that A = R * Z = (R 0...
    -
    Solves a system of Cholesky factored equations.
    -
    Solves the overdetermined or underdetermined system (A*X = B) of M equations of N unknowns,...
    -
    Solves the overdetermined or underdetermined system (A*X = B) of M equations of N unknowns using a si...
    -
    Solves the overdetermined or underdetermined system (A*X = B) of M equations of N unknowns.
    -
    Solves a system of LU-factored equations.
    -
    Solves a system of M QR-factored equations of N unknowns.
    -
    Solves a triangular system of equations.
    -
    Sorts an array.
    -
    Computes the singular value decomposition of a matrix A. The SVD is defined as: A = U * S * V**T,...
    +
    Factors an upper trapezoidal matrix by means of orthogonal transformations such that A = R * Z = (R 0...
    +
    Solves a system of Cholesky factored equations.
    +
    Solves the overdetermined or underdetermined system (A*X = B) of M equations of N unknowns,...
    +
    Solves the overdetermined or underdetermined system (A*X = B) of M equations of N unknowns using a si...
    +
    Solves the overdetermined or underdetermined system (A*X = B) of M equations of N unknowns.
    +
    Solves a system of LU-factored equations.
    +
    Solves a system of M QR-factored equations of N unknowns.
    +
    Solves a triangular system of equations.
    +
    Sorts an array.
    +
    Computes the singular value decomposition of a matrix A. The SVD is defined as: A = U * S * V**T,...
    Swaps the contents of two arrays.
    Computes the trace of a matrix (the sum of the main diagonal elements).
    Computes the triangular matrix operation: , or , where A is a triangular matrix.
    diff --git a/doc/html/linalg__immutable_8f90_source.html b/doc/html/linalg__immutable_8f90_source.html index f14704de..0fe1aaed 100644 --- a/doc/html/linalg__immutable_8f90_source.html +++ b/doc/html/linalg__immutable_8f90_source.html @@ -845,23 +845,23 @@
    1030 end function
    1031
    1032end module
    -
    Computes the Cholesky factorization of a symmetric, positive definite matrix.
    -
    Computes the rank 1 downdate to a Cholesky factored matrix (upper triangular).
    -
    Computes the rank 1 update to a Cholesky factored matrix (upper triangular).
    +
    Computes the Cholesky factorization of a symmetric, positive definite matrix.
    +
    Computes the rank 1 downdate to a Cholesky factored matrix (upper triangular).
    +
    Computes the rank 1 update to a Cholesky factored matrix (upper triangular).
    Computes the determinant of a square matrix.
    Multiplies a diagonal matrix with another matrix or array.
    -
    Computes the eigenvalues, and optionally the eigenvectors, of a matrix.
    +
    Computes the eigenvalues, and optionally the eigenvectors, of a matrix.
    Extracts the L and U matrices from the condensed [L\U] storage format used by the lu_factor.
    -
    Forms the full M-by-M orthogonal matrix Q from the elementary reflectors returned by the base QR fact...
    +
    Forms the full M-by-M orthogonal matrix Q from the elementary reflectors returned by the base QR fact...
    Computes the LU factorization of an M-by-N matrix.
    -
    Computes the inverse of a square matrix.
    -
    Computes the Moore-Penrose pseudo-inverse of a M-by-N matrix using the singular value decomposition o...
    +
    Computes the inverse of a square matrix.
    +
    Computes the Moore-Penrose pseudo-inverse of a M-by-N matrix using the singular value decomposition o...
    Computes the QR factorization of an M-by-N matrix.
    -
    Computes the rank 1 update to an M-by-N QR factored matrix A (M >= N) where A = Q * R,...
    +
    Computes the rank 1 update to an M-by-N QR factored matrix A (M >= N) where A = Q * R,...
    Performs the rank-1 update to matrix A such that: , where is an M-by-N matrix, is a scalar,...
    -
    Solves a triangular system of equations.
    -
    Sorts an array.
    -
    Computes the singular value decomposition of a matrix A. The SVD is defined as: A = U * S * V**T,...
    +
    Solves a triangular system of equations.
    +
    Sorts an array.
    +
    Computes the singular value decomposition of a matrix A. The SVD is defined as: A = U * S * V**T,...
    Computes the eigenvalues and eigenvectors (right) of a general N-by-N matrix.
    Computes the LU factorization of a square matrix. Notice, partial row pivoting is utilized.
    Computes the matrix operation: C = A * B, where A is a diagonal matrix.
    diff --git a/src/linalg_core.f90 b/src/linalg_core.f90 index dd94296a..27d23ff0 100644 --- a/src/linalg_core.f90 +++ b/src/linalg_core.f90 @@ -224,7 +224,7 @@ module linalg_core !! !! @par Usage !! The following example illustrates the use of the diagonal matrix -!! multiplication routine to compute the S * V**T component of a singular +!! multiplication routine to compute the \f$ S V^T \f$ component of a singular !! value decomposition. !! @code{.f90} !! program example @@ -839,6 +839,83 @@ module linalg_core !> @brief Forms the full M-by-M orthogonal matrix Q from the elementary !! reflectors returned by the base QR factorization algorithm. !! +!! @par Syntax 1 +!! @code{.f90} +!! subroutine form_qr(real(real64) r(:,:), real(real64) tau(:), real(real64) q(:,:), optional real(real64) work(:), optional integer(int32) olwork, optional class(errors) err) +!! subroutine form_qr(complex(real64) r(:,:), complex(real64) tau(:), complex(real64) q(:,:), optional complex(real64) work(:), optional integer(int32) olwork, optional class(errors) err) +!! @endcode +!! +!! @param[in,out] r On input, an M-by-N matrix where the elements below the +!! diagonal contain the elementary reflectors generated from the QR +!! factorization. On and above the diagonal, the matrix contains the +!! matrix R. On output, the elements below the diagonal are zeroed such +!! that the remaining matrix is simply the M-by-N matrix R. +!! @param[in] tau A MIN(M, N)-element array containing the scalar factors of +!! each elementary reflector defined in @p r. +!! @param[out] q An M-by-M matrix where the full orthogonal matrix Q will be +!! written. In the event that M > N, Q may be supplied as M-by-N, and +!! therefore only return the useful submatrix Q1 (Q = [Q1, Q2]) as the +!! factorization can be written as Q * R = [Q1, Q2] * [R1; 0]. +!! @param[out] work An optional input, that if provided, prevents any local +!! memory allocation. If not provided, the memory required is allocated +!! within. If provided, the length of the array must be at least +!! @p olwork. +!! @param[out] olwork An optional output used to determine workspace size. +!! If supplied, the routine determines the optimal size for @p work, and +!! returns without performing any actual calculations. +!! @param[in,out] err An optional errors-based object that if provided can be +!! used to retrieve information relating to any errors encountered during +!! execution. If not provided, a default implementation of the errors +!! class is used internally to provide error handling. Possible errors and +!! warning messages that may be encountered are as follows. +!! - LA_ARRAY_SIZE_ERROR: Occurs if any of the input arrays are not sized +!! appropriately. +!! - LA_OUT_OF_MEMORY_ERROR: Occurs if local memory must be allocated, and +!! there is insufficient memory available. +!! +!! @par Notes +!! This routine utilizes the LAPACK routine DORGQR (ZUNQR in the complex case). +!! +!! @par Syntax 2 +!! @code{.f90} +!! subroutine form_qr(real(real64) r(:,:), real(real64) tau(:), integer(int32) pvt(:), real(real64) q(:,:), real(real64) p(:,:), optional real(real64) work(:), optional integer(int32) olwork, optional class(errors) err) +!! subroutine form_qr(complex(real64) r(:,:), complex(real64) tau(:), integer(int32) pvt(:), complex(real64) q(:,:), complex(real64) p(:,:), optional complex(real64) work(:), optional integer(int32) olwork, optional class(errors) err) +!! @endcode +!! +!! @param[in,out] r On input, an M-by-N matrix where the elements below the +!! diagonal contain the elementary reflectors generated from the QR +!! factorization. On and above the diagonal, the matrix contains the +!! matrix R. On output, the elements below the diagonal are zeroed such +!! that the remaining matrix is simply the M-by-N matrix R. +!! @param[in] tau A MIN(M, N)-element array containing the scalar factors of +!! each elementary reflector defined in @p r. +!! @param[in] pvt An N-element column pivot array as returned by the QR +!! factorization. +!! @param[out] q An M-by-M matrix where the full orthogonal matrix Q will be +!! written. In the event that M > N, Q may be supplied as M-by-N, and +!! therefore only return the useful submatrix Q1 (Q = [Q1, Q2]) as the +!! factorization can be written as Q * R = [Q1, Q2] * [R1; 0]. +!! @param[out] p An N-by-N matrix where the pivot matrix will be written. +!! @param[out] work An optional input, that if provided, prevents any local +!! memory allocation. If not provided, the memory required is allocated +!! within. If provided, the length of the array must be at least +!! @p olwork. +!! @param[out] olwork An optional output used to determine workspace size. +!! If supplied, the routine determines the optimal size for @p work, and +!! returns without performing any actual calculations. +!! @param[in,out] err An optional errors-based object that if provided can be +!! used to retrieve information relating to any errors encountered during +!! execution. If not provided, a default implementation of the errors +!! class is used internally to provide error handling. Possible errors and +!! warning messages that may be encountered are as follows. +!! - LA_ARRAY_SIZE_ERROR: Occurs if any of the input arrays are not sized +!! appropriately. +!! - LA_OUT_OF_MEMORY_ERROR: Occurs if local memory must be allocated, and +!! there is insufficient memory available. +!! +!! @par Notes +!! This routine utilizes the LAPACK routine DORGQR (ZUNQR in the complex case). +!! !! @par Usage !! The following example illustrates how to explicitly form the Q and R !! matrices from the output of qr_factor, and then use the resulting @@ -922,10 +999,87 @@ module linalg_core !> @brief Multiplies a general matrix by the orthogonal matrix Q from a QR !! factorization. !! +!! @par Syntax 1 +!! Multiplies a general matrix by the orthogonal matrix \f$ Q \f$ from a QR +!! factorization such that: \f$ C = op(Q) C \f$, or \f$ C = C op(Q) \f$. +!! @code{.f90} +!! subroutine mult_qr(logical lside, logical trans, real(real64) a(:,:), real(real64) tau(:), real(real64) c(:,:), optional real(real64) work(:), optional integer(int32) olwork, optional class(errors) err) +!! subroutine mult_qr(logical lside, logical trans, complex(real64) a(:,:), complex(real64) tau(:), complex(real64) c(:,:), optional complex(real64) work(:), optional integer(int32) olwork, optional class(errors) err) +!! @endcode +!! +!! +!! @param[in] lside Set to true to apply \f$ Q \f$ or \f$ Q^T \f$ from the left; +!! else, set to false to apply \f$ Q \f$ or \f$ Q^T \f$ from the right. +!! @param[in] trans Set to true to apply \f$ Q^T \f$; else, set to false. +!! @param[in] a On input, an LDA-by-K matrix containing the elementary +!! reflectors output from the QR factorization. If @p lside is set to +!! true, LDA = M, and M >= K >= 0; else, if @p lside is set to false, +!! LDA = N, and N >= K >= 0. Notice, the contents of this matrix are +!! restored on exit. +!! @param[in] tau A K-element array containing the scalar factors of each +!! elementary reflector defined in @p a. +!! @param[in,out] c On input, the M-by-N matrix C. On output, the product +!! of the orthogonal matrix Q and the original matrix C. +!! @param[out] work An optional input, that if provided, prevents any local +!! memory allocation. If not provided, the memory required is allocated +!! within. If provided, the length of the array must be at least +!! @p olwork. +!! @param[in,out] olwork An optional output used to determine workspace size. +!! If supplied, the routine determines the optimal size for @p work, and +!! returns without performing any actual calculations. +!! @param[out] err An optional errors-based object that if provided can be +!! used to retrieve information relating to any errors encountered during +!! execution. If not provided, a default implementation of the errors +!! class is used internally to provide error handling. Possible errors and +!! warning messages that may be encountered are as follows. +!! - LA_ARRAY_SIZE_ERROR: Occurs if any of the input arrays are not sized +!! appropriately. +!! - LA_OUT_OF_MEMORY_ERROR: Occurs if local memory must be allocated, and +!! there is insufficient memory available. +!! +!! @par Notes +!! This routine utilizes the LAPACK routine DORMQR (ZUNMQR in the complex case). +!! +!! @par Syntax 2 +!! Multiplies a vector by the orthogonal matrix \f$ Q \f$ from a QR +!! factorization such that: \f$ C = op(Q) C\f$. +!! @code{.f90} +!! subroutine mult_qr(logical trans, real(real64) a(:,:), real(real64) tau(:), real(real64) c(:), optional real(real64) work(:), optional integer(int32) olwork, optional class(errors) err) +!! subroutine mult_qr(logical trans, complex(real64) a(:,:), complex(real64) tau(:), complex(real64) c(:), optional complex(real64) work(:), optional integer(int32) olwork, optional class(errors) err) +!! @endcode +!! +!! @param[in] trans Set to true to apply \f$ Q^T \f$; else, set to false. +!! @param[in] a On input, an M-by-K matrix containing the elementary +!! reflectors output from the QR factorization. Notice, the contents of +!! this matrix are restored on exit. +!! @param[in] tau A K-element array containing the scalar factors of each +!! elementary reflector defined in @p a. +!! @param[in,out] c On input, the M-element vector C. On output, the +!! product of the orthogonal matrix Q and the original vector C. +!! @param[out] work An optional input, that if provided, prevents any local +!! memory allocation. If not provided, the memory required is allocated +!! within. If provided, the length of the array must be at least +!! @p olwork. +!! @param[out] olwork An optional output used to determine workspace size. +!! If supplied, the routine determines the optimal size for @p work, and +!! returns without performing any actual calculations. +!! @param[in,out] err An optional errors-based object that if provided can be +!! used to retrieve information relating to any errors encountered during +!! execution. If not provided, a default implementation of the errors +!! class is used internally to provide error handling. Possible errors and +!! warning messages that may be encountered are as follows. +!! - LA_ARRAY_SIZE_ERROR: Occurs if any of the input arrays are not sized +!! appropriately. +!! - LA_OUT_OF_MEMORY_ERROR: Occurs if local memory must be allocated, and +!! there is insufficient memory available. +!! +!! @par Notes +!! This routine utilizes the LAPACK routine DORMQR (ZUNMQR in the complex case). +!! !! @par Usage !! The following example illustrates how to perform the multiplication -!! Q**T * B when solving a system of QR factored equations without -!! explicitly forming the matrix Q. +!! \f$ Q^T B \f$ when solving a system of QR factored equations without +!! explicitly forming the matrix \f$ Q \f$. !! @code{.f90} !! program example !! use iso_fortran_env, only : real64, int32 @@ -2357,40 +2511,7 @@ module subroutine qr_factor_pivot_cmplx(a, tau, jpvt, work, olwork, rwork, & real(real64), intent(out), target, dimension(:), optional :: rwork class(errors), intent(inout), optional, target :: err end subroutine - - !> @brief Forms the full M-by-M orthogonal matrix Q from the elementary - !! reflectors returned by the base QR factorization algorithm. - !! - !! @param[in,out] r On input, an M-by-N matrix where the elements below the - !! diagonal contain the elementary reflectors generated from the QR - !! factorization. On and above the diagonal, the matrix contains the - !! matrix R. On output, the elements below the diagonal are zeroed such - !! that the remaining matrix is simply the M-by-N matrix R. - !! @param[in] tau A MIN(M, N)-element array containing the scalar factors of - !! each elementary reflector defined in @p r. - !! @param[out] q An M-by-M matrix where the full orthogonal matrix Q will be - !! written. In the event that M > N, Q may be supplied as M-by-N, and - !! therefore only return the useful submatrix Q1 (Q = [Q1, Q2]) as the - !! factorization can be written as Q * R = [Q1, Q2] * [R1; 0]. - !! @param[out] work An optional input, that if provided, prevents any local - !! memory allocation. If not provided, the memory required is allocated - !! within. If provided, the length of the array must be at least - !! @p olwork. - !! @param[out] olwork An optional output used to determine workspace size. - !! If supplied, the routine determines the optimal size for @p work, and - !! returns without performing any actual calculations. - !! @param[out] err An optional errors-based object that if provided can be - !! used to retrieve information relating to any errors encountered during - !! execution. If not provided, a default implementation of the errors - !! class is used internally to provide error handling. Possible errors and - !! warning messages that may be encountered are as follows. - !! - LA_ARRAY_SIZE_ERROR: Occurs if any of the input arrays are not sized - !! appropriately. - !! - LA_OUT_OF_MEMORY_ERROR: Occurs if local memory must be allocated, and - !! there is insufficient memory available. - !! - !! @par Notes - !! This routine utilizes the LAPACK routine DORGQR. + module subroutine form_qr_no_pivot(r, tau, q, work, olwork, err) real(real64), intent(inout), dimension(:,:) :: r real(real64), intent(in), dimension(:) :: tau @@ -2399,40 +2520,7 @@ module subroutine form_qr_no_pivot(r, tau, q, work, olwork, err) integer(int32), intent(out), optional :: olwork class(errors), intent(inout), optional, target :: err end subroutine - - !> @brief Forms the full M-by-M orthogonal matrix Q from the elementary - !! reflectors returned by the base QR factorization algorithm. - !! - !! @param[in,out] r On input, an M-by-N matrix where the elements below the - !! diagonal contain the elementary reflectors generated from the QR - !! factorization. On and above the diagonal, the matrix contains the - !! matrix R. On output, the elements below the diagonal are zeroed such - !! that the remaining matrix is simply the M-by-N matrix R. - !! @param[in] tau A MIN(M, N)-element array containing the scalar factors of - !! each elementary reflector defined in @p r. - !! @param[out] q An M-by-M matrix where the full orthogonal matrix Q will be - !! written. In the event that M > N, Q may be supplied as M-by-N, and - !! therefore only return the useful submatrix Q1 (Q = [Q1, Q2]) as the - !! factorization can be written as Q * R = [Q1, Q2] * [R1; 0]. - !! @param[out] work An optional input, that if provided, prevents any local - !! memory allocation. If not provided, the memory required is allocated - !! within. If provided, the length of the array must be at least - !! @p olwork. - !! @param[out] olwork An optional output used to determine workspace size. - !! If supplied, the routine determines the optimal size for @p work, and - !! returns without performing any actual calculations. - !! @param[out] err An optional errors-based object that if provided can be - !! used to retrieve information relating to any errors encountered during - !! execution. If not provided, a default implementation of the errors - !! class is used internally to provide error handling. Possible errors and - !! warning messages that may be encountered are as follows. - !! - LA_ARRAY_SIZE_ERROR: Occurs if any of the input arrays are not sized - !! appropriately. - !! - LA_OUT_OF_MEMORY_ERROR: Occurs if local memory must be allocated, and - !! there is insufficient memory available. - !! - !! @par Notes - !! This routine utilizes the LAPACK routine ZUNGQR. + module subroutine form_qr_no_pivot_cmplx(r, tau, q, work, olwork, err) complex(real64), intent(inout), dimension(:,:) :: r complex(real64), intent(in), dimension(:) :: tau @@ -2441,43 +2529,7 @@ module subroutine form_qr_no_pivot_cmplx(r, tau, q, work, olwork, err) integer(int32), intent(out), optional :: olwork class(errors), intent(inout), optional, target :: err end subroutine - - !> @brief Forms the full M-by-M orthogonal matrix Q from the elementary - !! reflectors returned by the base QR factorization algorithm. - !! - !! @param[in,out] r On input, an M-by-N matrix where the elements below the - !! diagonal contain the elementary reflectors generated from the QR - !! factorization. On and above the diagonal, the matrix contains the - !! matrix R. On output, the elements below the diagonal are zeroed such - !! that the remaining matrix is simply the M-by-N matrix R. - !! @param[in] tau A MIN(M, N)-element array containing the scalar factors of - !! each elementary reflector defined in @p r. - !! @param[in] pvt An N-element column pivot array as returned by the QR - !! factorization. - !! @param[out] q An M-by-M matrix where the full orthogonal matrix Q will be - !! written. In the event that M > N, Q may be supplied as M-by-N, and - !! therefore only return the useful submatrix Q1 (Q = [Q1, Q2]) as the - !! factorization can be written as Q * R = [Q1, Q2] * [R1; 0]. - !! @param[out] p An N-by-N matrix where the pivot matrix will be written. - !! @param[out] work An optional input, that if provided, prevents any local - !! memory allocation. If not provided, the memory required is allocated - !! within. If provided, the length of the array must be at least - !! @p olwork. - !! @param[out] olwork An optional output used to determine workspace size. - !! If supplied, the routine determines the optimal size for @p work, and - !! returns without performing any actual calculations. - !! @param[out] err An optional errors-based object that if provided can be - !! used to retrieve information relating to any errors encountered during - !! execution. If not provided, a default implementation of the errors - !! class is used internally to provide error handling. Possible errors and - !! warning messages that may be encountered are as follows. - !! - LA_ARRAY_SIZE_ERROR: Occurs if any of the input arrays are not sized - !! appropriately. - !! - LA_OUT_OF_MEMORY_ERROR: Occurs if local memory must be allocated, and - !! there is insufficient memory available. - !! - !! @par Notes - !! This routine utilizes the LAPACK routine DORGQR. + module subroutine form_qr_pivot(r, tau, pvt, q, p, work, olwork, err) real(real64), intent(inout), dimension(:,:) :: r real(real64), intent(in), dimension(:) :: tau @@ -2488,42 +2540,6 @@ module subroutine form_qr_pivot(r, tau, pvt, q, p, work, olwork, err) class(errors), intent(inout), optional, target :: err end subroutine - !> @brief Forms the full M-by-M orthogonal matrix Q from the elementary - !! reflectors returned by the base QR factorization algorithm. - !! - !! @param[in,out] r On input, an M-by-N matrix where the elements below the - !! diagonal contain the elementary reflectors generated from the QR - !! factorization. On and above the diagonal, the matrix contains the - !! matrix R. On output, the elements below the diagonal are zeroed such - !! that the remaining matrix is simply the M-by-N matrix R. - !! @param[in] tau A MIN(M, N)-element array containing the scalar factors of - !! each elementary reflector defined in @p r. - !! @param[in] pvt An N-element column pivot array as returned by the QR - !! factorization. - !! @param[out] q An M-by-M matrix where the full orthogonal matrix Q will be - !! written. In the event that M > N, Q may be supplied as M-by-N, and - !! therefore only return the useful submatrix Q1 (Q = [Q1, Q2]) as the - !! factorization can be written as Q * R = [Q1, Q2] * [R1; 0]. - !! @param[out] p An N-by-N matrix where the pivot matrix will be written. - !! @param[out] work An optional input, that if provided, prevents any local - !! memory allocation. If not provided, the memory required is allocated - !! within. If provided, the length of the array must be at least - !! @p olwork. - !! @param[out] olwork An optional output used to determine workspace size. - !! If supplied, the routine determines the optimal size for @p work, and - !! returns without performing any actual calculations. - !! @param[out] err An optional errors-based object that if provided can be - !! used to retrieve information relating to any errors encountered during - !! execution. If not provided, a default implementation of the errors - !! class is used internally to provide error handling. Possible errors and - !! warning messages that may be encountered are as follows. - !! - LA_ARRAY_SIZE_ERROR: Occurs if any of the input arrays are not sized - !! appropriately. - !! - LA_OUT_OF_MEMORY_ERROR: Occurs if local memory must be allocated, and - !! there is insufficient memory available. - !! - !! @par Notes - !! This routine utilizes the LAPACK routine ZUNGQR. module subroutine form_qr_pivot_cmplx(r, tau, pvt, q, p, work, olwork, err) complex(real64), intent(inout), dimension(:,:) :: r complex(real64), intent(in), dimension(:) :: tau @@ -2533,41 +2549,7 @@ module subroutine form_qr_pivot_cmplx(r, tau, pvt, q, p, work, olwork, err) integer(int32), intent(out), optional :: olwork class(errors), intent(inout), optional, target :: err end subroutine - - !> @brief Multiplies a general matrix by the orthogonal matrix Q from a QR - !! factorization such that: C = op(Q) * C, or C = C * op(Q). - !! - !! @param[in] lside Set to true to apply Q or Q**T from the left; else, set - !! to false to apply Q or Q**T from the right. - !! @param[in] trans Set to true to apply Q**T; else, set to false. - !! @param[in] a On input, an LDA-by-K matrix containing the elementary - !! reflectors output from the QR factorization. If @p lside is set to - !! true, LDA = M, and M >= K >= 0; else, if @p lside is set to false, - !! LDA = N, and N >= K >= 0. Notice, the contents of this matrix are - !! restored on exit. - !! @param[in] tau A K-element array containing the scalar factors of each - !! elementary reflector defined in @p a. - !! @param[in,out] c On input, the M-by-N matrix C. On output, the product - !! of the orthogonal matrix Q and the original matrix C. - !! @param[out] work An optional input, that if provided, prevents any local - !! memory allocation. If not provided, the memory required is allocated - !! within. If provided, the length of the array must be at least - !! @p olwork. - !! @param[out] olwork An optional output used to determine workspace size. - !! If supplied, the routine determines the optimal size for @p work, and - !! returns without performing any actual calculations. - !! @param[out] err An optional errors-based object that if provided can be - !! used to retrieve information relating to any errors encountered during - !! execution. If not provided, a default implementation of the errors - !! class is used internally to provide error handling. Possible errors and - !! warning messages that may be encountered are as follows. - !! - LA_ARRAY_SIZE_ERROR: Occurs if any of the input arrays are not sized - !! appropriately. - !! - LA_OUT_OF_MEMORY_ERROR: Occurs if local memory must be allocated, and - !! there is insufficient memory available. - !! - !! @par Notes - !! This routine utilizes the LAPACK routine DORMQR. + module subroutine mult_qr_mtx(lside, trans, a, tau, c, work, olwork, err) logical, intent(in) :: lside, trans real(real64), intent(in), dimension(:) :: tau @@ -2576,41 +2558,7 @@ module subroutine mult_qr_mtx(lside, trans, a, tau, c, work, olwork, err) integer(int32), intent(out), optional :: olwork class(errors), intent(inout), optional, target :: err end subroutine - - !> @brief Multiplies a general matrix by the orthogonal matrix Q from a QR - !! factorization such that: C = op(Q) * C, or C = C * op(Q). - !! - !! @param[in] lside Set to true to apply Q or Q**T from the left; else, set - !! to false to apply Q or Q**T from the right. - !! @param[in] trans Set to true to apply Q**H; else, set to false. - !! @param[in] a On input, an LDA-by-K matrix containing the elementary - !! reflectors output from the QR factorization. If @p lside is set to - !! true, LDA = M, and M >= K >= 0; else, if @p lside is set to false, - !! LDA = N, and N >= K >= 0. Notice, the contents of this matrix are - !! restored on exit. - !! @param[in] tau A K-element array containing the scalar factors of each - !! elementary reflector defined in @p a. - !! @param[in,out] c On input, the M-by-N matrix C. On output, the product - !! of the orthogonal matrix Q and the original matrix C. - !! @param[out] work An optional input, that if provided, prevents any local - !! memory allocation. If not provided, the memory required is allocated - !! within. If provided, the length of the array must be at least - !! @p olwork. - !! @param[out] olwork An optional output used to determine workspace size. - !! If supplied, the routine determines the optimal size for @p work, and - !! returns without performing any actual calculations. - !! @param[out] err An optional errors-based object that if provided can be - !! used to retrieve information relating to any errors encountered during - !! execution. If not provided, a default implementation of the errors - !! class is used internally to provide error handling. Possible errors and - !! warning messages that may be encountered are as follows. - !! - LA_ARRAY_SIZE_ERROR: Occurs if any of the input arrays are not sized - !! appropriately. - !! - LA_OUT_OF_MEMORY_ERROR: Occurs if local memory must be allocated, and - !! there is insufficient memory available. - !! - !! @par Notes - !! This routine utilizes the LAPACK routine ZUNMQR. + module subroutine mult_qr_mtx_cmplx(lside, trans, a, tau, c, work, olwork, err) logical, intent(in) :: lside, trans complex(real64), intent(in), dimension(:) :: tau @@ -2619,37 +2567,7 @@ module subroutine mult_qr_mtx_cmplx(lside, trans, a, tau, c, work, olwork, err) integer(int32), intent(out), optional :: olwork class(errors), intent(inout), optional, target :: err end subroutine - - !> @brief Multiplies a vector by the orthogonal matrix Q from a QR - !! factorization such that: C = op(Q) * C. - !! - !! @param[in] trans Set to true to apply Q**T; else, set to false. - !! @param[in] a On input, an M-by-K matrix containing the elementary - !! reflectors output from the QR factorization. Notice, the contents of - !! this matrix are restored on exit. - !! @param[in] tau A K-element array containing the scalar factors of each - !! elementary reflector defined in @p a. - !! @param[in,out] c On input, the M-element vector C. On output, the - !! product of the orthogonal matrix Q and the original vector C. - !! @param[out] work An optional input, that if provided, prevents any local - !! memory allocation. If not provided, the memory required is allocated - !! within. If provided, the length of the array must be at least - !! @p olwork. - !! @param[out] olwork An optional output used to determine workspace size. - !! If supplied, the routine determines the optimal size for @p work, and - !! returns without performing any actual calculations. - !! @param[out] err An optional errors-based object that if provided can be - !! used to retrieve information relating to any errors encountered during - !! execution. If not provided, a default implementation of the errors - !! class is used internally to provide error handling. Possible errors and - !! warning messages that may be encountered are as follows. - !! - LA_ARRAY_SIZE_ERROR: Occurs if any of the input arrays are not sized - !! appropriately. - !! - LA_OUT_OF_MEMORY_ERROR: Occurs if local memory must be allocated, and - !! there is insufficient memory available. - !! - !! @par Notes - !! This routine is based upon the LAPACK routine DORMQR. + module subroutine mult_qr_vec(trans, a, tau, c, work, olwork, err) logical, intent(in) :: trans real(real64), intent(inout), dimension(:,:) :: a @@ -2659,37 +2577,7 @@ module subroutine mult_qr_vec(trans, a, tau, c, work, olwork, err) integer(int32), intent(out), optional :: olwork class(errors), intent(inout), optional, target :: err end subroutine - - !> @brief Multiplies a vector by the orthogonal matrix Q from a QR - !! factorization such that: C = op(Q) * C. - !! - !! @param[in] trans Set to true to apply Q**H; else, set to false. - !! @param[in] a On input, an M-by-K matrix containing the elementary - !! reflectors output from the QR factorization. Notice, the contents of - !! this matrix are restored on exit. - !! @param[in] tau A K-element array containing the scalar factors of each - !! elementary reflector defined in @p a. - !! @param[in,out] c On input, the M-element vector C. On output, the - !! product of the orthogonal matrix Q and the original vector C. - !! @param[out] work An optional input, that if provided, prevents any local - !! memory allocation. If not provided, the memory required is allocated - !! within. If provided, the length of the array must be at least - !! @p olwork. - !! @param[out] olwork An optional output used to determine workspace size. - !! If supplied, the routine determines the optimal size for @p work, and - !! returns without performing any actual calculations. - !! @param[out] err An optional errors-based object that if provided can be - !! used to retrieve information relating to any errors encountered during - !! execution. If not provided, a default implementation of the errors - !! class is used internally to provide error handling. Possible errors and - !! warning messages that may be encountered are as follows. - !! - LA_ARRAY_SIZE_ERROR: Occurs if any of the input arrays are not sized - !! appropriately. - !! - LA_OUT_OF_MEMORY_ERROR: Occurs if local memory must be allocated, and - !! there is insufficient memory available. - !! - !! @par Notes - !! This routine is based upon the LAPACK routine DORMQR. + module subroutine mult_qr_vec_cmplx(trans, a, tau, c, work, olwork, err) logical, intent(in) :: trans complex(real64), intent(inout), dimension(:,:) :: a From 68748e0f015ab6ccc7b92130d4b2865b52a2f9a8 Mon Sep 17 00:00:00 2001 From: jchristopherson Date: Wed, 14 Dec 2022 05:58:07 -0600 Subject: [PATCH 17/65] Update documentation --- doc/html/annotated.html | 2 +- ...rfacelinalg__core_1_1cholesky__factor.html | 24 +- ...lg__core_1_1cholesky__rank1__downdate.html | 26 +- ...nalg__core_1_1cholesky__rank1__update.html | 24 +- ...erfacelinalg__core_1_1diag__mtx__mult.html | 2 +- doc/html/interfacelinalg__core_1_1eigen.html | 4 +- .../interfacelinalg__core_1_1form__lu.html | 2 +- .../interfacelinalg__core_1_1form__qr.html | 2 +- .../interfacelinalg__core_1_1lu__factor.html | 2 +- ...interfacelinalg__core_1_1mtx__inverse.html | 4 +- ...nterfacelinalg__core_1_1mtx__pinverse.html | 4 +- .../interfacelinalg__core_1_1mult__qr.html | 2 +- .../interfacelinalg__core_1_1mult__rz.html | 2 +- .../interfacelinalg__core_1_1qr__factor.html | 2 +- ...facelinalg__core_1_1qr__rank1__update.html | 31 +- .../interfacelinalg__core_1_1rz__factor.html | 2 +- ...erfacelinalg__core_1_1solve__cholesky.html | 8 +- ...linalg__core_1_1solve__least__squares.html | 4 +- ...__core_1_1solve__least__squares__full.html | 4 +- ...g__core_1_1solve__least__squares__svd.html | 4 +- .../interfacelinalg__core_1_1solve__lu.html | 4 +- .../interfacelinalg__core_1_1solve__qr.html | 4 +- ...lg__core_1_1solve__triangular__system.html | 4 +- doc/html/interfacelinalg__core_1_1sort.html | 2 +- doc/html/interfacelinalg__core_1_1svd.html | 4 +- doc/html/linalg__c__api_8f90_source.html | 28 +- doc/html/linalg__core_8f90_source.html | 2014 ++++++++--------- doc/html/linalg__immutable_8f90_source.html | 20 +- doc/html/namespacelinalg__core.html | 2 +- doc/html/namespaces.html | 2 +- src/linalg_core.f90 | 385 ++-- 31 files changed, 1302 insertions(+), 1322 deletions(-) diff --git a/doc/html/annotated.html b/doc/html/annotated.html index 6a9b3aaf..11653014 100644 --- a/doc/html/annotated.html +++ b/doc/html/annotated.html @@ -119,7 +119,7 @@  Cmult_qrMultiplies a general matrix by the orthogonal matrix Q from a QR factorization  Cmult_rzMultiplies a general matrix by the orthogonal matrix Z from an RZ factorization  Cqr_factorComputes the QR factorization of an M-by-N matrix - Cqr_rank1_updateComputes the rank 1 update to an M-by-N QR factored matrix A (M >= N) where A = Q * R, and A1 = A + U * V**T such that A1 = Q1 * R1 + Cqr_rank1_updateComputes the rank 1 update to an M-by-N QR factored matrix A (M >= N) where \( A = Q R \), and \( A1 = A + U V^T \) such that \( A1 = Q1 R1 \)  Crank1_updatePerforms the rank-1 update to matrix A such that: \( A = \alpha X Y^T + A \), where \( A \) is an M-by-N matrix, \( \alpha \)is a scalar, \( X \) is an M-element array, and \( Y \) is an N-element array. In the event that \( Y \) is complex, \( Y^H \) is used instead of \( Y^T \)  Crecip_mult_arrayMultiplies a vector by the reciprocal of a real scalar  Crz_factorFactors an upper trapezoidal matrix by means of orthogonal transformations such that A = R * Z = (R 0) * Z. Z is an orthogonal matrix of dimension N-by-N, and R is an M-by-M upper triangular matrix diff --git a/doc/html/interfacelinalg__core_1_1cholesky__factor.html b/doc/html/interfacelinalg__core_1_1cholesky__factor.html index a554e194..fed9b632 100644 --- a/doc/html/interfacelinalg__core_1_1cholesky__factor.html +++ b/doc/html/interfacelinalg__core_1_1cholesky__factor.html @@ -107,6 +107,22 @@ More...

    Detailed Description

    Computes the Cholesky factorization of a symmetric, positive definite matrix.

    +
    Syntax
    subroutine cholesky_factor(real(real64) a(:,:), optional logical upper, optional class(errors) err)
    +
    subroutine cholesky_factor(complex(real64) a(:,:), optional logical upper, optional class(errors) err)
    +
    +
    Parameters
    + + + + +
    [in,out]aOn input, the N-by-N matrix to factor. On output, the factored matrix is returned in either the upper or lower triangular portion of the matrix, dependent upon the value of upper.
    [in]upperAn optional input that, if specified, provides control over whether the factorization is computed as \( A = U^T U \) (set to true), or as \( A = L L^T \) (set to false). The default value is true such that \( A = U^T U \).
    [in,out]errAn optional errors-based object that if provided can be used to retrieve information relating to any errors encountered during execution. If not provided, a default implementation of the errors class is used internally to provide error handling. Possible errors and warning messages that may be encountered are as follows.
      +
    • LA_ARRAY_SIZE_ERROR: Occurs if a is not square.
    • +
    • LA_MATRIX_FORMAT_ERROR: Occurs if a is not positive definite.
    • +
    +
    +
    +
    +
    Notes
    This routine utilizes the LAPACK routine DPOTRF (ZPOTRF in the complex case).
    Usage
    The following example illustrates the solution of a positive-definite system of equations via Cholesky factorization.
    program example
    use iso_fortran_env, only : real64, int32
    @@ -157,9 +173,9 @@
    print '(A)', "Cholesky Solution (Manual Approach): X = "
    print '(F8.4)', (bu(i), i = 1, size(bu))
    end program
    -
    Computes the Cholesky factorization of a symmetric, positive definite matrix.
    -
    Solves a system of Cholesky factored equations.
    -
    Solves a triangular system of equations.
    +
    Computes the Cholesky factorization of a symmetric, positive definite matrix.
    +
    Solves a system of Cholesky factored equations.
    +
    Solves a triangular system of equations.
    Provides a set of common linear algebra routines.
    Definition: linalg_core.f90:15
    The above program produces the following output.
    Cholesky Solution: X =
    239.5833
    @@ -171,7 +187,7 @@
    10.3333
    -

    Definition at line 1322 of file linalg_core.f90.

    +

    Definition at line 1393 of file linalg_core.f90.


    The documentation for this interface was generated from the following file: diff --git a/doc/html/interfacelinalg__core_1_1cholesky__rank1__downdate.html b/doc/html/interfacelinalg__core_1_1cholesky__rank1__downdate.html index 31c03bfe..0d245bd3 100644 --- a/doc/html/interfacelinalg__core_1_1cholesky__rank1__downdate.html +++ b/doc/html/interfacelinalg__core_1_1cholesky__rank1__downdate.html @@ -107,6 +107,26 @@ More...

    Detailed Description

    Computes the rank 1 downdate to a Cholesky factored matrix (upper triangular).

    +
    Syntax
    subroutine cholesky_rank1_downdate(real(real64) r(:,:), real(real64) u(:), optional real(real64) work(:), optional class(errors) err)
    +
    subroutine cholesky_rank1_downdate(complex(real64) r(:,:), complex(real64) u(:), optional complex(real64) work(:), optional class(errors) err)
    +
    +
    Parameters
    + + + + + +
    [in,out]rOn input, the N-by-N upper triangular matrix R. On output, the updated matrix R1.
    [in,out]uOn input, the N-element update vector U. On output, the rotation sines used to transform R to R1.
    [out]workAn optional argument that if supplied prevents local memory allocation. If provided, the array must have at least N elements. Additionally, this workspace array is used to contain the rotation cosines used to transform R to R1.
    [in,out]errAn optional errors-based object that if provided can be used to retrieve information relating to any errors encountered during execution. If not provided, a default implementation of the errors class is used internally to provide error handling. Possible errors and warning messages that may be encountered are as follows.
      +
    • LA_ARRAY_SIZE_ERROR: Occurs if any of the input array sizes are incorrect.
    • +
    • LA_OUT_OF_MEMORY_ERROR: Occurs if local memory must be allocated, and there is insufficient memory available.
    • +
    • LA_MATRIX_FORMAT_ERROR: Occurs if the downdated matrix is not positive definite.
    • +
    • LA_SINGULAR_MATRIX_ERROR: Occurs if r is singular.
    • +
    +
    +
    +
    +
    Notes
    This routine utilizes the QRUPDATE routine DCH1DN (ZCH1DN in the complex case).
    +
    See Also
    Source
    Usage
    The following example illustrates the use of the rank 1 Cholesky downdate, and compares the results to factoring the original rank 1 downdated matrix.
    program example
    use iso_fortran_env, only : real64, int32
    use linalg_factor, only : cholesky_factor, cholesky_rank1_downdate
    @@ -154,8 +174,8 @@
    print *, ad(i,:)
    end do
    end program
    -
    Computes the Cholesky factorization of a symmetric, positive definite matrix.
    -
    Computes the rank 1 downdate to a Cholesky factored matrix (upper triangular).
    +
    Computes the Cholesky factorization of a symmetric, positive definite matrix.
    +
    Computes the rank 1 downdate to a Cholesky factored matrix (upper triangular).
    Performs the rank-1 update to matrix A such that: , where is an M-by-N matrix, is a scalar,...
    Provides a set of common linear algebra routines.
    Definition: linalg_core.f90:15
    The above program produces the following output.
    Downdating the Factored Form:
    @@ -168,7 +188,7 @@
    0.0000000000000000 0.0000000000000000 3.0000000000000000
    -

    Definition at line 1463 of file linalg_core.f90.

    +

    Definition at line 1599 of file linalg_core.f90.


    The documentation for this interface was generated from the following file: diff --git a/doc/html/interfacelinalg__core_1_1cholesky__rank1__update.html b/doc/html/interfacelinalg__core_1_1cholesky__rank1__update.html index 78bb7648..58fe63a6 100644 --- a/doc/html/interfacelinalg__core_1_1cholesky__rank1__update.html +++ b/doc/html/interfacelinalg__core_1_1cholesky__rank1__update.html @@ -107,6 +107,24 @@ More...

    Detailed Description

    Computes the rank 1 update to a Cholesky factored matrix (upper triangular).

    +
    Syntax
    subroutine cholesky_rank1_update(real(real64) r(:,:), real(real64) u(:), optional real(real64) work(:), optional class(errors) err)
    +
    subroutine cholesky_rank1_update(complex(real64) r(:,:), complex(real64) u(:), optional complex(real64) work(:), optional class(errors) err)
    +
    +
    Parameters
    + + + + + +
    [in,out]rOn input, the N-by-N upper triangular matrix R. On output, the updated matrix R1.
    [in,out]uOn input, the N-element update vector U. On output, the rotation sines used to transform R to R1.
    [out]workAn optional argument that if supplied prevents local memory allocation. If provided, the array must have at least N elements. Additionally, this workspace array is used to contain the rotation cosines used to transform R to R1.
    [in,out]errAn optional errors-based object that if provided can be used to retrieve information relating to any errors encountered during execution. If not provided, a default implementation of the errors class is used internally to provide error handling. Possible errors and warning messages that may be encountered are as follows.
      +
    • LA_ARRAY_SIZE_ERROR: Occurs if any of the input array sizes are incorrect.
    • +
    • LA_OUT_OF_MEMORY_ERROR: Occurs if local memory must be allocated, and there is insufficient memory available.
    • +
    +
    +
    +
    +
    Notes
    This routine utilizes the QRUPDATE routine DCH1UP (ZCH1UP in the complex case).
    +
    See Also
    Source
    Usage
    The following example illustrates the use of the rank 1 Cholesky update, and compares the results to factoring the original rank 1 updated matrix.
    program example
    use iso_fortran_env, only : real64, int32
    @@ -150,8 +168,8 @@
    print *, au(i,:)
    end do
    end program
    -
    Computes the Cholesky factorization of a symmetric, positive definite matrix.
    -
    Computes the rank 1 update to a Cholesky factored matrix (upper triangular).
    +
    Computes the Cholesky factorization of a symmetric, positive definite matrix.
    +
    Computes the rank 1 update to a Cholesky factored matrix (upper triangular).
    Performs the rank-1 update to matrix A such that: , where is an M-by-N matrix, is a scalar,...
    Provides a set of common linear algebra routines.
    Definition: linalg_core.f90:15
    The above program produces the following output.
    Updating the Factored Form:
    @@ -164,7 +182,7 @@
    0.0000000000000000 0.0000000000000000 6.6989384530323557
    -

    Definition at line 1390 of file linalg_core.f90.

    +

    Definition at line 1492 of file linalg_core.f90.


    The documentation for this interface was generated from the following file: diff --git a/doc/html/interfacelinalg__core_1_1diag__mtx__mult.html b/doc/html/interfacelinalg__core_1_1diag__mtx__mult.html index 1c150469..f92e5820 100644 --- a/doc/html/interfacelinalg__core_1_1diag__mtx__mult.html +++ b/doc/html/interfacelinalg__core_1_1diag__mtx__mult.html @@ -194,7 +194,7 @@
    end do
    end program
    Multiplies a diagonal matrix with another matrix or array.
    -
    Computes the singular value decomposition of a matrix A. The SVD is defined as: A = U * S * V**T,...
    +
    Computes the singular value decomposition of a matrix A. The SVD is defined as: A = U * S * V**T,...
    Provides a set of common linear algebra routines.
    Definition: linalg_core.f90:15
    The above program produces the following output.
    U =
    -0.47411577501825380 -0.81850539032073777 -0.32444284226152509
    diff --git a/doc/html/interfacelinalg__core_1_1eigen.html b/doc/html/interfacelinalg__core_1_1eigen.html index 57ad2e95..73625571 100644 --- a/doc/html/interfacelinalg__core_1_1eigen.html +++ b/doc/html/interfacelinalg__core_1_1eigen.html @@ -164,7 +164,7 @@
    print '(F10.3)', (real(modeshapes(j,i)), j = 1, size(natfreq))
    end do
    end program
    -
    Computes the eigenvalues, and optionally the eigenvectors, of a matrix.
    +
    Computes the eigenvalues, and optionally the eigenvectors, of a matrix.
    Provides a set of common linear algebra routines.
    Definition: linalg_core.f90:15
    The above program produces the following output.
    Modal Information:
    Mode 1: (232.9225 Hz)
    @@ -187,7 +187,7 @@ -

    Definition at line 2217 of file linalg_core.f90.

    +

    Definition at line 2353 of file linalg_core.f90.


    The documentation for this interface was generated from the following file: diff --git a/doc/html/interfacelinalg__core_1_1form__lu.html b/doc/html/interfacelinalg__core_1_1form__lu.html index 171399d0..9b3c7d3a 100644 --- a/doc/html/interfacelinalg__core_1_1form__lu.html +++ b/doc/html/interfacelinalg__core_1_1form__lu.html @@ -199,7 +199,7 @@
    end program
    Extracts the L and U matrices from the condensed [L\U] storage format used by the lu_factor.
    Computes the LU factorization of an M-by-N matrix.
    -
    Solves a triangular system of equations.
    +
    Solves a triangular system of equations.
    Provides a set of common linear algebra routines.
    Definition: linalg_core.f90:15
    The above program produces the following output.
    LU Solution: X =
    0.3333
    diff --git a/doc/html/interfacelinalg__core_1_1form__qr.html b/doc/html/interfacelinalg__core_1_1form__qr.html index 37412277..591dcf66 100644 --- a/doc/html/interfacelinalg__core_1_1form__qr.html +++ b/doc/html/interfacelinalg__core_1_1form__qr.html @@ -204,7 +204,7 @@
    end program
    Forms the full M-by-M orthogonal matrix Q from the elementary reflectors returned by the base QR fact...
    Computes the QR factorization of an M-by-N matrix.
    -
    Solves a triangular system of equations.
    +
    Solves a triangular system of equations.
    Provides a set of common linear algebra routines.
    Definition: linalg_core.f90:15
    The above program produces the following output.
    QR Solution: X =
    0.3333
    diff --git a/doc/html/interfacelinalg__core_1_1lu__factor.html b/doc/html/interfacelinalg__core_1_1lu__factor.html index bf3cc919..9150e7d9 100644 --- a/doc/html/interfacelinalg__core_1_1lu__factor.html +++ b/doc/html/interfacelinalg__core_1_1lu__factor.html @@ -167,7 +167,7 @@
    print '(F8.4)', (b(i), i = 1, size(b))
    end program
    Computes the LU factorization of an M-by-N matrix.
    -
    Solves a system of LU-factored equations.
    +
    Solves a system of LU-factored equations.
    Provides a set of common linear algebra routines.
    Definition: linalg_core.f90:15
    The program generates the following output.
    LU Solution: X =
    0.3333
    diff --git a/doc/html/interfacelinalg__core_1_1mtx__inverse.html b/doc/html/interfacelinalg__core_1_1mtx__inverse.html index 99d60057..7a62727a 100644 --- a/doc/html/interfacelinalg__core_1_1mtx__inverse.html +++ b/doc/html/interfacelinalg__core_1_1mtx__inverse.html @@ -143,7 +143,7 @@
    print *, c(i,:)
    end do
    end program
    -
    Computes the inverse of a square matrix.
    +
    Computes the inverse of a square matrix.
    Provides a set of common linear algebra routines.
    Definition: linalg_core.f90:15
    The above program produces the following output.
    Inverse:
    -1.7777777777777777 0.88888888888888884 -0.11111111111111110
    @@ -155,7 +155,7 @@
    1.7763568394002505E-015 -8.8817841970012523E-016 1.0000000000000000
    -

    Definition at line 2062 of file linalg_core.f90.

    +

    Definition at line 2198 of file linalg_core.f90.


    The documentation for this interface was generated from the following file: diff --git a/doc/html/interfacelinalg__core_1_1mtx__pinverse.html b/doc/html/interfacelinalg__core_1_1mtx__pinverse.html index a4684f0c..c0ea44de 100644 --- a/doc/html/interfacelinalg__core_1_1mtx__pinverse.html +++ b/doc/html/interfacelinalg__core_1_1mtx__pinverse.html @@ -145,7 +145,7 @@
    print *, c(i,:)
    end do
    end program
    -
    Computes the Moore-Penrose pseudo-inverse of a M-by-N matrix using the singular value decomposition o...
    +
    Computes the Moore-Penrose pseudo-inverse of a M-by-N matrix using the singular value decomposition o...
    Provides a set of common linear algebra routines.
    Definition: linalg_core.f90:15
    The above program produces the following output.
    Inverse:
    1.0000000000000000 0.0000000000000000 0.0000000000000000
    @@ -155,7 +155,7 @@
    0.0000000000000000 0.99999999999999967
    -

    Definition at line 2123 of file linalg_core.f90.

    +

    Definition at line 2259 of file linalg_core.f90.


    The documentation for this interface was generated from the following file: diff --git a/doc/html/interfacelinalg__core_1_1mult__qr.html b/doc/html/interfacelinalg__core_1_1mult__qr.html index e6dce07c..76ad3f63 100644 --- a/doc/html/interfacelinalg__core_1_1mult__qr.html +++ b/doc/html/interfacelinalg__core_1_1mult__qr.html @@ -203,7 +203,7 @@
    end program
    Multiplies a general matrix by the orthogonal matrix Q from a QR factorization.
    Computes the QR factorization of an M-by-N matrix.
    -
    Solves a triangular system of equations.
    +
    Solves a triangular system of equations.
    Provides a set of common linear algebra routines.
    Definition: linalg_core.f90:15
    The above program produces the following output.
    QR Solution: X =
    0.3333
    diff --git a/doc/html/interfacelinalg__core_1_1mult__rz.html b/doc/html/interfacelinalg__core_1_1mult__rz.html index 71e08607..e940f2be 100644 --- a/doc/html/interfacelinalg__core_1_1mult__rz.html +++ b/doc/html/interfacelinalg__core_1_1mult__rz.html @@ -108,7 +108,7 @@

    Detailed Description

    Multiplies a general matrix by the orthogonal matrix Z from an RZ factorization.

    -

    Definition at line 1481 of file linalg_core.f90.

    +

    Definition at line 1617 of file linalg_core.f90.


    The documentation for this interface was generated from the following file: diff --git a/doc/html/interfacelinalg__core_1_1qr__factor.html b/doc/html/interfacelinalg__core_1_1qr__factor.html index f89ff6ee..db5d1d78 100644 --- a/doc/html/interfacelinalg__core_1_1qr__factor.html +++ b/doc/html/interfacelinalg__core_1_1qr__factor.html @@ -190,7 +190,7 @@
    ! tracking array).
    end program
    Computes the QR factorization of an M-by-N matrix.
    -
    Solves a system of M QR-factored equations of N unknowns.
    +
    Solves a system of M QR-factored equations of N unknowns.
    Provides a set of common linear algebra routines.
    Definition: linalg_core.f90:15
    The above program produces the following output.
    QR Solution: X =
    0.3333
    diff --git a/doc/html/interfacelinalg__core_1_1qr__rank1__update.html b/doc/html/interfacelinalg__core_1_1qr__rank1__update.html index 2832d52b..d76bdf55 100644 --- a/doc/html/interfacelinalg__core_1_1qr__rank1__update.html +++ b/doc/html/interfacelinalg__core_1_1qr__rank1__update.html @@ -103,10 +103,33 @@
    -

    Computes the rank 1 update to an M-by-N QR factored matrix A (M >= N) where A = Q * R, and A1 = A + U * V**T such that A1 = Q1 * R1. +

    Computes the rank 1 update to an M-by-N QR factored matrix A (M >= N) where \( A = Q R \), and \( A1 = A + U V^T \) such that \( A1 = Q1 R1 \). More...

    Detailed Description

    -

    Computes the rank 1 update to an M-by-N QR factored matrix A (M >= N) where A = Q * R, and A1 = A + U * V**T such that A1 = Q1 * R1.

    +

    Computes the rank 1 update to an M-by-N QR factored matrix A (M >= N) where \( A = Q R \), and \( A1 = A + U V^T \) such that \( A1 = Q1 R1 \).

    +
    Syntax
    subroutine qr_rank1_update(real(real64) q(:,:), real(real64) r(:,:), real(real64) u(:), real(real64) v(:), optional real(real64) work(:), optional class(errors) err)
    +
    subroutine qr_rank1_update(complex(real64) q(:,:), complex(real64) r(:,:), complex(real64) u(:), complex(real64) v(:), optional complex(real64) work(:), optional real(real64) rwork(:), optional class(errors) err)
    +
    +
    Parameters
    + + + + + + + + +
    [in,out]qOn input, the original M-by-K orthogonal matrix Q. On output, the updated matrix Q1.
    [in,out]rOn input, the M-by-N matrix R. On output, the updated matrix R1.
    [in,out]uOn input, the M-element U update vector. On output, the original content of the array is overwritten.
    [in,out]vOn input, the N-element V update vector. On output, the original content of the array is overwritten.
    [out]workAn optional argument that if supplied prevents local memory allocation. If provided, the array must have at least K elements.
    [out]rworkAn optional argument that if supplied prevents local memory allocation. If provided, the array must have at least K elements.
    [in,out]errAn optional errors-based object that if provided can be used to retrieve information relating to any errors encountered during execution. If not provided, a default implementation of the errors class is used internally to provide error handling. Possible errors and warning messages that may be encountered are as follows.
      +
    • LA_ARRAY_SIZE_ERROR: Occurs if any of the input arrays are not sized appropriately.
    • +
    • LA_OUT_OF_MEMORY_ERROR: Occurs if local memory must be allocated, and there is insufficient memory available.
    • +
    +
    +
    +
    +
    Remarks
    Notice, K must either be equal to M, or equal to N. In the event that K = N, only the submatrix Qa is updated. This is appropriate as the QR factorization for an overdetermined system can be written as follows:
      A = Q * R = [Qa, Qb] * [Ra]
    +                         [0 ]
    Note: Ra is upper triangular of dimension N-by-N.
    +
    Notes
    This routine utilizes the QRUPDATE routine ZQR1UP.
    +
    See Also
    Source
    Usage
    The following example illustrates a rank 1 update to a QR factored system. The results are compared to updating the original matrix, and then performing the factorization.
    program example
    use iso_fortran_env
    @@ -173,7 +196,7 @@
    end program
    Forms the full M-by-M orthogonal matrix Q from the elementary reflectors returned by the base QR fact...
    Computes the QR factorization of an M-by-N matrix.
    -
    Computes the rank 1 update to an M-by-N QR factored matrix A (M >= N) where A = Q * R,...
    +
    Computes the rank 1 update to an M-by-N QR factored matrix A (M >= N) where , and such that .
    Performs the rank-1 update to matrix A such that: , where is an M-by-N matrix, is a scalar,...
    Provides a set of common linear algebra routines.
    Definition: linalg_core.f90:15
    The above program produces the following output.
    Updating the Factored Form:
    @@ -196,7 +219,7 @@
    0.0000000000000000 0.0000000000000000 -5.2929341121113058
    -

    Definition at line 1247 of file linalg_core.f90.

    +

    Definition at line 1294 of file linalg_core.f90.


    The documentation for this interface was generated from the following file: diff --git a/doc/html/interfacelinalg__core_1_1rz__factor.html b/doc/html/interfacelinalg__core_1_1rz__factor.html index 9069624a..7089f2cd 100644 --- a/doc/html/interfacelinalg__core_1_1rz__factor.html +++ b/doc/html/interfacelinalg__core_1_1rz__factor.html @@ -108,7 +108,7 @@

    Detailed Description

    Factors an upper trapezoidal matrix by means of orthogonal transformations such that A = R * Z = (R 0) * Z. Z is an orthogonal matrix of dimension N-by-N, and R is an M-by-M upper triangular matrix.

    -

    Definition at line 1473 of file linalg_core.f90.

    +

    Definition at line 1609 of file linalg_core.f90.


    The documentation for this interface was generated from the following file: diff --git a/doc/html/interfacelinalg__core_1_1solve__cholesky.html b/doc/html/interfacelinalg__core_1_1solve__cholesky.html index 014017c0..a2af617e 100644 --- a/doc/html/interfacelinalg__core_1_1solve__cholesky.html +++ b/doc/html/interfacelinalg__core_1_1solve__cholesky.html @@ -157,9 +157,9 @@
    print '(A)', "Cholesky Solution (Manual Approach): X = "
    print '(F8.4)', (bu(i), i = 1, size(bu))
    end program
    -
    Computes the Cholesky factorization of a symmetric, positive definite matrix.
    -
    Solves a system of Cholesky factored equations.
    -
    Solves a triangular system of equations.
    +
    Computes the Cholesky factorization of a symmetric, positive definite matrix.
    +
    Solves a system of Cholesky factored equations.
    +
    Solves a triangular system of equations.
    Provides a set of common linear algebra routines.
    Definition: linalg_core.f90:15
    The above program produces the following output.
    Cholesky Solution: X =
    239.5833
    @@ -171,7 +171,7 @@
    10.3333
    -

    Definition at line 1839 of file linalg_core.f90.

    +

    Definition at line 1975 of file linalg_core.f90.


    The documentation for this interface was generated from the following file: diff --git a/doc/html/interfacelinalg__core_1_1solve__least__squares.html b/doc/html/interfacelinalg__core_1_1solve__least__squares.html index 2b76ceed..e2404dc9 100644 --- a/doc/html/interfacelinalg__core_1_1solve__least__squares.html +++ b/doc/html/interfacelinalg__core_1_1solve__least__squares.html @@ -139,14 +139,14 @@
    print '(A)', "Least Squares Solution: X = "
    print '(F9.5)', (b(i), i = 1, size(a, 2))
    end program
    -
    Solves the overdetermined or underdetermined system (A*X = B) of M equations of N unknowns.
    +
    Solves the overdetermined or underdetermined system (A*X = B) of M equations of N unknowns.
    Provides a set of common linear algebra routines.
    Definition: linalg_core.f90:15
    The above program produces the following output.
    Least Squares Solution: X =
    0.13158
    -0.57895
    -

    Definition at line 1893 of file linalg_core.f90.

    +

    Definition at line 2029 of file linalg_core.f90.


    The documentation for this interface was generated from the following file: diff --git a/doc/html/interfacelinalg__core_1_1solve__least__squares__full.html b/doc/html/interfacelinalg__core_1_1solve__least__squares__full.html index 9f618cc4..28cf39e5 100644 --- a/doc/html/interfacelinalg__core_1_1solve__least__squares__full.html +++ b/doc/html/interfacelinalg__core_1_1solve__least__squares__full.html @@ -139,14 +139,14 @@
    print '(A)', "Least Squares Solution: X = "
    print '(F9.5)', (b(i), i = 1, size(a, 2))
    end program
    -
    Solves the overdetermined or underdetermined system (A*X = B) of M equations of N unknowns,...
    +
    Solves the overdetermined or underdetermined system (A*X = B) of M equations of N unknowns,...
    Provides a set of common linear algebra routines.
    Definition: linalg_core.f90:15
    The above program produces the following output.
    Least Squares Solution: X =
    0.13158
    -0.57895
    -

    Definition at line 1948 of file linalg_core.f90.

    +

    Definition at line 2084 of file linalg_core.f90.


    The documentation for this interface was generated from the following file: diff --git a/doc/html/interfacelinalg__core_1_1solve__least__squares__svd.html b/doc/html/interfacelinalg__core_1_1solve__least__squares__svd.html index a69a04d5..d979c152 100644 --- a/doc/html/interfacelinalg__core_1_1solve__least__squares__svd.html +++ b/doc/html/interfacelinalg__core_1_1solve__least__squares__svd.html @@ -139,14 +139,14 @@
    print '(A)', "Least Squares Solution: X = "
    print '(F9.5)', (b(i), i = 1, size(a, 2))
    end program
    -
    Solves the overdetermined or underdetermined system (A*X = B) of M equations of N unknowns using a si...
    +
    Solves the overdetermined or underdetermined system (A*X = B) of M equations of N unknowns using a si...
    Provides a set of common linear algebra routines.
    Definition: linalg_core.f90:15
    The above program produces the following output.
    Least Squares Solution: X =
    0.13158
    -0.57895
    -

    Definition at line 2003 of file linalg_core.f90.

    +

    Definition at line 2139 of file linalg_core.f90.


    The documentation for this interface was generated from the following file: diff --git a/doc/html/interfacelinalg__core_1_1solve__lu.html b/doc/html/interfacelinalg__core_1_1solve__lu.html index d330743b..12fe8a89 100644 --- a/doc/html/interfacelinalg__core_1_1solve__lu.html +++ b/doc/html/interfacelinalg__core_1_1solve__lu.html @@ -146,7 +146,7 @@
    print '(F8.4)', (b(i), i = 1, size(b))
    end program
    Computes the LU factorization of an M-by-N matrix.
    -
    Solves a system of LU-factored equations.
    +
    Solves a system of LU-factored equations.
    Provides a set of common linear algebra routines.
    Definition: linalg_core.f90:15
    The program generates the following output.
    LU Solution: X =
    0.3333
    @@ -159,7 +159,7 @@ -

    Definition at line 1690 of file linalg_core.f90.

    +

    Definition at line 1826 of file linalg_core.f90.


    The documentation for this interface was generated from the following file: diff --git a/doc/html/interfacelinalg__core_1_1solve__qr.html b/doc/html/interfacelinalg__core_1_1solve__qr.html index 5c4c8909..fd6e307e 100644 --- a/doc/html/interfacelinalg__core_1_1solve__qr.html +++ b/doc/html/interfacelinalg__core_1_1solve__qr.html @@ -151,7 +151,7 @@
    ! tracking array).
    end program
    Computes the QR factorization of an M-by-N matrix.
    -
    Solves a system of M QR-factored equations of N unknowns.
    +
    Solves a system of M QR-factored equations of N unknowns.
    Provides a set of common linear algebra routines.
    Definition: linalg_core.f90:15
    The above program produces the following output.
    QR Solution: X =
    0.3333
    @@ -164,7 +164,7 @@ -

    Definition at line 1759 of file linalg_core.f90.

    +

    Definition at line 1895 of file linalg_core.f90.


    The documentation for this interface was generated from the following file: diff --git a/doc/html/interfacelinalg__core_1_1solve__triangular__system.html b/doc/html/interfacelinalg__core_1_1solve__triangular__system.html index 5186ec60..ce800ac0 100644 --- a/doc/html/interfacelinalg__core_1_1solve__triangular__system.html +++ b/doc/html/interfacelinalg__core_1_1solve__triangular__system.html @@ -158,7 +158,7 @@
    end program
    Extracts the L and U matrices from the condensed [L\U] storage format used by the lu_factor.
    Computes the LU factorization of an M-by-N matrix.
    -
    Solves a triangular system of equations.
    +
    Solves a triangular system of equations.
    Provides a set of common linear algebra routines.
    Definition: linalg_core.f90:15
    The above program produces the following output.
    LU Solution: X =
    0.3333
    @@ -166,7 +166,7 @@
    0.0000
    -

    Definition at line 1626 of file linalg_core.f90.

    +

    Definition at line 1762 of file linalg_core.f90.


    The documentation for this interface was generated from the following file: diff --git a/doc/html/interfacelinalg__core_1_1sort.html b/doc/html/interfacelinalg__core_1_1sort.html index 1daf8324..6ceb00b9 100644 --- a/doc/html/interfacelinalg__core_1_1sort.html +++ b/doc/html/interfacelinalg__core_1_1sort.html @@ -108,7 +108,7 @@

    Detailed Description

    Sorts an array.

    -

    Definition at line 2226 of file linalg_core.f90.

    +

    Definition at line 2362 of file linalg_core.f90.


    The documentation for this interface was generated from the following file: diff --git a/doc/html/interfacelinalg__core_1_1svd.html b/doc/html/interfacelinalg__core_1_1svd.html index d07b34d5..65efc04f 100644 --- a/doc/html/interfacelinalg__core_1_1svd.html +++ b/doc/html/interfacelinalg__core_1_1svd.html @@ -149,7 +149,7 @@
    end do
    end program
    Multiplies a diagonal matrix with another matrix or array.
    -
    Computes the singular value decomposition of a matrix A. The SVD is defined as: A = U * S * V**T,...
    +
    Computes the singular value decomposition of a matrix A. The SVD is defined as: A = U * S * V**T,...
    Provides a set of common linear algebra routines.
    Definition: linalg_core.f90:15
    The above program produces the following output.
    U =
    -0.47411577501825380 -0.81850539032073777 -0.32444284226152509
    @@ -167,7 +167,7 @@
    -1.0000000000000000 0.99999999999999967
    -

    Definition at line 1557 of file linalg_core.f90.

    +

    Definition at line 1693 of file linalg_core.f90.


    The documentation for this interface was generated from the following file: diff --git a/doc/html/linalg__c__api_8f90_source.html b/doc/html/linalg__c__api_8f90_source.html index edb723e7..2bb795ef 100644 --- a/doc/html/linalg__c__api_8f90_source.html +++ b/doc/html/linalg__c__api_8f90_source.html @@ -2022,29 +2022,29 @@
    3159
    3160! ------------------------------------------------------------------------------
    3161end module
    -
    Computes the Cholesky factorization of a symmetric, positive definite matrix.
    -
    Computes the rank 1 downdate to a Cholesky factored matrix (upper triangular).
    -
    Computes the rank 1 update to a Cholesky factored matrix (upper triangular).
    +
    Computes the Cholesky factorization of a symmetric, positive definite matrix.
    +
    Computes the rank 1 downdate to a Cholesky factored matrix (upper triangular).
    +
    Computes the rank 1 update to a Cholesky factored matrix (upper triangular).
    Computes the determinant of a square matrix.
    Multiplies a diagonal matrix with another matrix or array.
    -
    Computes the eigenvalues, and optionally the eigenvectors, of a matrix.
    +
    Computes the eigenvalues, and optionally the eigenvectors, of a matrix.
    Extracts the L and U matrices from the condensed [L\U] storage format used by the lu_factor.
    Forms the full M-by-M orthogonal matrix Q from the elementary reflectors returned by the base QR fact...
    Computes the LU factorization of an M-by-N matrix.
    -
    Computes the inverse of a square matrix.
    -
    Computes the Moore-Penrose pseudo-inverse of a M-by-N matrix using the singular value decomposition o...
    +
    Computes the inverse of a square matrix.
    +
    Computes the Moore-Penrose pseudo-inverse of a M-by-N matrix using the singular value decomposition o...
    Computes the rank of a matrix.
    Multiplies a general matrix by the orthogonal matrix Q from a QR factorization.
    Computes the QR factorization of an M-by-N matrix.
    -
    Computes the rank 1 update to an M-by-N QR factored matrix A (M >= N) where A = Q * R,...
    +
    Computes the rank 1 update to an M-by-N QR factored matrix A (M >= N) where , and such that .
    Performs the rank-1 update to matrix A such that: , where is an M-by-N matrix, is a scalar,...
    -
    Solves a system of Cholesky factored equations.
    -
    Solves the overdetermined or underdetermined system (A*X = B) of M equations of N unknowns.
    -
    Solves a system of LU-factored equations.
    -
    Solves a system of M QR-factored equations of N unknowns.
    -
    Solves a triangular system of equations.
    -
    Sorts an array.
    -
    Computes the singular value decomposition of a matrix A. The SVD is defined as: A = U * S * V**T,...
    +
    Solves a system of Cholesky factored equations.
    +
    Solves the overdetermined or underdetermined system (A*X = B) of M equations of N unknowns.
    +
    Solves a system of LU-factored equations.
    +
    Solves a system of M QR-factored equations of N unknowns.
    +
    Solves a triangular system of equations.
    +
    Sorts an array.
    +
    Computes the singular value decomposition of a matrix A. The SVD is defined as: A = U * S * V**T,...
    Computes the trace of a matrix (the sum of the main diagonal elements).
    Computes the triangular matrix operation: , or , where A is a triangular matrix.
    Provides a C-friendly API to the LINALG library. Notice, all C-API LINALG routines begin with the pre...
    Definition: linalg_c_api.f90:5
    diff --git a/doc/html/linalg__core_8f90_source.html b/doc/html/linalg__core_8f90_source.html index ee7a106d..5fbd00b5 100644 --- a/doc/html/linalg__core_8f90_source.html +++ b/doc/html/linalg__core_8f90_source.html @@ -246,1057 +246,1057 @@
    1150end interface
    1151
    1152! ------------------------------------------------------------------------------
    - -
    1248 module procedure :: qr_rank1_update_dbl
    -
    1249 module procedure :: qr_rank1_update_cmplx
    -
    1250end interface
    -
    1251
    -
    1252! ------------------------------------------------------------------------------
    - -
    1323 module procedure :: cholesky_factor_dbl
    -
    1324 module procedure :: cholesky_factor_cmplx
    -
    1325end interface
    -
    1326
    -
    1327! ------------------------------------------------------------------------------
    - -
    1391 module procedure :: cholesky_rank1_update_dbl
    -
    1392 module procedure :: cholesky_rank1_update_cmplx
    -
    1393end interface
    -
    1394
    -
    1395! ------------------------------------------------------------------------------
    - -
    1464 module procedure :: cholesky_rank1_downdate_dbl
    -
    1465 module procedure :: cholesky_rank1_downdate_cmplx
    -
    1466end interface
    -
    1467
    -
    1468! ------------------------------------------------------------------------------
    -
    1473interface rz_factor
    -
    1474 module procedure :: rz_factor_dbl
    -
    1475 module procedure :: rz_factor_cmplx
    -
    1476end interface
    -
    1477
    -
    1478! ------------------------------------------------------------------------------
    -
    1481interface mult_rz
    -
    1482 module procedure :: mult_rz_mtx
    -
    1483 module procedure :: mult_rz_mtx_cmplx
    -
    1484 module procedure :: mult_rz_vec
    -
    1485 module procedure :: mult_rz_vec_cmplx
    -
    1486end interface
    -
    1487
    -
    1488! ------------------------------------------------------------------------------
    -
    1557interface svd
    -
    1558 module procedure :: svd_dbl
    -
    1559 module procedure :: svd_cmplx
    -
    1560end interface
    -
    1561
    -
    1562! ------------------------------------------------------------------------------
    - -
    1627 module procedure :: solve_tri_mtx
    -
    1628 module procedure :: solve_tri_mtx_cmplx
    -
    1629 module procedure :: solve_tri_vec
    -
    1630 module procedure :: solve_tri_vec_cmplx
    -
    1631end interface
    -
    1632
    -
    1633! ------------------------------------------------------------------------------
    -
    1690interface solve_lu
    -
    1691 module procedure :: solve_lu_mtx
    -
    1692 module procedure :: solve_lu_mtx_cmplx
    -
    1693 module procedure :: solve_lu_vec
    -
    1694 module procedure :: solve_lu_vec_cmplx
    -
    1695end interface
    -
    1696
    -
    1697! ------------------------------------------------------------------------------
    -
    1759interface solve_qr
    -
    1760 module procedure :: solve_qr_no_pivot_mtx
    -
    1761 module procedure :: solve_qr_no_pivot_mtx_cmplx
    -
    1762 module procedure :: solve_qr_no_pivot_vec
    -
    1763 module procedure :: solve_qr_no_pivot_vec_cmplx
    -
    1764 module procedure :: solve_qr_pivot_mtx
    -
    1765 module procedure :: solve_qr_pivot_mtx_cmplx
    -
    1766 module procedure :: solve_qr_pivot_vec
    -
    1767 module procedure :: solve_qr_pivot_vec_cmplx
    -
    1768end interface
    -
    1769
    -
    1770! ------------------------------------------------------------------------------
    - -
    1840 module procedure :: solve_cholesky_mtx
    -
    1841 module procedure :: solve_cholesky_mtx_cmplx
    -
    1842 module procedure :: solve_cholesky_vec
    -
    1843 module procedure :: solve_cholesky_vec_cmplx
    -
    1844end interface
    -
    1845
    -
    1846! ------------------------------------------------------------------------------
    - -
    1894 module procedure :: solve_least_squares_mtx
    -
    1895 module procedure :: solve_least_squares_mtx_cmplx
    -
    1896 module procedure :: solve_least_squares_vec
    -
    1897 module procedure :: solve_least_squares_vec_cmplx
    -
    1898end interface
    -
    1899
    -
    1900! ------------------------------------------------------------------------------
    - -
    1949 module procedure :: solve_least_squares_mtx_pvt
    -
    1950 module procedure :: solve_least_squares_mtx_pvt_cmplx
    -
    1951 module procedure :: solve_least_squares_vec_pvt
    -
    1952 module procedure :: solve_least_squares_vec_pvt_cmplx
    -
    1953end interface
    -
    1954
    -
    1955! ------------------------------------------------------------------------------
    - -
    2004 module procedure :: solve_least_squares_mtx_svd
    -
    2005 module procedure :: solve_least_squares_vec_svd
    -
    2006end interface
    -
    2007
    -
    2008! ------------------------------------------------------------------------------
    - -
    2063 module procedure :: mtx_inverse_dbl
    -
    2064 module procedure :: mtx_inverse_cmplx
    -
    2065end interface
    -
    2066
    -
    2067! ------------------------------------------------------------------------------
    - -
    2124 module procedure :: mtx_pinverse_dbl
    -
    2125 module procedure :: mtx_pinverse_cmplx
    -
    2126end interface
    -
    2127
    -
    2128! ------------------------------------------------------------------------------
    -
    2217interface eigen
    -
    2218 module procedure :: eigen_symm
    -
    2219 module procedure :: eigen_asymm
    -
    2220 module procedure :: eigen_gen
    -
    2221 module procedure :: eigen_cmplx
    -
    2222end interface
    -
    2223
    -
    2224! ------------------------------------------------------------------------------
    -
    2226interface sort
    -
    2227 module procedure :: sort_dbl_array
    -
    2228 module procedure :: sort_dbl_array_ind
    -
    2229 module procedure :: sort_cmplx_array
    -
    2230 module procedure :: sort_cmplx_array_ind
    -
    2231 module procedure :: sort_eigen_cmplx
    -
    2232 module procedure :: sort_eigen_dbl
    -
    2233end interface
    -
    2234
    -
    2235
    -
    2236! ******************************************************************************
    -
    2237! LINALG_BASIC.F90
    -
    2238! ------------------------------------------------------------------------------
    -
    2239interface
    -
    2240 module subroutine mtx_mult_mtx(transa, transb, alpha, a, b, beta, c, err)
    -
    2241 logical, intent(in) :: transa, transb
    -
    2242 real(real64), intent(in) :: alpha, beta
    -
    2243 real(real64), intent(in), dimension(:,:) :: a, b
    -
    2244 real(real64), intent(inout), dimension(:,:) :: c
    -
    2245 class(errors), intent(inout), optional, target :: err
    -
    2246 end subroutine
    -
    2247
    -
    2248 module subroutine mtx_mult_vec(trans, alpha, a, b, beta, c, err)
    -
    2249 logical, intent(in) :: trans
    -
    2250 real(real64), intent(in) :: alpha, beta
    -
    2251 real(real64), intent(in), dimension(:,:) :: a
    -
    2252 real(real64), intent(in), dimension(:) :: b
    -
    2253 real(real64), intent(inout), dimension(:) :: c
    -
    2254 class(errors), intent(inout), optional, target :: err
    -
    2255 end subroutine
    -
    2256
    -
    2257 module subroutine cmtx_mult_mtx(opa, opb, alpha, a, b, beta, c, err)
    -
    2258 integer(int32), intent(in) :: opa, opb
    -
    2259 complex(real64), intent(in) :: alpha, beta
    -
    2260 complex(real64), intent(in), dimension(:,:) :: a, b
    -
    2261 complex(real64), intent(inout), dimension(:,:) :: c
    -
    2262 class(errors), intent(inout), optional, target :: err
    -
    2263 end subroutine
    -
    2264
    -
    2265 module subroutine cmtx_mult_vec(opa, alpha, a, b, beta, c, err)
    -
    2266 integer(int32), intent(in) :: opa
    -
    2267 complex(real64), intent(in) :: alpha, beta
    -
    2268 complex(real64), intent(in), dimension(:,:) :: a
    -
    2269 complex(real64), intent(in), dimension(:) :: b
    -
    2270 complex(real64), intent(inout), dimension(:) :: c
    -
    2271 class(errors), intent(inout), optional, target :: err
    -
    2272 end subroutine
    -
    2273
    -
    2274 module subroutine rank1_update_dbl(alpha, x, y, a, err)
    -
    2275 real(real64), intent(in) :: alpha
    -
    2276 real(real64), intent(in), dimension(:) :: x, y
    -
    2277 real(real64), intent(inout), dimension(:,:) :: a
    -
    2278 class(errors), intent(inout), optional, target :: err
    -
    2279 end subroutine
    -
    2280
    -
    2281 module subroutine rank1_update_cmplx(alpha, x, y, a, err)
    -
    2282 complex(real64), intent(in) :: alpha
    -
    2283 complex(real64), intent(in), dimension(:) :: x, y
    -
    2284 complex(real64), intent(inout), dimension(:,:) :: a
    -
    2285 class(errors), intent(inout), optional, target :: err
    -
    2286 end subroutine
    -
    2287
    -
    2288 module subroutine diag_mtx_mult_mtx(lside, trans, alpha, a, b, beta, c, err)
    -
    2289 logical, intent(in) :: lside, trans
    -
    2290 real(real64) :: alpha, beta
    -
    2291 real(real64), intent(in), dimension(:) :: a
    -
    2292 real(real64), intent(in), dimension(:,:) :: b
    -
    2293 real(real64), intent(inout), dimension(:,:) :: c
    -
    2294 class(errors), intent(inout), optional, target :: err
    -
    2295 end subroutine
    -
    2296
    -
    2297 module subroutine diag_mtx_mult_mtx2(lside, alpha, a, b, err)
    -
    2298 logical, intent(in) :: lside
    -
    2299 real(real64), intent(in) :: alpha
    -
    2300 real(real64), intent(in), dimension(:) :: a
    -
    2301 real(real64), intent(inout), dimension(:,:) :: b
    -
    2302 class(errors), intent(inout), optional, target :: err
    -
    2303 end subroutine
    -
    2304
    -
    2305 module subroutine diag_mtx_mult_mtx3(lside, trans, alpha, a, b, beta, c, err)
    -
    2306 logical, intent(in) :: lside, trans
    -
    2307 real(real64) :: alpha, beta
    -
    2308 complex(real64), intent(in), dimension(:) :: a
    -
    2309 real(real64), intent(in), dimension(:,:) :: b
    -
    2310 complex(real64), intent(inout), dimension(:,:) :: c
    -
    2311 class(errors), intent(inout), optional, target :: err
    -
    2312 end subroutine
    -
    2313
    -
    2314 module subroutine diag_mtx_mult_mtx4(lside, opb, alpha, a, b, beta, c, err)
    -
    2315 logical, intent(in) :: lside
    -
    2316 integer(int32), intent(in) :: opb
    -
    2317 real(real64) :: alpha, beta
    -
    2318 complex(real64), intent(in), dimension(:) :: a
    -
    2319 complex(real64), intent(in), dimension(:,:) :: b
    -
    2320 complex(real64), intent(inout), dimension(:,:) :: c
    -
    2321 class(errors), intent(inout), optional, target :: err
    -
    2322 end subroutine
    -
    2323
    -
    2324 module subroutine diag_mtx_mult_mtx_cmplx(lside, opb, alpha, a, b, beta, c, err)
    -
    2325 logical, intent(in) :: lside
    -
    2326 integer(int32), intent(in) :: opb
    -
    2327 complex(real64) :: alpha, beta
    -
    2328 complex(real64), intent(in), dimension(:) :: a
    -
    2329 complex(real64), intent(in), dimension(:,:) :: b
    -
    2330 complex(real64), intent(inout), dimension(:,:) :: c
    -
    2331 class(errors), intent(inout), optional, target :: err
    -
    2332 end subroutine
    -
    2333
    -
    2334 module subroutine diag_mtx_mult_mtx2_cmplx(lside, alpha, a, b, err)
    -
    2335 logical, intent(in) :: lside
    -
    2336 complex(real64), intent(in) :: alpha
    -
    2337 complex(real64), intent(in), dimension(:) :: a
    -
    2338 complex(real64), intent(inout), dimension(:,:) :: b
    -
    2339 class(errors), intent(inout), optional, target :: err
    -
    2340 end subroutine
    -
    2341
    -
    2342 module subroutine diag_mtx_mult_mtx_mix(lside, opb, alpha, a, b, beta, c, err)
    -
    2343 logical, intent(in) :: lside
    -
    2344 integer(int32), intent(in) :: opb
    -
    2345 complex(real64) :: alpha, beta
    -
    2346 real(real64), intent(in), dimension(:) :: a
    -
    2347 complex(real64), intent(in), dimension(:,:) :: b
    -
    2348 complex(real64), intent(inout), dimension(:,:) :: c
    -
    2349 class(errors), intent(inout), optional, target :: err
    -
    2350 end subroutine
    -
    2351
    -
    2352 module subroutine diag_mtx_mult_mtx2_mix(lside, alpha, a, b, err)
    -
    2353 logical, intent(in) :: lside
    -
    2354 complex(real64), intent(in) :: alpha
    -
    2355 real(real64), intent(in), dimension(:) :: a
    -
    2356 complex(real64), intent(inout), dimension(:,:) :: b
    -
    2357 class(errors), intent(inout), optional, target :: err
    -
    2358 end subroutine
    -
    2359
    -
    2360 pure module function trace_dbl(x) result(y)
    -
    2361 real(real64), intent(in), dimension(:,:) :: x
    -
    2362 real(real64) :: y
    -
    2363 end function
    -
    2364
    -
    2365 pure module function trace_cmplx(x) result(y)
    -
    2366 complex(real64), intent(in), dimension(:,:) :: x
    -
    2367 complex(real64) :: y
    -
    2368 end function
    -
    2369
    -
    2370 module function mtx_rank_dbl(a, tol, work, olwork, err) result(rnk)
    -
    2371 real(real64), intent(inout), dimension(:,:) :: a
    -
    2372 real(real64), intent(in), optional :: tol
    -
    2373 real(real64), intent(out), target, optional, dimension(:) :: work
    -
    2374 integer(int32), intent(out), optional :: olwork
    -
    2375 class(errors), intent(inout), optional, target :: err
    -
    2376 integer(int32) :: rnk
    -
    2377 end function
    -
    2378
    -
    2379 module function mtx_rank_cmplx(a, tol, work, olwork, rwork, err) result(rnk)
    -
    2380 complex(real64), intent(inout), dimension(:,:) :: a
    -
    2381 real(real64), intent(in), optional :: tol
    -
    2382 complex(real64), intent(out), target, optional, dimension(:) :: work
    -
    2383 integer(int32), intent(out), optional :: olwork
    -
    2384 real(real64), intent(out), target, optional, dimension(:) :: rwork
    -
    2385 class(errors), intent(inout), optional, target :: err
    -
    2386 integer(int32) :: rnk
    -
    2387 end function
    -
    2388
    -
    2389 module function det_dbl(a, iwork, err) result(x)
    -
    2390 real(real64), intent(inout), dimension(:,:) :: a
    -
    2391 integer(int32), intent(out), target, optional, dimension(:) :: iwork
    -
    2392 class(errors), intent(inout), optional, target :: err
    -
    2393 real(real64) :: x
    -
    2394 end function
    -
    2395
    -
    2396 module function det_cmplx(a, iwork, err) result(x)
    -
    2397 complex(real64), intent(inout), dimension(:,:) :: a
    -
    2398 integer(int32), intent(out), target, optional, dimension(:) :: iwork
    -
    2399 class(errors), intent(inout), optional, target :: err
    -
    2400 complex(real64) :: x
    -
    2401 end function
    -
    2402
    -
    2403 module subroutine swap_dbl(x, y, err)
    -
    2404 real(real64), intent(inout), dimension(:) :: x, y
    -
    2405 class(errors), intent(inout), optional, target :: err
    -
    2406 end subroutine
    -
    2407
    -
    2408 module subroutine swap_cmplx(x, y, err)
    -
    2409 complex(real64), intent(inout), dimension(:) :: x, y
    -
    2410 class(errors), intent(inout), optional, target :: err
    -
    2411 end subroutine
    -
    2412
    -
    2413 module subroutine recip_mult_array_dbl(a, x)
    -
    2414 real(real64), intent(in) :: a
    -
    2415 real(real64), intent(inout), dimension(:) :: x
    -
    2416 end subroutine
    -
    2417
    -
    2418 module subroutine tri_mtx_mult_dbl(upper, alpha, a, beta, b, err)
    -
    2419 logical, intent(in) :: upper
    -
    2420 real(real64), intent(in) :: alpha, beta
    -
    2421 real(real64), intent(in), dimension(:,:) :: a
    -
    2422 real(real64), intent(inout), dimension(:,:) :: b
    -
    2423 class(errors), intent(inout), optional, target :: err
    -
    2424 end subroutine
    -
    2425
    -
    2426 module subroutine tri_mtx_mult_cmplx(upper, alpha, a, beta, b, err)
    -
    2427 logical, intent(in) :: upper
    -
    2428 complex(real64), intent(in) :: alpha, beta
    -
    2429 complex(real64), intent(in), dimension(:,:) :: a
    -
    2430 complex(real64), intent(inout), dimension(:,:) :: b
    -
    2431 class(errors), intent(inout), optional, target :: err
    -
    2432 end subroutine
    -
    2433
    -
    2434end interface
    -
    2435
    -
    2436! ******************************************************************************
    -
    2437! LINALG_FACTOR.F90
    -
    2438! ------------------------------------------------------------------------------
    -
    2439interface
    -
    2440 module subroutine lu_factor_dbl(a, ipvt, err)
    -
    2441 real(real64), intent(inout), dimension(:,:) :: a
    -
    2442 integer(int32), intent(out), dimension(:) :: ipvt
    -
    2443 class(errors), intent(inout), optional, target :: err
    -
    2444 end subroutine
    -
    2445
    -
    2446 module subroutine lu_factor_cmplx(a, ipvt, err)
    -
    2447 complex(real64), intent(inout), dimension(:,:) :: a
    -
    2448 integer(int32), intent(out), dimension(:) :: ipvt
    -
    2449 class(errors), intent(inout), optional, target :: err
    -
    2450 end subroutine
    -
    2451
    -
    2452 module subroutine form_lu_all(lu, ipvt, u, p, err)
    -
    2453 real(real64), intent(inout), dimension(:,:) :: lu
    -
    2454 integer(int32), intent(in), dimension(:) :: ipvt
    -
    2455 real(real64), intent(out), dimension(:,:) :: u, p
    -
    2456 class(errors), intent(inout), optional, target :: err
    -
    2457 end subroutine
    -
    2458
    -
    2459 module subroutine form_lu_all_cmplx(lu, ipvt, u, p, err)
    -
    2460 complex(real64), intent(inout), dimension(:,:) :: lu
    -
    2461 integer(int32), intent(in), dimension(:) :: ipvt
    -
    2462 complex(real64), intent(out), dimension(:,:) :: u
    -
    2463 real(real64), intent(out), dimension(:,:) :: p
    -
    2464 class(errors), intent(inout), optional, target :: err
    -
    2465 end subroutine
    -
    2466
    -
    2467 module subroutine form_lu_only(lu, u, err)
    -
    2468 real(real64), intent(inout), dimension(:,:) :: lu
    -
    2469 real(real64), intent(out), dimension(:,:) :: u
    -
    2470 class(errors), intent(inout), optional, target :: err
    -
    2471 end subroutine
    -
    2472
    -
    2473 module subroutine form_lu_only_cmplx(lu, u, err)
    -
    2474 complex(real64), intent(inout), dimension(:,:) :: lu
    -
    2475 complex(real64), intent(out), dimension(:,:) :: u
    -
    2476 class(errors), intent(inout), optional, target :: err
    -
    2477 end subroutine
    -
    2478
    -
    2479 module subroutine qr_factor_no_pivot(a, tau, work, olwork, err)
    -
    2480 real(real64), intent(inout), dimension(:,:) :: a
    -
    2481 real(real64), intent(out), dimension(:) :: tau
    -
    2482 real(real64), intent(out), target, dimension(:), optional :: work
    -
    2483 integer(int32), intent(out), optional :: olwork
    -
    2484 class(errors), intent(inout), optional, target :: err
    -
    2485 end subroutine
    -
    2486
    -
    2487 module subroutine qr_factor_no_pivot_cmplx(a, tau, work, olwork, err)
    -
    2488 complex(real64), intent(inout), dimension(:,:) :: a
    -
    2489 complex(real64), intent(out), dimension(:) :: tau
    -
    2490 complex(real64), intent(out), target, dimension(:), optional :: work
    -
    2491 integer(int32), intent(out), optional :: olwork
    -
    2492 class(errors), intent(inout), optional, target :: err
    -
    2493 end subroutine
    -
    2494
    -
    2495 module subroutine qr_factor_pivot(a, tau, jpvt, work, olwork, err)
    -
    2496 real(real64), intent(inout), dimension(:,:) :: a
    -
    2497 real(real64), intent(out), dimension(:) :: tau
    -
    2498 integer(int32), intent(inout), dimension(:) :: jpvt
    -
    2499 real(real64), intent(out), target, dimension(:), optional :: work
    -
    2500 integer(int32), intent(out), optional :: olwork
    -
    2501 class(errors), intent(inout), optional, target :: err
    -
    2502 end subroutine
    -
    2503
    -
    2504 module subroutine qr_factor_pivot_cmplx(a, tau, jpvt, work, olwork, rwork, &
    -
    2505 err)
    -
    2506 complex(real64), intent(inout), dimension(:,:) :: a
    -
    2507 complex(real64), intent(out), dimension(:) :: tau
    -
    2508 integer(int32), intent(inout), dimension(:) :: jpvt
    -
    2509 complex(real64), intent(out), target, dimension(:), optional :: work
    + +
    1295 module procedure :: qr_rank1_update_dbl
    +
    1296 module procedure :: qr_rank1_update_cmplx
    +
    1297end interface
    +
    1298
    +
    1299! ------------------------------------------------------------------------------
    + +
    1394 module procedure :: cholesky_factor_dbl
    +
    1395 module procedure :: cholesky_factor_cmplx
    +
    1396end interface
    +
    1397
    +
    1398! ------------------------------------------------------------------------------
    + +
    1493 module procedure :: cholesky_rank1_update_dbl
    +
    1494 module procedure :: cholesky_rank1_update_cmplx
    +
    1495end interface
    +
    1496
    +
    1497! ------------------------------------------------------------------------------
    + +
    1600 module procedure :: cholesky_rank1_downdate_dbl
    +
    1601 module procedure :: cholesky_rank1_downdate_cmplx
    +
    1602end interface
    +
    1603
    +
    1604! ------------------------------------------------------------------------------
    +
    1609interface rz_factor
    +
    1610 module procedure :: rz_factor_dbl
    +
    1611 module procedure :: rz_factor_cmplx
    +
    1612end interface
    +
    1613
    +
    1614! ------------------------------------------------------------------------------
    +
    1617interface mult_rz
    +
    1618 module procedure :: mult_rz_mtx
    +
    1619 module procedure :: mult_rz_mtx_cmplx
    +
    1620 module procedure :: mult_rz_vec
    +
    1621 module procedure :: mult_rz_vec_cmplx
    +
    1622end interface
    +
    1623
    +
    1624! ------------------------------------------------------------------------------
    +
    1693interface svd
    +
    1694 module procedure :: svd_dbl
    +
    1695 module procedure :: svd_cmplx
    +
    1696end interface
    +
    1697
    +
    1698! ------------------------------------------------------------------------------
    + +
    1763 module procedure :: solve_tri_mtx
    +
    1764 module procedure :: solve_tri_mtx_cmplx
    +
    1765 module procedure :: solve_tri_vec
    +
    1766 module procedure :: solve_tri_vec_cmplx
    +
    1767end interface
    +
    1768
    +
    1769! ------------------------------------------------------------------------------
    +
    1826interface solve_lu
    +
    1827 module procedure :: solve_lu_mtx
    +
    1828 module procedure :: solve_lu_mtx_cmplx
    +
    1829 module procedure :: solve_lu_vec
    +
    1830 module procedure :: solve_lu_vec_cmplx
    +
    1831end interface
    +
    1832
    +
    1833! ------------------------------------------------------------------------------
    +
    1895interface solve_qr
    +
    1896 module procedure :: solve_qr_no_pivot_mtx
    +
    1897 module procedure :: solve_qr_no_pivot_mtx_cmplx
    +
    1898 module procedure :: solve_qr_no_pivot_vec
    +
    1899 module procedure :: solve_qr_no_pivot_vec_cmplx
    +
    1900 module procedure :: solve_qr_pivot_mtx
    +
    1901 module procedure :: solve_qr_pivot_mtx_cmplx
    +
    1902 module procedure :: solve_qr_pivot_vec
    +
    1903 module procedure :: solve_qr_pivot_vec_cmplx
    +
    1904end interface
    +
    1905
    +
    1906! ------------------------------------------------------------------------------
    + +
    1976 module procedure :: solve_cholesky_mtx
    +
    1977 module procedure :: solve_cholesky_mtx_cmplx
    +
    1978 module procedure :: solve_cholesky_vec
    +
    1979 module procedure :: solve_cholesky_vec_cmplx
    +
    1980end interface
    +
    1981
    +
    1982! ------------------------------------------------------------------------------
    + +
    2030 module procedure :: solve_least_squares_mtx
    +
    2031 module procedure :: solve_least_squares_mtx_cmplx
    +
    2032 module procedure :: solve_least_squares_vec
    +
    2033 module procedure :: solve_least_squares_vec_cmplx
    +
    2034end interface
    +
    2035
    +
    2036! ------------------------------------------------------------------------------
    + +
    2085 module procedure :: solve_least_squares_mtx_pvt
    +
    2086 module procedure :: solve_least_squares_mtx_pvt_cmplx
    +
    2087 module procedure :: solve_least_squares_vec_pvt
    +
    2088 module procedure :: solve_least_squares_vec_pvt_cmplx
    +
    2089end interface
    +
    2090
    +
    2091! ------------------------------------------------------------------------------
    + +
    2140 module procedure :: solve_least_squares_mtx_svd
    +
    2141 module procedure :: solve_least_squares_vec_svd
    +
    2142end interface
    +
    2143
    +
    2144! ------------------------------------------------------------------------------
    + +
    2199 module procedure :: mtx_inverse_dbl
    +
    2200 module procedure :: mtx_inverse_cmplx
    +
    2201end interface
    +
    2202
    +
    2203! ------------------------------------------------------------------------------
    + +
    2260 module procedure :: mtx_pinverse_dbl
    +
    2261 module procedure :: mtx_pinverse_cmplx
    +
    2262end interface
    +
    2263
    +
    2264! ------------------------------------------------------------------------------
    +
    2353interface eigen
    +
    2354 module procedure :: eigen_symm
    +
    2355 module procedure :: eigen_asymm
    +
    2356 module procedure :: eigen_gen
    +
    2357 module procedure :: eigen_cmplx
    +
    2358end interface
    +
    2359
    +
    2360! ------------------------------------------------------------------------------
    +
    2362interface sort
    +
    2363 module procedure :: sort_dbl_array
    +
    2364 module procedure :: sort_dbl_array_ind
    +
    2365 module procedure :: sort_cmplx_array
    +
    2366 module procedure :: sort_cmplx_array_ind
    +
    2367 module procedure :: sort_eigen_cmplx
    +
    2368 module procedure :: sort_eigen_dbl
    +
    2369end interface
    +
    2370
    +
    2371
    +
    2372! ******************************************************************************
    +
    2373! LINALG_BASIC.F90
    +
    2374! ------------------------------------------------------------------------------
    +
    2375interface
    +
    2376 module subroutine mtx_mult_mtx(transa, transb, alpha, a, b, beta, c, err)
    +
    2377 logical, intent(in) :: transa, transb
    +
    2378 real(real64), intent(in) :: alpha, beta
    +
    2379 real(real64), intent(in), dimension(:,:) :: a, b
    +
    2380 real(real64), intent(inout), dimension(:,:) :: c
    +
    2381 class(errors), intent(inout), optional, target :: err
    +
    2382 end subroutine
    +
    2383
    +
    2384 module subroutine mtx_mult_vec(trans, alpha, a, b, beta, c, err)
    +
    2385 logical, intent(in) :: trans
    +
    2386 real(real64), intent(in) :: alpha, beta
    +
    2387 real(real64), intent(in), dimension(:,:) :: a
    +
    2388 real(real64), intent(in), dimension(:) :: b
    +
    2389 real(real64), intent(inout), dimension(:) :: c
    +
    2390 class(errors), intent(inout), optional, target :: err
    +
    2391 end subroutine
    +
    2392
    +
    2393 module subroutine cmtx_mult_mtx(opa, opb, alpha, a, b, beta, c, err)
    +
    2394 integer(int32), intent(in) :: opa, opb
    +
    2395 complex(real64), intent(in) :: alpha, beta
    +
    2396 complex(real64), intent(in), dimension(:,:) :: a, b
    +
    2397 complex(real64), intent(inout), dimension(:,:) :: c
    +
    2398 class(errors), intent(inout), optional, target :: err
    +
    2399 end subroutine
    +
    2400
    +
    2401 module subroutine cmtx_mult_vec(opa, alpha, a, b, beta, c, err)
    +
    2402 integer(int32), intent(in) :: opa
    +
    2403 complex(real64), intent(in) :: alpha, beta
    +
    2404 complex(real64), intent(in), dimension(:,:) :: a
    +
    2405 complex(real64), intent(in), dimension(:) :: b
    +
    2406 complex(real64), intent(inout), dimension(:) :: c
    +
    2407 class(errors), intent(inout), optional, target :: err
    +
    2408 end subroutine
    +
    2409
    +
    2410 module subroutine rank1_update_dbl(alpha, x, y, a, err)
    +
    2411 real(real64), intent(in) :: alpha
    +
    2412 real(real64), intent(in), dimension(:) :: x, y
    +
    2413 real(real64), intent(inout), dimension(:,:) :: a
    +
    2414 class(errors), intent(inout), optional, target :: err
    +
    2415 end subroutine
    +
    2416
    +
    2417 module subroutine rank1_update_cmplx(alpha, x, y, a, err)
    +
    2418 complex(real64), intent(in) :: alpha
    +
    2419 complex(real64), intent(in), dimension(:) :: x, y
    +
    2420 complex(real64), intent(inout), dimension(:,:) :: a
    +
    2421 class(errors), intent(inout), optional, target :: err
    +
    2422 end subroutine
    +
    2423
    +
    2424 module subroutine diag_mtx_mult_mtx(lside, trans, alpha, a, b, beta, c, err)
    +
    2425 logical, intent(in) :: lside, trans
    +
    2426 real(real64) :: alpha, beta
    +
    2427 real(real64), intent(in), dimension(:) :: a
    +
    2428 real(real64), intent(in), dimension(:,:) :: b
    +
    2429 real(real64), intent(inout), dimension(:,:) :: c
    +
    2430 class(errors), intent(inout), optional, target :: err
    +
    2431 end subroutine
    +
    2432
    +
    2433 module subroutine diag_mtx_mult_mtx2(lside, alpha, a, b, err)
    +
    2434 logical, intent(in) :: lside
    +
    2435 real(real64), intent(in) :: alpha
    +
    2436 real(real64), intent(in), dimension(:) :: a
    +
    2437 real(real64), intent(inout), dimension(:,:) :: b
    +
    2438 class(errors), intent(inout), optional, target :: err
    +
    2439 end subroutine
    +
    2440
    +
    2441 module subroutine diag_mtx_mult_mtx3(lside, trans, alpha, a, b, beta, c, err)
    +
    2442 logical, intent(in) :: lside, trans
    +
    2443 real(real64) :: alpha, beta
    +
    2444 complex(real64), intent(in), dimension(:) :: a
    +
    2445 real(real64), intent(in), dimension(:,:) :: b
    +
    2446 complex(real64), intent(inout), dimension(:,:) :: c
    +
    2447 class(errors), intent(inout), optional, target :: err
    +
    2448 end subroutine
    +
    2449
    +
    2450 module subroutine diag_mtx_mult_mtx4(lside, opb, alpha, a, b, beta, c, err)
    +
    2451 logical, intent(in) :: lside
    +
    2452 integer(int32), intent(in) :: opb
    +
    2453 real(real64) :: alpha, beta
    +
    2454 complex(real64), intent(in), dimension(:) :: a
    +
    2455 complex(real64), intent(in), dimension(:,:) :: b
    +
    2456 complex(real64), intent(inout), dimension(:,:) :: c
    +
    2457 class(errors), intent(inout), optional, target :: err
    +
    2458 end subroutine
    +
    2459
    +
    2460 module subroutine diag_mtx_mult_mtx_cmplx(lside, opb, alpha, a, b, beta, c, err)
    +
    2461 logical, intent(in) :: lside
    +
    2462 integer(int32), intent(in) :: opb
    +
    2463 complex(real64) :: alpha, beta
    +
    2464 complex(real64), intent(in), dimension(:) :: a
    +
    2465 complex(real64), intent(in), dimension(:,:) :: b
    +
    2466 complex(real64), intent(inout), dimension(:,:) :: c
    +
    2467 class(errors), intent(inout), optional, target :: err
    +
    2468 end subroutine
    +
    2469
    +
    2470 module subroutine diag_mtx_mult_mtx2_cmplx(lside, alpha, a, b, err)
    +
    2471 logical, intent(in) :: lside
    +
    2472 complex(real64), intent(in) :: alpha
    +
    2473 complex(real64), intent(in), dimension(:) :: a
    +
    2474 complex(real64), intent(inout), dimension(:,:) :: b
    +
    2475 class(errors), intent(inout), optional, target :: err
    +
    2476 end subroutine
    +
    2477
    +
    2478 module subroutine diag_mtx_mult_mtx_mix(lside, opb, alpha, a, b, beta, c, err)
    +
    2479 logical, intent(in) :: lside
    +
    2480 integer(int32), intent(in) :: opb
    +
    2481 complex(real64) :: alpha, beta
    +
    2482 real(real64), intent(in), dimension(:) :: a
    +
    2483 complex(real64), intent(in), dimension(:,:) :: b
    +
    2484 complex(real64), intent(inout), dimension(:,:) :: c
    +
    2485 class(errors), intent(inout), optional, target :: err
    +
    2486 end subroutine
    +
    2487
    +
    2488 module subroutine diag_mtx_mult_mtx2_mix(lside, alpha, a, b, err)
    +
    2489 logical, intent(in) :: lside
    +
    2490 complex(real64), intent(in) :: alpha
    +
    2491 real(real64), intent(in), dimension(:) :: a
    +
    2492 complex(real64), intent(inout), dimension(:,:) :: b
    +
    2493 class(errors), intent(inout), optional, target :: err
    +
    2494 end subroutine
    +
    2495
    +
    2496 pure module function trace_dbl(x) result(y)
    +
    2497 real(real64), intent(in), dimension(:,:) :: x
    +
    2498 real(real64) :: y
    +
    2499 end function
    +
    2500
    +
    2501 pure module function trace_cmplx(x) result(y)
    +
    2502 complex(real64), intent(in), dimension(:,:) :: x
    +
    2503 complex(real64) :: y
    +
    2504 end function
    +
    2505
    +
    2506 module function mtx_rank_dbl(a, tol, work, olwork, err) result(rnk)
    +
    2507 real(real64), intent(inout), dimension(:,:) :: a
    +
    2508 real(real64), intent(in), optional :: tol
    +
    2509 real(real64), intent(out), target, optional, dimension(:) :: work
    2510 integer(int32), intent(out), optional :: olwork
    -
    2511 real(real64), intent(out), target, dimension(:), optional :: rwork
    -
    2512 class(errors), intent(inout), optional, target :: err
    -
    2513 end subroutine
    -
    2514
    -
    2515 module subroutine form_qr_no_pivot(r, tau, q, work, olwork, err)
    -
    2516 real(real64), intent(inout), dimension(:,:) :: r
    -
    2517 real(real64), intent(in), dimension(:) :: tau
    -
    2518 real(real64), intent(out), dimension(:,:) :: q
    -
    2519 real(real64), intent(out), target, dimension(:), optional :: work
    -
    2520 integer(int32), intent(out), optional :: olwork
    +
    2511 class(errors), intent(inout), optional, target :: err
    +
    2512 integer(int32) :: rnk
    +
    2513 end function
    +
    2514
    +
    2515 module function mtx_rank_cmplx(a, tol, work, olwork, rwork, err) result(rnk)
    +
    2516 complex(real64), intent(inout), dimension(:,:) :: a
    +
    2517 real(real64), intent(in), optional :: tol
    +
    2518 complex(real64), intent(out), target, optional, dimension(:) :: work
    +
    2519 integer(int32), intent(out), optional :: olwork
    +
    2520 real(real64), intent(out), target, optional, dimension(:) :: rwork
    2521 class(errors), intent(inout), optional, target :: err
    -
    2522 end subroutine
    -
    2523
    -
    2524 module subroutine form_qr_no_pivot_cmplx(r, tau, q, work, olwork, err)
    -
    2525 complex(real64), intent(inout), dimension(:,:) :: r
    -
    2526 complex(real64), intent(in), dimension(:) :: tau
    -
    2527 complex(real64), intent(out), dimension(:,:) :: q
    -
    2528 complex(real64), intent(out), target, dimension(:), optional :: work
    -
    2529 integer(int32), intent(out), optional :: olwork
    -
    2530 class(errors), intent(inout), optional, target :: err
    -
    2531 end subroutine
    -
    2532
    -
    2533 module subroutine form_qr_pivot(r, tau, pvt, q, p, work, olwork, err)
    -
    2534 real(real64), intent(inout), dimension(:,:) :: r
    -
    2535 real(real64), intent(in), dimension(:) :: tau
    -
    2536 integer(int32), intent(in), dimension(:) :: pvt
    -
    2537 real(real64), intent(out), dimension(:,:) :: q, p
    -
    2538 real(real64), intent(out), target, dimension(:), optional :: work
    -
    2539 integer(int32), intent(out), optional :: olwork
    -
    2540 class(errors), intent(inout), optional, target :: err
    -
    2541 end subroutine
    -
    2542
    -
    2543 module subroutine form_qr_pivot_cmplx(r, tau, pvt, q, p, work, olwork, err)
    -
    2544 complex(real64), intent(inout), dimension(:,:) :: r
    -
    2545 complex(real64), intent(in), dimension(:) :: tau
    -
    2546 integer(int32), intent(in), dimension(:) :: pvt
    -
    2547 complex(real64), intent(out), dimension(:,:) :: q, p
    -
    2548 complex(real64), intent(out), target, dimension(:), optional :: work
    -
    2549 integer(int32), intent(out), optional :: olwork
    -
    2550 class(errors), intent(inout), optional, target :: err
    -
    2551 end subroutine
    -
    2552
    -
    2553 module subroutine mult_qr_mtx(lside, trans, a, tau, c, work, olwork, err)
    -
    2554 logical, intent(in) :: lside, trans
    -
    2555 real(real64), intent(in), dimension(:) :: tau
    -
    2556 real(real64), intent(inout), dimension(:,:) :: a, c
    -
    2557 real(real64), intent(out), target, dimension(:), optional :: work
    -
    2558 integer(int32), intent(out), optional :: olwork
    +
    2522 integer(int32) :: rnk
    +
    2523 end function
    +
    2524
    +
    2525 module function det_dbl(a, iwork, err) result(x)
    +
    2526 real(real64), intent(inout), dimension(:,:) :: a
    +
    2527 integer(int32), intent(out), target, optional, dimension(:) :: iwork
    +
    2528 class(errors), intent(inout), optional, target :: err
    +
    2529 real(real64) :: x
    +
    2530 end function
    +
    2531
    +
    2532 module function det_cmplx(a, iwork, err) result(x)
    +
    2533 complex(real64), intent(inout), dimension(:,:) :: a
    +
    2534 integer(int32), intent(out), target, optional, dimension(:) :: iwork
    +
    2535 class(errors), intent(inout), optional, target :: err
    +
    2536 complex(real64) :: x
    +
    2537 end function
    +
    2538
    +
    2539 module subroutine swap_dbl(x, y, err)
    +
    2540 real(real64), intent(inout), dimension(:) :: x, y
    +
    2541 class(errors), intent(inout), optional, target :: err
    +
    2542 end subroutine
    +
    2543
    +
    2544 module subroutine swap_cmplx(x, y, err)
    +
    2545 complex(real64), intent(inout), dimension(:) :: x, y
    +
    2546 class(errors), intent(inout), optional, target :: err
    +
    2547 end subroutine
    +
    2548
    +
    2549 module subroutine recip_mult_array_dbl(a, x)
    +
    2550 real(real64), intent(in) :: a
    +
    2551 real(real64), intent(inout), dimension(:) :: x
    +
    2552 end subroutine
    +
    2553
    +
    2554 module subroutine tri_mtx_mult_dbl(upper, alpha, a, beta, b, err)
    +
    2555 logical, intent(in) :: upper
    +
    2556 real(real64), intent(in) :: alpha, beta
    +
    2557 real(real64), intent(in), dimension(:,:) :: a
    +
    2558 real(real64), intent(inout), dimension(:,:) :: b
    2559 class(errors), intent(inout), optional, target :: err
    2560 end subroutine
    -
    2561
    -
    2562 module subroutine mult_qr_mtx_cmplx(lside, trans, a, tau, c, work, olwork, err)
    -
    2563 logical, intent(in) :: lside, trans
    -
    2564 complex(real64), intent(in), dimension(:) :: tau
    -
    2565 complex(real64), intent(inout), dimension(:,:) :: a, c
    -
    2566 complex(real64), intent(out), target, dimension(:), optional :: work
    -
    2567 integer(int32), intent(out), optional :: olwork
    -
    2568 class(errors), intent(inout), optional, target :: err
    -
    2569 end subroutine
    -
    2570
    -
    2571 module subroutine mult_qr_vec(trans, a, tau, c, work, olwork, err)
    -
    2572 logical, intent(in) :: trans
    -
    2573 real(real64), intent(inout), dimension(:,:) :: a
    -
    2574 real(real64), intent(in), dimension(:) :: tau
    -
    2575 real(real64), intent(inout), dimension(:) :: c
    -
    2576 real(real64), intent(out), target, dimension(:), optional :: work
    -
    2577 integer(int32), intent(out), optional :: olwork
    -
    2578 class(errors), intent(inout), optional, target :: err
    -
    2579 end subroutine
    -
    2580
    -
    2581 module subroutine mult_qr_vec_cmplx(trans, a, tau, c, work, olwork, err)
    -
    2582 logical, intent(in) :: trans
    +
    2561
    +
    2562 module subroutine tri_mtx_mult_cmplx(upper, alpha, a, beta, b, err)
    +
    2563 logical, intent(in) :: upper
    +
    2564 complex(real64), intent(in) :: alpha, beta
    +
    2565 complex(real64), intent(in), dimension(:,:) :: a
    +
    2566 complex(real64), intent(inout), dimension(:,:) :: b
    +
    2567 class(errors), intent(inout), optional, target :: err
    +
    2568 end subroutine
    +
    2569
    +
    2570end interface
    +
    2571
    +
    2572! ******************************************************************************
    +
    2573! LINALG_FACTOR.F90
    +
    2574! ------------------------------------------------------------------------------
    +
    2575interface
    +
    2576 module subroutine lu_factor_dbl(a, ipvt, err)
    +
    2577 real(real64), intent(inout), dimension(:,:) :: a
    +
    2578 integer(int32), intent(out), dimension(:) :: ipvt
    +
    2579 class(errors), intent(inout), optional, target :: err
    +
    2580 end subroutine
    +
    2581
    +
    2582 module subroutine lu_factor_cmplx(a, ipvt, err)
    2583 complex(real64), intent(inout), dimension(:,:) :: a
    -
    2584 complex(real64), intent(in), dimension(:) :: tau
    -
    2585 complex(real64), intent(inout), dimension(:) :: c
    -
    2586 complex(real64), intent(out), target, dimension(:), optional :: work
    -
    2587 integer(int32), intent(out), optional :: olwork
    -
    2588 class(errors), intent(inout), optional, target :: err
    -
    2589 end subroutine
    -
    2590
    -
    2631 module subroutine qr_rank1_update_dbl(q, r, u, v, work, err)
    -
    2632 real(real64), intent(inout), dimension(:,:) :: q, r
    -
    2633 real(real64), intent(inout), dimension(:) :: u, v
    -
    2634 real(real64), intent(out), target, optional, dimension(:) :: work
    -
    2635 class(errors), intent(inout), optional, target :: err
    -
    2636 end subroutine
    -
    2637
    -
    2681 module subroutine qr_rank1_update_cmplx(q, r, u, v, work, rwork, err)
    -
    2682 complex(real64), intent(inout), dimension(:,:) :: q, r
    -
    2683 complex(real64), intent(inout), dimension(:) :: u, v
    -
    2684 complex(real64), intent(out), target, optional, dimension(:) :: work
    -
    2685 real(real64), intent(out), target, optional, dimension(:) :: rwork
    +
    2584 integer(int32), intent(out), dimension(:) :: ipvt
    +
    2585 class(errors), intent(inout), optional, target :: err
    +
    2586 end subroutine
    +
    2587
    +
    2588 module subroutine form_lu_all(lu, ipvt, u, p, err)
    +
    2589 real(real64), intent(inout), dimension(:,:) :: lu
    +
    2590 integer(int32), intent(in), dimension(:) :: ipvt
    +
    2591 real(real64), intent(out), dimension(:,:) :: u, p
    +
    2592 class(errors), intent(inout), optional, target :: err
    +
    2593 end subroutine
    +
    2594
    +
    2595 module subroutine form_lu_all_cmplx(lu, ipvt, u, p, err)
    +
    2596 complex(real64), intent(inout), dimension(:,:) :: lu
    +
    2597 integer(int32), intent(in), dimension(:) :: ipvt
    +
    2598 complex(real64), intent(out), dimension(:,:) :: u
    +
    2599 real(real64), intent(out), dimension(:,:) :: p
    +
    2600 class(errors), intent(inout), optional, target :: err
    +
    2601 end subroutine
    +
    2602
    +
    2603 module subroutine form_lu_only(lu, u, err)
    +
    2604 real(real64), intent(inout), dimension(:,:) :: lu
    +
    2605 real(real64), intent(out), dimension(:,:) :: u
    +
    2606 class(errors), intent(inout), optional, target :: err
    +
    2607 end subroutine
    +
    2608
    +
    2609 module subroutine form_lu_only_cmplx(lu, u, err)
    +
    2610 complex(real64), intent(inout), dimension(:,:) :: lu
    +
    2611 complex(real64), intent(out), dimension(:,:) :: u
    +
    2612 class(errors), intent(inout), optional, target :: err
    +
    2613 end subroutine
    +
    2614
    +
    2615 module subroutine qr_factor_no_pivot(a, tau, work, olwork, err)
    +
    2616 real(real64), intent(inout), dimension(:,:) :: a
    +
    2617 real(real64), intent(out), dimension(:) :: tau
    +
    2618 real(real64), intent(out), target, dimension(:), optional :: work
    +
    2619 integer(int32), intent(out), optional :: olwork
    +
    2620 class(errors), intent(inout), optional, target :: err
    +
    2621 end subroutine
    +
    2622
    +
    2623 module subroutine qr_factor_no_pivot_cmplx(a, tau, work, olwork, err)
    +
    2624 complex(real64), intent(inout), dimension(:,:) :: a
    +
    2625 complex(real64), intent(out), dimension(:) :: tau
    +
    2626 complex(real64), intent(out), target, dimension(:), optional :: work
    +
    2627 integer(int32), intent(out), optional :: olwork
    +
    2628 class(errors), intent(inout), optional, target :: err
    +
    2629 end subroutine
    +
    2630
    +
    2631 module subroutine qr_factor_pivot(a, tau, jpvt, work, olwork, err)
    +
    2632 real(real64), intent(inout), dimension(:,:) :: a
    +
    2633 real(real64), intent(out), dimension(:) :: tau
    +
    2634 integer(int32), intent(inout), dimension(:) :: jpvt
    +
    2635 real(real64), intent(out), target, dimension(:), optional :: work
    +
    2636 integer(int32), intent(out), optional :: olwork
    +
    2637 class(errors), intent(inout), optional, target :: err
    +
    2638 end subroutine
    +
    2639
    +
    2640 module subroutine qr_factor_pivot_cmplx(a, tau, jpvt, work, olwork, rwork, &
    +
    2641 err)
    +
    2642 complex(real64), intent(inout), dimension(:,:) :: a
    +
    2643 complex(real64), intent(out), dimension(:) :: tau
    +
    2644 integer(int32), intent(inout), dimension(:) :: jpvt
    +
    2645 complex(real64), intent(out), target, dimension(:), optional :: work
    +
    2646 integer(int32), intent(out), optional :: olwork
    +
    2647 real(real64), intent(out), target, dimension(:), optional :: rwork
    +
    2648 class(errors), intent(inout), optional, target :: err
    +
    2649 end subroutine
    +
    2650
    +
    2651 module subroutine form_qr_no_pivot(r, tau, q, work, olwork, err)
    +
    2652 real(real64), intent(inout), dimension(:,:) :: r
    +
    2653 real(real64), intent(in), dimension(:) :: tau
    +
    2654 real(real64), intent(out), dimension(:,:) :: q
    +
    2655 real(real64), intent(out), target, dimension(:), optional :: work
    +
    2656 integer(int32), intent(out), optional :: olwork
    +
    2657 class(errors), intent(inout), optional, target :: err
    +
    2658 end subroutine
    +
    2659
    +
    2660 module subroutine form_qr_no_pivot_cmplx(r, tau, q, work, olwork, err)
    +
    2661 complex(real64), intent(inout), dimension(:,:) :: r
    +
    2662 complex(real64), intent(in), dimension(:) :: tau
    +
    2663 complex(real64), intent(out), dimension(:,:) :: q
    +
    2664 complex(real64), intent(out), target, dimension(:), optional :: work
    +
    2665 integer(int32), intent(out), optional :: olwork
    +
    2666 class(errors), intent(inout), optional, target :: err
    +
    2667 end subroutine
    +
    2668
    +
    2669 module subroutine form_qr_pivot(r, tau, pvt, q, p, work, olwork, err)
    +
    2670 real(real64), intent(inout), dimension(:,:) :: r
    +
    2671 real(real64), intent(in), dimension(:) :: tau
    +
    2672 integer(int32), intent(in), dimension(:) :: pvt
    +
    2673 real(real64), intent(out), dimension(:,:) :: q, p
    +
    2674 real(real64), intent(out), target, dimension(:), optional :: work
    +
    2675 integer(int32), intent(out), optional :: olwork
    +
    2676 class(errors), intent(inout), optional, target :: err
    +
    2677 end subroutine
    +
    2678
    +
    2679 module subroutine form_qr_pivot_cmplx(r, tau, pvt, q, p, work, olwork, err)
    +
    2680 complex(real64), intent(inout), dimension(:,:) :: r
    +
    2681 complex(real64), intent(in), dimension(:) :: tau
    +
    2682 integer(int32), intent(in), dimension(:) :: pvt
    +
    2683 complex(real64), intent(out), dimension(:,:) :: q, p
    +
    2684 complex(real64), intent(out), target, dimension(:), optional :: work
    +
    2685 integer(int32), intent(out), optional :: olwork
    2686 class(errors), intent(inout), optional, target :: err
    2687 end subroutine
    -
    2688
    -
    2709 module subroutine cholesky_factor_dbl(a, upper, err)
    -
    2710 real(real64), intent(inout), dimension(:,:) :: a
    -
    2711 logical, intent(in), optional :: upper
    -
    2712 class(errors), intent(inout), optional, target :: err
    -
    2713 end subroutine
    -
    2714
    -
    2735 module subroutine cholesky_factor_cmplx(a, upper, err)
    -
    2736 complex(real64), intent(inout), dimension(:,:) :: a
    -
    2737 logical, intent(in), optional :: upper
    -
    2738 class(errors), intent(inout), optional, target :: err
    -
    2739 end subroutine
    -
    2740
    -
    2767 module subroutine cholesky_rank1_update_dbl(r, u, work, err)
    -
    2768 real(real64), intent(inout), dimension(:,:) :: r
    -
    2769 real(real64), intent(inout), dimension(:) :: u
    -
    2770 real(real64), intent(out), target, optional, dimension(:) :: work
    -
    2771 class(errors), intent(inout), optional, target :: err
    -
    2772 end subroutine
    -
    2773
    -
    2800 module subroutine cholesky_rank1_update_cmplx(r, u, work, err)
    -
    2801 complex(real64), intent(inout), dimension(:,:) :: r
    -
    2802 complex(real64), intent(inout), dimension(:) :: u
    -
    2803 real(real64), intent(out), target, optional, dimension(:) :: work
    -
    2804 class(errors), intent(inout), optional, target :: err
    -
    2805 end subroutine
    -
    2806
    -
    2836 module subroutine cholesky_rank1_downdate_dbl(r, u, work, err)
    -
    2837 real(real64), intent(inout), dimension(:,:) :: r
    -
    2838 real(real64), intent(inout), dimension(:) :: u
    -
    2839 real(real64), intent(out), target, optional, dimension(:) :: work
    -
    2840 class(errors), intent(inout), optional, target :: err
    -
    2841 end subroutine
    -
    2842
    -
    2872 module subroutine cholesky_rank1_downdate_cmplx(r, u, work, err)
    -
    2873 complex(real64), intent(inout), dimension(:,:) :: r
    -
    2874 complex(real64), intent(inout), dimension(:) :: u
    -
    2875 real(real64), intent(out), target, optional, dimension(:) :: work
    -
    2876 class(errors), intent(inout), optional, target :: err
    -
    2877 end subroutine
    -
    2878
    -
    2941 module subroutine rz_factor_dbl(a, tau, work, olwork, err)
    -
    2942 real(real64), intent(inout), dimension(:,:) :: a
    -
    2943 real(real64), intent(out), dimension(:) :: tau
    -
    2944 real(real64), intent(out), target, optional, dimension(:) :: work
    -
    2945 integer(int32), intent(out), optional :: olwork
    -
    2946 class(errors), intent(inout), optional, target :: err
    -
    2947 end subroutine
    -
    2948
    -
    3011 module subroutine rz_factor_cmplx(a, tau, work, olwork, err)
    -
    3012 complex(real64), intent(inout), dimension(:,:) :: a
    -
    3013 complex(real64), intent(out), dimension(:) :: tau
    -
    3014 complex(real64), intent(out), target, optional, dimension(:) :: work
    -
    3015 integer(int32), intent(out), optional :: olwork
    -
    3016 class(errors), intent(inout), optional, target :: err
    -
    3017 end subroutine
    -
    3018
    -
    3056 module subroutine mult_rz_mtx(lside, trans, l, a, tau, c, work, olwork, err)
    -
    3057 logical, intent(in) :: lside, trans
    -
    3058 integer(int32), intent(in) :: l
    -
    3059 real(real64), intent(inout), dimension(:,:) :: a, c
    -
    3060 real(real64), intent(in), dimension(:) :: tau
    -
    3061 real(real64), intent(out), target, optional, dimension(:) :: work
    -
    3062 integer(int32), intent(out), optional :: olwork
    -
    3063 class(errors), intent(inout), optional, target :: err
    -
    3064 end subroutine
    -
    3065
    -
    3103 module subroutine mult_rz_mtx_cmplx(lside, trans, l, a, tau, c, work, olwork, err)
    -
    3104 logical, intent(in) :: lside, trans
    -
    3105 integer(int32), intent(in) :: l
    -
    3106 complex(real64), intent(inout), dimension(:,:) :: a, c
    -
    3107 complex(real64), intent(in), dimension(:) :: tau
    -
    3108 complex(real64), intent(out), target, optional, dimension(:) :: work
    -
    3109 integer(int32), intent(out), optional :: olwork
    -
    3110 class(errors), intent(inout), optional, target :: err
    -
    3111 end subroutine
    -
    3112
    -
    3148 module subroutine mult_rz_vec(trans, l, a, tau, c, work, olwork, err)
    -
    3149 logical, intent(in) :: trans
    -
    3150 integer(int32), intent(in) :: l
    +
    2688
    +
    2689 module subroutine mult_qr_mtx(lside, trans, a, tau, c, work, olwork, err)
    +
    2690 logical, intent(in) :: lside, trans
    +
    2691 real(real64), intent(in), dimension(:) :: tau
    +
    2692 real(real64), intent(inout), dimension(:,:) :: a, c
    +
    2693 real(real64), intent(out), target, dimension(:), optional :: work
    +
    2694 integer(int32), intent(out), optional :: olwork
    +
    2695 class(errors), intent(inout), optional, target :: err
    +
    2696 end subroutine
    +
    2697
    +
    2698 module subroutine mult_qr_mtx_cmplx(lside, trans, a, tau, c, work, olwork, err)
    +
    2699 logical, intent(in) :: lside, trans
    +
    2700 complex(real64), intent(in), dimension(:) :: tau
    +
    2701 complex(real64), intent(inout), dimension(:,:) :: a, c
    +
    2702 complex(real64), intent(out), target, dimension(:), optional :: work
    +
    2703 integer(int32), intent(out), optional :: olwork
    +
    2704 class(errors), intent(inout), optional, target :: err
    +
    2705 end subroutine
    +
    2706
    +
    2707 module subroutine mult_qr_vec(trans, a, tau, c, work, olwork, err)
    +
    2708 logical, intent(in) :: trans
    +
    2709 real(real64), intent(inout), dimension(:,:) :: a
    +
    2710 real(real64), intent(in), dimension(:) :: tau
    +
    2711 real(real64), intent(inout), dimension(:) :: c
    +
    2712 real(real64), intent(out), target, dimension(:), optional :: work
    +
    2713 integer(int32), intent(out), optional :: olwork
    +
    2714 class(errors), intent(inout), optional, target :: err
    +
    2715 end subroutine
    +
    2716
    +
    2717 module subroutine mult_qr_vec_cmplx(trans, a, tau, c, work, olwork, err)
    +
    2718 logical, intent(in) :: trans
    +
    2719 complex(real64), intent(inout), dimension(:,:) :: a
    +
    2720 complex(real64), intent(in), dimension(:) :: tau
    +
    2721 complex(real64), intent(inout), dimension(:) :: c
    +
    2722 complex(real64), intent(out), target, dimension(:), optional :: work
    +
    2723 integer(int32), intent(out), optional :: olwork
    +
    2724 class(errors), intent(inout), optional, target :: err
    +
    2725 end subroutine
    +
    2726
    +
    2727 module subroutine qr_rank1_update_dbl(q, r, u, v, work, err)
    +
    2728 real(real64), intent(inout), dimension(:,:) :: q, r
    +
    2729 real(real64), intent(inout), dimension(:) :: u, v
    +
    2730 real(real64), intent(out), target, optional, dimension(:) :: work
    +
    2731 class(errors), intent(inout), optional, target :: err
    +
    2732 end subroutine
    +
    2733
    +
    2734 module subroutine qr_rank1_update_cmplx(q, r, u, v, work, rwork, err)
    +
    2735 complex(real64), intent(inout), dimension(:,:) :: q, r
    +
    2736 complex(real64), intent(inout), dimension(:) :: u, v
    +
    2737 complex(real64), intent(out), target, optional, dimension(:) :: work
    +
    2738 real(real64), intent(out), target, optional, dimension(:) :: rwork
    +
    2739 class(errors), intent(inout), optional, target :: err
    +
    2740 end subroutine
    +
    2741
    +
    2742 module subroutine cholesky_factor_dbl(a, upper, err)
    +
    2743 real(real64), intent(inout), dimension(:,:) :: a
    +
    2744 logical, intent(in), optional :: upper
    +
    2745 class(errors), intent(inout), optional, target :: err
    +
    2746 end subroutine
    +
    2747
    +
    2748 module subroutine cholesky_factor_cmplx(a, upper, err)
    +
    2749 complex(real64), intent(inout), dimension(:,:) :: a
    +
    2750 logical, intent(in), optional :: upper
    +
    2751 class(errors), intent(inout), optional, target :: err
    +
    2752 end subroutine
    +
    2753
    +
    2754 module subroutine cholesky_rank1_update_dbl(r, u, work, err)
    +
    2755 real(real64), intent(inout), dimension(:,:) :: r
    +
    2756 real(real64), intent(inout), dimension(:) :: u
    +
    2757 real(real64), intent(out), target, optional, dimension(:) :: work
    +
    2758 class(errors), intent(inout), optional, target :: err
    +
    2759 end subroutine
    +
    2760
    +
    2761 module subroutine cholesky_rank1_update_cmplx(r, u, work, err)
    +
    2762 complex(real64), intent(inout), dimension(:,:) :: r
    +
    2763 complex(real64), intent(inout), dimension(:) :: u
    +
    2764 real(real64), intent(out), target, optional, dimension(:) :: work
    +
    2765 class(errors), intent(inout), optional, target :: err
    +
    2766 end subroutine
    +
    2767
    +
    2768 module subroutine cholesky_rank1_downdate_dbl(r, u, work, err)
    +
    2769 real(real64), intent(inout), dimension(:,:) :: r
    +
    2770 real(real64), intent(inout), dimension(:) :: u
    +
    2771 real(real64), intent(out), target, optional, dimension(:) :: work
    +
    2772 class(errors), intent(inout), optional, target :: err
    +
    2773 end subroutine
    +
    2774
    +
    2775 module subroutine cholesky_rank1_downdate_cmplx(r, u, work, err)
    +
    2776 complex(real64), intent(inout), dimension(:,:) :: r
    +
    2777 complex(real64), intent(inout), dimension(:) :: u
    +
    2778 real(real64), intent(out), target, optional, dimension(:) :: work
    +
    2779 class(errors), intent(inout), optional, target :: err
    +
    2780 end subroutine
    +
    2781
    +
    2844 module subroutine rz_factor_dbl(a, tau, work, olwork, err)
    +
    2845 real(real64), intent(inout), dimension(:,:) :: a
    +
    2846 real(real64), intent(out), dimension(:) :: tau
    +
    2847 real(real64), intent(out), target, optional, dimension(:) :: work
    +
    2848 integer(int32), intent(out), optional :: olwork
    +
    2849 class(errors), intent(inout), optional, target :: err
    +
    2850 end subroutine
    +
    2851
    +
    2914 module subroutine rz_factor_cmplx(a, tau, work, olwork, err)
    +
    2915 complex(real64), intent(inout), dimension(:,:) :: a
    +
    2916 complex(real64), intent(out), dimension(:) :: tau
    +
    2917 complex(real64), intent(out), target, optional, dimension(:) :: work
    +
    2918 integer(int32), intent(out), optional :: olwork
    +
    2919 class(errors), intent(inout), optional, target :: err
    +
    2920 end subroutine
    +
    2921
    +
    2959 module subroutine mult_rz_mtx(lside, trans, l, a, tau, c, work, olwork, err)
    +
    2960 logical, intent(in) :: lside, trans
    +
    2961 integer(int32), intent(in) :: l
    +
    2962 real(real64), intent(inout), dimension(:,:) :: a, c
    +
    2963 real(real64), intent(in), dimension(:) :: tau
    +
    2964 real(real64), intent(out), target, optional, dimension(:) :: work
    +
    2965 integer(int32), intent(out), optional :: olwork
    +
    2966 class(errors), intent(inout), optional, target :: err
    +
    2967 end subroutine
    +
    2968
    +
    3006 module subroutine mult_rz_mtx_cmplx(lside, trans, l, a, tau, c, work, olwork, err)
    +
    3007 logical, intent(in) :: lside, trans
    +
    3008 integer(int32), intent(in) :: l
    +
    3009 complex(real64), intent(inout), dimension(:,:) :: a, c
    +
    3010 complex(real64), intent(in), dimension(:) :: tau
    +
    3011 complex(real64), intent(out), target, optional, dimension(:) :: work
    +
    3012 integer(int32), intent(out), optional :: olwork
    +
    3013 class(errors), intent(inout), optional, target :: err
    +
    3014 end subroutine
    +
    3015
    +
    3051 module subroutine mult_rz_vec(trans, l, a, tau, c, work, olwork, err)
    +
    3052 logical, intent(in) :: trans
    +
    3053 integer(int32), intent(in) :: l
    +
    3054 real(real64), intent(inout), dimension(:,:) :: a
    +
    3055 real(real64), intent(in), dimension(:) :: tau
    +
    3056 real(real64), intent(inout), dimension(:) :: c
    +
    3057 real(real64), intent(out), target, optional, dimension(:) :: work
    +
    3058 integer(int32), intent(out), optional :: olwork
    +
    3059 class(errors), intent(inout), optional, target :: err
    +
    3060 end subroutine
    +
    3061
    +
    3097 module subroutine mult_rz_vec_cmplx(trans, l, a, tau, c, work, olwork, err)
    +
    3098 logical, intent(in) :: trans
    +
    3099 integer(int32), intent(in) :: l
    +
    3100 complex(real64), intent(inout), dimension(:,:) :: a
    +
    3101 complex(real64), intent(in), dimension(:) :: tau
    +
    3102 complex(real64), intent(inout), dimension(:) :: c
    +
    3103 complex(real64), intent(out), target, optional, dimension(:) :: work
    +
    3104 integer(int32), intent(out), optional :: olwork
    +
    3105 class(errors), intent(inout), optional, target :: err
    +
    3106 end subroutine
    +
    3107
    +
    3150 module subroutine svd_dbl(a, s, u, vt, work, olwork, err)
    3151 real(real64), intent(inout), dimension(:,:) :: a
    -
    3152 real(real64), intent(in), dimension(:) :: tau
    -
    3153 real(real64), intent(inout), dimension(:) :: c
    +
    3152 real(real64), intent(out), dimension(:) :: s
    +
    3153 real(real64), intent(out), optional, dimension(:,:) :: u, vt
    3154 real(real64), intent(out), target, optional, dimension(:) :: work
    3155 integer(int32), intent(out), optional :: olwork
    3156 class(errors), intent(inout), optional, target :: err
    3157 end subroutine
    3158
    -
    3194 module subroutine mult_rz_vec_cmplx(trans, l, a, tau, c, work, olwork, err)
    -
    3195 logical, intent(in) :: trans
    -
    3196 integer(int32), intent(in) :: l
    -
    3197 complex(real64), intent(inout), dimension(:,:) :: a
    -
    3198 complex(real64), intent(in), dimension(:) :: tau
    -
    3199 complex(real64), intent(inout), dimension(:) :: c
    -
    3200 complex(real64), intent(out), target, optional, dimension(:) :: work
    -
    3201 integer(int32), intent(out), optional :: olwork
    -
    3202 class(errors), intent(inout), optional, target :: err
    -
    3203 end subroutine
    -
    3204
    -
    3247 module subroutine svd_dbl(a, s, u, vt, work, olwork, err)
    -
    3248 real(real64), intent(inout), dimension(:,:) :: a
    -
    3249 real(real64), intent(out), dimension(:) :: s
    -
    3250 real(real64), intent(out), optional, dimension(:,:) :: u, vt
    -
    3251 real(real64), intent(out), target, optional, dimension(:) :: work
    -
    3252 integer(int32), intent(out), optional :: olwork
    +
    3205 module subroutine svd_cmplx(a, s, u, vt, work, olwork, rwork, err)
    +
    3206 complex(real64), intent(inout), dimension(:,:) :: a
    +
    3207 real(real64), intent(out), dimension(:) :: s
    +
    3208 complex(real64), intent(out), optional, dimension(:,:) :: u, vt
    +
    3209 complex(real64), intent(out), target, optional, dimension(:) :: work
    +
    3210 integer(int32), intent(out), optional :: olwork
    +
    3211 real(real64), intent(out), target, optional, dimension(:) :: rwork
    +
    3212 class(errors), intent(inout), optional, target :: err
    +
    3213 end subroutine
    +
    3214end interface
    +
    3215
    +
    3216! ******************************************************************************
    +
    3217! LINALG_SOLVE.F90
    +
    3218! ------------------------------------------------------------------------------
    +
    3219interface
    +
    3220
    +
    3248 module subroutine solve_tri_mtx(lside, upper, trans, nounit, alpha, a, b, err)
    +
    3249 logical, intent(in) :: lside, upper, trans, nounit
    +
    3250 real(real64), intent(in) :: alpha
    +
    3251 real(real64), intent(in), dimension(:,:) :: a
    +
    3252 real(real64), intent(inout), dimension(:,:) :: b
    3253 class(errors), intent(inout), optional, target :: err
    3254 end subroutine
    3255
    -
    3302 module subroutine svd_cmplx(a, s, u, vt, work, olwork, rwork, err)
    -
    3303 complex(real64), intent(inout), dimension(:,:) :: a
    -
    3304 real(real64), intent(out), dimension(:) :: s
    -
    3305 complex(real64), intent(out), optional, dimension(:,:) :: u, vt
    -
    3306 complex(real64), intent(out), target, optional, dimension(:) :: work
    -
    3307 integer(int32), intent(out), optional :: olwork
    -
    3308 real(real64), intent(out), target, optional, dimension(:) :: rwork
    -
    3309 class(errors), intent(inout), optional, target :: err
    -
    3310 end subroutine
    -
    3311end interface
    -
    3312
    -
    3313! ******************************************************************************
    -
    3314! LINALG_SOLVE.F90
    -
    3315! ------------------------------------------------------------------------------
    -
    3316interface
    -
    3317
    -
    3345 module subroutine solve_tri_mtx(lside, upper, trans, nounit, alpha, a, b, err)
    -
    3346 logical, intent(in) :: lside, upper, trans, nounit
    -
    3347 real(real64), intent(in) :: alpha
    -
    3348 real(real64), intent(in), dimension(:,:) :: a
    -
    3349 real(real64), intent(inout), dimension(:,:) :: b
    -
    3350 class(errors), intent(inout), optional, target :: err
    -
    3351 end subroutine
    -
    3352
    -
    3381 module subroutine solve_tri_mtx_cmplx(lside, upper, trans, nounit, alpha, a, b, err)
    -
    3382 logical, intent(in) :: lside, upper, trans, nounit
    -
    3383 complex(real64), intent(in) :: alpha
    -
    3384 complex(real64), intent(in), dimension(:,:) :: a
    -
    3385 complex(real64), intent(inout), dimension(:,:) :: b
    -
    3386 class(errors), intent(inout), optional, target :: err
    -
    3387 end subroutine
    -
    3388
    -
    3433 module subroutine solve_tri_vec(upper, trans, nounit, a, x, err)
    -
    3434 logical, intent(in) :: upper, trans, nounit
    -
    3435 real(real64), intent(in), dimension(:,:) :: a
    -
    3436 real(real64), intent(inout), dimension(:) :: x
    +
    3284 module subroutine solve_tri_mtx_cmplx(lside, upper, trans, nounit, alpha, a, b, err)
    +
    3285 logical, intent(in) :: lside, upper, trans, nounit
    +
    3286 complex(real64), intent(in) :: alpha
    +
    3287 complex(real64), intent(in), dimension(:,:) :: a
    +
    3288 complex(real64), intent(inout), dimension(:,:) :: b
    +
    3289 class(errors), intent(inout), optional, target :: err
    +
    3290 end subroutine
    +
    3291
    +
    3336 module subroutine solve_tri_vec(upper, trans, nounit, a, x, err)
    +
    3337 logical, intent(in) :: upper, trans, nounit
    +
    3338 real(real64), intent(in), dimension(:,:) :: a
    +
    3339 real(real64), intent(inout), dimension(:) :: x
    +
    3340 class(errors), intent(inout), optional, target :: err
    +
    3341 end subroutine
    +
    3342
    +
    3387 module subroutine solve_tri_vec_cmplx(upper, trans, nounit, a, x, err)
    +
    3388 logical, intent(in) :: upper, trans, nounit
    +
    3389 complex(real64), intent(in), dimension(:,:) :: a
    +
    3390 complex(real64), intent(inout), dimension(:) :: x
    +
    3391 class(errors), intent(inout), optional, target :: err
    +
    3392 end subroutine
    +
    3393
    +
    3410 module subroutine solve_lu_mtx(a, ipvt, b, err)
    +
    3411 real(real64), intent(in), dimension(:,:) :: a
    +
    3412 integer(int32), intent(in), dimension(:) :: ipvt
    +
    3413 real(real64), intent(inout), dimension(:,:) :: b
    +
    3414 class(errors), intent(inout), optional, target :: err
    +
    3415 end subroutine
    +
    3416
    +
    3433 module subroutine solve_lu_mtx_cmplx(a, ipvt, b, err)
    +
    3434 complex(real64), intent(in), dimension(:,:) :: a
    +
    3435 integer(int32), intent(in), dimension(:) :: ipvt
    +
    3436 complex(real64), intent(inout), dimension(:,:) :: b
    3437 class(errors), intent(inout), optional, target :: err
    3438 end subroutine
    3439
    -
    3484 module subroutine solve_tri_vec_cmplx(upper, trans, nounit, a, x, err)
    -
    3485 logical, intent(in) :: upper, trans, nounit
    -
    3486 complex(real64), intent(in), dimension(:,:) :: a
    -
    3487 complex(real64), intent(inout), dimension(:) :: x
    -
    3488 class(errors), intent(inout), optional, target :: err
    -
    3489 end subroutine
    -
    3490
    -
    3507 module subroutine solve_lu_mtx(a, ipvt, b, err)
    -
    3508 real(real64), intent(in), dimension(:,:) :: a
    -
    3509 integer(int32), intent(in), dimension(:) :: ipvt
    -
    3510 real(real64), intent(inout), dimension(:,:) :: b
    -
    3511 class(errors), intent(inout), optional, target :: err
    -
    3512 end subroutine
    -
    3513
    -
    3530 module subroutine solve_lu_mtx_cmplx(a, ipvt, b, err)
    -
    3531 complex(real64), intent(in), dimension(:,:) :: a
    -
    3532 integer(int32), intent(in), dimension(:) :: ipvt
    -
    3533 complex(real64), intent(inout), dimension(:,:) :: b
    -
    3534 class(errors), intent(inout), optional, target :: err
    -
    3535 end subroutine
    -
    3536
    -
    3553 module subroutine solve_lu_vec(a, ipvt, b, err)
    -
    3554 real(real64), intent(in), dimension(:,:) :: a
    -
    3555 integer(int32), intent(in), dimension(:) :: ipvt
    -
    3556 real(real64), intent(inout), dimension(:) :: b
    +
    3456 module subroutine solve_lu_vec(a, ipvt, b, err)
    +
    3457 real(real64), intent(in), dimension(:,:) :: a
    +
    3458 integer(int32), intent(in), dimension(:) :: ipvt
    +
    3459 real(real64), intent(inout), dimension(:) :: b
    +
    3460 class(errors), intent(inout), optional, target :: err
    +
    3461 end subroutine
    +
    3462
    +
    3479 module subroutine solve_lu_vec_cmplx(a, ipvt, b, err)
    +
    3480 complex(real64), intent(in), dimension(:,:) :: a
    +
    3481 integer(int32), intent(in), dimension(:) :: ipvt
    +
    3482 complex(real64), intent(inout), dimension(:) :: b
    +
    3483 class(errors), intent(inout), optional, target :: err
    +
    3484 end subroutine
    +
    3485
    +
    3515 module subroutine solve_qr_no_pivot_mtx(a, tau, b, work, olwork, err)
    +
    3516 real(real64), intent(inout), dimension(:,:) :: a, b
    +
    3517 real(real64), intent(in), dimension(:) :: tau
    +
    3518 real(real64), intent(out), target, optional, dimension(:) :: work
    +
    3519 integer(int32), intent(out), optional :: olwork
    +
    3520 class(errors), intent(inout), optional, target :: err
    +
    3521 end subroutine
    +
    3522
    +
    3552 module subroutine solve_qr_no_pivot_mtx_cmplx(a, tau, b, work, olwork, err)
    +
    3553 complex(real64), intent(inout), dimension(:,:) :: a, b
    +
    3554 complex(real64), intent(in), dimension(:) :: tau
    +
    3555 complex(real64), intent(out), target, optional, dimension(:) :: work
    +
    3556 integer(int32), intent(out), optional :: olwork
    3557 class(errors), intent(inout), optional, target :: err
    3558 end subroutine
    3559
    -
    3576 module subroutine solve_lu_vec_cmplx(a, ipvt, b, err)
    -
    3577 complex(real64), intent(in), dimension(:,:) :: a
    -
    3578 integer(int32), intent(in), dimension(:) :: ipvt
    -
    3579 complex(real64), intent(inout), dimension(:) :: b
    -
    3580 class(errors), intent(inout), optional, target :: err
    -
    3581 end subroutine
    -
    3582
    -
    3612 module subroutine solve_qr_no_pivot_mtx(a, tau, b, work, olwork, err)
    -
    3613 real(real64), intent(inout), dimension(:,:) :: a, b
    -
    3614 real(real64), intent(in), dimension(:) :: tau
    -
    3615 real(real64), intent(out), target, optional, dimension(:) :: work
    -
    3616 integer(int32), intent(out), optional :: olwork
    -
    3617 class(errors), intent(inout), optional, target :: err
    -
    3618 end subroutine
    -
    3619
    -
    3649 module subroutine solve_qr_no_pivot_mtx_cmplx(a, tau, b, work, olwork, err)
    -
    3650 complex(real64), intent(inout), dimension(:,:) :: a, b
    -
    3651 complex(real64), intent(in), dimension(:) :: tau
    -
    3652 complex(real64), intent(out), target, optional, dimension(:) :: work
    -
    3653 integer(int32), intent(out), optional :: olwork
    -
    3654 class(errors), intent(inout), optional, target :: err
    -
    3655 end subroutine
    -
    3656
    -
    3686 module subroutine solve_qr_no_pivot_vec(a, tau, b, work, olwork, err)
    -
    3687 real(real64), intent(inout), dimension(:,:) :: a
    -
    3688 real(real64), intent(in), dimension(:) :: tau
    -
    3689 real(real64), intent(inout), dimension(:) :: b
    -
    3690 real(real64), intent(out), target, optional, dimension(:) :: work
    -
    3691 integer(int32), intent(out), optional :: olwork
    -
    3692 class(errors), intent(inout), optional, target :: err
    -
    3693 end subroutine
    -
    3694
    -
    3724 module subroutine solve_qr_no_pivot_vec_cmplx(a, tau, b, work, olwork, err)
    -
    3725 complex(real64), intent(inout), dimension(:,:) :: a
    -
    3726 complex(real64), intent(in), dimension(:) :: tau
    -
    3727 complex(real64), intent(inout), dimension(:) :: b
    -
    3728 complex(real64), intent(out), target, optional, dimension(:) :: work
    -
    3729 integer(int32), intent(out), optional :: olwork
    -
    3730 class(errors), intent(inout), optional, target :: err
    -
    3731 end subroutine
    -
    3732
    -
    3764 module subroutine solve_qr_pivot_mtx(a, tau, jpvt, b, work, olwork, err)
    -
    3765 real(real64), intent(inout), dimension(:,:) :: a
    -
    3766 real(real64), intent(in), dimension(:) :: tau
    -
    3767 integer(int32), intent(in), dimension(:) :: jpvt
    -
    3768 real(real64), intent(inout), dimension(:,:) :: b
    -
    3769 real(real64), intent(out), target, optional, dimension(:) :: work
    -
    3770 integer(int32), intent(out), optional :: olwork
    -
    3771 class(errors), intent(inout), optional, target :: err
    -
    3772 end subroutine
    -
    3773
    -
    3805 module subroutine solve_qr_pivot_mtx_cmplx(a, tau, jpvt, b, work, olwork, err)
    -
    3806 complex(real64), intent(inout), dimension(:,:) :: a
    -
    3807 complex(real64), intent(in), dimension(:) :: tau
    -
    3808 integer(int32), intent(in), dimension(:) :: jpvt
    -
    3809 complex(real64), intent(inout), dimension(:,:) :: b
    -
    3810 complex(real64), intent(out), target, optional, dimension(:) :: work
    -
    3811 integer(int32), intent(out), optional :: olwork
    -
    3812 class(errors), intent(inout), optional, target :: err
    -
    3813 end subroutine
    -
    3814
    -
    3846 module subroutine solve_qr_pivot_vec(a, tau, jpvt, b, work, olwork, err)
    -
    3847 real(real64), intent(inout), dimension(:,:) :: a
    -
    3848 real(real64), intent(in), dimension(:) :: tau
    -
    3849 integer(int32), intent(in), dimension(:) :: jpvt
    -
    3850 real(real64), intent(inout), dimension(:) :: b
    -
    3851 real(real64), intent(out), target, optional, dimension(:) :: work
    -
    3852 integer(int32), intent(out), optional :: olwork
    -
    3853 class(errors), intent(inout), optional, target :: err
    -
    3854 end subroutine
    -
    3855
    -
    3887 module subroutine solve_qr_pivot_vec_cmplx(a, tau, jpvt, b, work, olwork, err)
    -
    3888 complex(real64), intent(inout), dimension(:,:) :: a
    -
    3889 complex(real64), intent(in), dimension(:) :: tau
    -
    3890 integer(int32), intent(in), dimension(:) :: jpvt
    -
    3891 complex(real64), intent(inout), dimension(:) :: b
    -
    3892 complex(real64), intent(out), target, optional, dimension(:) :: work
    -
    3893 integer(int32), intent(out), optional :: olwork
    -
    3894 class(errors), intent(inout), optional, target :: err
    -
    3895 end subroutine
    -
    3896
    -
    3915 module subroutine solve_cholesky_mtx(upper, a, b, err)
    -
    3916 logical, intent(in) :: upper
    -
    3917 real(real64), intent(in), dimension(:,:) :: a
    -
    3918 real(real64), intent(inout), dimension(:,:) :: b
    -
    3919 class(errors), intent(inout), optional, target :: err
    -
    3920 end subroutine
    -
    3921
    -
    3940 module subroutine solve_cholesky_mtx_cmplx(upper, a, b, err)
    -
    3941 logical, intent(in) :: upper
    -
    3942 complex(real64), intent(in), dimension(:,:) :: a
    -
    3943 complex(real64), intent(inout), dimension(:,:) :: b
    -
    3944 class(errors), intent(inout), optional, target :: err
    -
    3945 end subroutine
    -
    3946
    -
    3965 module subroutine solve_cholesky_vec(upper, a, b, err)
    -
    3966 logical, intent(in) :: upper
    -
    3967 real(real64), intent(in), dimension(:,:) :: a
    -
    3968 real(real64), intent(inout), dimension(:) :: b
    -
    3969 class(errors), intent(inout), optional, target :: err
    -
    3970 end subroutine
    -
    3971
    -
    3990 module subroutine solve_cholesky_vec_cmplx(upper, a, b, err)
    -
    3991 logical, intent(in) :: upper
    -
    3992 complex(real64), intent(in), dimension(:,:) :: a
    -
    3993 complex(real64), intent(inout), dimension(:) :: b
    -
    3994 class(errors), intent(inout), optional, target :: err
    -
    3995 end subroutine
    -
    3996
    -
    4028 module subroutine solve_least_squares_mtx(a, b, work, olwork, err)
    -
    4029 real(real64), intent(inout), dimension(:,:) :: a, b
    -
    4030 real(real64), intent(out), target, optional, dimension(:) :: work
    -
    4031 integer(int32), intent(out), optional :: olwork
    -
    4032 class(errors), intent(inout), optional, target :: err
    -
    4033 end subroutine
    -
    4034
    -
    4066 module subroutine solve_least_squares_mtx_cmplx(a, b, work, olwork, err)
    -
    4067 complex(real64), intent(inout), dimension(:,:) :: a, b
    -
    4068 complex(real64), intent(out), target, optional, dimension(:) :: work
    -
    4069 integer(int32), intent(out), optional :: olwork
    -
    4070 class(errors), intent(inout), optional, target :: err
    -
    4071 end subroutine
    -
    4072
    -
    4104 module subroutine solve_least_squares_vec(a, b, work, olwork, err)
    -
    4105 real(real64), intent(inout), dimension(:,:) :: a
    -
    4106 real(real64), intent(inout), dimension(:) :: b
    -
    4107 real(real64), intent(out), target, optional, dimension(:) :: work
    -
    4108 integer(int32), intent(out), optional :: olwork
    -
    4109 class(errors), intent(inout), optional, target :: err
    -
    4110 end subroutine
    -
    4111
    -
    4143 module subroutine solve_least_squares_vec_cmplx(a, b, work, olwork, err)
    -
    4144 complex(real64), intent(inout), dimension(:,:) :: a
    -
    4145 complex(real64), intent(inout), dimension(:) :: b
    +
    3589 module subroutine solve_qr_no_pivot_vec(a, tau, b, work, olwork, err)
    +
    3590 real(real64), intent(inout), dimension(:,:) :: a
    +
    3591 real(real64), intent(in), dimension(:) :: tau
    +
    3592 real(real64), intent(inout), dimension(:) :: b
    +
    3593 real(real64), intent(out), target, optional, dimension(:) :: work
    +
    3594 integer(int32), intent(out), optional :: olwork
    +
    3595 class(errors), intent(inout), optional, target :: err
    +
    3596 end subroutine
    +
    3597
    +
    3627 module subroutine solve_qr_no_pivot_vec_cmplx(a, tau, b, work, olwork, err)
    +
    3628 complex(real64), intent(inout), dimension(:,:) :: a
    +
    3629 complex(real64), intent(in), dimension(:) :: tau
    +
    3630 complex(real64), intent(inout), dimension(:) :: b
    +
    3631 complex(real64), intent(out), target, optional, dimension(:) :: work
    +
    3632 integer(int32), intent(out), optional :: olwork
    +
    3633 class(errors), intent(inout), optional, target :: err
    +
    3634 end subroutine
    +
    3635
    +
    3667 module subroutine solve_qr_pivot_mtx(a, tau, jpvt, b, work, olwork, err)
    +
    3668 real(real64), intent(inout), dimension(:,:) :: a
    +
    3669 real(real64), intent(in), dimension(:) :: tau
    +
    3670 integer(int32), intent(in), dimension(:) :: jpvt
    +
    3671 real(real64), intent(inout), dimension(:,:) :: b
    +
    3672 real(real64), intent(out), target, optional, dimension(:) :: work
    +
    3673 integer(int32), intent(out), optional :: olwork
    +
    3674 class(errors), intent(inout), optional, target :: err
    +
    3675 end subroutine
    +
    3676
    +
    3708 module subroutine solve_qr_pivot_mtx_cmplx(a, tau, jpvt, b, work, olwork, err)
    +
    3709 complex(real64), intent(inout), dimension(:,:) :: a
    +
    3710 complex(real64), intent(in), dimension(:) :: tau
    +
    3711 integer(int32), intent(in), dimension(:) :: jpvt
    +
    3712 complex(real64), intent(inout), dimension(:,:) :: b
    +
    3713 complex(real64), intent(out), target, optional, dimension(:) :: work
    +
    3714 integer(int32), intent(out), optional :: olwork
    +
    3715 class(errors), intent(inout), optional, target :: err
    +
    3716 end subroutine
    +
    3717
    +
    3749 module subroutine solve_qr_pivot_vec(a, tau, jpvt, b, work, olwork, err)
    +
    3750 real(real64), intent(inout), dimension(:,:) :: a
    +
    3751 real(real64), intent(in), dimension(:) :: tau
    +
    3752 integer(int32), intent(in), dimension(:) :: jpvt
    +
    3753 real(real64), intent(inout), dimension(:) :: b
    +
    3754 real(real64), intent(out), target, optional, dimension(:) :: work
    +
    3755 integer(int32), intent(out), optional :: olwork
    +
    3756 class(errors), intent(inout), optional, target :: err
    +
    3757 end subroutine
    +
    3758
    +
    3790 module subroutine solve_qr_pivot_vec_cmplx(a, tau, jpvt, b, work, olwork, err)
    +
    3791 complex(real64), intent(inout), dimension(:,:) :: a
    +
    3792 complex(real64), intent(in), dimension(:) :: tau
    +
    3793 integer(int32), intent(in), dimension(:) :: jpvt
    +
    3794 complex(real64), intent(inout), dimension(:) :: b
    +
    3795 complex(real64), intent(out), target, optional, dimension(:) :: work
    +
    3796 integer(int32), intent(out), optional :: olwork
    +
    3797 class(errors), intent(inout), optional, target :: err
    +
    3798 end subroutine
    +
    3799
    +
    3818 module subroutine solve_cholesky_mtx(upper, a, b, err)
    +
    3819 logical, intent(in) :: upper
    +
    3820 real(real64), intent(in), dimension(:,:) :: a
    +
    3821 real(real64), intent(inout), dimension(:,:) :: b
    +
    3822 class(errors), intent(inout), optional, target :: err
    +
    3823 end subroutine
    +
    3824
    +
    3843 module subroutine solve_cholesky_mtx_cmplx(upper, a, b, err)
    +
    3844 logical, intent(in) :: upper
    +
    3845 complex(real64), intent(in), dimension(:,:) :: a
    +
    3846 complex(real64), intent(inout), dimension(:,:) :: b
    +
    3847 class(errors), intent(inout), optional, target :: err
    +
    3848 end subroutine
    +
    3849
    +
    3868 module subroutine solve_cholesky_vec(upper, a, b, err)
    +
    3869 logical, intent(in) :: upper
    +
    3870 real(real64), intent(in), dimension(:,:) :: a
    +
    3871 real(real64), intent(inout), dimension(:) :: b
    +
    3872 class(errors), intent(inout), optional, target :: err
    +
    3873 end subroutine
    +
    3874
    +
    3893 module subroutine solve_cholesky_vec_cmplx(upper, a, b, err)
    +
    3894 logical, intent(in) :: upper
    +
    3895 complex(real64), intent(in), dimension(:,:) :: a
    +
    3896 complex(real64), intent(inout), dimension(:) :: b
    +
    3897 class(errors), intent(inout), optional, target :: err
    +
    3898 end subroutine
    +
    3899
    +
    3931 module subroutine solve_least_squares_mtx(a, b, work, olwork, err)
    +
    3932 real(real64), intent(inout), dimension(:,:) :: a, b
    +
    3933 real(real64), intent(out), target, optional, dimension(:) :: work
    +
    3934 integer(int32), intent(out), optional :: olwork
    +
    3935 class(errors), intent(inout), optional, target :: err
    +
    3936 end subroutine
    +
    3937
    +
    3969 module subroutine solve_least_squares_mtx_cmplx(a, b, work, olwork, err)
    +
    3970 complex(real64), intent(inout), dimension(:,:) :: a, b
    +
    3971 complex(real64), intent(out), target, optional, dimension(:) :: work
    +
    3972 integer(int32), intent(out), optional :: olwork
    +
    3973 class(errors), intent(inout), optional, target :: err
    +
    3974 end subroutine
    +
    3975
    +
    4007 module subroutine solve_least_squares_vec(a, b, work, olwork, err)
    +
    4008 real(real64), intent(inout), dimension(:,:) :: a
    +
    4009 real(real64), intent(inout), dimension(:) :: b
    +
    4010 real(real64), intent(out), target, optional, dimension(:) :: work
    +
    4011 integer(int32), intent(out), optional :: olwork
    +
    4012 class(errors), intent(inout), optional, target :: err
    +
    4013 end subroutine
    +
    4014
    +
    4046 module subroutine solve_least_squares_vec_cmplx(a, b, work, olwork, err)
    +
    4047 complex(real64), intent(inout), dimension(:,:) :: a
    +
    4048 complex(real64), intent(inout), dimension(:) :: b
    +
    4049 complex(real64), intent(out), target, optional, dimension(:) :: work
    +
    4050 integer(int32), intent(out), optional :: olwork
    +
    4051 class(errors), intent(inout), optional, target :: err
    +
    4052 end subroutine
    +
    4053
    +
    4091 module subroutine solve_least_squares_mtx_pvt(a, b, ipvt, arnk, work, olwork, err)
    +
    4092 real(real64), intent(inout), dimension(:,:) :: a, b
    +
    4093 integer(int32), intent(inout), target, optional, dimension(:) :: ipvt
    +
    4094 integer(int32), intent(out), optional :: arnk
    +
    4095 real(real64), intent(out), target, optional, dimension(:) :: work
    +
    4096 integer(int32), intent(out), optional :: olwork
    +
    4097 class(errors), intent(inout), optional, target :: err
    +
    4098 end subroutine
    +
    4099
    +
    4141 module subroutine solve_least_squares_mtx_pvt_cmplx(a, b, ipvt, arnk, &
    +
    4142 work, olwork, rwork, err)
    +
    4143 complex(real64), intent(inout), dimension(:,:) :: a, b
    +
    4144 integer(int32), intent(inout), target, optional, dimension(:) :: ipvt
    +
    4145 integer(int32), intent(out), optional :: arnk
    4146 complex(real64), intent(out), target, optional, dimension(:) :: work
    4147 integer(int32), intent(out), optional :: olwork
    -
    4148 class(errors), intent(inout), optional, target :: err
    -
    4149 end subroutine
    -
    4150
    -
    4188 module subroutine solve_least_squares_mtx_pvt(a, b, ipvt, arnk, work, olwork, err)
    -
    4189 real(real64), intent(inout), dimension(:,:) :: a, b
    -
    4190 integer(int32), intent(inout), target, optional, dimension(:) :: ipvt
    -
    4191 integer(int32), intent(out), optional :: arnk
    -
    4192 real(real64), intent(out), target, optional, dimension(:) :: work
    -
    4193 integer(int32), intent(out), optional :: olwork
    -
    4194 class(errors), intent(inout), optional, target :: err
    -
    4195 end subroutine
    -
    4196
    -
    4238 module subroutine solve_least_squares_mtx_pvt_cmplx(a, b, ipvt, arnk, &
    -
    4239 work, olwork, rwork, err)
    -
    4240 complex(real64), intent(inout), dimension(:,:) :: a, b
    -
    4241 integer(int32), intent(inout), target, optional, dimension(:) :: ipvt
    -
    4242 integer(int32), intent(out), optional :: arnk
    -
    4243 complex(real64), intent(out), target, optional, dimension(:) :: work
    -
    4244 integer(int32), intent(out), optional :: olwork
    -
    4245 real(real64), intent(out), target, optional, dimension(:) :: rwork
    -
    4246 class(errors), intent(inout), optional, target :: err
    -
    4247 end subroutine
    -
    4248
    -
    4286 module subroutine solve_least_squares_vec_pvt(a, b, ipvt, arnk, work, olwork, err)
    -
    4287 real(real64), intent(inout), dimension(:,:) :: a
    -
    4288 real(real64), intent(inout), dimension(:) :: b
    -
    4289 integer(int32), intent(inout), target, optional, dimension(:) :: ipvt
    -
    4290 integer(int32), intent(out), optional :: arnk
    -
    4291 real(real64), intent(out), target, optional, dimension(:) :: work
    -
    4292 integer(int32), intent(out), optional :: olwork
    -
    4293 class(errors), intent(inout), optional, target :: err
    -
    4294 end subroutine
    -
    4295
    -
    4337 module subroutine solve_least_squares_vec_pvt_cmplx(a, b, ipvt, arnk, &
    -
    4338 work, olwork, rwork, err)
    -
    4339 complex(real64), intent(inout), dimension(:,:) :: a
    -
    4340 complex(real64), intent(inout), dimension(:) :: b
    -
    4341 integer(int32), intent(inout), target, optional, dimension(:) :: ipvt
    -
    4342 integer(int32), intent(out), optional :: arnk
    -
    4343 complex(real64), intent(out), target, optional, dimension(:) :: work
    -
    4344 integer(int32), intent(out), optional :: olwork
    -
    4345 real(real64), intent(out), target, optional, dimension(:) :: rwork
    -
    4346 class(errors), intent(inout), optional, target :: err
    -
    4347 end subroutine
    -
    4348
    -
    4387 module subroutine solve_least_squares_mtx_svd(a, b, s, arnk, work, olwork, err)
    -
    4388 real(real64), intent(inout), dimension(:,:) :: a, b
    +
    4148 real(real64), intent(out), target, optional, dimension(:) :: rwork
    +
    4149 class(errors), intent(inout), optional, target :: err
    +
    4150 end subroutine
    +
    4151
    +
    4189 module subroutine solve_least_squares_vec_pvt(a, b, ipvt, arnk, work, olwork, err)
    +
    4190 real(real64), intent(inout), dimension(:,:) :: a
    +
    4191 real(real64), intent(inout), dimension(:) :: b
    +
    4192 integer(int32), intent(inout), target, optional, dimension(:) :: ipvt
    +
    4193 integer(int32), intent(out), optional :: arnk
    +
    4194 real(real64), intent(out), target, optional, dimension(:) :: work
    +
    4195 integer(int32), intent(out), optional :: olwork
    +
    4196 class(errors), intent(inout), optional, target :: err
    +
    4197 end subroutine
    +
    4198
    +
    4240 module subroutine solve_least_squares_vec_pvt_cmplx(a, b, ipvt, arnk, &
    +
    4241 work, olwork, rwork, err)
    +
    4242 complex(real64), intent(inout), dimension(:,:) :: a
    +
    4243 complex(real64), intent(inout), dimension(:) :: b
    +
    4244 integer(int32), intent(inout), target, optional, dimension(:) :: ipvt
    +
    4245 integer(int32), intent(out), optional :: arnk
    +
    4246 complex(real64), intent(out), target, optional, dimension(:) :: work
    +
    4247 integer(int32), intent(out), optional :: olwork
    +
    4248 real(real64), intent(out), target, optional, dimension(:) :: rwork
    +
    4249 class(errors), intent(inout), optional, target :: err
    +
    4250 end subroutine
    +
    4251
    +
    4290 module subroutine solve_least_squares_mtx_svd(a, b, s, arnk, work, olwork, err)
    +
    4291 real(real64), intent(inout), dimension(:,:) :: a, b
    +
    4292 integer(int32), intent(out), optional :: arnk
    +
    4293 real(real64), intent(out), target, optional, dimension(:) :: work, s
    +
    4294 integer(int32), intent(out), optional :: olwork
    +
    4295 class(errors), intent(inout), optional, target :: err
    +
    4296 end subroutine
    +
    4297
    +
    4340 module subroutine solve_least_squares_mtx_svd_cmplx(a, b, s, arnk, work, &
    +
    4341 olwork, rwork, err)
    +
    4342 complex(real64), intent(inout), dimension(:,:) :: a, b
    +
    4343 integer(int32), intent(out), optional :: arnk
    +
    4344 complex(real64), intent(out), target, optional, dimension(:) :: work
    +
    4345 real(real64), intent(out), target, optional, dimension(:) :: rwork, s
    +
    4346 integer(int32), intent(out), optional :: olwork
    +
    4347 class(errors), intent(inout), optional, target :: err
    +
    4348 end subroutine
    +
    4349
    +
    4386 module subroutine solve_least_squares_vec_svd(a, b, s, arnk, work, olwork, err)
    +
    4387 real(real64), intent(inout), dimension(:,:) :: a
    +
    4388 real(real64), intent(inout), dimension(:) :: b
    4389 integer(int32), intent(out), optional :: arnk
    4390 real(real64), intent(out), target, optional, dimension(:) :: work, s
    4391 integer(int32), intent(out), optional :: olwork
    4392 class(errors), intent(inout), optional, target :: err
    4393 end subroutine
    4394
    -
    4437 module subroutine solve_least_squares_mtx_svd_cmplx(a, b, s, arnk, work, &
    -
    4438 olwork, rwork, err)
    -
    4439 complex(real64), intent(inout), dimension(:,:) :: a, b
    -
    4440 integer(int32), intent(out), optional :: arnk
    -
    4441 complex(real64), intent(out), target, optional, dimension(:) :: work
    -
    4442 real(real64), intent(out), target, optional, dimension(:) :: rwork, s
    -
    4443 integer(int32), intent(out), optional :: olwork
    -
    4444 class(errors), intent(inout), optional, target :: err
    -
    4445 end subroutine
    -
    4446
    -
    4483 module subroutine solve_least_squares_vec_svd(a, b, s, arnk, work, olwork, err)
    -
    4484 real(real64), intent(inout), dimension(:,:) :: a
    -
    4485 real(real64), intent(inout), dimension(:) :: b
    -
    4486 integer(int32), intent(out), optional :: arnk
    -
    4487 real(real64), intent(out), target, optional, dimension(:) :: work, s
    -
    4488 integer(int32), intent(out), optional :: olwork
    -
    4489 class(errors), intent(inout), optional, target :: err
    -
    4490 end subroutine
    -
    4491
    -
    4532 module subroutine solve_least_squares_vec_svd_cmplx(a, b, s, arnk, work, &
    -
    4533 olwork, rwork, err)
    -
    4534 complex(real64), intent(inout), dimension(:,:) :: a
    -
    4535 complex(real64), intent(inout), dimension(:) :: b
    -
    4536 integer(int32), intent(out), optional :: arnk
    -
    4537 complex(real64), intent(out), target, optional, dimension(:) :: work
    -
    4538 real(real64), intent(out), target, optional, dimension(:) :: rwork, s
    -
    4539 integer(int32), intent(out), optional :: olwork
    -
    4540 class(errors), intent(inout), optional, target :: err
    -
    4541 end subroutine
    -
    4542
    -
    4574 module subroutine mtx_inverse_dbl(a, iwork, work, olwork, err)
    -
    4575 real(real64), intent(inout), dimension(:,:) :: a
    -
    4576 integer(int32), intent(out), target, optional, dimension(:) :: iwork
    -
    4577 real(real64), intent(out), target, optional, dimension(:) :: work
    -
    4578 integer(int32), intent(out), optional :: olwork
    -
    4579 class(errors), intent(inout), optional, target :: err
    -
    4580 end subroutine
    -
    4581
    -
    4613 module subroutine mtx_inverse_cmplx(a, iwork, work, olwork, err)
    -
    4614 complex(real64), intent(inout), dimension(:,:) :: a
    -
    4615 integer(int32), intent(out), target, optional, dimension(:) :: iwork
    -
    4616 complex(real64), intent(out), target, optional, dimension(:) :: work
    -
    4617 integer(int32), intent(out), optional :: olwork
    +
    4435 module subroutine solve_least_squares_vec_svd_cmplx(a, b, s, arnk, work, &
    +
    4436 olwork, rwork, err)
    +
    4437 complex(real64), intent(inout), dimension(:,:) :: a
    +
    4438 complex(real64), intent(inout), dimension(:) :: b
    +
    4439 integer(int32), intent(out), optional :: arnk
    +
    4440 complex(real64), intent(out), target, optional, dimension(:) :: work
    +
    4441 real(real64), intent(out), target, optional, dimension(:) :: rwork, s
    +
    4442 integer(int32), intent(out), optional :: olwork
    +
    4443 class(errors), intent(inout), optional, target :: err
    +
    4444 end subroutine
    +
    4445
    +
    4477 module subroutine mtx_inverse_dbl(a, iwork, work, olwork, err)
    +
    4478 real(real64), intent(inout), dimension(:,:) :: a
    +
    4479 integer(int32), intent(out), target, optional, dimension(:) :: iwork
    +
    4480 real(real64), intent(out), target, optional, dimension(:) :: work
    +
    4481 integer(int32), intent(out), optional :: olwork
    +
    4482 class(errors), intent(inout), optional, target :: err
    +
    4483 end subroutine
    +
    4484
    +
    4516 module subroutine mtx_inverse_cmplx(a, iwork, work, olwork, err)
    +
    4517 complex(real64), intent(inout), dimension(:,:) :: a
    +
    4518 integer(int32), intent(out), target, optional, dimension(:) :: iwork
    +
    4519 complex(real64), intent(out), target, optional, dimension(:) :: work
    +
    4520 integer(int32), intent(out), optional :: olwork
    +
    4521 class(errors), intent(inout), optional, target :: err
    +
    4522 end subroutine
    +
    4523
    +
    4561 module subroutine mtx_pinverse_dbl(a, ainv, tol, work, olwork, err)
    +
    4562 real(real64), intent(inout), dimension(:,:) :: a
    +
    4563 real(real64), intent(out), dimension(:,:) :: ainv
    +
    4564 real(real64), intent(in), optional :: tol
    +
    4565 real(real64), intent(out), target, dimension(:), optional :: work
    +
    4566 integer(int32), intent(out), optional :: olwork
    +
    4567 class(errors), intent(inout), optional, target :: err
    +
    4568 end subroutine
    +
    4569
    +
    4611 module subroutine mtx_pinverse_cmplx(a, ainv, tol, work, olwork, rwork, err)
    +
    4612 complex(real64), intent(inout), dimension(:,:) :: a
    +
    4613 complex(real64), intent(out), dimension(:,:) :: ainv
    +
    4614 real(real64), intent(in), optional :: tol
    +
    4615 complex(real64), intent(out), target, dimension(:), optional :: work
    +
    4616 integer(int32), intent(out), optional :: olwork
    +
    4617 real(real64), intent(out), target, dimension(:), optional :: rwork
    4618 class(errors), intent(inout), optional, target :: err
    4619 end subroutine
    4620
    -
    4658 module subroutine mtx_pinverse_dbl(a, ainv, tol, work, olwork, err)
    -
    4659 real(real64), intent(inout), dimension(:,:) :: a
    -
    4660 real(real64), intent(out), dimension(:,:) :: ainv
    -
    4661 real(real64), intent(in), optional :: tol
    -
    4662 real(real64), intent(out), target, dimension(:), optional :: work
    -
    4663 integer(int32), intent(out), optional :: olwork
    -
    4664 class(errors), intent(inout), optional, target :: err
    -
    4665 end subroutine
    -
    4666
    -
    4708 module subroutine mtx_pinverse_cmplx(a, ainv, tol, work, olwork, rwork, err)
    -
    4709 complex(real64), intent(inout), dimension(:,:) :: a
    -
    4710 complex(real64), intent(out), dimension(:,:) :: ainv
    -
    4711 real(real64), intent(in), optional :: tol
    -
    4712 complex(real64), intent(out), target, dimension(:), optional :: work
    -
    4713 integer(int32), intent(out), optional :: olwork
    -
    4714 real(real64), intent(out), target, dimension(:), optional :: rwork
    -
    4715 class(errors), intent(inout), optional, target :: err
    -
    4716 end subroutine
    -
    4717
    -
    4718end interface
    -
    4719
    -
    4720! ******************************************************************************
    -
    4721! LINALG_EIGEN.F90
    -
    4722! ------------------------------------------------------------------------------
    -
    4723interface
    -
    4724
    -
    4756 module subroutine eigen_symm(vecs, a, vals, work, olwork, err)
    -
    4757 logical, intent(in) :: vecs
    -
    4758 real(real64), intent(inout), dimension(:,:) :: a
    -
    4759 real(real64), intent(out), dimension(:) :: vals
    -
    4760 real(real64), intent(out), pointer, optional, dimension(:) :: work
    -
    4761 integer(int32), intent(out), optional :: olwork
    -
    4762 class(errors), intent(inout), optional, target :: err
    -
    4763 end subroutine
    -
    4764
    -
    4795 module subroutine eigen_asymm(a, vals, vecs, work, olwork, err)
    -
    4796 real(real64), intent(inout), dimension(:,:) :: a
    -
    4797 complex(real64), intent(out), dimension(:) :: vals
    -
    4798 complex(real64), intent(out), optional, dimension(:,:) :: vecs
    -
    4799 real(real64), intent(out), pointer, optional, dimension(:) :: work
    -
    4800 integer(int32), intent(out), optional :: olwork
    -
    4801 class(errors), intent(inout), optional, target :: err
    -
    4802 end subroutine
    -
    4803
    -
    4846 module subroutine eigen_gen(a, b, alpha, beta, vecs, work, olwork, err)
    -
    4847 real(real64), intent(inout), dimension(:,:) :: a, b
    -
    4848 complex(real64), intent(out), dimension(:) :: alpha
    -
    4849 real(real64), intent(out), optional, dimension(:) :: beta
    -
    4850 complex(real64), intent(out), optional, dimension(:,:) :: vecs
    -
    4851 real(real64), intent(out), optional, pointer, dimension(:) :: work
    -
    4852 integer(int32), intent(out), optional :: olwork
    -
    4853 class(errors), intent(inout), optional, target :: err
    -
    4854 end subroutine
    -
    4855
    -
    4886 module subroutine eigen_cmplx(a, vals, vecs, work, olwork, rwork, err)
    -
    4887 complex(real64), intent(inout), dimension(:,:) :: a
    -
    4888 complex(real64), intent(out), dimension(:) :: vals
    -
    4889 complex(real64), intent(out), optional, dimension(:,:) :: vecs
    -
    4890 complex(real64), intent(out), target, optional, dimension(:) :: work
    -
    4891 real(real64), intent(out), target, optional, dimension(:) :: rwork
    -
    4892 integer(int32), intent(out), optional :: olwork
    -
    4893 class(errors), intent(inout), optional, target :: err
    -
    4894 end subroutine
    -
    4895end interface
    -
    4896
    -
    4897! ******************************************************************************
    -
    4898! LINALG_SORTING.F90
    -
    4899! ------------------------------------------------------------------------------
    -
    4900interface
    -
    4901
    -
    4916 module subroutine sort_dbl_array(x, ascend)
    -
    4917 real(real64), intent(inout), dimension(:) :: x
    -
    4918 logical, intent(in), optional :: ascend
    -
    4919 end subroutine
    -
    4920
    -
    4945 module subroutine sort_dbl_array_ind(x, ind, ascend, err)
    -
    4946 real(real64), intent(inout), dimension(:) :: x
    -
    4947 integer(int32), intent(inout), dimension(:) :: ind
    -
    4948 logical, intent(in), optional :: ascend
    -
    4949 class(errors), intent(inout), optional, target :: err
    -
    4950 end subroutine
    -
    4951
    -
    4968 module subroutine sort_cmplx_array(x, ascend)
    -
    4969 complex(real64), intent(inout), dimension(:) :: x
    -
    4970 logical, intent(in), optional :: ascend
    -
    4971 end subroutine
    -
    4972
    -
    5002 module subroutine sort_cmplx_array_ind(x, ind, ascend, err)
    -
    5003 complex(real64), intent(inout), dimension(:) :: x
    -
    5004 integer(int32), intent(inout), dimension(:) :: ind
    -
    5005 logical, intent(in), optional :: ascend
    -
    5006 class(errors), intent(inout), optional, target :: err
    -
    5007 end subroutine
    -
    5008
    -
    5028 module subroutine sort_eigen_cmplx(vals, vecs, ascend, err)
    -
    5029 complex(real64), intent(inout), dimension(:) :: vals
    -
    5030 complex(real64), intent(inout), dimension(:,:) :: vecs
    -
    5031 logical, intent(in), optional :: ascend
    -
    5032 class(errors), intent(inout), optional, target :: err
    -
    5033 end subroutine
    -
    5034
    -
    5054 module subroutine sort_eigen_dbl(vals, vecs, ascend, err)
    -
    5055 real(real64), intent(inout), dimension(:) :: vals
    -
    5056 real(real64), intent(inout), dimension(:,:) :: vecs
    -
    5057 logical, intent(in), optional :: ascend
    -
    5058 class(errors), intent(inout), optional, target :: err
    -
    5059 end subroutine
    -
    5060
    -
    5061end interface
    -
    5062
    -
    5063end module
    -
    Computes the Cholesky factorization of a symmetric, positive definite matrix.
    -
    Computes the rank 1 downdate to a Cholesky factored matrix (upper triangular).
    -
    Computes the rank 1 update to a Cholesky factored matrix (upper triangular).
    +
    4621end interface
    +
    4622
    +
    4623! ******************************************************************************
    +
    4624! LINALG_EIGEN.F90
    +
    4625! ------------------------------------------------------------------------------
    +
    4626interface
    +
    4627
    +
    4659 module subroutine eigen_symm(vecs, a, vals, work, olwork, err)
    +
    4660 logical, intent(in) :: vecs
    +
    4661 real(real64), intent(inout), dimension(:,:) :: a
    +
    4662 real(real64), intent(out), dimension(:) :: vals
    +
    4663 real(real64), intent(out), pointer, optional, dimension(:) :: work
    +
    4664 integer(int32), intent(out), optional :: olwork
    +
    4665 class(errors), intent(inout), optional, target :: err
    +
    4666 end subroutine
    +
    4667
    +
    4698 module subroutine eigen_asymm(a, vals, vecs, work, olwork, err)
    +
    4699 real(real64), intent(inout), dimension(:,:) :: a
    +
    4700 complex(real64), intent(out), dimension(:) :: vals
    +
    4701 complex(real64), intent(out), optional, dimension(:,:) :: vecs
    +
    4702 real(real64), intent(out), pointer, optional, dimension(:) :: work
    +
    4703 integer(int32), intent(out), optional :: olwork
    +
    4704 class(errors), intent(inout), optional, target :: err
    +
    4705 end subroutine
    +
    4706
    +
    4749 module subroutine eigen_gen(a, b, alpha, beta, vecs, work, olwork, err)
    +
    4750 real(real64), intent(inout), dimension(:,:) :: a, b
    +
    4751 complex(real64), intent(out), dimension(:) :: alpha
    +
    4752 real(real64), intent(out), optional, dimension(:) :: beta
    +
    4753 complex(real64), intent(out), optional, dimension(:,:) :: vecs
    +
    4754 real(real64), intent(out), optional, pointer, dimension(:) :: work
    +
    4755 integer(int32), intent(out), optional :: olwork
    +
    4756 class(errors), intent(inout), optional, target :: err
    +
    4757 end subroutine
    +
    4758
    +
    4789 module subroutine eigen_cmplx(a, vals, vecs, work, olwork, rwork, err)
    +
    4790 complex(real64), intent(inout), dimension(:,:) :: a
    +
    4791 complex(real64), intent(out), dimension(:) :: vals
    +
    4792 complex(real64), intent(out), optional, dimension(:,:) :: vecs
    +
    4793 complex(real64), intent(out), target, optional, dimension(:) :: work
    +
    4794 real(real64), intent(out), target, optional, dimension(:) :: rwork
    +
    4795 integer(int32), intent(out), optional :: olwork
    +
    4796 class(errors), intent(inout), optional, target :: err
    +
    4797 end subroutine
    +
    4798end interface
    +
    4799
    +
    4800! ******************************************************************************
    +
    4801! LINALG_SORTING.F90
    +
    4802! ------------------------------------------------------------------------------
    +
    4803interface
    +
    4804
    +
    4819 module subroutine sort_dbl_array(x, ascend)
    +
    4820 real(real64), intent(inout), dimension(:) :: x
    +
    4821 logical, intent(in), optional :: ascend
    +
    4822 end subroutine
    +
    4823
    +
    4848 module subroutine sort_dbl_array_ind(x, ind, ascend, err)
    +
    4849 real(real64), intent(inout), dimension(:) :: x
    +
    4850 integer(int32), intent(inout), dimension(:) :: ind
    +
    4851 logical, intent(in), optional :: ascend
    +
    4852 class(errors), intent(inout), optional, target :: err
    +
    4853 end subroutine
    +
    4854
    +
    4871 module subroutine sort_cmplx_array(x, ascend)
    +
    4872 complex(real64), intent(inout), dimension(:) :: x
    +
    4873 logical, intent(in), optional :: ascend
    +
    4874 end subroutine
    +
    4875
    +
    4905 module subroutine sort_cmplx_array_ind(x, ind, ascend, err)
    +
    4906 complex(real64), intent(inout), dimension(:) :: x
    +
    4907 integer(int32), intent(inout), dimension(:) :: ind
    +
    4908 logical, intent(in), optional :: ascend
    +
    4909 class(errors), intent(inout), optional, target :: err
    +
    4910 end subroutine
    +
    4911
    +
    4931 module subroutine sort_eigen_cmplx(vals, vecs, ascend, err)
    +
    4932 complex(real64), intent(inout), dimension(:) :: vals
    +
    4933 complex(real64), intent(inout), dimension(:,:) :: vecs
    +
    4934 logical, intent(in), optional :: ascend
    +
    4935 class(errors), intent(inout), optional, target :: err
    +
    4936 end subroutine
    +
    4937
    +
    4957 module subroutine sort_eigen_dbl(vals, vecs, ascend, err)
    +
    4958 real(real64), intent(inout), dimension(:) :: vals
    +
    4959 real(real64), intent(inout), dimension(:,:) :: vecs
    +
    4960 logical, intent(in), optional :: ascend
    +
    4961 class(errors), intent(inout), optional, target :: err
    +
    4962 end subroutine
    +
    4963
    +
    4964end interface
    +
    4965
    +
    4966end module
    +
    Computes the Cholesky factorization of a symmetric, positive definite matrix.
    +
    Computes the rank 1 downdate to a Cholesky factored matrix (upper triangular).
    +
    Computes the rank 1 update to a Cholesky factored matrix (upper triangular).
    Computes the determinant of a square matrix.
    Multiplies a diagonal matrix with another matrix or array.
    -
    Computes the eigenvalues, and optionally the eigenvectors, of a matrix.
    +
    Computes the eigenvalues, and optionally the eigenvectors, of a matrix.
    Extracts the L and U matrices from the condensed [L\U] storage format used by the lu_factor.
    Forms the full M-by-M orthogonal matrix Q from the elementary reflectors returned by the base QR fact...
    Computes the LU factorization of an M-by-N matrix.
    -
    Computes the inverse of a square matrix.
    +
    Computes the inverse of a square matrix.
    Performs the matrix operation: .
    -
    Computes the Moore-Penrose pseudo-inverse of a M-by-N matrix using the singular value decomposition o...
    +
    Computes the Moore-Penrose pseudo-inverse of a M-by-N matrix using the singular value decomposition o...
    Computes the rank of a matrix.
    Multiplies a general matrix by the orthogonal matrix Q from a QR factorization.
    -
    Multiplies a general matrix by the orthogonal matrix Z from an RZ factorization.
    +
    Multiplies a general matrix by the orthogonal matrix Z from an RZ factorization.
    Computes the QR factorization of an M-by-N matrix.
    -
    Computes the rank 1 update to an M-by-N QR factored matrix A (M >= N) where A = Q * R,...
    +
    Computes the rank 1 update to an M-by-N QR factored matrix A (M >= N) where , and such that .
    Performs the rank-1 update to matrix A such that: , where is an M-by-N matrix, is a scalar,...
    Multiplies a vector by the reciprocal of a real scalar.
    -
    Factors an upper trapezoidal matrix by means of orthogonal transformations such that A = R * Z = (R 0...
    -
    Solves a system of Cholesky factored equations.
    -
    Solves the overdetermined or underdetermined system (A*X = B) of M equations of N unknowns,...
    -
    Solves the overdetermined or underdetermined system (A*X = B) of M equations of N unknowns using a si...
    -
    Solves the overdetermined or underdetermined system (A*X = B) of M equations of N unknowns.
    -
    Solves a system of LU-factored equations.
    -
    Solves a system of M QR-factored equations of N unknowns.
    -
    Solves a triangular system of equations.
    -
    Sorts an array.
    -
    Computes the singular value decomposition of a matrix A. The SVD is defined as: A = U * S * V**T,...
    +
    Factors an upper trapezoidal matrix by means of orthogonal transformations such that A = R * Z = (R 0...
    +
    Solves a system of Cholesky factored equations.
    +
    Solves the overdetermined or underdetermined system (A*X = B) of M equations of N unknowns,...
    +
    Solves the overdetermined or underdetermined system (A*X = B) of M equations of N unknowns using a si...
    +
    Solves the overdetermined or underdetermined system (A*X = B) of M equations of N unknowns.
    +
    Solves a system of LU-factored equations.
    +
    Solves a system of M QR-factored equations of N unknowns.
    +
    Solves a triangular system of equations.
    +
    Sorts an array.
    +
    Computes the singular value decomposition of a matrix A. The SVD is defined as: A = U * S * V**T,...
    Swaps the contents of two arrays.
    Computes the trace of a matrix (the sum of the main diagonal elements).
    Computes the triangular matrix operation: , or , where A is a triangular matrix.
    diff --git a/doc/html/linalg__immutable_8f90_source.html b/doc/html/linalg__immutable_8f90_source.html index 0fe1aaed..b31016a6 100644 --- a/doc/html/linalg__immutable_8f90_source.html +++ b/doc/html/linalg__immutable_8f90_source.html @@ -845,23 +845,23 @@
    1030 end function
    1031
    1032end module
    -
    Computes the Cholesky factorization of a symmetric, positive definite matrix.
    -
    Computes the rank 1 downdate to a Cholesky factored matrix (upper triangular).
    -
    Computes the rank 1 update to a Cholesky factored matrix (upper triangular).
    +
    Computes the Cholesky factorization of a symmetric, positive definite matrix.
    +
    Computes the rank 1 downdate to a Cholesky factored matrix (upper triangular).
    +
    Computes the rank 1 update to a Cholesky factored matrix (upper triangular).
    Computes the determinant of a square matrix.
    Multiplies a diagonal matrix with another matrix or array.
    -
    Computes the eigenvalues, and optionally the eigenvectors, of a matrix.
    +
    Computes the eigenvalues, and optionally the eigenvectors, of a matrix.
    Extracts the L and U matrices from the condensed [L\U] storage format used by the lu_factor.
    Forms the full M-by-M orthogonal matrix Q from the elementary reflectors returned by the base QR fact...
    Computes the LU factorization of an M-by-N matrix.
    -
    Computes the inverse of a square matrix.
    -
    Computes the Moore-Penrose pseudo-inverse of a M-by-N matrix using the singular value decomposition o...
    +
    Computes the inverse of a square matrix.
    +
    Computes the Moore-Penrose pseudo-inverse of a M-by-N matrix using the singular value decomposition o...
    Computes the QR factorization of an M-by-N matrix.
    -
    Computes the rank 1 update to an M-by-N QR factored matrix A (M >= N) where A = Q * R,...
    +
    Computes the rank 1 update to an M-by-N QR factored matrix A (M >= N) where , and such that .
    Performs the rank-1 update to matrix A such that: , where is an M-by-N matrix, is a scalar,...
    -
    Solves a triangular system of equations.
    -
    Sorts an array.
    -
    Computes the singular value decomposition of a matrix A. The SVD is defined as: A = U * S * V**T,...
    +
    Solves a triangular system of equations.
    +
    Sorts an array.
    +
    Computes the singular value decomposition of a matrix A. The SVD is defined as: A = U * S * V**T,...
    Computes the eigenvalues and eigenvectors (right) of a general N-by-N matrix.
    Computes the LU factorization of a square matrix. Notice, partial row pivoting is utilized.
    Computes the matrix operation: C = A * B, where A is a diagonal matrix.
    diff --git a/doc/html/namespacelinalg__core.html b/doc/html/namespacelinalg__core.html index 762e0371..18cb1ef0 100644 --- a/doc/html/namespacelinalg__core.html +++ b/doc/html/namespacelinalg__core.html @@ -157,7 +157,7 @@  Computes the QR factorization of an M-by-N matrix. More...
      interface  qr_rank1_update - Computes the rank 1 update to an M-by-N QR factored matrix A (M >= N) where A = Q * R, and A1 = A + U * V**T such that A1 = Q1 * R1. More...
    + Computes the rank 1 update to an M-by-N QR factored matrix A (M >= N) where \( A = Q R \), and \( A1 = A + U V^T \) such that \( A1 = Q1 R1 \). More...
      interface  rank1_update  Performs the rank-1 update to matrix A such that: \( A = \alpha X Y^T + A \), where \( A \) is an M-by-N matrix, \( \alpha \)is a scalar, \( X \) is an M-element array, and \( Y \) is an N-element array. In the event that \( Y \) is complex, \( Y^H \) is used instead of \( Y^T \). More...
    diff --git a/doc/html/namespaces.html b/doc/html/namespaces.html index 7f01c29b..d70b1681 100644 --- a/doc/html/namespaces.html +++ b/doc/html/namespaces.html @@ -121,7 +121,7 @@  Cmult_qrMultiplies a general matrix by the orthogonal matrix Q from a QR factorization  Cmult_rzMultiplies a general matrix by the orthogonal matrix Z from an RZ factorization  Cqr_factorComputes the QR factorization of an M-by-N matrix - Cqr_rank1_updateComputes the rank 1 update to an M-by-N QR factored matrix A (M >= N) where A = Q * R, and A1 = A + U * V**T such that A1 = Q1 * R1 + Cqr_rank1_updateComputes the rank 1 update to an M-by-N QR factored matrix A (M >= N) where \( A = Q R \), and \( A1 = A + U V^T \) such that \( A1 = Q1 R1 \)  Crank1_updatePerforms the rank-1 update to matrix A such that: \( A = \alpha X Y^T + A \), where \( A \) is an M-by-N matrix, \( \alpha \)is a scalar, \( X \) is an M-element array, and \( Y \) is an N-element array. In the event that \( Y \) is complex, \( Y^H \) is used instead of \( Y^T \)  Crecip_mult_arrayMultiplies a vector by the reciprocal of a real scalar  Crz_factorFactors an upper trapezoidal matrix by means of orthogonal transformations such that A = R * Z = (R 0) * Z. Z is an orthogonal matrix of dimension N-by-N, and R is an M-by-M upper triangular matrix diff --git a/src/linalg_core.f90 b/src/linalg_core.f90 index 27d23ff0..e03b91d1 100644 --- a/src/linalg_core.f90 +++ b/src/linalg_core.f90 @@ -1151,7 +1151,54 @@ module linalg_core ! ------------------------------------------------------------------------------ !> @brief Computes the rank 1 update to an M-by-N QR factored matrix A -!! (M >= N) where A = Q * R, and A1 = A + U * V**T such that A1 = Q1 * R1. +!! (M >= N) where \f$ A = Q R \f$, and \f$ A1 = A + U V^T \f$ such that +!! \f$ A1 = Q1 R1 \f$. +!! +!! @par Syntax +!! @code{.f90} +!! subroutine qr_rank1_update(real(real64) q(:,:), real(real64) r(:,:), real(real64) u(:), real(real64) v(:), optional real(real64) work(:), optional class(errors) err) +!! subroutine qr_rank1_update(complex(real64) q(:,:), complex(real64) r(:,:), complex(real64) u(:), complex(real64) v(:), optional complex(real64) work(:), optional real(real64) rwork(:), optional class(errors) err) +!! @endcode +!! +!! @param[in,out] q On input, the original M-by-K orthogonal matrix Q. On +!! output, the updated matrix Q1. +!! @param[in,out] r On input, the M-by-N matrix R. On output, the updated +!! matrix R1. +!! @param[in,out] u On input, the M-element U update vector. On output, +!! the original content of the array is overwritten. +!! @param[in,out] v On input, the N-element V update vector. On output, +!! the original content of the array is overwritten. +!! @param[out] work An optional argument that if supplied prevents local +!! memory allocation. If provided, the array must have at least K +!! elements. +!! @param[out] rwork An optional argument that if supplied prevents local +!! memory allocation. If provided, the array must have at least K +!! elements. +!! @param[in,out] err An optional errors-based object that if provided can be +!! used to retrieve information relating to any errors encountered during +!! execution. If not provided, a default implementation of the errors +!! class is used internally to provide error handling. Possible errors and +!! warning messages that may be encountered are as follows. +!! - LA_ARRAY_SIZE_ERROR: Occurs if any of the input arrays are not sized +!! appropriately. +!! - LA_OUT_OF_MEMORY_ERROR: Occurs if local memory must be allocated, and +!! there is insufficient memory available. +!! +!! @par Remarks +!! Notice, K must either be equal to M, or equal to N. In the event that K = N, +!! only the submatrix Qa is updated. This is appropriate as the QR +!! factorization for an overdetermined system can be written as follows: +!! @verbatim +!! A = Q * R = [Qa, Qb] * [Ra] +!! [0 ] +!! @endverbatim +!! Note: Ra is upper triangular of dimension N-by-N. +!! +!! @par Notes +!! This routine utilizes the QRUPDATE routine ZQR1UP. +!! +!! @par See Also +!! [Source](https://sourceforge.net/projects/qrupdate/) !! !! @par Usage !! The following example illustrates a rank 1 update to a QR factored @@ -1253,6 +1300,30 @@ module linalg_core !> @brief Computes the Cholesky factorization of a symmetric, positive !! definite matrix. !! +!! @par Syntax +!! @code{.f90} +!! subroutine cholesky_factor(real(real64) a(:,:), optional logical upper, optional class(errors) err) +!! subroutine cholesky_factor(complex(real64) a(:,:), optional logical upper, optional class(errors) err) +!! @endcode +!! +!! @param[in,out] a On input, the N-by-N matrix to factor. On output, the +!! factored matrix is returned in either the upper or lower triangular +!! portion of the matrix, dependent upon the value of @p upper. +!! @param[in] upper An optional input that, if specified, provides control +!! over whether the factorization is computed as \f$ A = U^T U \f$ (set to +!! true), or as \f$ A = L L^T \f$ (set to false). The default value is true +!! such that \f$ A = U^T U \f$. +!! @param[in,out] err An optional errors-based object that if provided can be +!! used to retrieve information relating to any errors encountered during +!! execution. If not provided, a default implementation of the errors +!! class is used internally to provide error handling. Possible errors and +!! warning messages that may be encountered are as follows. +!! - LA_ARRAY_SIZE_ERROR: Occurs if @p a is not square. +!! - LA_MATRIX_FORMAT_ERROR: Occurs if @p a is not positive definite. +!! +!! @par Notes +!! This routine utilizes the LAPACK routine DPOTRF (ZPOTRF in the complex case). +!! !! @par Usage !! The following example illustrates the solution of a positive-definite !! system of equations via Cholesky factorization. @@ -1328,6 +1399,37 @@ module linalg_core !> @brief Computes the rank 1 update to a Cholesky factored matrix (upper !! triangular). !! +!! @par Syntax +!! @code{.f90} +!! subroutine cholesky_rank1_update(real(real64) r(:,:), real(real64) u(:), optional real(real64) work(:), optional class(errors) err) +!! subroutine cholesky_rank1_update(complex(real64) r(:,:), complex(real64) u(:), optional complex(real64) work(:), optional class(errors) err) +!! @endcode +!! +!! @param[in,out] r On input, the N-by-N upper triangular matrix R. On +!! output, the updated matrix R1. +!! @param[in,out] u On input, the N-element update vector U. On output, +!! the rotation sines used to transform R to R1. +!! @param[out] work An optional argument that if supplied prevents local +!! memory allocation. If provided, the array must have at least N +!! elements. Additionally, this workspace array is used to contain the +!! rotation cosines used to transform R to R1. +!! @param[in,out] err An optional errors-based object that if provided can be +!! used to retrieve information relating to any errors encountered during +!! execution. If not provided, a default implementation of the errors +!! class is used internally to provide error handling. Possible errors and +!! warning messages that may be encountered are as follows. +!! - LA_ARRAY_SIZE_ERROR: Occurs if any of the input array sizes are +!! incorrect. +!! - LA_OUT_OF_MEMORY_ERROR: Occurs if local memory must be allocated, and +!! there is insufficient memory available. +!! +!! @par Notes +!! This routine utilizes the QRUPDATE routine DCH1UP (ZCH1UP in the complex +!! case). +!! +!! @par See Also +!! [Source](https://sourceforge.net/projects/qrupdate/) +!! !! @par Usage !! The following example illustrates the use of the rank 1 Cholesky update, !! and compares the results to factoring the original rank 1 updated matrix. @@ -1396,6 +1498,40 @@ module linalg_core !> @brief Computes the rank 1 downdate to a Cholesky factored matrix (upper !! triangular). !! +!! @par Syntax +!! @code{.f90} +!! subroutine cholesky_rank1_downdate(real(real64) r(:,:), real(real64) u(:), optional real(real64) work(:), optional class(errors) err) +!! subroutine cholesky_rank1_downdate(complex(real64) r(:,:), complex(real64) u(:), optional complex(real64) work(:), optional class(errors) err) +!! @endcode +!! +!! @param[in,out] r On input, the N-by-N upper triangular matrix R. On +!! output, the updated matrix R1. +!! @param[in,out] u On input, the N-element update vector U. On output, +!! the rotation sines used to transform R to R1. +!! @param[out] work An optional argument that if supplied prevents local +!! memory allocation. If provided, the array must have at least N +!! elements. Additionally, this workspace array is used to contain the +!! rotation cosines used to transform R to R1. +!! @param[in,out] err An optional errors-based object that if provided can be +!! used to retrieve information relating to any errors encountered during +!! execution. If not provided, a default implementation of the errors +!! class is used internally to provide error handling. Possible errors and +!! warning messages that may be encountered are as follows. +!! - LA_ARRAY_SIZE_ERROR: Occurs if any of the input array sizes are +!! incorrect. +!! - LA_OUT_OF_MEMORY_ERROR: Occurs if local memory must be allocated, and +!! there is insufficient memory available. +!! - LA_MATRIX_FORMAT_ERROR: Occurs if the downdated matrix is not +!! positive definite. +!! - LA_SINGULAR_MATRIX_ERROR: Occurs if @p r is singular. +!! +!! @par Notes +!! This routine utilizes the QRUPDATE routine DCH1DN (ZCH1DN in the complex +!! case). +!! +!! @par See Also +!! [Source](https://sourceforge.net/projects/qrupdate/) +!! !! @par Usage !! The following example illustrates the use of the rank 1 Cholesky !! downdate, and compares the results to factoring the original rank 1 @@ -2587,97 +2723,14 @@ module subroutine mult_qr_vec_cmplx(trans, a, tau, c, work, olwork, err) integer(int32), intent(out), optional :: olwork class(errors), intent(inout), optional, target :: err end subroutine - - !> @brief Computes the rank 1 update to an M-by-N QR factored matrix A - !! (M >= N) where A = Q * R, and A1 = A + U * V**T such that A1 = Q1 * R1. - !! - !! @param[in,out] q On input, the original M-by-K orthogonal matrix Q. On - !! output, the updated matrix Q1. - !! @param[in,out] r On input, the M-by-N matrix R. On output, the updated - !! matrix R1. - !! @param[in,out] u On input, the M-element U update vector. On output, - !! the original content of the array is overwritten. - !! @param[in,out] v On input, the N-element V update vector. On output, - !! the original content of the array is overwritten. - !! @param[out] work An optional argument that if supplied prevents local - !! memory allocation. If provided, the array must have at least 2*K - !! elements. - !! @param[out] err An optional errors-based object that if provided can be - !! used to retrieve information relating to any errors encountered during - !! execution. If not provided, a default implementation of the errors - !! class is used internally to provide error handling. Possible errors and - !! warning messages that may be encountered are as follows. - !! - LA_ARRAY_SIZE_ERROR: Occurs if any of the input arrays are not sized - !! appropriately. - !! - LA_OUT_OF_MEMORY_ERROR: Occurs if local memory must be allocated, and - !! there is insufficient memory available. - !! - !! @par Remarks - !! @verbatim - !! Notice, K must either be equal to M, or to N. In the event that K = N, - !! only the submatrix Qa is updated. This is appropriate as the QR - !! factorization for an overdetermined system can be written as follows: - !! A = Q * R = [Qa, Qb] * [Ra] - !! [0 ] - !! - !! Note: Ra is upper triangular of dimension N-by-N. - !! @endverbatim - !! - !! @par Notes - !! This routine utilizes the QRUPDATE routine DQR1UP. - !! - !! @par See Also - !! [Source](https://sourceforge.net/projects/qrupdate/) + module subroutine qr_rank1_update_dbl(q, r, u, v, work, err) real(real64), intent(inout), dimension(:,:) :: q, r real(real64), intent(inout), dimension(:) :: u, v real(real64), intent(out), target, optional, dimension(:) :: work class(errors), intent(inout), optional, target :: err end subroutine - - !> @brief Computes the rank 1 update to an M-by-N QR factored matrix A - !! (M >= N) where A = Q * R, and A1 = A + U * V**T such that A1 = Q1 * R1. - !! - !! @param[in,out] q On input, the original M-by-K orthogonal matrix Q. On - !! output, the updated matrix Q1. - !! @param[in,out] r On input, the M-by-N matrix R. On output, the updated - !! matrix R1. - !! @param[in,out] u On input, the M-element U update vector. On output, - !! the original content of the array is overwritten. - !! @param[in,out] v On input, the N-element V update vector. On output, - !! the original content of the array is overwritten. - !! @param[out] work An optional argument that if supplied prevents local - !! memory allocation. If provided, the array must have at least K - !! elements. - !! @param[out] rwork An optional argument that if supplied prevents local - !! memory allocation. If provided, the array must have at least K - !! elements. - !! @param[out] err An optional errors-based object that if provided can be - !! used to retrieve information relating to any errors encountered during - !! execution. If not provided, a default implementation of the errors - !! class is used internally to provide error handling. Possible errors and - !! warning messages that may be encountered are as follows. - !! - LA_ARRAY_SIZE_ERROR: Occurs if any of the input arrays are not sized - !! appropriately. - !! - LA_OUT_OF_MEMORY_ERROR: Occurs if local memory must be allocated, and - !! there is insufficient memory available. - !! - !! @par Remarks - !! @verbatim - !! Notice, K must either be equal to M, or to N. In the event that K = N, - !! only the submatrix Qa is updated. This is appropriate as the QR - !! factorization for an overdetermined system can be written as follows: - !! A = Q * R = [Qa, Qb] * [Ra] - !! [0 ] - !! - !! Note: Ra is upper triangular of dimension N-by-N. - !! @endverbatim - !! - !! @par Notes - !! This routine utilizes the QRUPDATE routine ZQR1UP. - !! - !! @par See Also - !! [Source](https://sourceforge.net/projects/qrupdate/) + module subroutine qr_rank1_update_cmplx(q, r, u, v, work, rwork, err) complex(real64), intent(inout), dimension(:,:) :: q, r complex(real64), intent(inout), dimension(:) :: u, v @@ -2685,190 +2738,40 @@ module subroutine qr_rank1_update_cmplx(q, r, u, v, work, rwork, err) real(real64), intent(out), target, optional, dimension(:) :: rwork class(errors), intent(inout), optional, target :: err end subroutine - - !> @brief Computes the Cholesky factorization of a symmetric, positive - !! definite matrix. - !! - !! @param[in,out] a On input, the N-by-N matrix to factor. On output, the - !! factored matrix is returned in either the upper or lower triangular - !! portion of the matrix, dependent upon the value of @p upper. - !! @param[in] upper An optional input that, if specified, provides control - !! over whether the factorization is computed as A = U**T * U (set to - !! true), or as A = L * L**T (set to false). The default value is true - !! such that A = U**T * U. - !! @param[out] err An optional errors-based object that if provided can be - !! used to retrieve information relating to any errors encountered during - !! execution. If not provided, a default implementation of the errors - !! class is used internally to provide error handling. Possible errors and - !! warning messages that may be encountered are as follows. - !! - LA_ARRAY_SIZE_ERROR: Occurs if @p a is not square. - !! - LA_MATRIX_FORMAT_ERROR: Occurs if @p a is not positive definite. - !! - !! @par Notes - !! This routine utilizes the LAPACK routine DPOTRF. + module subroutine cholesky_factor_dbl(a, upper, err) real(real64), intent(inout), dimension(:,:) :: a logical, intent(in), optional :: upper class(errors), intent(inout), optional, target :: err end subroutine - - !> @brief Computes the Cholesky factorization of a symmetric, positive - !! definite matrix. - !! - !! @param[in,out] a On input, the N-by-N matrix to factor. On output, the - !! factored matrix is returned in either the upper or lower triangular - !! portion of the matrix, dependent upon the value of @p upper. - !! @param[in] upper An optional input that, if specified, provides control - !! over whether the factorization is computed as A = U**H * U (set to - !! true), or as A = L * L**H (set to false). The default value is true - !! such that A = U**H * U. - !! @param[out] err An optional errors-based object that if provided can be - !! used to retrieve information relating to any errors encountered during - !! execution. If not provided, a default implementation of the errors - !! class is used internally to provide error handling. Possible errors and - !! warning messages that may be encountered are as follows. - !! - LA_ARRAY_SIZE_ERROR: Occurs if @p a is not square. - !! - LA_MATRIX_FORMAT_ERROR: Occurs if @p a is not positive definite. - !! - !! @par Notes - !! This routine utilizes the LAPACK routine ZPOTRF. + module subroutine cholesky_factor_cmplx(a, upper, err) complex(real64), intent(inout), dimension(:,:) :: a logical, intent(in), optional :: upper class(errors), intent(inout), optional, target :: err end subroutine - !> @brief Computes the rank 1 update to a Cholesky factored matrix (upper - !! triangular). - !! - !! @param[in,out] r On input, the N-by-N upper triangular matrix R. On - !! output, the updated matrix R1. - !! @param[in,out] u On input, the N-element update vector U. On output, - !! the rotation sines used to transform R to R1. - !! @param[out] work An optional argument that if supplied prevents local - !! memory allocation. If provided, the array must have at least N - !! elements. Additionally, this workspace array is used to contain the - !! rotation cosines used to transform R to R1. - !! @param[out] err An optional errors-based object that if provided can be - !! used to retrieve information relating to any errors encountered during - !! execution. If not provided, a default implementation of the errors - !! class is used internally to provide error handling. Possible errors and - !! warning messages that may be encountered are as follows. - !! - LA_ARRAY_SIZE_ERROR: Occurs if any of the input array sizes are - !! incorrect. - !! - LA_OUT_OF_MEMORY_ERROR: Occurs if local memory must be allocated, and - !! there is insufficient memory available. - !! - !! @par Notes - !! This routine utilizes the QRUPDATE routine DCH1UP. - !! - !! @par See Also - !! [Source](https://sourceforge.net/projects/qrupdate/) module subroutine cholesky_rank1_update_dbl(r, u, work, err) real(real64), intent(inout), dimension(:,:) :: r real(real64), intent(inout), dimension(:) :: u real(real64), intent(out), target, optional, dimension(:) :: work class(errors), intent(inout), optional, target :: err end subroutine - - !> @brief Computes the rank 1 update to a Cholesky factored matrix (upper - !! triangular). - !! - !! @param[in,out] r On input, the N-by-N upper triangular matrix R. On - !! output, the updated matrix R1. - !! @param[in,out] u On input, the N-element update vector U. On output, - !! the rotation sines used to transform R to R1. - !! @param[out] work An optional argument that if supplied prevents local - !! memory allocation. If provided, the array must have at least N - !! elements. Additionally, this workspace array is used to contain the - !! rotation cosines used to transform R to R1. - !! @param[out] err An optional errors-based object that if provided can be - !! used to retrieve information relating to any errors encountered during - !! execution. If not provided, a default implementation of the errors - !! class is used internally to provide error handling. Possible errors and - !! warning messages that may be encountered are as follows. - !! - LA_ARRAY_SIZE_ERROR: Occurs if any of the input array sizes are - !! incorrect. - !! - LA_OUT_OF_MEMORY_ERROR: Occurs if local memory must be allocated, and - !! there is insufficient memory available. - !! - !! @par Notes - !! This routine utilizes the QRUPDATE routine ZCH1UP. - !! - !! @par See Also - !! [Source](https://sourceforge.net/projects/qrupdate/) + module subroutine cholesky_rank1_update_cmplx(r, u, work, err) complex(real64), intent(inout), dimension(:,:) :: r complex(real64), intent(inout), dimension(:) :: u real(real64), intent(out), target, optional, dimension(:) :: work class(errors), intent(inout), optional, target :: err end subroutine - - !> @brief Computes the rank 1 downdate to a Cholesky factored matrix (upper - !! triangular). - !! - !! @param[in,out] r On input, the N-by-N upper triangular matrix R. On - !! output, the updated matrix R1. - !! @param[in,out] u On input, the N-element update vector U. On output, - !! the rotation sines used to transform R to R1. - !! @param[out] work An optional argument that if supplied prevents local - !! memory allocation. If provided, the array must have at least N - !! elements. Additionally, this workspace array is used to contain the - !! rotation cosines used to transform R to R1. - !! @param[out] err An optional errors-based object that if provided can be - !! used to retrieve information relating to any errors encountered during - !! execution. If not provided, a default implementation of the errors - !! class is used internally to provide error handling. Possible errors and - !! warning messages that may be encountered are as follows. - !! - LA_ARRAY_SIZE_ERROR: Occurs if any of the input array sizes are - !! incorrect. - !! - LA_OUT_OF_MEMORY_ERROR: Occurs if local memory must be allocated, and - !! there is insufficient memory available. - !! - LA_MATRIX_FORMAT_ERROR: Occurs if the downdated matrix is not - !! positive definite. - !! - LA_SINGULAR_MATRIX_ERROR: Occurs if @p r is singular. - !! - !! @par Notes - !! This routine utilizes the QRUPDATE routine DCH1DN. - !! - !! @par See Also - !! [Source](https://sourceforge.net/projects/qrupdate/) + module subroutine cholesky_rank1_downdate_dbl(r, u, work, err) real(real64), intent(inout), dimension(:,:) :: r real(real64), intent(inout), dimension(:) :: u real(real64), intent(out), target, optional, dimension(:) :: work class(errors), intent(inout), optional, target :: err end subroutine - - !> @brief Computes the rank 1 downdate to a Cholesky factored matrix (upper - !! triangular). - !! - !! @param[in,out] r On input, the N-by-N upper triangular matrix R. On - !! output, the updated matrix R1. - !! @param[in,out] u On input, the N-element update vector U. On output, - !! the rotation sines used to transform R to R1. - !! @param[out] work An optional argument that if supplied prevents local - !! memory allocation. If provided, the array must have at least N - !! elements. Additionally, this workspace array is used to contain the - !! rotation cosines used to transform R to R1. - !! @param[out] err An optional errors-based object that if provided can be - !! used to retrieve information relating to any errors encountered during - !! execution. If not provided, a default implementation of the errors - !! class is used internally to provide error handling. Possible errors and - !! warning messages that may be encountered are as follows. - !! - LA_ARRAY_SIZE_ERROR: Occurs if any of the input array sizes are - !! incorrect. - !! - LA_OUT_OF_MEMORY_ERROR: Occurs if local memory must be allocated, and - !! there is insufficient memory available. - !! - LA_MATRIX_FORMAT_ERROR: Occurs if the downdated matrix is not - !! positive definite. - !! - LA_SINGULAR_MATRIX_ERROR: Occurs if @p r is singular. - !! - !! @par Notes - !! This routine utilizes the QRUPDATE routine ZCH1DN. - !! - !! @par See Also - !! [Source](https://sourceforge.net/projects/qrupdate/) + module subroutine cholesky_rank1_downdate_cmplx(r, u, work, err) complex(real64), intent(inout), dimension(:,:) :: r complex(real64), intent(inout), dimension(:) :: u From 90be25dac2a384f4b4179a1aedc2e66200ed4433 Mon Sep 17 00:00:00 2001 From: jchristopherson Date: Wed, 14 Dec 2022 07:21:48 -0600 Subject: [PATCH 18/65] Update documentation --- doc/html/annotated.html | 4 +- ...rfacelinalg__core_1_1cholesky__factor.html | 4 +- ...erfacelinalg__core_1_1diag__mtx__mult.html | 2 +- doc/html/interfacelinalg__core_1_1eigen.html | 4 +- .../interfacelinalg__core_1_1form__lu.html | 2 +- .../interfacelinalg__core_1_1form__qr.html | 2 +- .../interfacelinalg__core_1_1lu__factor.html | 2 +- ...interfacelinalg__core_1_1mtx__inverse.html | 4 +- ...nterfacelinalg__core_1_1mtx__pinverse.html | 4 +- .../interfacelinalg__core_1_1mult__qr.html | 2 +- .../interfacelinalg__core_1_1mult__rz.html | 44 +- .../interfacelinalg__core_1_1qr__factor.html | 2 +- .../interfacelinalg__core_1_1rz__factor.html | 33 +- ...erfacelinalg__core_1_1solve__cholesky.html | 6 +- ...linalg__core_1_1solve__least__squares.html | 4 +- ...__core_1_1solve__least__squares__full.html | 4 +- ...g__core_1_1solve__least__squares__svd.html | 4 +- .../interfacelinalg__core_1_1solve__lu.html | 4 +- .../interfacelinalg__core_1_1solve__qr.html | 4 +- ...lg__core_1_1solve__triangular__system.html | 4 +- doc/html/interfacelinalg__core_1_1sort.html | 2 +- doc/html/interfacelinalg__core_1_1svd.html | 37 +- doc/html/linalg__c__api_8f90_source.html | 20 +- doc/html/linalg__core_8f90_source.html | 1990 ++++++++--------- doc/html/linalg__immutable_8f90_source.html | 12 +- doc/html/namespacelinalg__core.html | 4 +- doc/html/namespaces.html | 4 +- src/linalg_core.f90 | 484 ++-- 28 files changed, 1357 insertions(+), 1335 deletions(-) diff --git a/doc/html/annotated.html b/doc/html/annotated.html index 11653014..0e167c47 100644 --- a/doc/html/annotated.html +++ b/doc/html/annotated.html @@ -122,7 +122,7 @@  Cqr_rank1_updateComputes the rank 1 update to an M-by-N QR factored matrix A (M >= N) where \( A = Q R \), and \( A1 = A + U V^T \) such that \( A1 = Q1 R1 \)  Crank1_updatePerforms the rank-1 update to matrix A such that: \( A = \alpha X Y^T + A \), where \( A \) is an M-by-N matrix, \( \alpha \)is a scalar, \( X \) is an M-element array, and \( Y \) is an N-element array. In the event that \( Y \) is complex, \( Y^H \) is used instead of \( Y^T \)  Crecip_mult_arrayMultiplies a vector by the reciprocal of a real scalar - Crz_factorFactors an upper trapezoidal matrix by means of orthogonal transformations such that A = R * Z = (R 0) * Z. Z is an orthogonal matrix of dimension N-by-N, and R is an M-by-M upper triangular matrix + Crz_factorFactors an upper trapezoidal matrix by means of orthogonal transformations such that \( A = R Z = (R 0) Z \). Z is an orthogonal matrix of dimension N-by-N, and R is an M-by-M upper triangular matrix  Csolve_choleskySolves a system of Cholesky factored equations  Csolve_least_squaresSolves the overdetermined or underdetermined system (A*X = B) of M equations of N unknowns  Csolve_least_squares_fullSolves the overdetermined or underdetermined system (A*X = B) of M equations of N unknowns, but uses a full orthogonal factorization of the system @@ -131,7 +131,7 @@  Csolve_qrSolves a system of M QR-factored equations of N unknowns  Csolve_triangular_systemSolves a triangular system of equations  CsortSorts an array - CsvdComputes the singular value decomposition of a matrix A. The SVD is defined as: A = U * S * V**T, where U is an M-by-M orthogonal matrix, S is an M-by-N diagonal matrix, and V is an N-by-N orthogonal matrix + CsvdComputes the singular value decomposition of a matrix A. The SVD is defined as: \( A = U S V^T \), where \( U \) is an M-by-M orthogonal matrix, \( S \) is an M-by-N diagonal matrix, and \( V \) is an N-by-N orthogonal matrix  CswapSwaps the contents of two arrays  CtraceComputes the trace of a matrix (the sum of the main diagonal elements)  Ctri_mtx_multComputes the triangular matrix operation: \( B = \alpha A^T A + \beta B \), or \( B = \alpha A A^T + \beta B \), where A is a triangular matrix diff --git a/doc/html/interfacelinalg__core_1_1cholesky__factor.html b/doc/html/interfacelinalg__core_1_1cholesky__factor.html index fed9b632..978278ef 100644 --- a/doc/html/interfacelinalg__core_1_1cholesky__factor.html +++ b/doc/html/interfacelinalg__core_1_1cholesky__factor.html @@ -174,8 +174,8 @@
    print '(F8.4)', (bu(i), i = 1, size(bu))
    end program
    Computes the Cholesky factorization of a symmetric, positive definite matrix.
    -
    Solves a system of Cholesky factored equations.
    -
    Solves a triangular system of equations.
    +
    Solves a system of Cholesky factored equations.
    +
    Solves a triangular system of equations.
    Provides a set of common linear algebra routines.
    Definition: linalg_core.f90:15
    The above program produces the following output.
    Cholesky Solution: X =
    239.5833
    diff --git a/doc/html/interfacelinalg__core_1_1diag__mtx__mult.html b/doc/html/interfacelinalg__core_1_1diag__mtx__mult.html index f92e5820..02b2b974 100644 --- a/doc/html/interfacelinalg__core_1_1diag__mtx__mult.html +++ b/doc/html/interfacelinalg__core_1_1diag__mtx__mult.html @@ -194,7 +194,7 @@
    end do
    end program
    Multiplies a diagonal matrix with another matrix or array.
    -
    Computes the singular value decomposition of a matrix A. The SVD is defined as: A = U * S * V**T,...
    +
    Computes the singular value decomposition of a matrix A. The SVD is defined as: , where is an M-by-M...
    Provides a set of common linear algebra routines.
    Definition: linalg_core.f90:15
    The above program produces the following output.
    U =
    -0.47411577501825380 -0.81850539032073777 -0.32444284226152509
    diff --git a/doc/html/interfacelinalg__core_1_1eigen.html b/doc/html/interfacelinalg__core_1_1eigen.html index 73625571..8514fbaf 100644 --- a/doc/html/interfacelinalg__core_1_1eigen.html +++ b/doc/html/interfacelinalg__core_1_1eigen.html @@ -164,7 +164,7 @@
    print '(F10.3)', (real(modeshapes(j,i)), j = 1, size(natfreq))
    end do
    end program
    -
    Computes the eigenvalues, and optionally the eigenvectors, of a matrix.
    +
    Computes the eigenvalues, and optionally the eigenvectors, of a matrix.
    Provides a set of common linear algebra routines.
    Definition: linalg_core.f90:15
    The above program produces the following output.
    Modal Information:
    Mode 1: (232.9225 Hz)
    @@ -187,7 +187,7 @@ -

    Definition at line 2353 of file linalg_core.f90.

    +

    Definition at line 2547 of file linalg_core.f90.


    The documentation for this interface was generated from the following file: diff --git a/doc/html/interfacelinalg__core_1_1form__lu.html b/doc/html/interfacelinalg__core_1_1form__lu.html index 9b3c7d3a..6f2f7865 100644 --- a/doc/html/interfacelinalg__core_1_1form__lu.html +++ b/doc/html/interfacelinalg__core_1_1form__lu.html @@ -199,7 +199,7 @@
    end program
    Extracts the L and U matrices from the condensed [L\U] storage format used by the lu_factor.
    Computes the LU factorization of an M-by-N matrix.
    -
    Solves a triangular system of equations.
    +
    Solves a triangular system of equations.
    Provides a set of common linear algebra routines.
    Definition: linalg_core.f90:15
    The above program produces the following output.
    LU Solution: X =
    0.3333
    diff --git a/doc/html/interfacelinalg__core_1_1form__qr.html b/doc/html/interfacelinalg__core_1_1form__qr.html index 591dcf66..727823f4 100644 --- a/doc/html/interfacelinalg__core_1_1form__qr.html +++ b/doc/html/interfacelinalg__core_1_1form__qr.html @@ -204,7 +204,7 @@
    end program
    Forms the full M-by-M orthogonal matrix Q from the elementary reflectors returned by the base QR fact...
    Computes the QR factorization of an M-by-N matrix.
    -
    Solves a triangular system of equations.
    +
    Solves a triangular system of equations.
    Provides a set of common linear algebra routines.
    Definition: linalg_core.f90:15
    The above program produces the following output.
    QR Solution: X =
    0.3333
    diff --git a/doc/html/interfacelinalg__core_1_1lu__factor.html b/doc/html/interfacelinalg__core_1_1lu__factor.html index 9150e7d9..5eb731ed 100644 --- a/doc/html/interfacelinalg__core_1_1lu__factor.html +++ b/doc/html/interfacelinalg__core_1_1lu__factor.html @@ -167,7 +167,7 @@
    print '(F8.4)', (b(i), i = 1, size(b))
    end program
    Computes the LU factorization of an M-by-N matrix.
    -
    Solves a system of LU-factored equations.
    +
    Solves a system of LU-factored equations.
    Provides a set of common linear algebra routines.
    Definition: linalg_core.f90:15
    The program generates the following output.
    LU Solution: X =
    0.3333
    diff --git a/doc/html/interfacelinalg__core_1_1mtx__inverse.html b/doc/html/interfacelinalg__core_1_1mtx__inverse.html index 7a62727a..a8887619 100644 --- a/doc/html/interfacelinalg__core_1_1mtx__inverse.html +++ b/doc/html/interfacelinalg__core_1_1mtx__inverse.html @@ -143,7 +143,7 @@
    print *, c(i,:)
    end do
    end program
    -
    Computes the inverse of a square matrix.
    +
    Computes the inverse of a square matrix.
    Provides a set of common linear algebra routines.
    Definition: linalg_core.f90:15
    The above program produces the following output.
    Inverse:
    -1.7777777777777777 0.88888888888888884 -0.11111111111111110
    @@ -155,7 +155,7 @@
    1.7763568394002505E-015 -8.8817841970012523E-016 1.0000000000000000
    -

    Definition at line 2198 of file linalg_core.f90.

    +

    Definition at line 2392 of file linalg_core.f90.


    The documentation for this interface was generated from the following file: diff --git a/doc/html/interfacelinalg__core_1_1mtx__pinverse.html b/doc/html/interfacelinalg__core_1_1mtx__pinverse.html index c0ea44de..3d60d82c 100644 --- a/doc/html/interfacelinalg__core_1_1mtx__pinverse.html +++ b/doc/html/interfacelinalg__core_1_1mtx__pinverse.html @@ -145,7 +145,7 @@
    print *, c(i,:)
    end do
    end program
    -
    Computes the Moore-Penrose pseudo-inverse of a M-by-N matrix using the singular value decomposition o...
    +
    Computes the Moore-Penrose pseudo-inverse of a M-by-N matrix using the singular value decomposition o...
    Provides a set of common linear algebra routines.
    Definition: linalg_core.f90:15
    The above program produces the following output.
    Inverse:
    1.0000000000000000 0.0000000000000000 0.0000000000000000
    @@ -155,7 +155,7 @@
    0.0000000000000000 0.99999999999999967
    -

    Definition at line 2259 of file linalg_core.f90.

    +

    Definition at line 2453 of file linalg_core.f90.


    The documentation for this interface was generated from the following file: diff --git a/doc/html/interfacelinalg__core_1_1mult__qr.html b/doc/html/interfacelinalg__core_1_1mult__qr.html index 76ad3f63..af7f3b13 100644 --- a/doc/html/interfacelinalg__core_1_1mult__qr.html +++ b/doc/html/interfacelinalg__core_1_1mult__qr.html @@ -203,7 +203,7 @@
    end program
    Multiplies a general matrix by the orthogonal matrix Q from a QR factorization.
    Computes the QR factorization of an M-by-N matrix.
    -
    Solves a triangular system of equations.
    +
    Solves a triangular system of equations.
    Provides a set of common linear algebra routines.
    Definition: linalg_core.f90:15
    The above program produces the following output.
    QR Solution: X =
    0.3333
    diff --git a/doc/html/interfacelinalg__core_1_1mult__rz.html b/doc/html/interfacelinalg__core_1_1mult__rz.html index e940f2be..4abc00e4 100644 --- a/doc/html/interfacelinalg__core_1_1mult__rz.html +++ b/doc/html/interfacelinalg__core_1_1mult__rz.html @@ -107,8 +107,50 @@ More...

    Detailed Description

    Multiplies a general matrix by the orthogonal matrix Z from an RZ factorization.

    +
    Syntax 1
    Multiplies a general matrix by the orthogonal matrix Z from an RZ factorization such that: \( C = op(Z) C \) , or \( C = C op(Z) \).
    subroutine mult_rz(logical lside, logical trans, integer(int32) l, real(real64) a(:,:), real(real64) tau(:), real(real64) c(:,:), optional real(real64) work(:), optional integer(int32) olwork, optional class(errors) err)
    +
    subroutine mult_rz(logical lside, logical trans, integer(int32) l, complex(real64) a(:,:), complex(real64) tau(:), complex(real64) c(:,:), optional complex(real64) work(:), optional integer(int32) olwork, optional class(errors) err)
    +
    +
    Parameters
    + + + + + + + + + + +
    [in]lsideSet to true to apply \( Z \) or \( Z^T \) from the left; else, set to false to apply \( Z \) or \( Z^T \) from the right.
    [in]transSet to true to apply \( Z^T \) ( \( Z^H \) in the complex case); else, set to false.
    [in]lThe number of columns in matrix a containing the meaningful part of the Householder vectors. If lside is true, M >= L >= 0; else, if lside is false, N >= L >= 0.
    [in,out]aOn input the K-by-LTA matrix Z, where LTA = M if lside is true; else, LTA = N if lside is false. The I-th row must contain the Householder vector in the last k rows. Notice, the contents of this matrix are restored on exit.
    [in]tauA K-element array containing the scalar factors of the elementary reflectors, where M >= K >= 0 if lside is true; else, N >= K >= 0 if lside is false.
    [in,out]cOn input, the M-by-N matrix C. On output, the product of the orthogonal matrix Z and the original matrix C.
    [out]workAn optional input, that if provided, prevents any local memory allocation. If not provided, the memory required is allocated within. If provided, the length of the array must be at least olwork.
    [out]olworkAn optional output used to determine workspace size. If supplied, the routine determines the optimal size for work, and returns without performing any actual calculations.
    [in,out]errAn optional errors-based object that if provided can be used to retrieve information relating to any errors encountered during execution. If not provided, a default implementation of the errors class is used internally to provide error handling. Possible errors and warning messages that may be encountered are as follows.
      +
    • LA_ARRAY_SIZE_ERROR: Occurs if any of the input arrays are not sized appropriately.
    • +
    • LA_OUT_OF_MEMORY_ERROR: Occurs if local memory must be allocated, and there is insufficient memory available.
    • +
    +
    +
    +
    +
    Syntax 2
    Multiplies a general matrix by the orthogonal matrix Z from an RZ factorization such that: \( C = op(Z) C \), or \( C = C op(Z) \).
    subroutine mult_rz(logical trans, integer(int32) l, real(real64) a(:,:), real(real64) tau(:), real(real64) c(:), optional real(real64) work(:), optional integer(int32) olwork, optional class(errors) err)
    +
    subroutine mult_rz(logical trans, integer(int32) l, complex(real64) a(:,:), complex(real64) tau(:), complex(real64) c(:), optional complex(real64) work(:), optional integer(int32) olwork, optional class(errors) err)
    +
    +
    Parameters
    + + + + + + + + + +
    [in]transSet to true to apply \( Z^T \) ( \( Z^H \) in the complex case); else, set to false.
    [in]lThe number of columns in matrix a containing the meaningful part of the Householder vectors. If lside is true, M >= L >= 0; else, if lside is false, N >= L >= 0.
    [in,out]aOn input the K-by-LTA matrix Z, where LTA = M if lside is true; else, LTA = N if lside is false. The I-th row must contain the Householder vector in the last k rows. Notice, the contents of this matrix are restored on exit.
    [in]tauA K-element array containing the scalar factors of the elementary reflectors, where M >= K >= 0 if lside is true; else, N >= K >= 0 if lside is false.
    [in,out]cOn input, the M-element array C. On output, the product of the orthogonal matrix Z and the original array C.
    [out]workAn optional input, that if provided, prevents any local memory allocation. If not provided, the memory required is allocated within. If provided, the length of the array must be at least olwork.
    [out]olworkAn optional output used to determine workspace size. If supplied, the routine determines the optimal size for work, and returns without performing any actual calculations.
    [in,out]errAn optional errors-based object that if provided can be used to retrieve information relating to any errors encountered during execution. If not provided, a default implementation of the errors class is used internally to provide error handling. Possible errors and warning messages that may be encountered are as follows.
      +
    • LA_ARRAY_SIZE_ERROR: Occurs if any of the input arrays are not sized appropriately.
    • +
    • LA_OUT_OF_MEMORY_ERROR: Occurs if local memory must be allocated, and there is insufficient memory available.
    • +
    +
    +
    +
    +
    Notes
    This routine utilizes the LAPACK routine DORMRZ (ZUNMRZ in the complex case).
    -

    Definition at line 1617 of file linalg_core.f90.

    +

    Definition at line 1763 of file linalg_core.f90.


    The documentation for this interface was generated from the following file: diff --git a/doc/html/interfacelinalg__core_1_1qr__factor.html b/doc/html/interfacelinalg__core_1_1qr__factor.html index db5d1d78..689f50ef 100644 --- a/doc/html/interfacelinalg__core_1_1qr__factor.html +++ b/doc/html/interfacelinalg__core_1_1qr__factor.html @@ -190,7 +190,7 @@
    ! tracking array).
    end program
    Computes the QR factorization of an M-by-N matrix.
    -
    Solves a system of M QR-factored equations of N unknowns.
    +
    Solves a system of M QR-factored equations of N unknowns.
    Provides a set of common linear algebra routines.
    Definition: linalg_core.f90:15
    The above program produces the following output.
    QR Solution: X =
    0.3333
    diff --git a/doc/html/interfacelinalg__core_1_1rz__factor.html b/doc/html/interfacelinalg__core_1_1rz__factor.html index 7089f2cd..e2b2c492 100644 --- a/doc/html/interfacelinalg__core_1_1rz__factor.html +++ b/doc/html/interfacelinalg__core_1_1rz__factor.html @@ -103,12 +103,39 @@
    -

    Factors an upper trapezoidal matrix by means of orthogonal transformations such that A = R * Z = (R 0) * Z. Z is an orthogonal matrix of dimension N-by-N, and R is an M-by-M upper triangular matrix. +

    Factors an upper trapezoidal matrix by means of orthogonal transformations such that \( A = R Z = (R 0) Z \). Z is an orthogonal matrix of dimension N-by-N, and R is an M-by-M upper triangular matrix. More...

    Detailed Description

    -

    Factors an upper trapezoidal matrix by means of orthogonal transformations such that A = R * Z = (R 0) * Z. Z is an orthogonal matrix of dimension N-by-N, and R is an M-by-M upper triangular matrix.

    +

    Factors an upper trapezoidal matrix by means of orthogonal transformations such that \( A = R Z = (R 0) Z \). Z is an orthogonal matrix of dimension N-by-N, and R is an M-by-M upper triangular matrix.

    +
    Syntax
    subroutine rz_factor(real(real64) a(:,:), real(real64) tau(:), optional real(real64) work(:), optional integer(int32) olwork, optional class(errors) err)
    +
    subroutine rz_factor(complex(real64) a(:,:), complex(real64) tau(:), optional complex(real64) work(:), optional integer(int32) olwork, optional class(errors) err)
    +
    +
    Parameters
    + + + + + + +
    [in,out]aOn input, the M-by-N upper trapezoidal matrix to factor. On output, the leading M-by-M upper triangular part of the matrix contains the upper triangular matrix R, and elements N-L+1 to N of the first M rows of A, with the array tau, represent the orthogonal matrix Z as a product of M elementary reflectors.
    [out]tauAn M-element array used to store the scalar factors of the elementary reflectors.
    [out]workAn optional input, that if provided, prevents any local memory allocation. If not provided, the memory required is allocated within. If provided, the length of the array must be at least olwork.
    [out]olworkAn optional output used to determine workspace size. If supplied, the routine determines the optimal size for work, and returns without performing any actual calculations.
    [in,out]errAn optional errors-based object that if provided can be used to retrieve information relating to any errors encountered during execution. If not provided, a default implementation of the errors class is used internally to provide error handling. Possible errors and warning messages that may be encountered are as follows.
      +
    • LA_ARRAY_SIZE_ERROR: Occurs if any of the input arrays are not sized appropriately.
    • +
    • LA_OUT_OF_MEMORY_ERROR: Occurs if local memory must be allocated, and there is insufficient memory available.
    • +
    +
    +
    +
    +
    Further Details
    The factorization is obtained by Householder's method. The kth transformation matrix, Z( k ), which is used to introduce zeros into the ( m - k + 1 )th row of A, is given in the form
         Z( k ) = ( I     0   ),
    +              ( 0  T( k ) )
    where
         T( k ) = I - tau*u( k )*u( k )**T,   u( k ) = (   1    ),
    +                                                   (   0    )
    +                                                   ( z( k ) )
    tau is a scalar and z( k ) is an l element vector. tau and z( k ) are chosen to annihilate the elements of the kth row of A2.
    +

    The scalar tau is returned in the kth element of TAU and the vector u( k ) in the kth row of A2, such that the elements of z( k ) are in a( k, l + 1 ), ..., a( k, n ). The elements of R are returned in the upper triangular part of A1.

    +

    Z is given by

         Z =  Z( 1 ) * Z( 2 ) * ... * Z( m ).
    Notes
    This routine is based upon the LAPACK routine DTZRZF.
    +
    See Also
    +
    -

    Definition at line 1609 of file linalg_core.f90.

    +

    Definition at line 1672 of file linalg_core.f90.


    The documentation for this interface was generated from the following file: diff --git a/doc/html/interfacelinalg__core_1_1solve__cholesky.html b/doc/html/interfacelinalg__core_1_1solve__cholesky.html index a2af617e..b82c59c1 100644 --- a/doc/html/interfacelinalg__core_1_1solve__cholesky.html +++ b/doc/html/interfacelinalg__core_1_1solve__cholesky.html @@ -158,8 +158,8 @@
    print '(F8.4)', (bu(i), i = 1, size(bu))
    end program
    Computes the Cholesky factorization of a symmetric, positive definite matrix.
    -
    Solves a system of Cholesky factored equations.
    -
    Solves a triangular system of equations.
    +
    Solves a system of Cholesky factored equations.
    +
    Solves a triangular system of equations.
    Provides a set of common linear algebra routines.
    Definition: linalg_core.f90:15
    The above program produces the following output.
    Cholesky Solution: X =
    239.5833
    @@ -171,7 +171,7 @@
    10.3333
    -

    Definition at line 1975 of file linalg_core.f90.

    +

    Definition at line 2169 of file linalg_core.f90.


    The documentation for this interface was generated from the following file: diff --git a/doc/html/interfacelinalg__core_1_1solve__least__squares.html b/doc/html/interfacelinalg__core_1_1solve__least__squares.html index e2404dc9..be270fa2 100644 --- a/doc/html/interfacelinalg__core_1_1solve__least__squares.html +++ b/doc/html/interfacelinalg__core_1_1solve__least__squares.html @@ -139,14 +139,14 @@
    print '(A)', "Least Squares Solution: X = "
    print '(F9.5)', (b(i), i = 1, size(a, 2))
    end program
    -
    Solves the overdetermined or underdetermined system (A*X = B) of M equations of N unknowns.
    +
    Solves the overdetermined or underdetermined system (A*X = B) of M equations of N unknowns.
    Provides a set of common linear algebra routines.
    Definition: linalg_core.f90:15
    The above program produces the following output.
    Least Squares Solution: X =
    0.13158
    -0.57895
    -

    Definition at line 2029 of file linalg_core.f90.

    +

    Definition at line 2223 of file linalg_core.f90.


    The documentation for this interface was generated from the following file: diff --git a/doc/html/interfacelinalg__core_1_1solve__least__squares__full.html b/doc/html/interfacelinalg__core_1_1solve__least__squares__full.html index 28cf39e5..d0c347b9 100644 --- a/doc/html/interfacelinalg__core_1_1solve__least__squares__full.html +++ b/doc/html/interfacelinalg__core_1_1solve__least__squares__full.html @@ -139,14 +139,14 @@
    print '(A)', "Least Squares Solution: X = "
    print '(F9.5)', (b(i), i = 1, size(a, 2))
    end program
    -
    Solves the overdetermined or underdetermined system (A*X = B) of M equations of N unknowns,...
    +
    Solves the overdetermined or underdetermined system (A*X = B) of M equations of N unknowns,...
    Provides a set of common linear algebra routines.
    Definition: linalg_core.f90:15
    The above program produces the following output.
    Least Squares Solution: X =
    0.13158
    -0.57895
    -

    Definition at line 2084 of file linalg_core.f90.

    +

    Definition at line 2278 of file linalg_core.f90.


    The documentation for this interface was generated from the following file: diff --git a/doc/html/interfacelinalg__core_1_1solve__least__squares__svd.html b/doc/html/interfacelinalg__core_1_1solve__least__squares__svd.html index d979c152..226c1444 100644 --- a/doc/html/interfacelinalg__core_1_1solve__least__squares__svd.html +++ b/doc/html/interfacelinalg__core_1_1solve__least__squares__svd.html @@ -139,14 +139,14 @@
    print '(A)', "Least Squares Solution: X = "
    print '(F9.5)', (b(i), i = 1, size(a, 2))
    end program
    -
    Solves the overdetermined or underdetermined system (A*X = B) of M equations of N unknowns using a si...
    +
    Solves the overdetermined or underdetermined system (A*X = B) of M equations of N unknowns using a si...
    Provides a set of common linear algebra routines.
    Definition: linalg_core.f90:15
    The above program produces the following output.
    Least Squares Solution: X =
    0.13158
    -0.57895
    -

    Definition at line 2139 of file linalg_core.f90.

    +

    Definition at line 2333 of file linalg_core.f90.


    The documentation for this interface was generated from the following file: diff --git a/doc/html/interfacelinalg__core_1_1solve__lu.html b/doc/html/interfacelinalg__core_1_1solve__lu.html index 12fe8a89..2253ee39 100644 --- a/doc/html/interfacelinalg__core_1_1solve__lu.html +++ b/doc/html/interfacelinalg__core_1_1solve__lu.html @@ -146,7 +146,7 @@
    print '(F8.4)', (b(i), i = 1, size(b))
    end program
    Computes the LU factorization of an M-by-N matrix.
    -
    Solves a system of LU-factored equations.
    +
    Solves a system of LU-factored equations.
    Provides a set of common linear algebra routines.
    Definition: linalg_core.f90:15
    The program generates the following output.
    LU Solution: X =
    0.3333
    @@ -159,7 +159,7 @@ -

    Definition at line 1826 of file linalg_core.f90.

    +

    Definition at line 2020 of file linalg_core.f90.


    The documentation for this interface was generated from the following file: diff --git a/doc/html/interfacelinalg__core_1_1solve__qr.html b/doc/html/interfacelinalg__core_1_1solve__qr.html index fd6e307e..bda68b55 100644 --- a/doc/html/interfacelinalg__core_1_1solve__qr.html +++ b/doc/html/interfacelinalg__core_1_1solve__qr.html @@ -151,7 +151,7 @@
    ! tracking array).
    end program
    Computes the QR factorization of an M-by-N matrix.
    -
    Solves a system of M QR-factored equations of N unknowns.
    +
    Solves a system of M QR-factored equations of N unknowns.
    Provides a set of common linear algebra routines.
    Definition: linalg_core.f90:15
    The above program produces the following output.
    QR Solution: X =
    0.3333
    @@ -164,7 +164,7 @@ -

    Definition at line 1895 of file linalg_core.f90.

    +

    Definition at line 2089 of file linalg_core.f90.


    The documentation for this interface was generated from the following file: diff --git a/doc/html/interfacelinalg__core_1_1solve__triangular__system.html b/doc/html/interfacelinalg__core_1_1solve__triangular__system.html index ce800ac0..0b19b1bf 100644 --- a/doc/html/interfacelinalg__core_1_1solve__triangular__system.html +++ b/doc/html/interfacelinalg__core_1_1solve__triangular__system.html @@ -158,7 +158,7 @@
    end program
    Extracts the L and U matrices from the condensed [L\U] storage format used by the lu_factor.
    Computes the LU factorization of an M-by-N matrix.
    -
    Solves a triangular system of equations.
    +
    Solves a triangular system of equations.
    Provides a set of common linear algebra routines.
    Definition: linalg_core.f90:15
    The above program produces the following output.
    LU Solution: X =
    0.3333
    @@ -166,7 +166,7 @@
    0.0000
    -

    Definition at line 1762 of file linalg_core.f90.

    +

    Definition at line 1956 of file linalg_core.f90.


    The documentation for this interface was generated from the following file: diff --git a/doc/html/interfacelinalg__core_1_1sort.html b/doc/html/interfacelinalg__core_1_1sort.html index 6ceb00b9..d9949eb6 100644 --- a/doc/html/interfacelinalg__core_1_1sort.html +++ b/doc/html/interfacelinalg__core_1_1sort.html @@ -108,7 +108,7 @@

    Detailed Description

    Sorts an array.

    -

    Definition at line 2362 of file linalg_core.f90.

    +

    Definition at line 2556 of file linalg_core.f90.


    The documentation for this interface was generated from the following file: diff --git a/doc/html/interfacelinalg__core_1_1svd.html b/doc/html/interfacelinalg__core_1_1svd.html index 65efc04f..79aaf7f5 100644 --- a/doc/html/interfacelinalg__core_1_1svd.html +++ b/doc/html/interfacelinalg__core_1_1svd.html @@ -103,10 +103,37 @@
    -

    Computes the singular value decomposition of a matrix A. The SVD is defined as: A = U * S * V**T, where U is an M-by-M orthogonal matrix, S is an M-by-N diagonal matrix, and V is an N-by-N orthogonal matrix. +

    Computes the singular value decomposition of a matrix A. The SVD is defined as: \( A = U S V^T \), where \( U \) is an M-by-M orthogonal matrix, \( S \) is an M-by-N diagonal matrix, and \( V \) is an N-by-N orthogonal matrix. More...

    Detailed Description

    -

    Computes the singular value decomposition of a matrix A. The SVD is defined as: A = U * S * V**T, where U is an M-by-M orthogonal matrix, S is an M-by-N diagonal matrix, and V is an N-by-N orthogonal matrix.

    +

    Computes the singular value decomposition of a matrix A. The SVD is defined as: \( A = U S V^T \), where \( U \) is an M-by-M orthogonal matrix, \( S \) is an M-by-N diagonal matrix, and \( V \) is an N-by-N orthogonal matrix.

    +
    Syntax
    subroutine svd(real(real64) a(:,:), real(real64) s(:), optional real(real64) u(:,:), optional real(real64) vt(:,:), optional real(real64) work(:), optional integer(int32) olwork, optional class(errors) err)
    +
    subroutine svd(complex(real64) a(:,:), real(real64) s(:), optional complex(real64) u(:,:), optional complex(real64) vt(:,:), optional complex(real64) work(:), optional integer(int32) olwork, optional real(real64) rwork(:), optional class(errors) err)
    +
    +
    Parameters
    + + + + + + + + + +
    [in,out]aOn input, the M-by-N matrix to factor. The matrix is overwritten on output.
    [out]sA MIN(M, N)-element array containing the singular values of a sorted in descending order.
    [out]uAn optional argument, that if supplied, is used to contain the orthogonal matrix U from the decomposition. The matrix U contains the left singular vectors, and can be either M-by-M (all left singular vectors are computed), or M-by-MIN(M,N) (only the first MIN(M, N) left singular vectors are computed).
    [out]vtAn optional argument, that if supplied, is used to contain the conjugate transpose of the N-by-N orthogonal matrix V. The matrix V contains the right singular vectors.
    [out]workAn optional input, that if provided, prevents any local memory allocation for complex-valued workspaces. If not provided, the memory required is allocated within. If provided, the length of the array must be at least olwork.
    [out]olworkAn optional output used to determine workspace size. If supplied, the routine determines the optimal size for work, and returns without performing any actual calculations.
    [out]rworkAn optional input, that if provided, prevents any local memory allocation for real-valued workspaces. If not provided, the memory required is allocated within. If provided, the length of the array must be at least 5 * MIN(M, N).
    [in,out]errAn optional errors-based object that if provided can be used to retrieve information relating to any errors encountered during execution. If not provided, a default implementation of the errors class is used internally to provide error handling. Possible errors and warning messages that may be encountered are as follows.
      +
    • LA_ARRAY_SIZE_ERROR: Occurs if any of the input arrays are not sized appropriately.
    • +
    • LA_OUT_OF_MEMORY_ERROR: Occurs if local memory must be allocated, and there is insufficient memory available.
    • +
    • LA_CONVERGENCE_ERROR: Occurs as a warning if the QR iteration process could not converge to a zero value.
    • +
    +
    +
    +
    +
    Notes
    This routine utilizes the LAPACK routine DGESVD (ZGESVD in the complex case).
    +
    See Also
    +
    Usage
    The following example illustrates the calculation of the singular value decomposition of an overdetermined system.
    program example
    use iso_fortran_env, only : int32, real64
    @@ -140,7 +167,7 @@
    print *, vt(i,:)
    end do
    -
    ! Compute U * S * V**T, but first establish S in full form
    +
    ! Compute U * S * V**T
    call diag_mtx_mult(.true., 1.0d0, s, vt) ! Compute: VT = S * V**T
    ac = matmul(u(:,1:2), vt)
    print '(A)', "U * S * V**T ="
    @@ -149,7 +176,7 @@
    end do
    end program
    Multiplies a diagonal matrix with another matrix or array.
    -
    Computes the singular value decomposition of a matrix A. The SVD is defined as: A = U * S * V**T,...
    +
    Computes the singular value decomposition of a matrix A. The SVD is defined as: , where is an M-by-M...
    Provides a set of common linear algebra routines.
    Definition: linalg_core.f90:15
    The above program produces the following output.
    U =
    -0.47411577501825380 -0.81850539032073777 -0.32444284226152509
    @@ -167,7 +194,7 @@
    -1.0000000000000000 0.99999999999999967
    -

    Definition at line 1693 of file linalg_core.f90.

    +

    Definition at line 1887 of file linalg_core.f90.


    The documentation for this interface was generated from the following file: diff --git a/doc/html/linalg__c__api_8f90_source.html b/doc/html/linalg__c__api_8f90_source.html index 2bb795ef..311bdbf5 100644 --- a/doc/html/linalg__c__api_8f90_source.html +++ b/doc/html/linalg__c__api_8f90_source.html @@ -2027,24 +2027,24 @@
    Computes the rank 1 update to a Cholesky factored matrix (upper triangular).
    Computes the determinant of a square matrix.
    Multiplies a diagonal matrix with another matrix or array.
    -
    Computes the eigenvalues, and optionally the eigenvectors, of a matrix.
    +
    Computes the eigenvalues, and optionally the eigenvectors, of a matrix.
    Extracts the L and U matrices from the condensed [L\U] storage format used by the lu_factor.
    Forms the full M-by-M orthogonal matrix Q from the elementary reflectors returned by the base QR fact...
    Computes the LU factorization of an M-by-N matrix.
    -
    Computes the inverse of a square matrix.
    -
    Computes the Moore-Penrose pseudo-inverse of a M-by-N matrix using the singular value decomposition o...
    +
    Computes the inverse of a square matrix.
    +
    Computes the Moore-Penrose pseudo-inverse of a M-by-N matrix using the singular value decomposition o...
    Computes the rank of a matrix.
    Multiplies a general matrix by the orthogonal matrix Q from a QR factorization.
    Computes the QR factorization of an M-by-N matrix.
    Computes the rank 1 update to an M-by-N QR factored matrix A (M >= N) where , and such that .
    Performs the rank-1 update to matrix A such that: , where is an M-by-N matrix, is a scalar,...
    -
    Solves a system of Cholesky factored equations.
    -
    Solves the overdetermined or underdetermined system (A*X = B) of M equations of N unknowns.
    -
    Solves a system of LU-factored equations.
    -
    Solves a system of M QR-factored equations of N unknowns.
    -
    Solves a triangular system of equations.
    -
    Sorts an array.
    -
    Computes the singular value decomposition of a matrix A. The SVD is defined as: A = U * S * V**T,...
    +
    Solves a system of Cholesky factored equations.
    +
    Solves the overdetermined or underdetermined system (A*X = B) of M equations of N unknowns.
    +
    Solves a system of LU-factored equations.
    +
    Solves a system of M QR-factored equations of N unknowns.
    +
    Solves a triangular system of equations.
    +
    Sorts an array.
    +
    Computes the singular value decomposition of a matrix A. The SVD is defined as: , where is an M-by-M...
    Computes the trace of a matrix (the sum of the main diagonal elements).
    Computes the triangular matrix operation: , or , where A is a triangular matrix.
    Provides a C-friendly API to the LINALG library. Notice, all C-API LINALG routines begin with the pre...
    Definition: linalg_c_api.f90:5
    diff --git a/doc/html/linalg__core_8f90_source.html b/doc/html/linalg__core_8f90_source.html index 5fbd00b5..21e6dba8 100644 --- a/doc/html/linalg__core_8f90_source.html +++ b/doc/html/linalg__core_8f90_source.html @@ -270,1033 +270,1033 @@
    1602end interface
    1603
    1604! ------------------------------------------------------------------------------
    -
    1609interface rz_factor
    -
    1610 module procedure :: rz_factor_dbl
    -
    1611 module procedure :: rz_factor_cmplx
    -
    1612end interface
    -
    1613
    -
    1614! ------------------------------------------------------------------------------
    -
    1617interface mult_rz
    -
    1618 module procedure :: mult_rz_mtx
    -
    1619 module procedure :: mult_rz_mtx_cmplx
    -
    1620 module procedure :: mult_rz_vec
    -
    1621 module procedure :: mult_rz_vec_cmplx
    -
    1622end interface
    -
    1623
    -
    1624! ------------------------------------------------------------------------------
    -
    1693interface svd
    -
    1694 module procedure :: svd_dbl
    -
    1695 module procedure :: svd_cmplx
    -
    1696end interface
    -
    1697
    -
    1698! ------------------------------------------------------------------------------
    - -
    1763 module procedure :: solve_tri_mtx
    -
    1764 module procedure :: solve_tri_mtx_cmplx
    -
    1765 module procedure :: solve_tri_vec
    -
    1766 module procedure :: solve_tri_vec_cmplx
    -
    1767end interface
    -
    1768
    -
    1769! ------------------------------------------------------------------------------
    -
    1826interface solve_lu
    -
    1827 module procedure :: solve_lu_mtx
    -
    1828 module procedure :: solve_lu_mtx_cmplx
    -
    1829 module procedure :: solve_lu_vec
    -
    1830 module procedure :: solve_lu_vec_cmplx
    -
    1831end interface
    -
    1832
    -
    1833! ------------------------------------------------------------------------------
    -
    1895interface solve_qr
    -
    1896 module procedure :: solve_qr_no_pivot_mtx
    -
    1897 module procedure :: solve_qr_no_pivot_mtx_cmplx
    -
    1898 module procedure :: solve_qr_no_pivot_vec
    -
    1899 module procedure :: solve_qr_no_pivot_vec_cmplx
    -
    1900 module procedure :: solve_qr_pivot_mtx
    -
    1901 module procedure :: solve_qr_pivot_mtx_cmplx
    -
    1902 module procedure :: solve_qr_pivot_vec
    -
    1903 module procedure :: solve_qr_pivot_vec_cmplx
    -
    1904end interface
    -
    1905
    -
    1906! ------------------------------------------------------------------------------
    - -
    1976 module procedure :: solve_cholesky_mtx
    -
    1977 module procedure :: solve_cholesky_mtx_cmplx
    -
    1978 module procedure :: solve_cholesky_vec
    -
    1979 module procedure :: solve_cholesky_vec_cmplx
    -
    1980end interface
    -
    1981
    -
    1982! ------------------------------------------------------------------------------
    - -
    2030 module procedure :: solve_least_squares_mtx
    -
    2031 module procedure :: solve_least_squares_mtx_cmplx
    -
    2032 module procedure :: solve_least_squares_vec
    -
    2033 module procedure :: solve_least_squares_vec_cmplx
    -
    2034end interface
    -
    2035
    -
    2036! ------------------------------------------------------------------------------
    - -
    2085 module procedure :: solve_least_squares_mtx_pvt
    -
    2086 module procedure :: solve_least_squares_mtx_pvt_cmplx
    -
    2087 module procedure :: solve_least_squares_vec_pvt
    -
    2088 module procedure :: solve_least_squares_vec_pvt_cmplx
    -
    2089end interface
    -
    2090
    -
    2091! ------------------------------------------------------------------------------
    - -
    2140 module procedure :: solve_least_squares_mtx_svd
    -
    2141 module procedure :: solve_least_squares_vec_svd
    -
    2142end interface
    -
    2143
    -
    2144! ------------------------------------------------------------------------------
    - -
    2199 module procedure :: mtx_inverse_dbl
    -
    2200 module procedure :: mtx_inverse_cmplx
    -
    2201end interface
    -
    2202
    -
    2203! ------------------------------------------------------------------------------
    - -
    2260 module procedure :: mtx_pinverse_dbl
    -
    2261 module procedure :: mtx_pinverse_cmplx
    -
    2262end interface
    -
    2263
    -
    2264! ------------------------------------------------------------------------------
    -
    2353interface eigen
    -
    2354 module procedure :: eigen_symm
    -
    2355 module procedure :: eigen_asymm
    -
    2356 module procedure :: eigen_gen
    -
    2357 module procedure :: eigen_cmplx
    -
    2358end interface
    -
    2359
    -
    2360! ------------------------------------------------------------------------------
    -
    2362interface sort
    -
    2363 module procedure :: sort_dbl_array
    -
    2364 module procedure :: sort_dbl_array_ind
    -
    2365 module procedure :: sort_cmplx_array
    -
    2366 module procedure :: sort_cmplx_array_ind
    -
    2367 module procedure :: sort_eigen_cmplx
    -
    2368 module procedure :: sort_eigen_dbl
    -
    2369end interface
    -
    2370
    -
    2371
    -
    2372! ******************************************************************************
    -
    2373! LINALG_BASIC.F90
    -
    2374! ------------------------------------------------------------------------------
    -
    2375interface
    -
    2376 module subroutine mtx_mult_mtx(transa, transb, alpha, a, b, beta, c, err)
    -
    2377 logical, intent(in) :: transa, transb
    -
    2378 real(real64), intent(in) :: alpha, beta
    -
    2379 real(real64), intent(in), dimension(:,:) :: a, b
    -
    2380 real(real64), intent(inout), dimension(:,:) :: c
    -
    2381 class(errors), intent(inout), optional, target :: err
    -
    2382 end subroutine
    -
    2383
    -
    2384 module subroutine mtx_mult_vec(trans, alpha, a, b, beta, c, err)
    -
    2385 logical, intent(in) :: trans
    -
    2386 real(real64), intent(in) :: alpha, beta
    -
    2387 real(real64), intent(in), dimension(:,:) :: a
    -
    2388 real(real64), intent(in), dimension(:) :: b
    -
    2389 real(real64), intent(inout), dimension(:) :: c
    -
    2390 class(errors), intent(inout), optional, target :: err
    -
    2391 end subroutine
    -
    2392
    -
    2393 module subroutine cmtx_mult_mtx(opa, opb, alpha, a, b, beta, c, err)
    -
    2394 integer(int32), intent(in) :: opa, opb
    -
    2395 complex(real64), intent(in) :: alpha, beta
    -
    2396 complex(real64), intent(in), dimension(:,:) :: a, b
    -
    2397 complex(real64), intent(inout), dimension(:,:) :: c
    -
    2398 class(errors), intent(inout), optional, target :: err
    -
    2399 end subroutine
    -
    2400
    -
    2401 module subroutine cmtx_mult_vec(opa, alpha, a, b, beta, c, err)
    -
    2402 integer(int32), intent(in) :: opa
    -
    2403 complex(real64), intent(in) :: alpha, beta
    -
    2404 complex(real64), intent(in), dimension(:,:) :: a
    -
    2405 complex(real64), intent(in), dimension(:) :: b
    -
    2406 complex(real64), intent(inout), dimension(:) :: c
    -
    2407 class(errors), intent(inout), optional, target :: err
    -
    2408 end subroutine
    -
    2409
    -
    2410 module subroutine rank1_update_dbl(alpha, x, y, a, err)
    -
    2411 real(real64), intent(in) :: alpha
    -
    2412 real(real64), intent(in), dimension(:) :: x, y
    -
    2413 real(real64), intent(inout), dimension(:,:) :: a
    -
    2414 class(errors), intent(inout), optional, target :: err
    -
    2415 end subroutine
    -
    2416
    -
    2417 module subroutine rank1_update_cmplx(alpha, x, y, a, err)
    -
    2418 complex(real64), intent(in) :: alpha
    -
    2419 complex(real64), intent(in), dimension(:) :: x, y
    -
    2420 complex(real64), intent(inout), dimension(:,:) :: a
    -
    2421 class(errors), intent(inout), optional, target :: err
    -
    2422 end subroutine
    -
    2423
    -
    2424 module subroutine diag_mtx_mult_mtx(lside, trans, alpha, a, b, beta, c, err)
    -
    2425 logical, intent(in) :: lside, trans
    -
    2426 real(real64) :: alpha, beta
    -
    2427 real(real64), intent(in), dimension(:) :: a
    -
    2428 real(real64), intent(in), dimension(:,:) :: b
    -
    2429 real(real64), intent(inout), dimension(:,:) :: c
    -
    2430 class(errors), intent(inout), optional, target :: err
    -
    2431 end subroutine
    -
    2432
    -
    2433 module subroutine diag_mtx_mult_mtx2(lside, alpha, a, b, err)
    -
    2434 logical, intent(in) :: lside
    -
    2435 real(real64), intent(in) :: alpha
    -
    2436 real(real64), intent(in), dimension(:) :: a
    -
    2437 real(real64), intent(inout), dimension(:,:) :: b
    -
    2438 class(errors), intent(inout), optional, target :: err
    -
    2439 end subroutine
    -
    2440
    -
    2441 module subroutine diag_mtx_mult_mtx3(lside, trans, alpha, a, b, beta, c, err)
    -
    2442 logical, intent(in) :: lside, trans
    -
    2443 real(real64) :: alpha, beta
    -
    2444 complex(real64), intent(in), dimension(:) :: a
    -
    2445 real(real64), intent(in), dimension(:,:) :: b
    -
    2446 complex(real64), intent(inout), dimension(:,:) :: c
    -
    2447 class(errors), intent(inout), optional, target :: err
    -
    2448 end subroutine
    -
    2449
    -
    2450 module subroutine diag_mtx_mult_mtx4(lside, opb, alpha, a, b, beta, c, err)
    -
    2451 logical, intent(in) :: lside
    -
    2452 integer(int32), intent(in) :: opb
    -
    2453 real(real64) :: alpha, beta
    -
    2454 complex(real64), intent(in), dimension(:) :: a
    -
    2455 complex(real64), intent(in), dimension(:,:) :: b
    -
    2456 complex(real64), intent(inout), dimension(:,:) :: c
    -
    2457 class(errors), intent(inout), optional, target :: err
    -
    2458 end subroutine
    -
    2459
    -
    2460 module subroutine diag_mtx_mult_mtx_cmplx(lside, opb, alpha, a, b, beta, c, err)
    -
    2461 logical, intent(in) :: lside
    -
    2462 integer(int32), intent(in) :: opb
    -
    2463 complex(real64) :: alpha, beta
    -
    2464 complex(real64), intent(in), dimension(:) :: a
    -
    2465 complex(real64), intent(in), dimension(:,:) :: b
    -
    2466 complex(real64), intent(inout), dimension(:,:) :: c
    -
    2467 class(errors), intent(inout), optional, target :: err
    -
    2468 end subroutine
    -
    2469
    -
    2470 module subroutine diag_mtx_mult_mtx2_cmplx(lside, alpha, a, b, err)
    -
    2471 logical, intent(in) :: lside
    -
    2472 complex(real64), intent(in) :: alpha
    -
    2473 complex(real64), intent(in), dimension(:) :: a
    -
    2474 complex(real64), intent(inout), dimension(:,:) :: b
    -
    2475 class(errors), intent(inout), optional, target :: err
    -
    2476 end subroutine
    -
    2477
    -
    2478 module subroutine diag_mtx_mult_mtx_mix(lside, opb, alpha, a, b, beta, c, err)
    -
    2479 logical, intent(in) :: lside
    -
    2480 integer(int32), intent(in) :: opb
    -
    2481 complex(real64) :: alpha, beta
    -
    2482 real(real64), intent(in), dimension(:) :: a
    -
    2483 complex(real64), intent(in), dimension(:,:) :: b
    -
    2484 complex(real64), intent(inout), dimension(:,:) :: c
    -
    2485 class(errors), intent(inout), optional, target :: err
    -
    2486 end subroutine
    -
    2487
    -
    2488 module subroutine diag_mtx_mult_mtx2_mix(lside, alpha, a, b, err)
    -
    2489 logical, intent(in) :: lside
    -
    2490 complex(real64), intent(in) :: alpha
    -
    2491 real(real64), intent(in), dimension(:) :: a
    -
    2492 complex(real64), intent(inout), dimension(:,:) :: b
    -
    2493 class(errors), intent(inout), optional, target :: err
    -
    2494 end subroutine
    -
    2495
    -
    2496 pure module function trace_dbl(x) result(y)
    -
    2497 real(real64), intent(in), dimension(:,:) :: x
    -
    2498 real(real64) :: y
    -
    2499 end function
    -
    2500
    -
    2501 pure module function trace_cmplx(x) result(y)
    -
    2502 complex(real64), intent(in), dimension(:,:) :: x
    -
    2503 complex(real64) :: y
    -
    2504 end function
    -
    2505
    -
    2506 module function mtx_rank_dbl(a, tol, work, olwork, err) result(rnk)
    -
    2507 real(real64), intent(inout), dimension(:,:) :: a
    -
    2508 real(real64), intent(in), optional :: tol
    -
    2509 real(real64), intent(out), target, optional, dimension(:) :: work
    -
    2510 integer(int32), intent(out), optional :: olwork
    -
    2511 class(errors), intent(inout), optional, target :: err
    -
    2512 integer(int32) :: rnk
    -
    2513 end function
    -
    2514
    -
    2515 module function mtx_rank_cmplx(a, tol, work, olwork, rwork, err) result(rnk)
    -
    2516 complex(real64), intent(inout), dimension(:,:) :: a
    -
    2517 real(real64), intent(in), optional :: tol
    -
    2518 complex(real64), intent(out), target, optional, dimension(:) :: work
    -
    2519 integer(int32), intent(out), optional :: olwork
    -
    2520 real(real64), intent(out), target, optional, dimension(:) :: rwork
    -
    2521 class(errors), intent(inout), optional, target :: err
    -
    2522 integer(int32) :: rnk
    -
    2523 end function
    -
    2524
    -
    2525 module function det_dbl(a, iwork, err) result(x)
    -
    2526 real(real64), intent(inout), dimension(:,:) :: a
    -
    2527 integer(int32), intent(out), target, optional, dimension(:) :: iwork
    -
    2528 class(errors), intent(inout), optional, target :: err
    -
    2529 real(real64) :: x
    -
    2530 end function
    -
    2531
    -
    2532 module function det_cmplx(a, iwork, err) result(x)
    -
    2533 complex(real64), intent(inout), dimension(:,:) :: a
    -
    2534 integer(int32), intent(out), target, optional, dimension(:) :: iwork
    -
    2535 class(errors), intent(inout), optional, target :: err
    -
    2536 complex(real64) :: x
    -
    2537 end function
    -
    2538
    -
    2539 module subroutine swap_dbl(x, y, err)
    -
    2540 real(real64), intent(inout), dimension(:) :: x, y
    -
    2541 class(errors), intent(inout), optional, target :: err
    -
    2542 end subroutine
    -
    2543
    -
    2544 module subroutine swap_cmplx(x, y, err)
    -
    2545 complex(real64), intent(inout), dimension(:) :: x, y
    -
    2546 class(errors), intent(inout), optional, target :: err
    -
    2547 end subroutine
    -
    2548
    -
    2549 module subroutine recip_mult_array_dbl(a, x)
    -
    2550 real(real64), intent(in) :: a
    -
    2551 real(real64), intent(inout), dimension(:) :: x
    -
    2552 end subroutine
    -
    2553
    -
    2554 module subroutine tri_mtx_mult_dbl(upper, alpha, a, beta, b, err)
    -
    2555 logical, intent(in) :: upper
    -
    2556 real(real64), intent(in) :: alpha, beta
    -
    2557 real(real64), intent(in), dimension(:,:) :: a
    -
    2558 real(real64), intent(inout), dimension(:,:) :: b
    -
    2559 class(errors), intent(inout), optional, target :: err
    -
    2560 end subroutine
    -
    2561
    -
    2562 module subroutine tri_mtx_mult_cmplx(upper, alpha, a, beta, b, err)
    -
    2563 logical, intent(in) :: upper
    -
    2564 complex(real64), intent(in) :: alpha, beta
    -
    2565 complex(real64), intent(in), dimension(:,:) :: a
    -
    2566 complex(real64), intent(inout), dimension(:,:) :: b
    -
    2567 class(errors), intent(inout), optional, target :: err
    -
    2568 end subroutine
    -
    2569
    -
    2570end interface
    -
    2571
    -
    2572! ******************************************************************************
    -
    2573! LINALG_FACTOR.F90
    -
    2574! ------------------------------------------------------------------------------
    -
    2575interface
    -
    2576 module subroutine lu_factor_dbl(a, ipvt, err)
    -
    2577 real(real64), intent(inout), dimension(:,:) :: a
    -
    2578 integer(int32), intent(out), dimension(:) :: ipvt
    -
    2579 class(errors), intent(inout), optional, target :: err
    -
    2580 end subroutine
    -
    2581
    -
    2582 module subroutine lu_factor_cmplx(a, ipvt, err)
    -
    2583 complex(real64), intent(inout), dimension(:,:) :: a
    -
    2584 integer(int32), intent(out), dimension(:) :: ipvt
    -
    2585 class(errors), intent(inout), optional, target :: err
    -
    2586 end subroutine
    -
    2587
    -
    2588 module subroutine form_lu_all(lu, ipvt, u, p, err)
    -
    2589 real(real64), intent(inout), dimension(:,:) :: lu
    -
    2590 integer(int32), intent(in), dimension(:) :: ipvt
    -
    2591 real(real64), intent(out), dimension(:,:) :: u, p
    +
    1672interface rz_factor
    +
    1673 module procedure :: rz_factor_dbl
    +
    1674 module procedure :: rz_factor_cmplx
    +
    1675end interface
    +
    1676
    +
    1677! ------------------------------------------------------------------------------
    +
    1763interface mult_rz
    +
    1764 module procedure :: mult_rz_mtx
    +
    1765 module procedure :: mult_rz_mtx_cmplx
    +
    1766 module procedure :: mult_rz_vec
    +
    1767 module procedure :: mult_rz_vec_cmplx
    +
    1768end interface
    +
    1769
    +
    1770! ------------------------------------------------------------------------------
    +
    1887interface svd
    +
    1888 module procedure :: svd_dbl
    +
    1889 module procedure :: svd_cmplx
    +
    1890end interface
    +
    1891
    +
    1892! ------------------------------------------------------------------------------
    + +
    1957 module procedure :: solve_tri_mtx
    +
    1958 module procedure :: solve_tri_mtx_cmplx
    +
    1959 module procedure :: solve_tri_vec
    +
    1960 module procedure :: solve_tri_vec_cmplx
    +
    1961end interface
    +
    1962
    +
    1963! ------------------------------------------------------------------------------
    +
    2020interface solve_lu
    +
    2021 module procedure :: solve_lu_mtx
    +
    2022 module procedure :: solve_lu_mtx_cmplx
    +
    2023 module procedure :: solve_lu_vec
    +
    2024 module procedure :: solve_lu_vec_cmplx
    +
    2025end interface
    +
    2026
    +
    2027! ------------------------------------------------------------------------------
    +
    2089interface solve_qr
    +
    2090 module procedure :: solve_qr_no_pivot_mtx
    +
    2091 module procedure :: solve_qr_no_pivot_mtx_cmplx
    +
    2092 module procedure :: solve_qr_no_pivot_vec
    +
    2093 module procedure :: solve_qr_no_pivot_vec_cmplx
    +
    2094 module procedure :: solve_qr_pivot_mtx
    +
    2095 module procedure :: solve_qr_pivot_mtx_cmplx
    +
    2096 module procedure :: solve_qr_pivot_vec
    +
    2097 module procedure :: solve_qr_pivot_vec_cmplx
    +
    2098end interface
    +
    2099
    +
    2100! ------------------------------------------------------------------------------
    + +
    2170 module procedure :: solve_cholesky_mtx
    +
    2171 module procedure :: solve_cholesky_mtx_cmplx
    +
    2172 module procedure :: solve_cholesky_vec
    +
    2173 module procedure :: solve_cholesky_vec_cmplx
    +
    2174end interface
    +
    2175
    +
    2176! ------------------------------------------------------------------------------
    + +
    2224 module procedure :: solve_least_squares_mtx
    +
    2225 module procedure :: solve_least_squares_mtx_cmplx
    +
    2226 module procedure :: solve_least_squares_vec
    +
    2227 module procedure :: solve_least_squares_vec_cmplx
    +
    2228end interface
    +
    2229
    +
    2230! ------------------------------------------------------------------------------
    + +
    2279 module procedure :: solve_least_squares_mtx_pvt
    +
    2280 module procedure :: solve_least_squares_mtx_pvt_cmplx
    +
    2281 module procedure :: solve_least_squares_vec_pvt
    +
    2282 module procedure :: solve_least_squares_vec_pvt_cmplx
    +
    2283end interface
    +
    2284
    +
    2285! ------------------------------------------------------------------------------
    + +
    2334 module procedure :: solve_least_squares_mtx_svd
    +
    2335 module procedure :: solve_least_squares_vec_svd
    +
    2336end interface
    +
    2337
    +
    2338! ------------------------------------------------------------------------------
    + +
    2393 module procedure :: mtx_inverse_dbl
    +
    2394 module procedure :: mtx_inverse_cmplx
    +
    2395end interface
    +
    2396
    +
    2397! ------------------------------------------------------------------------------
    + +
    2454 module procedure :: mtx_pinverse_dbl
    +
    2455 module procedure :: mtx_pinverse_cmplx
    +
    2456end interface
    +
    2457
    +
    2458! ------------------------------------------------------------------------------
    +
    2547interface eigen
    +
    2548 module procedure :: eigen_symm
    +
    2549 module procedure :: eigen_asymm
    +
    2550 module procedure :: eigen_gen
    +
    2551 module procedure :: eigen_cmplx
    +
    2552end interface
    +
    2553
    +
    2554! ------------------------------------------------------------------------------
    +
    2556interface sort
    +
    2557 module procedure :: sort_dbl_array
    +
    2558 module procedure :: sort_dbl_array_ind
    +
    2559 module procedure :: sort_cmplx_array
    +
    2560 module procedure :: sort_cmplx_array_ind
    +
    2561 module procedure :: sort_eigen_cmplx
    +
    2562 module procedure :: sort_eigen_dbl
    +
    2563end interface
    +
    2564
    +
    2565
    +
    2566! ******************************************************************************
    +
    2567! LINALG_BASIC.F90
    +
    2568! ------------------------------------------------------------------------------
    +
    2569interface
    +
    2570 module subroutine mtx_mult_mtx(transa, transb, alpha, a, b, beta, c, err)
    +
    2571 logical, intent(in) :: transa, transb
    +
    2572 real(real64), intent(in) :: alpha, beta
    +
    2573 real(real64), intent(in), dimension(:,:) :: a, b
    +
    2574 real(real64), intent(inout), dimension(:,:) :: c
    +
    2575 class(errors), intent(inout), optional, target :: err
    +
    2576 end subroutine
    +
    2577
    +
    2578 module subroutine mtx_mult_vec(trans, alpha, a, b, beta, c, err)
    +
    2579 logical, intent(in) :: trans
    +
    2580 real(real64), intent(in) :: alpha, beta
    +
    2581 real(real64), intent(in), dimension(:,:) :: a
    +
    2582 real(real64), intent(in), dimension(:) :: b
    +
    2583 real(real64), intent(inout), dimension(:) :: c
    +
    2584 class(errors), intent(inout), optional, target :: err
    +
    2585 end subroutine
    +
    2586
    +
    2587 module subroutine cmtx_mult_mtx(opa, opb, alpha, a, b, beta, c, err)
    +
    2588 integer(int32), intent(in) :: opa, opb
    +
    2589 complex(real64), intent(in) :: alpha, beta
    +
    2590 complex(real64), intent(in), dimension(:,:) :: a, b
    +
    2591 complex(real64), intent(inout), dimension(:,:) :: c
    2592 class(errors), intent(inout), optional, target :: err
    2593 end subroutine
    -
    2594
    -
    2595 module subroutine form_lu_all_cmplx(lu, ipvt, u, p, err)
    -
    2596 complex(real64), intent(inout), dimension(:,:) :: lu
    -
    2597 integer(int32), intent(in), dimension(:) :: ipvt
    -
    2598 complex(real64), intent(out), dimension(:,:) :: u
    -
    2599 real(real64), intent(out), dimension(:,:) :: p
    -
    2600 class(errors), intent(inout), optional, target :: err
    -
    2601 end subroutine
    -
    2602
    -
    2603 module subroutine form_lu_only(lu, u, err)
    -
    2604 real(real64), intent(inout), dimension(:,:) :: lu
    -
    2605 real(real64), intent(out), dimension(:,:) :: u
    -
    2606 class(errors), intent(inout), optional, target :: err
    -
    2607 end subroutine
    -
    2608
    -
    2609 module subroutine form_lu_only_cmplx(lu, u, err)
    -
    2610 complex(real64), intent(inout), dimension(:,:) :: lu
    -
    2611 complex(real64), intent(out), dimension(:,:) :: u
    -
    2612 class(errors), intent(inout), optional, target :: err
    -
    2613 end subroutine
    -
    2614
    -
    2615 module subroutine qr_factor_no_pivot(a, tau, work, olwork, err)
    -
    2616 real(real64), intent(inout), dimension(:,:) :: a
    -
    2617 real(real64), intent(out), dimension(:) :: tau
    -
    2618 real(real64), intent(out), target, dimension(:), optional :: work
    -
    2619 integer(int32), intent(out), optional :: olwork
    -
    2620 class(errors), intent(inout), optional, target :: err
    -
    2621 end subroutine
    -
    2622
    -
    2623 module subroutine qr_factor_no_pivot_cmplx(a, tau, work, olwork, err)
    -
    2624 complex(real64), intent(inout), dimension(:,:) :: a
    -
    2625 complex(real64), intent(out), dimension(:) :: tau
    -
    2626 complex(real64), intent(out), target, dimension(:), optional :: work
    -
    2627 integer(int32), intent(out), optional :: olwork
    -
    2628 class(errors), intent(inout), optional, target :: err
    -
    2629 end subroutine
    -
    2630
    -
    2631 module subroutine qr_factor_pivot(a, tau, jpvt, work, olwork, err)
    -
    2632 real(real64), intent(inout), dimension(:,:) :: a
    -
    2633 real(real64), intent(out), dimension(:) :: tau
    -
    2634 integer(int32), intent(inout), dimension(:) :: jpvt
    -
    2635 real(real64), intent(out), target, dimension(:), optional :: work
    -
    2636 integer(int32), intent(out), optional :: olwork
    -
    2637 class(errors), intent(inout), optional, target :: err
    -
    2638 end subroutine
    -
    2639
    -
    2640 module subroutine qr_factor_pivot_cmplx(a, tau, jpvt, work, olwork, rwork, &
    -
    2641 err)
    -
    2642 complex(real64), intent(inout), dimension(:,:) :: a
    -
    2643 complex(real64), intent(out), dimension(:) :: tau
    -
    2644 integer(int32), intent(inout), dimension(:) :: jpvt
    -
    2645 complex(real64), intent(out), target, dimension(:), optional :: work
    -
    2646 integer(int32), intent(out), optional :: olwork
    -
    2647 real(real64), intent(out), target, dimension(:), optional :: rwork
    -
    2648 class(errors), intent(inout), optional, target :: err
    -
    2649 end subroutine
    -
    2650
    -
    2651 module subroutine form_qr_no_pivot(r, tau, q, work, olwork, err)
    -
    2652 real(real64), intent(inout), dimension(:,:) :: r
    -
    2653 real(real64), intent(in), dimension(:) :: tau
    -
    2654 real(real64), intent(out), dimension(:,:) :: q
    -
    2655 real(real64), intent(out), target, dimension(:), optional :: work
    -
    2656 integer(int32), intent(out), optional :: olwork
    -
    2657 class(errors), intent(inout), optional, target :: err
    -
    2658 end subroutine
    -
    2659
    -
    2660 module subroutine form_qr_no_pivot_cmplx(r, tau, q, work, olwork, err)
    -
    2661 complex(real64), intent(inout), dimension(:,:) :: r
    -
    2662 complex(real64), intent(in), dimension(:) :: tau
    -
    2663 complex(real64), intent(out), dimension(:,:) :: q
    -
    2664 complex(real64), intent(out), target, dimension(:), optional :: work
    -
    2665 integer(int32), intent(out), optional :: olwork
    -
    2666 class(errors), intent(inout), optional, target :: err
    -
    2667 end subroutine
    -
    2668
    -
    2669 module subroutine form_qr_pivot(r, tau, pvt, q, p, work, olwork, err)
    -
    2670 real(real64), intent(inout), dimension(:,:) :: r
    -
    2671 real(real64), intent(in), dimension(:) :: tau
    -
    2672 integer(int32), intent(in), dimension(:) :: pvt
    -
    2673 real(real64), intent(out), dimension(:,:) :: q, p
    -
    2674 real(real64), intent(out), target, dimension(:), optional :: work
    -
    2675 integer(int32), intent(out), optional :: olwork
    -
    2676 class(errors), intent(inout), optional, target :: err
    -
    2677 end subroutine
    -
    2678
    -
    2679 module subroutine form_qr_pivot_cmplx(r, tau, pvt, q, p, work, olwork, err)
    -
    2680 complex(real64), intent(inout), dimension(:,:) :: r
    -
    2681 complex(real64), intent(in), dimension(:) :: tau
    -
    2682 integer(int32), intent(in), dimension(:) :: pvt
    -
    2683 complex(real64), intent(out), dimension(:,:) :: q, p
    -
    2684 complex(real64), intent(out), target, dimension(:), optional :: work
    -
    2685 integer(int32), intent(out), optional :: olwork
    -
    2686 class(errors), intent(inout), optional, target :: err
    -
    2687 end subroutine
    -
    2688
    -
    2689 module subroutine mult_qr_mtx(lside, trans, a, tau, c, work, olwork, err)
    -
    2690 logical, intent(in) :: lside, trans
    -
    2691 real(real64), intent(in), dimension(:) :: tau
    -
    2692 real(real64), intent(inout), dimension(:,:) :: a, c
    -
    2693 real(real64), intent(out), target, dimension(:), optional :: work
    -
    2694 integer(int32), intent(out), optional :: olwork
    -
    2695 class(errors), intent(inout), optional, target :: err
    -
    2696 end subroutine
    -
    2697
    -
    2698 module subroutine mult_qr_mtx_cmplx(lside, trans, a, tau, c, work, olwork, err)
    -
    2699 logical, intent(in) :: lside, trans
    -
    2700 complex(real64), intent(in), dimension(:) :: tau
    -
    2701 complex(real64), intent(inout), dimension(:,:) :: a, c
    -
    2702 complex(real64), intent(out), target, dimension(:), optional :: work
    -
    2703 integer(int32), intent(out), optional :: olwork
    -
    2704 class(errors), intent(inout), optional, target :: err
    -
    2705 end subroutine
    -
    2706
    -
    2707 module subroutine mult_qr_vec(trans, a, tau, c, work, olwork, err)
    -
    2708 logical, intent(in) :: trans
    -
    2709 real(real64), intent(inout), dimension(:,:) :: a
    -
    2710 real(real64), intent(in), dimension(:) :: tau
    -
    2711 real(real64), intent(inout), dimension(:) :: c
    -
    2712 real(real64), intent(out), target, dimension(:), optional :: work
    +
    2594
    +
    2595 module subroutine cmtx_mult_vec(opa, alpha, a, b, beta, c, err)
    +
    2596 integer(int32), intent(in) :: opa
    +
    2597 complex(real64), intent(in) :: alpha, beta
    +
    2598 complex(real64), intent(in), dimension(:,:) :: a
    +
    2599 complex(real64), intent(in), dimension(:) :: b
    +
    2600 complex(real64), intent(inout), dimension(:) :: c
    +
    2601 class(errors), intent(inout), optional, target :: err
    +
    2602 end subroutine
    +
    2603
    +
    2604 module subroutine rank1_update_dbl(alpha, x, y, a, err)
    +
    2605 real(real64), intent(in) :: alpha
    +
    2606 real(real64), intent(in), dimension(:) :: x, y
    +
    2607 real(real64), intent(inout), dimension(:,:) :: a
    +
    2608 class(errors), intent(inout), optional, target :: err
    +
    2609 end subroutine
    +
    2610
    +
    2611 module subroutine rank1_update_cmplx(alpha, x, y, a, err)
    +
    2612 complex(real64), intent(in) :: alpha
    +
    2613 complex(real64), intent(in), dimension(:) :: x, y
    +
    2614 complex(real64), intent(inout), dimension(:,:) :: a
    +
    2615 class(errors), intent(inout), optional, target :: err
    +
    2616 end subroutine
    +
    2617
    +
    2618 module subroutine diag_mtx_mult_mtx(lside, trans, alpha, a, b, beta, c, err)
    +
    2619 logical, intent(in) :: lside, trans
    +
    2620 real(real64) :: alpha, beta
    +
    2621 real(real64), intent(in), dimension(:) :: a
    +
    2622 real(real64), intent(in), dimension(:,:) :: b
    +
    2623 real(real64), intent(inout), dimension(:,:) :: c
    +
    2624 class(errors), intent(inout), optional, target :: err
    +
    2625 end subroutine
    +
    2626
    +
    2627 module subroutine diag_mtx_mult_mtx2(lside, alpha, a, b, err)
    +
    2628 logical, intent(in) :: lside
    +
    2629 real(real64), intent(in) :: alpha
    +
    2630 real(real64), intent(in), dimension(:) :: a
    +
    2631 real(real64), intent(inout), dimension(:,:) :: b
    +
    2632 class(errors), intent(inout), optional, target :: err
    +
    2633 end subroutine
    +
    2634
    +
    2635 module subroutine diag_mtx_mult_mtx3(lside, trans, alpha, a, b, beta, c, err)
    +
    2636 logical, intent(in) :: lside, trans
    +
    2637 real(real64) :: alpha, beta
    +
    2638 complex(real64), intent(in), dimension(:) :: a
    +
    2639 real(real64), intent(in), dimension(:,:) :: b
    +
    2640 complex(real64), intent(inout), dimension(:,:) :: c
    +
    2641 class(errors), intent(inout), optional, target :: err
    +
    2642 end subroutine
    +
    2643
    +
    2644 module subroutine diag_mtx_mult_mtx4(lside, opb, alpha, a, b, beta, c, err)
    +
    2645 logical, intent(in) :: lside
    +
    2646 integer(int32), intent(in) :: opb
    +
    2647 real(real64) :: alpha, beta
    +
    2648 complex(real64), intent(in), dimension(:) :: a
    +
    2649 complex(real64), intent(in), dimension(:,:) :: b
    +
    2650 complex(real64), intent(inout), dimension(:,:) :: c
    +
    2651 class(errors), intent(inout), optional, target :: err
    +
    2652 end subroutine
    +
    2653
    +
    2654 module subroutine diag_mtx_mult_mtx_cmplx(lside, opb, alpha, a, b, beta, c, err)
    +
    2655 logical, intent(in) :: lside
    +
    2656 integer(int32), intent(in) :: opb
    +
    2657 complex(real64) :: alpha, beta
    +
    2658 complex(real64), intent(in), dimension(:) :: a
    +
    2659 complex(real64), intent(in), dimension(:,:) :: b
    +
    2660 complex(real64), intent(inout), dimension(:,:) :: c
    +
    2661 class(errors), intent(inout), optional, target :: err
    +
    2662 end subroutine
    +
    2663
    +
    2664 module subroutine diag_mtx_mult_mtx2_cmplx(lside, alpha, a, b, err)
    +
    2665 logical, intent(in) :: lside
    +
    2666 complex(real64), intent(in) :: alpha
    +
    2667 complex(real64), intent(in), dimension(:) :: a
    +
    2668 complex(real64), intent(inout), dimension(:,:) :: b
    +
    2669 class(errors), intent(inout), optional, target :: err
    +
    2670 end subroutine
    +
    2671
    +
    2672 module subroutine diag_mtx_mult_mtx_mix(lside, opb, alpha, a, b, beta, c, err)
    +
    2673 logical, intent(in) :: lside
    +
    2674 integer(int32), intent(in) :: opb
    +
    2675 complex(real64) :: alpha, beta
    +
    2676 real(real64), intent(in), dimension(:) :: a
    +
    2677 complex(real64), intent(in), dimension(:,:) :: b
    +
    2678 complex(real64), intent(inout), dimension(:,:) :: c
    +
    2679 class(errors), intent(inout), optional, target :: err
    +
    2680 end subroutine
    +
    2681
    +
    2682 module subroutine diag_mtx_mult_mtx2_mix(lside, alpha, a, b, err)
    +
    2683 logical, intent(in) :: lside
    +
    2684 complex(real64), intent(in) :: alpha
    +
    2685 real(real64), intent(in), dimension(:) :: a
    +
    2686 complex(real64), intent(inout), dimension(:,:) :: b
    +
    2687 class(errors), intent(inout), optional, target :: err
    +
    2688 end subroutine
    +
    2689
    +
    2690 pure module function trace_dbl(x) result(y)
    +
    2691 real(real64), intent(in), dimension(:,:) :: x
    +
    2692 real(real64) :: y
    +
    2693 end function
    +
    2694
    +
    2695 pure module function trace_cmplx(x) result(y)
    +
    2696 complex(real64), intent(in), dimension(:,:) :: x
    +
    2697 complex(real64) :: y
    +
    2698 end function
    +
    2699
    +
    2700 module function mtx_rank_dbl(a, tol, work, olwork, err) result(rnk)
    +
    2701 real(real64), intent(inout), dimension(:,:) :: a
    +
    2702 real(real64), intent(in), optional :: tol
    +
    2703 real(real64), intent(out), target, optional, dimension(:) :: work
    +
    2704 integer(int32), intent(out), optional :: olwork
    +
    2705 class(errors), intent(inout), optional, target :: err
    +
    2706 integer(int32) :: rnk
    +
    2707 end function
    +
    2708
    +
    2709 module function mtx_rank_cmplx(a, tol, work, olwork, rwork, err) result(rnk)
    +
    2710 complex(real64), intent(inout), dimension(:,:) :: a
    +
    2711 real(real64), intent(in), optional :: tol
    +
    2712 complex(real64), intent(out), target, optional, dimension(:) :: work
    2713 integer(int32), intent(out), optional :: olwork
    -
    2714 class(errors), intent(inout), optional, target :: err
    -
    2715 end subroutine
    -
    2716
    -
    2717 module subroutine mult_qr_vec_cmplx(trans, a, tau, c, work, olwork, err)
    -
    2718 logical, intent(in) :: trans
    -
    2719 complex(real64), intent(inout), dimension(:,:) :: a
    -
    2720 complex(real64), intent(in), dimension(:) :: tau
    -
    2721 complex(real64), intent(inout), dimension(:) :: c
    -
    2722 complex(real64), intent(out), target, dimension(:), optional :: work
    -
    2723 integer(int32), intent(out), optional :: olwork
    -
    2724 class(errors), intent(inout), optional, target :: err
    -
    2725 end subroutine
    -
    2726
    -
    2727 module subroutine qr_rank1_update_dbl(q, r, u, v, work, err)
    -
    2728 real(real64), intent(inout), dimension(:,:) :: q, r
    -
    2729 real(real64), intent(inout), dimension(:) :: u, v
    -
    2730 real(real64), intent(out), target, optional, dimension(:) :: work
    -
    2731 class(errors), intent(inout), optional, target :: err
    -
    2732 end subroutine
    -
    2733
    -
    2734 module subroutine qr_rank1_update_cmplx(q, r, u, v, work, rwork, err)
    -
    2735 complex(real64), intent(inout), dimension(:,:) :: q, r
    -
    2736 complex(real64), intent(inout), dimension(:) :: u, v
    -
    2737 complex(real64), intent(out), target, optional, dimension(:) :: work
    -
    2738 real(real64), intent(out), target, optional, dimension(:) :: rwork
    -
    2739 class(errors), intent(inout), optional, target :: err
    -
    2740 end subroutine
    -
    2741
    -
    2742 module subroutine cholesky_factor_dbl(a, upper, err)
    -
    2743 real(real64), intent(inout), dimension(:,:) :: a
    -
    2744 logical, intent(in), optional :: upper
    -
    2745 class(errors), intent(inout), optional, target :: err
    +
    2714 real(real64), intent(out), target, optional, dimension(:) :: rwork
    +
    2715 class(errors), intent(inout), optional, target :: err
    +
    2716 integer(int32) :: rnk
    +
    2717 end function
    +
    2718
    +
    2719 module function det_dbl(a, iwork, err) result(x)
    +
    2720 real(real64), intent(inout), dimension(:,:) :: a
    +
    2721 integer(int32), intent(out), target, optional, dimension(:) :: iwork
    +
    2722 class(errors), intent(inout), optional, target :: err
    +
    2723 real(real64) :: x
    +
    2724 end function
    +
    2725
    +
    2726 module function det_cmplx(a, iwork, err) result(x)
    +
    2727 complex(real64), intent(inout), dimension(:,:) :: a
    +
    2728 integer(int32), intent(out), target, optional, dimension(:) :: iwork
    +
    2729 class(errors), intent(inout), optional, target :: err
    +
    2730 complex(real64) :: x
    +
    2731 end function
    +
    2732
    +
    2733 module subroutine swap_dbl(x, y, err)
    +
    2734 real(real64), intent(inout), dimension(:) :: x, y
    +
    2735 class(errors), intent(inout), optional, target :: err
    +
    2736 end subroutine
    +
    2737
    +
    2738 module subroutine swap_cmplx(x, y, err)
    +
    2739 complex(real64), intent(inout), dimension(:) :: x, y
    +
    2740 class(errors), intent(inout), optional, target :: err
    +
    2741 end subroutine
    +
    2742
    +
    2743 module subroutine recip_mult_array_dbl(a, x)
    +
    2744 real(real64), intent(in) :: a
    +
    2745 real(real64), intent(inout), dimension(:) :: x
    2746 end subroutine
    2747
    -
    2748 module subroutine cholesky_factor_cmplx(a, upper, err)
    -
    2749 complex(real64), intent(inout), dimension(:,:) :: a
    -
    2750 logical, intent(in), optional :: upper
    -
    2751 class(errors), intent(inout), optional, target :: err
    -
    2752 end subroutine
    -
    2753
    -
    2754 module subroutine cholesky_rank1_update_dbl(r, u, work, err)
    -
    2755 real(real64), intent(inout), dimension(:,:) :: r
    -
    2756 real(real64), intent(inout), dimension(:) :: u
    -
    2757 real(real64), intent(out), target, optional, dimension(:) :: work
    -
    2758 class(errors), intent(inout), optional, target :: err
    -
    2759 end subroutine
    -
    2760
    -
    2761 module subroutine cholesky_rank1_update_cmplx(r, u, work, err)
    -
    2762 complex(real64), intent(inout), dimension(:,:) :: r
    -
    2763 complex(real64), intent(inout), dimension(:) :: u
    -
    2764 real(real64), intent(out), target, optional, dimension(:) :: work
    -
    2765 class(errors), intent(inout), optional, target :: err
    -
    2766 end subroutine
    -
    2767
    -
    2768 module subroutine cholesky_rank1_downdate_dbl(r, u, work, err)
    -
    2769 real(real64), intent(inout), dimension(:,:) :: r
    -
    2770 real(real64), intent(inout), dimension(:) :: u
    -
    2771 real(real64), intent(out), target, optional, dimension(:) :: work
    -
    2772 class(errors), intent(inout), optional, target :: err
    -
    2773 end subroutine
    -
    2774
    -
    2775 module subroutine cholesky_rank1_downdate_cmplx(r, u, work, err)
    -
    2776 complex(real64), intent(inout), dimension(:,:) :: r
    -
    2777 complex(real64), intent(inout), dimension(:) :: u
    -
    2778 real(real64), intent(out), target, optional, dimension(:) :: work
    +
    2748 module subroutine tri_mtx_mult_dbl(upper, alpha, a, beta, b, err)
    +
    2749 logical, intent(in) :: upper
    +
    2750 real(real64), intent(in) :: alpha, beta
    +
    2751 real(real64), intent(in), dimension(:,:) :: a
    +
    2752 real(real64), intent(inout), dimension(:,:) :: b
    +
    2753 class(errors), intent(inout), optional, target :: err
    +
    2754 end subroutine
    +
    2755
    +
    2756 module subroutine tri_mtx_mult_cmplx(upper, alpha, a, beta, b, err)
    +
    2757 logical, intent(in) :: upper
    +
    2758 complex(real64), intent(in) :: alpha, beta
    +
    2759 complex(real64), intent(in), dimension(:,:) :: a
    +
    2760 complex(real64), intent(inout), dimension(:,:) :: b
    +
    2761 class(errors), intent(inout), optional, target :: err
    +
    2762 end subroutine
    +
    2763
    +
    2764end interface
    +
    2765
    +
    2766! ******************************************************************************
    +
    2767! LINALG_FACTOR.F90
    +
    2768! ------------------------------------------------------------------------------
    +
    2769interface
    +
    2770 module subroutine lu_factor_dbl(a, ipvt, err)
    +
    2771 real(real64), intent(inout), dimension(:,:) :: a
    +
    2772 integer(int32), intent(out), dimension(:) :: ipvt
    +
    2773 class(errors), intent(inout), optional, target :: err
    +
    2774 end subroutine
    +
    2775
    +
    2776 module subroutine lu_factor_cmplx(a, ipvt, err)
    +
    2777 complex(real64), intent(inout), dimension(:,:) :: a
    +
    2778 integer(int32), intent(out), dimension(:) :: ipvt
    2779 class(errors), intent(inout), optional, target :: err
    2780 end subroutine
    2781
    -
    2844 module subroutine rz_factor_dbl(a, tau, work, olwork, err)
    -
    2845 real(real64), intent(inout), dimension(:,:) :: a
    -
    2846 real(real64), intent(out), dimension(:) :: tau
    -
    2847 real(real64), intent(out), target, optional, dimension(:) :: work
    -
    2848 integer(int32), intent(out), optional :: olwork
    -
    2849 class(errors), intent(inout), optional, target :: err
    -
    2850 end subroutine
    -
    2851
    -
    2914 module subroutine rz_factor_cmplx(a, tau, work, olwork, err)
    -
    2915 complex(real64), intent(inout), dimension(:,:) :: a
    -
    2916 complex(real64), intent(out), dimension(:) :: tau
    -
    2917 complex(real64), intent(out), target, optional, dimension(:) :: work
    -
    2918 integer(int32), intent(out), optional :: olwork
    -
    2919 class(errors), intent(inout), optional, target :: err
    -
    2920 end subroutine
    -
    2921
    -
    2959 module subroutine mult_rz_mtx(lside, trans, l, a, tau, c, work, olwork, err)
    -
    2960 logical, intent(in) :: lside, trans
    -
    2961 integer(int32), intent(in) :: l
    -
    2962 real(real64), intent(inout), dimension(:,:) :: a, c
    -
    2963 real(real64), intent(in), dimension(:) :: tau
    -
    2964 real(real64), intent(out), target, optional, dimension(:) :: work
    -
    2965 integer(int32), intent(out), optional :: olwork
    +
    2782 module subroutine form_lu_all(lu, ipvt, u, p, err)
    +
    2783 real(real64), intent(inout), dimension(:,:) :: lu
    +
    2784 integer(int32), intent(in), dimension(:) :: ipvt
    +
    2785 real(real64), intent(out), dimension(:,:) :: u, p
    +
    2786 class(errors), intent(inout), optional, target :: err
    +
    2787 end subroutine
    +
    2788
    +
    2789 module subroutine form_lu_all_cmplx(lu, ipvt, u, p, err)
    +
    2790 complex(real64), intent(inout), dimension(:,:) :: lu
    +
    2791 integer(int32), intent(in), dimension(:) :: ipvt
    +
    2792 complex(real64), intent(out), dimension(:,:) :: u
    +
    2793 real(real64), intent(out), dimension(:,:) :: p
    +
    2794 class(errors), intent(inout), optional, target :: err
    +
    2795 end subroutine
    +
    2796
    +
    2797 module subroutine form_lu_only(lu, u, err)
    +
    2798 real(real64), intent(inout), dimension(:,:) :: lu
    +
    2799 real(real64), intent(out), dimension(:,:) :: u
    +
    2800 class(errors), intent(inout), optional, target :: err
    +
    2801 end subroutine
    +
    2802
    +
    2803 module subroutine form_lu_only_cmplx(lu, u, err)
    +
    2804 complex(real64), intent(inout), dimension(:,:) :: lu
    +
    2805 complex(real64), intent(out), dimension(:,:) :: u
    +
    2806 class(errors), intent(inout), optional, target :: err
    +
    2807 end subroutine
    +
    2808
    +
    2809 module subroutine qr_factor_no_pivot(a, tau, work, olwork, err)
    +
    2810 real(real64), intent(inout), dimension(:,:) :: a
    +
    2811 real(real64), intent(out), dimension(:) :: tau
    +
    2812 real(real64), intent(out), target, dimension(:), optional :: work
    +
    2813 integer(int32), intent(out), optional :: olwork
    +
    2814 class(errors), intent(inout), optional, target :: err
    +
    2815 end subroutine
    +
    2816
    +
    2817 module subroutine qr_factor_no_pivot_cmplx(a, tau, work, olwork, err)
    +
    2818 complex(real64), intent(inout), dimension(:,:) :: a
    +
    2819 complex(real64), intent(out), dimension(:) :: tau
    +
    2820 complex(real64), intent(out), target, dimension(:), optional :: work
    +
    2821 integer(int32), intent(out), optional :: olwork
    +
    2822 class(errors), intent(inout), optional, target :: err
    +
    2823 end subroutine
    +
    2824
    +
    2825 module subroutine qr_factor_pivot(a, tau, jpvt, work, olwork, err)
    +
    2826 real(real64), intent(inout), dimension(:,:) :: a
    +
    2827 real(real64), intent(out), dimension(:) :: tau
    +
    2828 integer(int32), intent(inout), dimension(:) :: jpvt
    +
    2829 real(real64), intent(out), target, dimension(:), optional :: work
    +
    2830 integer(int32), intent(out), optional :: olwork
    +
    2831 class(errors), intent(inout), optional, target :: err
    +
    2832 end subroutine
    +
    2833
    +
    2834 module subroutine qr_factor_pivot_cmplx(a, tau, jpvt, work, olwork, rwork, &
    +
    2835 err)
    +
    2836 complex(real64), intent(inout), dimension(:,:) :: a
    +
    2837 complex(real64), intent(out), dimension(:) :: tau
    +
    2838 integer(int32), intent(inout), dimension(:) :: jpvt
    +
    2839 complex(real64), intent(out), target, dimension(:), optional :: work
    +
    2840 integer(int32), intent(out), optional :: olwork
    +
    2841 real(real64), intent(out), target, dimension(:), optional :: rwork
    +
    2842 class(errors), intent(inout), optional, target :: err
    +
    2843 end subroutine
    +
    2844
    +
    2845 module subroutine form_qr_no_pivot(r, tau, q, work, olwork, err)
    +
    2846 real(real64), intent(inout), dimension(:,:) :: r
    +
    2847 real(real64), intent(in), dimension(:) :: tau
    +
    2848 real(real64), intent(out), dimension(:,:) :: q
    +
    2849 real(real64), intent(out), target, dimension(:), optional :: work
    +
    2850 integer(int32), intent(out), optional :: olwork
    +
    2851 class(errors), intent(inout), optional, target :: err
    +
    2852 end subroutine
    +
    2853
    +
    2854 module subroutine form_qr_no_pivot_cmplx(r, tau, q, work, olwork, err)
    +
    2855 complex(real64), intent(inout), dimension(:,:) :: r
    +
    2856 complex(real64), intent(in), dimension(:) :: tau
    +
    2857 complex(real64), intent(out), dimension(:,:) :: q
    +
    2858 complex(real64), intent(out), target, dimension(:), optional :: work
    +
    2859 integer(int32), intent(out), optional :: olwork
    +
    2860 class(errors), intent(inout), optional, target :: err
    +
    2861 end subroutine
    +
    2862
    +
    2863 module subroutine form_qr_pivot(r, tau, pvt, q, p, work, olwork, err)
    +
    2864 real(real64), intent(inout), dimension(:,:) :: r
    +
    2865 real(real64), intent(in), dimension(:) :: tau
    +
    2866 integer(int32), intent(in), dimension(:) :: pvt
    +
    2867 real(real64), intent(out), dimension(:,:) :: q, p
    +
    2868 real(real64), intent(out), target, dimension(:), optional :: work
    +
    2869 integer(int32), intent(out), optional :: olwork
    +
    2870 class(errors), intent(inout), optional, target :: err
    +
    2871 end subroutine
    +
    2872
    +
    2873 module subroutine form_qr_pivot_cmplx(r, tau, pvt, q, p, work, olwork, err)
    +
    2874 complex(real64), intent(inout), dimension(:,:) :: r
    +
    2875 complex(real64), intent(in), dimension(:) :: tau
    +
    2876 integer(int32), intent(in), dimension(:) :: pvt
    +
    2877 complex(real64), intent(out), dimension(:,:) :: q, p
    +
    2878 complex(real64), intent(out), target, dimension(:), optional :: work
    +
    2879 integer(int32), intent(out), optional :: olwork
    +
    2880 class(errors), intent(inout), optional, target :: err
    +
    2881 end subroutine
    +
    2882
    +
    2883 module subroutine mult_qr_mtx(lside, trans, a, tau, c, work, olwork, err)
    +
    2884 logical, intent(in) :: lside, trans
    +
    2885 real(real64), intent(in), dimension(:) :: tau
    +
    2886 real(real64), intent(inout), dimension(:,:) :: a, c
    +
    2887 real(real64), intent(out), target, dimension(:), optional :: work
    +
    2888 integer(int32), intent(out), optional :: olwork
    +
    2889 class(errors), intent(inout), optional, target :: err
    +
    2890 end subroutine
    +
    2891
    +
    2892 module subroutine mult_qr_mtx_cmplx(lside, trans, a, tau, c, work, olwork, err)
    +
    2893 logical, intent(in) :: lside, trans
    +
    2894 complex(real64), intent(in), dimension(:) :: tau
    +
    2895 complex(real64), intent(inout), dimension(:,:) :: a, c
    +
    2896 complex(real64), intent(out), target, dimension(:), optional :: work
    +
    2897 integer(int32), intent(out), optional :: olwork
    +
    2898 class(errors), intent(inout), optional, target :: err
    +
    2899 end subroutine
    +
    2900
    +
    2901 module subroutine mult_qr_vec(trans, a, tau, c, work, olwork, err)
    +
    2902 logical, intent(in) :: trans
    +
    2903 real(real64), intent(inout), dimension(:,:) :: a
    +
    2904 real(real64), intent(in), dimension(:) :: tau
    +
    2905 real(real64), intent(inout), dimension(:) :: c
    +
    2906 real(real64), intent(out), target, dimension(:), optional :: work
    +
    2907 integer(int32), intent(out), optional :: olwork
    +
    2908 class(errors), intent(inout), optional, target :: err
    +
    2909 end subroutine
    +
    2910
    +
    2911 module subroutine mult_qr_vec_cmplx(trans, a, tau, c, work, olwork, err)
    +
    2912 logical, intent(in) :: trans
    +
    2913 complex(real64), intent(inout), dimension(:,:) :: a
    +
    2914 complex(real64), intent(in), dimension(:) :: tau
    +
    2915 complex(real64), intent(inout), dimension(:) :: c
    +
    2916 complex(real64), intent(out), target, dimension(:), optional :: work
    +
    2917 integer(int32), intent(out), optional :: olwork
    +
    2918 class(errors), intent(inout), optional, target :: err
    +
    2919 end subroutine
    +
    2920
    +
    2921 module subroutine qr_rank1_update_dbl(q, r, u, v, work, err)
    +
    2922 real(real64), intent(inout), dimension(:,:) :: q, r
    +
    2923 real(real64), intent(inout), dimension(:) :: u, v
    +
    2924 real(real64), intent(out), target, optional, dimension(:) :: work
    +
    2925 class(errors), intent(inout), optional, target :: err
    +
    2926 end subroutine
    +
    2927
    +
    2928 module subroutine qr_rank1_update_cmplx(q, r, u, v, work, rwork, err)
    +
    2929 complex(real64), intent(inout), dimension(:,:) :: q, r
    +
    2930 complex(real64), intent(inout), dimension(:) :: u, v
    +
    2931 complex(real64), intent(out), target, optional, dimension(:) :: work
    +
    2932 real(real64), intent(out), target, optional, dimension(:) :: rwork
    +
    2933 class(errors), intent(inout), optional, target :: err
    +
    2934 end subroutine
    +
    2935
    +
    2936 module subroutine cholesky_factor_dbl(a, upper, err)
    +
    2937 real(real64), intent(inout), dimension(:,:) :: a
    +
    2938 logical, intent(in), optional :: upper
    +
    2939 class(errors), intent(inout), optional, target :: err
    +
    2940 end subroutine
    +
    2941
    +
    2942 module subroutine cholesky_factor_cmplx(a, upper, err)
    +
    2943 complex(real64), intent(inout), dimension(:,:) :: a
    +
    2944 logical, intent(in), optional :: upper
    +
    2945 class(errors), intent(inout), optional, target :: err
    +
    2946 end subroutine
    +
    2947
    +
    2948 module subroutine cholesky_rank1_update_dbl(r, u, work, err)
    +
    2949 real(real64), intent(inout), dimension(:,:) :: r
    +
    2950 real(real64), intent(inout), dimension(:) :: u
    +
    2951 real(real64), intent(out), target, optional, dimension(:) :: work
    +
    2952 class(errors), intent(inout), optional, target :: err
    +
    2953 end subroutine
    +
    2954
    +
    2955 module subroutine cholesky_rank1_update_cmplx(r, u, work, err)
    +
    2956 complex(real64), intent(inout), dimension(:,:) :: r
    +
    2957 complex(real64), intent(inout), dimension(:) :: u
    +
    2958 real(real64), intent(out), target, optional, dimension(:) :: work
    +
    2959 class(errors), intent(inout), optional, target :: err
    +
    2960 end subroutine
    +
    2961
    +
    2962 module subroutine cholesky_rank1_downdate_dbl(r, u, work, err)
    +
    2963 real(real64), intent(inout), dimension(:,:) :: r
    +
    2964 real(real64), intent(inout), dimension(:) :: u
    +
    2965 real(real64), intent(out), target, optional, dimension(:) :: work
    2966 class(errors), intent(inout), optional, target :: err
    2967 end subroutine
    -
    2968
    -
    3006 module subroutine mult_rz_mtx_cmplx(lside, trans, l, a, tau, c, work, olwork, err)
    -
    3007 logical, intent(in) :: lside, trans
    -
    3008 integer(int32), intent(in) :: l
    -
    3009 complex(real64), intent(inout), dimension(:,:) :: a, c
    -
    3010 complex(real64), intent(in), dimension(:) :: tau
    -
    3011 complex(real64), intent(out), target, optional, dimension(:) :: work
    -
    3012 integer(int32), intent(out), optional :: olwork
    -
    3013 class(errors), intent(inout), optional, target :: err
    -
    3014 end subroutine
    -
    3015
    -
    3051 module subroutine mult_rz_vec(trans, l, a, tau, c, work, olwork, err)
    -
    3052 logical, intent(in) :: trans
    -
    3053 integer(int32), intent(in) :: l
    -
    3054 real(real64), intent(inout), dimension(:,:) :: a
    -
    3055 real(real64), intent(in), dimension(:) :: tau
    -
    3056 real(real64), intent(inout), dimension(:) :: c
    -
    3057 real(real64), intent(out), target, optional, dimension(:) :: work
    -
    3058 integer(int32), intent(out), optional :: olwork
    -
    3059 class(errors), intent(inout), optional, target :: err
    -
    3060 end subroutine
    -
    3061
    -
    3097 module subroutine mult_rz_vec_cmplx(trans, l, a, tau, c, work, olwork, err)
    -
    3098 logical, intent(in) :: trans
    -
    3099 integer(int32), intent(in) :: l
    -
    3100 complex(real64), intent(inout), dimension(:,:) :: a
    -
    3101 complex(real64), intent(in), dimension(:) :: tau
    -
    3102 complex(real64), intent(inout), dimension(:) :: c
    -
    3103 complex(real64), intent(out), target, optional, dimension(:) :: work
    -
    3104 integer(int32), intent(out), optional :: olwork
    -
    3105 class(errors), intent(inout), optional, target :: err
    -
    3106 end subroutine
    -
    3107
    -
    3150 module subroutine svd_dbl(a, s, u, vt, work, olwork, err)
    -
    3151 real(real64), intent(inout), dimension(:,:) :: a
    -
    3152 real(real64), intent(out), dimension(:) :: s
    -
    3153 real(real64), intent(out), optional, dimension(:,:) :: u, vt
    -
    3154 real(real64), intent(out), target, optional, dimension(:) :: work
    -
    3155 integer(int32), intent(out), optional :: olwork
    -
    3156 class(errors), intent(inout), optional, target :: err
    -
    3157 end subroutine
    -
    3158
    -
    3205 module subroutine svd_cmplx(a, s, u, vt, work, olwork, rwork, err)
    -
    3206 complex(real64), intent(inout), dimension(:,:) :: a
    -
    3207 real(real64), intent(out), dimension(:) :: s
    -
    3208 complex(real64), intent(out), optional, dimension(:,:) :: u, vt
    -
    3209 complex(real64), intent(out), target, optional, dimension(:) :: work
    -
    3210 integer(int32), intent(out), optional :: olwork
    -
    3211 real(real64), intent(out), target, optional, dimension(:) :: rwork
    -
    3212 class(errors), intent(inout), optional, target :: err
    -
    3213 end subroutine
    -
    3214end interface
    -
    3215
    -
    3216! ******************************************************************************
    -
    3217! LINALG_SOLVE.F90
    -
    3218! ------------------------------------------------------------------------------
    -
    3219interface
    -
    3220
    -
    3248 module subroutine solve_tri_mtx(lside, upper, trans, nounit, alpha, a, b, err)
    -
    3249 logical, intent(in) :: lside, upper, trans, nounit
    -
    3250 real(real64), intent(in) :: alpha
    -
    3251 real(real64), intent(in), dimension(:,:) :: a
    -
    3252 real(real64), intent(inout), dimension(:,:) :: b
    -
    3253 class(errors), intent(inout), optional, target :: err
    -
    3254 end subroutine
    -
    3255
    -
    3284 module subroutine solve_tri_mtx_cmplx(lside, upper, trans, nounit, alpha, a, b, err)
    -
    3285 logical, intent(in) :: lside, upper, trans, nounit
    -
    3286 complex(real64), intent(in) :: alpha
    -
    3287 complex(real64), intent(in), dimension(:,:) :: a
    -
    3288 complex(real64), intent(inout), dimension(:,:) :: b
    -
    3289 class(errors), intent(inout), optional, target :: err
    -
    3290 end subroutine
    -
    3291
    -
    3336 module subroutine solve_tri_vec(upper, trans, nounit, a, x, err)
    -
    3337 logical, intent(in) :: upper, trans, nounit
    -
    3338 real(real64), intent(in), dimension(:,:) :: a
    -
    3339 real(real64), intent(inout), dimension(:) :: x
    +
    2968
    +
    2969 module subroutine cholesky_rank1_downdate_cmplx(r, u, work, err)
    +
    2970 complex(real64), intent(inout), dimension(:,:) :: r
    +
    2971 complex(real64), intent(inout), dimension(:) :: u
    +
    2972 real(real64), intent(out), target, optional, dimension(:) :: work
    +
    2973 class(errors), intent(inout), optional, target :: err
    +
    2974 end subroutine
    +
    2975
    +
    2976 module subroutine rz_factor_dbl(a, tau, work, olwork, err)
    +
    2977 real(real64), intent(inout), dimension(:,:) :: a
    +
    2978 real(real64), intent(out), dimension(:) :: tau
    +
    2979 real(real64), intent(out), target, optional, dimension(:) :: work
    +
    2980 integer(int32), intent(out), optional :: olwork
    +
    2981 class(errors), intent(inout), optional, target :: err
    +
    2982 end subroutine
    +
    2983
    +
    2984 module subroutine rz_factor_cmplx(a, tau, work, olwork, err)
    +
    2985 complex(real64), intent(inout), dimension(:,:) :: a
    +
    2986 complex(real64), intent(out), dimension(:) :: tau
    +
    2987 complex(real64), intent(out), target, optional, dimension(:) :: work
    +
    2988 integer(int32), intent(out), optional :: olwork
    +
    2989 class(errors), intent(inout), optional, target :: err
    +
    2990 end subroutine
    +
    2991
    +
    2992 module subroutine mult_rz_mtx(lside, trans, l, a, tau, c, work, olwork, err)
    +
    2993 logical, intent(in) :: lside, trans
    +
    2994 integer(int32), intent(in) :: l
    +
    2995 real(real64), intent(inout), dimension(:,:) :: a, c
    +
    2996 real(real64), intent(in), dimension(:) :: tau
    +
    2997 real(real64), intent(out), target, optional, dimension(:) :: work
    +
    2998 integer(int32), intent(out), optional :: olwork
    +
    2999 class(errors), intent(inout), optional, target :: err
    +
    3000 end subroutine
    +
    3001
    +
    3002 module subroutine mult_rz_mtx_cmplx(lside, trans, l, a, tau, c, work, olwork, err)
    +
    3003 logical, intent(in) :: lside, trans
    +
    3004 integer(int32), intent(in) :: l
    +
    3005 complex(real64), intent(inout), dimension(:,:) :: a, c
    +
    3006 complex(real64), intent(in), dimension(:) :: tau
    +
    3007 complex(real64), intent(out), target, optional, dimension(:) :: work
    +
    3008 integer(int32), intent(out), optional :: olwork
    +
    3009 class(errors), intent(inout), optional, target :: err
    +
    3010 end subroutine
    +
    3011
    +
    3012 module subroutine mult_rz_vec(trans, l, a, tau, c, work, olwork, err)
    +
    3013 logical, intent(in) :: trans
    +
    3014 integer(int32), intent(in) :: l
    +
    3015 real(real64), intent(inout), dimension(:,:) :: a
    +
    3016 real(real64), intent(in), dimension(:) :: tau
    +
    3017 real(real64), intent(inout), dimension(:) :: c
    +
    3018 real(real64), intent(out), target, optional, dimension(:) :: work
    +
    3019 integer(int32), intent(out), optional :: olwork
    +
    3020 class(errors), intent(inout), optional, target :: err
    +
    3021 end subroutine
    +
    3022
    +
    3023 module subroutine mult_rz_vec_cmplx(trans, l, a, tau, c, work, olwork, err)
    +
    3024 logical, intent(in) :: trans
    +
    3025 integer(int32), intent(in) :: l
    +
    3026 complex(real64), intent(inout), dimension(:,:) :: a
    +
    3027 complex(real64), intent(in), dimension(:) :: tau
    +
    3028 complex(real64), intent(inout), dimension(:) :: c
    +
    3029 complex(real64), intent(out), target, optional, dimension(:) :: work
    +
    3030 integer(int32), intent(out), optional :: olwork
    +
    3031 class(errors), intent(inout), optional, target :: err
    +
    3032 end subroutine
    +
    3033
    +
    3076 module subroutine svd_dbl(a, s, u, vt, work, olwork, err)
    +
    3077 real(real64), intent(inout), dimension(:,:) :: a
    +
    3078 real(real64), intent(out), dimension(:) :: s
    +
    3079 real(real64), intent(out), optional, dimension(:,:) :: u, vt
    +
    3080 real(real64), intent(out), target, optional, dimension(:) :: work
    +
    3081 integer(int32), intent(out), optional :: olwork
    +
    3082 class(errors), intent(inout), optional, target :: err
    +
    3083 end subroutine
    +
    3084
    +
    3131 module subroutine svd_cmplx(a, s, u, vt, work, olwork, rwork, err)
    +
    3132 complex(real64), intent(inout), dimension(:,:) :: a
    +
    3133 real(real64), intent(out), dimension(:) :: s
    +
    3134 complex(real64), intent(out), optional, dimension(:,:) :: u, vt
    +
    3135 complex(real64), intent(out), target, optional, dimension(:) :: work
    +
    3136 integer(int32), intent(out), optional :: olwork
    +
    3137 real(real64), intent(out), target, optional, dimension(:) :: rwork
    +
    3138 class(errors), intent(inout), optional, target :: err
    +
    3139 end subroutine
    +
    3140end interface
    +
    3141
    +
    3142! ******************************************************************************
    +
    3143! LINALG_SOLVE.F90
    +
    3144! ------------------------------------------------------------------------------
    +
    3145interface
    +
    3146
    +
    3174 module subroutine solve_tri_mtx(lside, upper, trans, nounit, alpha, a, b, err)
    +
    3175 logical, intent(in) :: lside, upper, trans, nounit
    +
    3176 real(real64), intent(in) :: alpha
    +
    3177 real(real64), intent(in), dimension(:,:) :: a
    +
    3178 real(real64), intent(inout), dimension(:,:) :: b
    +
    3179 class(errors), intent(inout), optional, target :: err
    +
    3180 end subroutine
    +
    3181
    +
    3210 module subroutine solve_tri_mtx_cmplx(lside, upper, trans, nounit, alpha, a, b, err)
    +
    3211 logical, intent(in) :: lside, upper, trans, nounit
    +
    3212 complex(real64), intent(in) :: alpha
    +
    3213 complex(real64), intent(in), dimension(:,:) :: a
    +
    3214 complex(real64), intent(inout), dimension(:,:) :: b
    +
    3215 class(errors), intent(inout), optional, target :: err
    +
    3216 end subroutine
    +
    3217
    +
    3262 module subroutine solve_tri_vec(upper, trans, nounit, a, x, err)
    +
    3263 logical, intent(in) :: upper, trans, nounit
    +
    3264 real(real64), intent(in), dimension(:,:) :: a
    +
    3265 real(real64), intent(inout), dimension(:) :: x
    +
    3266 class(errors), intent(inout), optional, target :: err
    +
    3267 end subroutine
    +
    3268
    +
    3313 module subroutine solve_tri_vec_cmplx(upper, trans, nounit, a, x, err)
    +
    3314 logical, intent(in) :: upper, trans, nounit
    +
    3315 complex(real64), intent(in), dimension(:,:) :: a
    +
    3316 complex(real64), intent(inout), dimension(:) :: x
    +
    3317 class(errors), intent(inout), optional, target :: err
    +
    3318 end subroutine
    +
    3319
    +
    3336 module subroutine solve_lu_mtx(a, ipvt, b, err)
    +
    3337 real(real64), intent(in), dimension(:,:) :: a
    +
    3338 integer(int32), intent(in), dimension(:) :: ipvt
    +
    3339 real(real64), intent(inout), dimension(:,:) :: b
    3340 class(errors), intent(inout), optional, target :: err
    3341 end subroutine
    3342
    -
    3387 module subroutine solve_tri_vec_cmplx(upper, trans, nounit, a, x, err)
    -
    3388 logical, intent(in) :: upper, trans, nounit
    -
    3389 complex(real64), intent(in), dimension(:,:) :: a
    -
    3390 complex(real64), intent(inout), dimension(:) :: x
    -
    3391 class(errors), intent(inout), optional, target :: err
    -
    3392 end subroutine
    -
    3393
    -
    3410 module subroutine solve_lu_mtx(a, ipvt, b, err)
    -
    3411 real(real64), intent(in), dimension(:,:) :: a
    -
    3412 integer(int32), intent(in), dimension(:) :: ipvt
    -
    3413 real(real64), intent(inout), dimension(:,:) :: b
    -
    3414 class(errors), intent(inout), optional, target :: err
    -
    3415 end subroutine
    -
    3416
    -
    3433 module subroutine solve_lu_mtx_cmplx(a, ipvt, b, err)
    -
    3434 complex(real64), intent(in), dimension(:,:) :: a
    -
    3435 integer(int32), intent(in), dimension(:) :: ipvt
    -
    3436 complex(real64), intent(inout), dimension(:,:) :: b
    -
    3437 class(errors), intent(inout), optional, target :: err
    -
    3438 end subroutine
    -
    3439
    -
    3456 module subroutine solve_lu_vec(a, ipvt, b, err)
    -
    3457 real(real64), intent(in), dimension(:,:) :: a
    -
    3458 integer(int32), intent(in), dimension(:) :: ipvt
    -
    3459 real(real64), intent(inout), dimension(:) :: b
    -
    3460 class(errors), intent(inout), optional, target :: err
    -
    3461 end subroutine
    -
    3462
    -
    3479 module subroutine solve_lu_vec_cmplx(a, ipvt, b, err)
    -
    3480 complex(real64), intent(in), dimension(:,:) :: a
    -
    3481 integer(int32), intent(in), dimension(:) :: ipvt
    -
    3482 complex(real64), intent(inout), dimension(:) :: b
    +
    3359 module subroutine solve_lu_mtx_cmplx(a, ipvt, b, err)
    +
    3360 complex(real64), intent(in), dimension(:,:) :: a
    +
    3361 integer(int32), intent(in), dimension(:) :: ipvt
    +
    3362 complex(real64), intent(inout), dimension(:,:) :: b
    +
    3363 class(errors), intent(inout), optional, target :: err
    +
    3364 end subroutine
    +
    3365
    +
    3382 module subroutine solve_lu_vec(a, ipvt, b, err)
    +
    3383 real(real64), intent(in), dimension(:,:) :: a
    +
    3384 integer(int32), intent(in), dimension(:) :: ipvt
    +
    3385 real(real64), intent(inout), dimension(:) :: b
    +
    3386 class(errors), intent(inout), optional, target :: err
    +
    3387 end subroutine
    +
    3388
    +
    3405 module subroutine solve_lu_vec_cmplx(a, ipvt, b, err)
    +
    3406 complex(real64), intent(in), dimension(:,:) :: a
    +
    3407 integer(int32), intent(in), dimension(:) :: ipvt
    +
    3408 complex(real64), intent(inout), dimension(:) :: b
    +
    3409 class(errors), intent(inout), optional, target :: err
    +
    3410 end subroutine
    +
    3411
    +
    3441 module subroutine solve_qr_no_pivot_mtx(a, tau, b, work, olwork, err)
    +
    3442 real(real64), intent(inout), dimension(:,:) :: a, b
    +
    3443 real(real64), intent(in), dimension(:) :: tau
    +
    3444 real(real64), intent(out), target, optional, dimension(:) :: work
    +
    3445 integer(int32), intent(out), optional :: olwork
    +
    3446 class(errors), intent(inout), optional, target :: err
    +
    3447 end subroutine
    +
    3448
    +
    3478 module subroutine solve_qr_no_pivot_mtx_cmplx(a, tau, b, work, olwork, err)
    +
    3479 complex(real64), intent(inout), dimension(:,:) :: a, b
    +
    3480 complex(real64), intent(in), dimension(:) :: tau
    +
    3481 complex(real64), intent(out), target, optional, dimension(:) :: work
    +
    3482 integer(int32), intent(out), optional :: olwork
    3483 class(errors), intent(inout), optional, target :: err
    3484 end subroutine
    3485
    -
    3515 module subroutine solve_qr_no_pivot_mtx(a, tau, b, work, olwork, err)
    -
    3516 real(real64), intent(inout), dimension(:,:) :: a, b
    +
    3515 module subroutine solve_qr_no_pivot_vec(a, tau, b, work, olwork, err)
    +
    3516 real(real64), intent(inout), dimension(:,:) :: a
    3517 real(real64), intent(in), dimension(:) :: tau
    -
    3518 real(real64), intent(out), target, optional, dimension(:) :: work
    -
    3519 integer(int32), intent(out), optional :: olwork
    -
    3520 class(errors), intent(inout), optional, target :: err
    -
    3521 end subroutine
    -
    3522
    -
    3552 module subroutine solve_qr_no_pivot_mtx_cmplx(a, tau, b, work, olwork, err)
    -
    3553 complex(real64), intent(inout), dimension(:,:) :: a, b
    -
    3554 complex(real64), intent(in), dimension(:) :: tau
    -
    3555 complex(real64), intent(out), target, optional, dimension(:) :: work
    -
    3556 integer(int32), intent(out), optional :: olwork
    -
    3557 class(errors), intent(inout), optional, target :: err
    -
    3558 end subroutine
    -
    3559
    -
    3589 module subroutine solve_qr_no_pivot_vec(a, tau, b, work, olwork, err)
    -
    3590 real(real64), intent(inout), dimension(:,:) :: a
    -
    3591 real(real64), intent(in), dimension(:) :: tau
    -
    3592 real(real64), intent(inout), dimension(:) :: b
    -
    3593 real(real64), intent(out), target, optional, dimension(:) :: work
    -
    3594 integer(int32), intent(out), optional :: olwork
    -
    3595 class(errors), intent(inout), optional, target :: err
    -
    3596 end subroutine
    -
    3597
    -
    3627 module subroutine solve_qr_no_pivot_vec_cmplx(a, tau, b, work, olwork, err)
    -
    3628 complex(real64), intent(inout), dimension(:,:) :: a
    -
    3629 complex(real64), intent(in), dimension(:) :: tau
    -
    3630 complex(real64), intent(inout), dimension(:) :: b
    -
    3631 complex(real64), intent(out), target, optional, dimension(:) :: work
    -
    3632 integer(int32), intent(out), optional :: olwork
    -
    3633 class(errors), intent(inout), optional, target :: err
    -
    3634 end subroutine
    -
    3635
    -
    3667 module subroutine solve_qr_pivot_mtx(a, tau, jpvt, b, work, olwork, err)
    -
    3668 real(real64), intent(inout), dimension(:,:) :: a
    -
    3669 real(real64), intent(in), dimension(:) :: tau
    -
    3670 integer(int32), intent(in), dimension(:) :: jpvt
    -
    3671 real(real64), intent(inout), dimension(:,:) :: b
    -
    3672 real(real64), intent(out), target, optional, dimension(:) :: work
    -
    3673 integer(int32), intent(out), optional :: olwork
    -
    3674 class(errors), intent(inout), optional, target :: err
    -
    3675 end subroutine
    -
    3676
    -
    3708 module subroutine solve_qr_pivot_mtx_cmplx(a, tau, jpvt, b, work, olwork, err)
    -
    3709 complex(real64), intent(inout), dimension(:,:) :: a
    -
    3710 complex(real64), intent(in), dimension(:) :: tau
    -
    3711 integer(int32), intent(in), dimension(:) :: jpvt
    -
    3712 complex(real64), intent(inout), dimension(:,:) :: b
    -
    3713 complex(real64), intent(out), target, optional, dimension(:) :: work
    -
    3714 integer(int32), intent(out), optional :: olwork
    -
    3715 class(errors), intent(inout), optional, target :: err
    -
    3716 end subroutine
    -
    3717
    -
    3749 module subroutine solve_qr_pivot_vec(a, tau, jpvt, b, work, olwork, err)
    -
    3750 real(real64), intent(inout), dimension(:,:) :: a
    -
    3751 real(real64), intent(in), dimension(:) :: tau
    -
    3752 integer(int32), intent(in), dimension(:) :: jpvt
    -
    3753 real(real64), intent(inout), dimension(:) :: b
    -
    3754 real(real64), intent(out), target, optional, dimension(:) :: work
    -
    3755 integer(int32), intent(out), optional :: olwork
    -
    3756 class(errors), intent(inout), optional, target :: err
    -
    3757 end subroutine
    -
    3758
    -
    3790 module subroutine solve_qr_pivot_vec_cmplx(a, tau, jpvt, b, work, olwork, err)
    -
    3791 complex(real64), intent(inout), dimension(:,:) :: a
    -
    3792 complex(real64), intent(in), dimension(:) :: tau
    -
    3793 integer(int32), intent(in), dimension(:) :: jpvt
    -
    3794 complex(real64), intent(inout), dimension(:) :: b
    -
    3795 complex(real64), intent(out), target, optional, dimension(:) :: work
    -
    3796 integer(int32), intent(out), optional :: olwork
    -
    3797 class(errors), intent(inout), optional, target :: err
    -
    3798 end subroutine
    -
    3799
    -
    3818 module subroutine solve_cholesky_mtx(upper, a, b, err)
    -
    3819 logical, intent(in) :: upper
    -
    3820 real(real64), intent(in), dimension(:,:) :: a
    -
    3821 real(real64), intent(inout), dimension(:,:) :: b
    -
    3822 class(errors), intent(inout), optional, target :: err
    -
    3823 end subroutine
    -
    3824
    -
    3843 module subroutine solve_cholesky_mtx_cmplx(upper, a, b, err)
    -
    3844 logical, intent(in) :: upper
    -
    3845 complex(real64), intent(in), dimension(:,:) :: a
    -
    3846 complex(real64), intent(inout), dimension(:,:) :: b
    -
    3847 class(errors), intent(inout), optional, target :: err
    -
    3848 end subroutine
    -
    3849
    -
    3868 module subroutine solve_cholesky_vec(upper, a, b, err)
    -
    3869 logical, intent(in) :: upper
    -
    3870 real(real64), intent(in), dimension(:,:) :: a
    -
    3871 real(real64), intent(inout), dimension(:) :: b
    -
    3872 class(errors), intent(inout), optional, target :: err
    -
    3873 end subroutine
    -
    3874
    -
    3893 module subroutine solve_cholesky_vec_cmplx(upper, a, b, err)
    -
    3894 logical, intent(in) :: upper
    -
    3895 complex(real64), intent(in), dimension(:,:) :: a
    -
    3896 complex(real64), intent(inout), dimension(:) :: b
    -
    3897 class(errors), intent(inout), optional, target :: err
    -
    3898 end subroutine
    -
    3899
    -
    3931 module subroutine solve_least_squares_mtx(a, b, work, olwork, err)
    -
    3932 real(real64), intent(inout), dimension(:,:) :: a, b
    -
    3933 real(real64), intent(out), target, optional, dimension(:) :: work
    -
    3934 integer(int32), intent(out), optional :: olwork
    -
    3935 class(errors), intent(inout), optional, target :: err
    -
    3936 end subroutine
    -
    3937
    -
    3969 module subroutine solve_least_squares_mtx_cmplx(a, b, work, olwork, err)
    -
    3970 complex(real64), intent(inout), dimension(:,:) :: a, b
    -
    3971 complex(real64), intent(out), target, optional, dimension(:) :: work
    -
    3972 integer(int32), intent(out), optional :: olwork
    -
    3973 class(errors), intent(inout), optional, target :: err
    -
    3974 end subroutine
    -
    3975
    -
    4007 module subroutine solve_least_squares_vec(a, b, work, olwork, err)
    -
    4008 real(real64), intent(inout), dimension(:,:) :: a
    -
    4009 real(real64), intent(inout), dimension(:) :: b
    -
    4010 real(real64), intent(out), target, optional, dimension(:) :: work
    -
    4011 integer(int32), intent(out), optional :: olwork
    -
    4012 class(errors), intent(inout), optional, target :: err
    -
    4013 end subroutine
    -
    4014
    -
    4046 module subroutine solve_least_squares_vec_cmplx(a, b, work, olwork, err)
    -
    4047 complex(real64), intent(inout), dimension(:,:) :: a
    -
    4048 complex(real64), intent(inout), dimension(:) :: b
    -
    4049 complex(real64), intent(out), target, optional, dimension(:) :: work
    -
    4050 integer(int32), intent(out), optional :: olwork
    -
    4051 class(errors), intent(inout), optional, target :: err
    -
    4052 end subroutine
    -
    4053
    -
    4091 module subroutine solve_least_squares_mtx_pvt(a, b, ipvt, arnk, work, olwork, err)
    -
    4092 real(real64), intent(inout), dimension(:,:) :: a, b
    -
    4093 integer(int32), intent(inout), target, optional, dimension(:) :: ipvt
    -
    4094 integer(int32), intent(out), optional :: arnk
    -
    4095 real(real64), intent(out), target, optional, dimension(:) :: work
    -
    4096 integer(int32), intent(out), optional :: olwork
    -
    4097 class(errors), intent(inout), optional, target :: err
    -
    4098 end subroutine
    -
    4099
    -
    4141 module subroutine solve_least_squares_mtx_pvt_cmplx(a, b, ipvt, arnk, &
    -
    4142 work, olwork, rwork, err)
    -
    4143 complex(real64), intent(inout), dimension(:,:) :: a, b
    -
    4144 integer(int32), intent(inout), target, optional, dimension(:) :: ipvt
    -
    4145 integer(int32), intent(out), optional :: arnk
    -
    4146 complex(real64), intent(out), target, optional, dimension(:) :: work
    -
    4147 integer(int32), intent(out), optional :: olwork
    -
    4148 real(real64), intent(out), target, optional, dimension(:) :: rwork
    -
    4149 class(errors), intent(inout), optional, target :: err
    -
    4150 end subroutine
    -
    4151
    -
    4189 module subroutine solve_least_squares_vec_pvt(a, b, ipvt, arnk, work, olwork, err)
    -
    4190 real(real64), intent(inout), dimension(:,:) :: a
    -
    4191 real(real64), intent(inout), dimension(:) :: b
    -
    4192 integer(int32), intent(inout), target, optional, dimension(:) :: ipvt
    -
    4193 integer(int32), intent(out), optional :: arnk
    -
    4194 real(real64), intent(out), target, optional, dimension(:) :: work
    -
    4195 integer(int32), intent(out), optional :: olwork
    -
    4196 class(errors), intent(inout), optional, target :: err
    -
    4197 end subroutine
    -
    4198
    -
    4240 module subroutine solve_least_squares_vec_pvt_cmplx(a, b, ipvt, arnk, &
    -
    4241 work, olwork, rwork, err)
    -
    4242 complex(real64), intent(inout), dimension(:,:) :: a
    -
    4243 complex(real64), intent(inout), dimension(:) :: b
    -
    4244 integer(int32), intent(inout), target, optional, dimension(:) :: ipvt
    -
    4245 integer(int32), intent(out), optional :: arnk
    -
    4246 complex(real64), intent(out), target, optional, dimension(:) :: work
    -
    4247 integer(int32), intent(out), optional :: olwork
    -
    4248 real(real64), intent(out), target, optional, dimension(:) :: rwork
    -
    4249 class(errors), intent(inout), optional, target :: err
    -
    4250 end subroutine
    -
    4251
    -
    4290 module subroutine solve_least_squares_mtx_svd(a, b, s, arnk, work, olwork, err)
    -
    4291 real(real64), intent(inout), dimension(:,:) :: a, b
    -
    4292 integer(int32), intent(out), optional :: arnk
    -
    4293 real(real64), intent(out), target, optional, dimension(:) :: work, s
    -
    4294 integer(int32), intent(out), optional :: olwork
    -
    4295 class(errors), intent(inout), optional, target :: err
    -
    4296 end subroutine
    -
    4297
    -
    4340 module subroutine solve_least_squares_mtx_svd_cmplx(a, b, s, arnk, work, &
    -
    4341 olwork, rwork, err)
    -
    4342 complex(real64), intent(inout), dimension(:,:) :: a, b
    -
    4343 integer(int32), intent(out), optional :: arnk
    -
    4344 complex(real64), intent(out), target, optional, dimension(:) :: work
    -
    4345 real(real64), intent(out), target, optional, dimension(:) :: rwork, s
    -
    4346 integer(int32), intent(out), optional :: olwork
    -
    4347 class(errors), intent(inout), optional, target :: err
    -
    4348 end subroutine
    -
    4349
    -
    4386 module subroutine solve_least_squares_vec_svd(a, b, s, arnk, work, olwork, err)
    -
    4387 real(real64), intent(inout), dimension(:,:) :: a
    -
    4388 real(real64), intent(inout), dimension(:) :: b
    -
    4389 integer(int32), intent(out), optional :: arnk
    -
    4390 real(real64), intent(out), target, optional, dimension(:) :: work, s
    -
    4391 integer(int32), intent(out), optional :: olwork
    -
    4392 class(errors), intent(inout), optional, target :: err
    -
    4393 end subroutine
    -
    4394
    -
    4435 module subroutine solve_least_squares_vec_svd_cmplx(a, b, s, arnk, work, &
    -
    4436 olwork, rwork, err)
    -
    4437 complex(real64), intent(inout), dimension(:,:) :: a
    -
    4438 complex(real64), intent(inout), dimension(:) :: b
    -
    4439 integer(int32), intent(out), optional :: arnk
    -
    4440 complex(real64), intent(out), target, optional, dimension(:) :: work
    -
    4441 real(real64), intent(out), target, optional, dimension(:) :: rwork, s
    -
    4442 integer(int32), intent(out), optional :: olwork
    -
    4443 class(errors), intent(inout), optional, target :: err
    -
    4444 end subroutine
    -
    4445
    -
    4477 module subroutine mtx_inverse_dbl(a, iwork, work, olwork, err)
    -
    4478 real(real64), intent(inout), dimension(:,:) :: a
    -
    4479 integer(int32), intent(out), target, optional, dimension(:) :: iwork
    -
    4480 real(real64), intent(out), target, optional, dimension(:) :: work
    -
    4481 integer(int32), intent(out), optional :: olwork
    -
    4482 class(errors), intent(inout), optional, target :: err
    -
    4483 end subroutine
    -
    4484
    -
    4516 module subroutine mtx_inverse_cmplx(a, iwork, work, olwork, err)
    -
    4517 complex(real64), intent(inout), dimension(:,:) :: a
    -
    4518 integer(int32), intent(out), target, optional, dimension(:) :: iwork
    -
    4519 complex(real64), intent(out), target, optional, dimension(:) :: work
    -
    4520 integer(int32), intent(out), optional :: olwork
    -
    4521 class(errors), intent(inout), optional, target :: err
    -
    4522 end subroutine
    -
    4523
    -
    4561 module subroutine mtx_pinverse_dbl(a, ainv, tol, work, olwork, err)
    -
    4562 real(real64), intent(inout), dimension(:,:) :: a
    -
    4563 real(real64), intent(out), dimension(:,:) :: ainv
    -
    4564 real(real64), intent(in), optional :: tol
    -
    4565 real(real64), intent(out), target, dimension(:), optional :: work
    -
    4566 integer(int32), intent(out), optional :: olwork
    -
    4567 class(errors), intent(inout), optional, target :: err
    -
    4568 end subroutine
    -
    4569
    -
    4611 module subroutine mtx_pinverse_cmplx(a, ainv, tol, work, olwork, rwork, err)
    -
    4612 complex(real64), intent(inout), dimension(:,:) :: a
    -
    4613 complex(real64), intent(out), dimension(:,:) :: ainv
    -
    4614 real(real64), intent(in), optional :: tol
    -
    4615 complex(real64), intent(out), target, dimension(:), optional :: work
    -
    4616 integer(int32), intent(out), optional :: olwork
    -
    4617 real(real64), intent(out), target, dimension(:), optional :: rwork
    -
    4618 class(errors), intent(inout), optional, target :: err
    -
    4619 end subroutine
    -
    4620
    -
    4621end interface
    -
    4622
    -
    4623! ******************************************************************************
    -
    4624! LINALG_EIGEN.F90
    -
    4625! ------------------------------------------------------------------------------
    -
    4626interface
    -
    4627
    -
    4659 module subroutine eigen_symm(vecs, a, vals, work, olwork, err)
    -
    4660 logical, intent(in) :: vecs
    -
    4661 real(real64), intent(inout), dimension(:,:) :: a
    -
    4662 real(real64), intent(out), dimension(:) :: vals
    -
    4663 real(real64), intent(out), pointer, optional, dimension(:) :: work
    -
    4664 integer(int32), intent(out), optional :: olwork
    -
    4665 class(errors), intent(inout), optional, target :: err
    -
    4666 end subroutine
    -
    4667
    -
    4698 module subroutine eigen_asymm(a, vals, vecs, work, olwork, err)
    -
    4699 real(real64), intent(inout), dimension(:,:) :: a
    -
    4700 complex(real64), intent(out), dimension(:) :: vals
    -
    4701 complex(real64), intent(out), optional, dimension(:,:) :: vecs
    -
    4702 real(real64), intent(out), pointer, optional, dimension(:) :: work
    -
    4703 integer(int32), intent(out), optional :: olwork
    -
    4704 class(errors), intent(inout), optional, target :: err
    -
    4705 end subroutine
    -
    4706
    -
    4749 module subroutine eigen_gen(a, b, alpha, beta, vecs, work, olwork, err)
    -
    4750 real(real64), intent(inout), dimension(:,:) :: a, b
    -
    4751 complex(real64), intent(out), dimension(:) :: alpha
    -
    4752 real(real64), intent(out), optional, dimension(:) :: beta
    -
    4753 complex(real64), intent(out), optional, dimension(:,:) :: vecs
    -
    4754 real(real64), intent(out), optional, pointer, dimension(:) :: work
    -
    4755 integer(int32), intent(out), optional :: olwork
    -
    4756 class(errors), intent(inout), optional, target :: err
    -
    4757 end subroutine
    -
    4758
    -
    4789 module subroutine eigen_cmplx(a, vals, vecs, work, olwork, rwork, err)
    -
    4790 complex(real64), intent(inout), dimension(:,:) :: a
    -
    4791 complex(real64), intent(out), dimension(:) :: vals
    -
    4792 complex(real64), intent(out), optional, dimension(:,:) :: vecs
    -
    4793 complex(real64), intent(out), target, optional, dimension(:) :: work
    -
    4794 real(real64), intent(out), target, optional, dimension(:) :: rwork
    -
    4795 integer(int32), intent(out), optional :: olwork
    -
    4796 class(errors), intent(inout), optional, target :: err
    -
    4797 end subroutine
    -
    4798end interface
    -
    4799
    -
    4800! ******************************************************************************
    -
    4801! LINALG_SORTING.F90
    -
    4802! ------------------------------------------------------------------------------
    -
    4803interface
    -
    4804
    -
    4819 module subroutine sort_dbl_array(x, ascend)
    -
    4820 real(real64), intent(inout), dimension(:) :: x
    -
    4821 logical, intent(in), optional :: ascend
    -
    4822 end subroutine
    -
    4823
    -
    4848 module subroutine sort_dbl_array_ind(x, ind, ascend, err)
    -
    4849 real(real64), intent(inout), dimension(:) :: x
    -
    4850 integer(int32), intent(inout), dimension(:) :: ind
    -
    4851 logical, intent(in), optional :: ascend
    -
    4852 class(errors), intent(inout), optional, target :: err
    -
    4853 end subroutine
    -
    4854
    -
    4871 module subroutine sort_cmplx_array(x, ascend)
    -
    4872 complex(real64), intent(inout), dimension(:) :: x
    -
    4873 logical, intent(in), optional :: ascend
    -
    4874 end subroutine
    -
    4875
    -
    4905 module subroutine sort_cmplx_array_ind(x, ind, ascend, err)
    -
    4906 complex(real64), intent(inout), dimension(:) :: x
    -
    4907 integer(int32), intent(inout), dimension(:) :: ind
    -
    4908 logical, intent(in), optional :: ascend
    -
    4909 class(errors), intent(inout), optional, target :: err
    -
    4910 end subroutine
    -
    4911
    -
    4931 module subroutine sort_eigen_cmplx(vals, vecs, ascend, err)
    -
    4932 complex(real64), intent(inout), dimension(:) :: vals
    -
    4933 complex(real64), intent(inout), dimension(:,:) :: vecs
    -
    4934 logical, intent(in), optional :: ascend
    -
    4935 class(errors), intent(inout), optional, target :: err
    -
    4936 end subroutine
    -
    4937
    -
    4957 module subroutine sort_eigen_dbl(vals, vecs, ascend, err)
    -
    4958 real(real64), intent(inout), dimension(:) :: vals
    -
    4959 real(real64), intent(inout), dimension(:,:) :: vecs
    -
    4960 logical, intent(in), optional :: ascend
    -
    4961 class(errors), intent(inout), optional, target :: err
    -
    4962 end subroutine
    -
    4963
    -
    4964end interface
    -
    4965
    -
    4966end module
    +
    3518 real(real64), intent(inout), dimension(:) :: b
    +
    3519 real(real64), intent(out), target, optional, dimension(:) :: work
    +
    3520 integer(int32), intent(out), optional :: olwork
    +
    3521 class(errors), intent(inout), optional, target :: err
    +
    3522 end subroutine
    +
    3523
    +
    3553 module subroutine solve_qr_no_pivot_vec_cmplx(a, tau, b, work, olwork, err)
    +
    3554 complex(real64), intent(inout), dimension(:,:) :: a
    +
    3555 complex(real64), intent(in), dimension(:) :: tau
    +
    3556 complex(real64), intent(inout), dimension(:) :: b
    +
    3557 complex(real64), intent(out), target, optional, dimension(:) :: work
    +
    3558 integer(int32), intent(out), optional :: olwork
    +
    3559 class(errors), intent(inout), optional, target :: err
    +
    3560 end subroutine
    +
    3561
    +
    3593 module subroutine solve_qr_pivot_mtx(a, tau, jpvt, b, work, olwork, err)
    +
    3594 real(real64), intent(inout), dimension(:,:) :: a
    +
    3595 real(real64), intent(in), dimension(:) :: tau
    +
    3596 integer(int32), intent(in), dimension(:) :: jpvt
    +
    3597 real(real64), intent(inout), dimension(:,:) :: b
    +
    3598 real(real64), intent(out), target, optional, dimension(:) :: work
    +
    3599 integer(int32), intent(out), optional :: olwork
    +
    3600 class(errors), intent(inout), optional, target :: err
    +
    3601 end subroutine
    +
    3602
    +
    3634 module subroutine solve_qr_pivot_mtx_cmplx(a, tau, jpvt, b, work, olwork, err)
    +
    3635 complex(real64), intent(inout), dimension(:,:) :: a
    +
    3636 complex(real64), intent(in), dimension(:) :: tau
    +
    3637 integer(int32), intent(in), dimension(:) :: jpvt
    +
    3638 complex(real64), intent(inout), dimension(:,:) :: b
    +
    3639 complex(real64), intent(out), target, optional, dimension(:) :: work
    +
    3640 integer(int32), intent(out), optional :: olwork
    +
    3641 class(errors), intent(inout), optional, target :: err
    +
    3642 end subroutine
    +
    3643
    +
    3675 module subroutine solve_qr_pivot_vec(a, tau, jpvt, b, work, olwork, err)
    +
    3676 real(real64), intent(inout), dimension(:,:) :: a
    +
    3677 real(real64), intent(in), dimension(:) :: tau
    +
    3678 integer(int32), intent(in), dimension(:) :: jpvt
    +
    3679 real(real64), intent(inout), dimension(:) :: b
    +
    3680 real(real64), intent(out), target, optional, dimension(:) :: work
    +
    3681 integer(int32), intent(out), optional :: olwork
    +
    3682 class(errors), intent(inout), optional, target :: err
    +
    3683 end subroutine
    +
    3684
    +
    3716 module subroutine solve_qr_pivot_vec_cmplx(a, tau, jpvt, b, work, olwork, err)
    +
    3717 complex(real64), intent(inout), dimension(:,:) :: a
    +
    3718 complex(real64), intent(in), dimension(:) :: tau
    +
    3719 integer(int32), intent(in), dimension(:) :: jpvt
    +
    3720 complex(real64), intent(inout), dimension(:) :: b
    +
    3721 complex(real64), intent(out), target, optional, dimension(:) :: work
    +
    3722 integer(int32), intent(out), optional :: olwork
    +
    3723 class(errors), intent(inout), optional, target :: err
    +
    3724 end subroutine
    +
    3725
    +
    3744 module subroutine solve_cholesky_mtx(upper, a, b, err)
    +
    3745 logical, intent(in) :: upper
    +
    3746 real(real64), intent(in), dimension(:,:) :: a
    +
    3747 real(real64), intent(inout), dimension(:,:) :: b
    +
    3748 class(errors), intent(inout), optional, target :: err
    +
    3749 end subroutine
    +
    3750
    +
    3769 module subroutine solve_cholesky_mtx_cmplx(upper, a, b, err)
    +
    3770 logical, intent(in) :: upper
    +
    3771 complex(real64), intent(in), dimension(:,:) :: a
    +
    3772 complex(real64), intent(inout), dimension(:,:) :: b
    +
    3773 class(errors), intent(inout), optional, target :: err
    +
    3774 end subroutine
    +
    3775
    +
    3794 module subroutine solve_cholesky_vec(upper, a, b, err)
    +
    3795 logical, intent(in) :: upper
    +
    3796 real(real64), intent(in), dimension(:,:) :: a
    +
    3797 real(real64), intent(inout), dimension(:) :: b
    +
    3798 class(errors), intent(inout), optional, target :: err
    +
    3799 end subroutine
    +
    3800
    +
    3819 module subroutine solve_cholesky_vec_cmplx(upper, a, b, err)
    +
    3820 logical, intent(in) :: upper
    +
    3821 complex(real64), intent(in), dimension(:,:) :: a
    +
    3822 complex(real64), intent(inout), dimension(:) :: b
    +
    3823 class(errors), intent(inout), optional, target :: err
    +
    3824 end subroutine
    +
    3825
    +
    3857 module subroutine solve_least_squares_mtx(a, b, work, olwork, err)
    +
    3858 real(real64), intent(inout), dimension(:,:) :: a, b
    +
    3859 real(real64), intent(out), target, optional, dimension(:) :: work
    +
    3860 integer(int32), intent(out), optional :: olwork
    +
    3861 class(errors), intent(inout), optional, target :: err
    +
    3862 end subroutine
    +
    3863
    +
    3895 module subroutine solve_least_squares_mtx_cmplx(a, b, work, olwork, err)
    +
    3896 complex(real64), intent(inout), dimension(:,:) :: a, b
    +
    3897 complex(real64), intent(out), target, optional, dimension(:) :: work
    +
    3898 integer(int32), intent(out), optional :: olwork
    +
    3899 class(errors), intent(inout), optional, target :: err
    +
    3900 end subroutine
    +
    3901
    +
    3933 module subroutine solve_least_squares_vec(a, b, work, olwork, err)
    +
    3934 real(real64), intent(inout), dimension(:,:) :: a
    +
    3935 real(real64), intent(inout), dimension(:) :: b
    +
    3936 real(real64), intent(out), target, optional, dimension(:) :: work
    +
    3937 integer(int32), intent(out), optional :: olwork
    +
    3938 class(errors), intent(inout), optional, target :: err
    +
    3939 end subroutine
    +
    3940
    +
    3972 module subroutine solve_least_squares_vec_cmplx(a, b, work, olwork, err)
    +
    3973 complex(real64), intent(inout), dimension(:,:) :: a
    +
    3974 complex(real64), intent(inout), dimension(:) :: b
    +
    3975 complex(real64), intent(out), target, optional, dimension(:) :: work
    +
    3976 integer(int32), intent(out), optional :: olwork
    +
    3977 class(errors), intent(inout), optional, target :: err
    +
    3978 end subroutine
    +
    3979
    +
    4017 module subroutine solve_least_squares_mtx_pvt(a, b, ipvt, arnk, work, olwork, err)
    +
    4018 real(real64), intent(inout), dimension(:,:) :: a, b
    +
    4019 integer(int32), intent(inout), target, optional, dimension(:) :: ipvt
    +
    4020 integer(int32), intent(out), optional :: arnk
    +
    4021 real(real64), intent(out), target, optional, dimension(:) :: work
    +
    4022 integer(int32), intent(out), optional :: olwork
    +
    4023 class(errors), intent(inout), optional, target :: err
    +
    4024 end subroutine
    +
    4025
    +
    4067 module subroutine solve_least_squares_mtx_pvt_cmplx(a, b, ipvt, arnk, &
    +
    4068 work, olwork, rwork, err)
    +
    4069 complex(real64), intent(inout), dimension(:,:) :: a, b
    +
    4070 integer(int32), intent(inout), target, optional, dimension(:) :: ipvt
    +
    4071 integer(int32), intent(out), optional :: arnk
    +
    4072 complex(real64), intent(out), target, optional, dimension(:) :: work
    +
    4073 integer(int32), intent(out), optional :: olwork
    +
    4074 real(real64), intent(out), target, optional, dimension(:) :: rwork
    +
    4075 class(errors), intent(inout), optional, target :: err
    +
    4076 end subroutine
    +
    4077
    +
    4115 module subroutine solve_least_squares_vec_pvt(a, b, ipvt, arnk, work, olwork, err)
    +
    4116 real(real64), intent(inout), dimension(:,:) :: a
    +
    4117 real(real64), intent(inout), dimension(:) :: b
    +
    4118 integer(int32), intent(inout), target, optional, dimension(:) :: ipvt
    +
    4119 integer(int32), intent(out), optional :: arnk
    +
    4120 real(real64), intent(out), target, optional, dimension(:) :: work
    +
    4121 integer(int32), intent(out), optional :: olwork
    +
    4122 class(errors), intent(inout), optional, target :: err
    +
    4123 end subroutine
    +
    4124
    +
    4166 module subroutine solve_least_squares_vec_pvt_cmplx(a, b, ipvt, arnk, &
    +
    4167 work, olwork, rwork, err)
    +
    4168 complex(real64), intent(inout), dimension(:,:) :: a
    +
    4169 complex(real64), intent(inout), dimension(:) :: b
    +
    4170 integer(int32), intent(inout), target, optional, dimension(:) :: ipvt
    +
    4171 integer(int32), intent(out), optional :: arnk
    +
    4172 complex(real64), intent(out), target, optional, dimension(:) :: work
    +
    4173 integer(int32), intent(out), optional :: olwork
    +
    4174 real(real64), intent(out), target, optional, dimension(:) :: rwork
    +
    4175 class(errors), intent(inout), optional, target :: err
    +
    4176 end subroutine
    +
    4177
    +
    4216 module subroutine solve_least_squares_mtx_svd(a, b, s, arnk, work, olwork, err)
    +
    4217 real(real64), intent(inout), dimension(:,:) :: a, b
    +
    4218 integer(int32), intent(out), optional :: arnk
    +
    4219 real(real64), intent(out), target, optional, dimension(:) :: work, s
    +
    4220 integer(int32), intent(out), optional :: olwork
    +
    4221 class(errors), intent(inout), optional, target :: err
    +
    4222 end subroutine
    +
    4223
    +
    4266 module subroutine solve_least_squares_mtx_svd_cmplx(a, b, s, arnk, work, &
    +
    4267 olwork, rwork, err)
    +
    4268 complex(real64), intent(inout), dimension(:,:) :: a, b
    +
    4269 integer(int32), intent(out), optional :: arnk
    +
    4270 complex(real64), intent(out), target, optional, dimension(:) :: work
    +
    4271 real(real64), intent(out), target, optional, dimension(:) :: rwork, s
    +
    4272 integer(int32), intent(out), optional :: olwork
    +
    4273 class(errors), intent(inout), optional, target :: err
    +
    4274 end subroutine
    +
    4275
    +
    4312 module subroutine solve_least_squares_vec_svd(a, b, s, arnk, work, olwork, err)
    +
    4313 real(real64), intent(inout), dimension(:,:) :: a
    +
    4314 real(real64), intent(inout), dimension(:) :: b
    +
    4315 integer(int32), intent(out), optional :: arnk
    +
    4316 real(real64), intent(out), target, optional, dimension(:) :: work, s
    +
    4317 integer(int32), intent(out), optional :: olwork
    +
    4318 class(errors), intent(inout), optional, target :: err
    +
    4319 end subroutine
    +
    4320
    +
    4361 module subroutine solve_least_squares_vec_svd_cmplx(a, b, s, arnk, work, &
    +
    4362 olwork, rwork, err)
    +
    4363 complex(real64), intent(inout), dimension(:,:) :: a
    +
    4364 complex(real64), intent(inout), dimension(:) :: b
    +
    4365 integer(int32), intent(out), optional :: arnk
    +
    4366 complex(real64), intent(out), target, optional, dimension(:) :: work
    +
    4367 real(real64), intent(out), target, optional, dimension(:) :: rwork, s
    +
    4368 integer(int32), intent(out), optional :: olwork
    +
    4369 class(errors), intent(inout), optional, target :: err
    +
    4370 end subroutine
    +
    4371
    +
    4403 module subroutine mtx_inverse_dbl(a, iwork, work, olwork, err)
    +
    4404 real(real64), intent(inout), dimension(:,:) :: a
    +
    4405 integer(int32), intent(out), target, optional, dimension(:) :: iwork
    +
    4406 real(real64), intent(out), target, optional, dimension(:) :: work
    +
    4407 integer(int32), intent(out), optional :: olwork
    +
    4408 class(errors), intent(inout), optional, target :: err
    +
    4409 end subroutine
    +
    4410
    +
    4442 module subroutine mtx_inverse_cmplx(a, iwork, work, olwork, err)
    +
    4443 complex(real64), intent(inout), dimension(:,:) :: a
    +
    4444 integer(int32), intent(out), target, optional, dimension(:) :: iwork
    +
    4445 complex(real64), intent(out), target, optional, dimension(:) :: work
    +
    4446 integer(int32), intent(out), optional :: olwork
    +
    4447 class(errors), intent(inout), optional, target :: err
    +
    4448 end subroutine
    +
    4449
    +
    4487 module subroutine mtx_pinverse_dbl(a, ainv, tol, work, olwork, err)
    +
    4488 real(real64), intent(inout), dimension(:,:) :: a
    +
    4489 real(real64), intent(out), dimension(:,:) :: ainv
    +
    4490 real(real64), intent(in), optional :: tol
    +
    4491 real(real64), intent(out), target, dimension(:), optional :: work
    +
    4492 integer(int32), intent(out), optional :: olwork
    +
    4493 class(errors), intent(inout), optional, target :: err
    +
    4494 end subroutine
    +
    4495
    +
    4537 module subroutine mtx_pinverse_cmplx(a, ainv, tol, work, olwork, rwork, err)
    +
    4538 complex(real64), intent(inout), dimension(:,:) :: a
    +
    4539 complex(real64), intent(out), dimension(:,:) :: ainv
    +
    4540 real(real64), intent(in), optional :: tol
    +
    4541 complex(real64), intent(out), target, dimension(:), optional :: work
    +
    4542 integer(int32), intent(out), optional :: olwork
    +
    4543 real(real64), intent(out), target, dimension(:), optional :: rwork
    +
    4544 class(errors), intent(inout), optional, target :: err
    +
    4545 end subroutine
    +
    4546
    +
    4547end interface
    +
    4548
    +
    4549! ******************************************************************************
    +
    4550! LINALG_EIGEN.F90
    +
    4551! ------------------------------------------------------------------------------
    +
    4552interface
    +
    4553
    +
    4585 module subroutine eigen_symm(vecs, a, vals, work, olwork, err)
    +
    4586 logical, intent(in) :: vecs
    +
    4587 real(real64), intent(inout), dimension(:,:) :: a
    +
    4588 real(real64), intent(out), dimension(:) :: vals
    +
    4589 real(real64), intent(out), pointer, optional, dimension(:) :: work
    +
    4590 integer(int32), intent(out), optional :: olwork
    +
    4591 class(errors), intent(inout), optional, target :: err
    +
    4592 end subroutine
    +
    4593
    +
    4624 module subroutine eigen_asymm(a, vals, vecs, work, olwork, err)
    +
    4625 real(real64), intent(inout), dimension(:,:) :: a
    +
    4626 complex(real64), intent(out), dimension(:) :: vals
    +
    4627 complex(real64), intent(out), optional, dimension(:,:) :: vecs
    +
    4628 real(real64), intent(out), pointer, optional, dimension(:) :: work
    +
    4629 integer(int32), intent(out), optional :: olwork
    +
    4630 class(errors), intent(inout), optional, target :: err
    +
    4631 end subroutine
    +
    4632
    +
    4675 module subroutine eigen_gen(a, b, alpha, beta, vecs, work, olwork, err)
    +
    4676 real(real64), intent(inout), dimension(:,:) :: a, b
    +
    4677 complex(real64), intent(out), dimension(:) :: alpha
    +
    4678 real(real64), intent(out), optional, dimension(:) :: beta
    +
    4679 complex(real64), intent(out), optional, dimension(:,:) :: vecs
    +
    4680 real(real64), intent(out), optional, pointer, dimension(:) :: work
    +
    4681 integer(int32), intent(out), optional :: olwork
    +
    4682 class(errors), intent(inout), optional, target :: err
    +
    4683 end subroutine
    +
    4684
    +
    4715 module subroutine eigen_cmplx(a, vals, vecs, work, olwork, rwork, err)
    +
    4716 complex(real64), intent(inout), dimension(:,:) :: a
    +
    4717 complex(real64), intent(out), dimension(:) :: vals
    +
    4718 complex(real64), intent(out), optional, dimension(:,:) :: vecs
    +
    4719 complex(real64), intent(out), target, optional, dimension(:) :: work
    +
    4720 real(real64), intent(out), target, optional, dimension(:) :: rwork
    +
    4721 integer(int32), intent(out), optional :: olwork
    +
    4722 class(errors), intent(inout), optional, target :: err
    +
    4723 end subroutine
    +
    4724end interface
    +
    4725
    +
    4726! ******************************************************************************
    +
    4727! LINALG_SORTING.F90
    +
    4728! ------------------------------------------------------------------------------
    +
    4729interface
    +
    4730
    +
    4745 module subroutine sort_dbl_array(x, ascend)
    +
    4746 real(real64), intent(inout), dimension(:) :: x
    +
    4747 logical, intent(in), optional :: ascend
    +
    4748 end subroutine
    +
    4749
    +
    4774 module subroutine sort_dbl_array_ind(x, ind, ascend, err)
    +
    4775 real(real64), intent(inout), dimension(:) :: x
    +
    4776 integer(int32), intent(inout), dimension(:) :: ind
    +
    4777 logical, intent(in), optional :: ascend
    +
    4778 class(errors), intent(inout), optional, target :: err
    +
    4779 end subroutine
    +
    4780
    +
    4797 module subroutine sort_cmplx_array(x, ascend)
    +
    4798 complex(real64), intent(inout), dimension(:) :: x
    +
    4799 logical, intent(in), optional :: ascend
    +
    4800 end subroutine
    +
    4801
    +
    4831 module subroutine sort_cmplx_array_ind(x, ind, ascend, err)
    +
    4832 complex(real64), intent(inout), dimension(:) :: x
    +
    4833 integer(int32), intent(inout), dimension(:) :: ind
    +
    4834 logical, intent(in), optional :: ascend
    +
    4835 class(errors), intent(inout), optional, target :: err
    +
    4836 end subroutine
    +
    4837
    +
    4857 module subroutine sort_eigen_cmplx(vals, vecs, ascend, err)
    +
    4858 complex(real64), intent(inout), dimension(:) :: vals
    +
    4859 complex(real64), intent(inout), dimension(:,:) :: vecs
    +
    4860 logical, intent(in), optional :: ascend
    +
    4861 class(errors), intent(inout), optional, target :: err
    +
    4862 end subroutine
    +
    4863
    +
    4883 module subroutine sort_eigen_dbl(vals, vecs, ascend, err)
    +
    4884 real(real64), intent(inout), dimension(:) :: vals
    +
    4885 real(real64), intent(inout), dimension(:,:) :: vecs
    +
    4886 logical, intent(in), optional :: ascend
    +
    4887 class(errors), intent(inout), optional, target :: err
    +
    4888 end subroutine
    +
    4889
    +
    4890end interface
    +
    4891
    +
    4892end module
    Computes the Cholesky factorization of a symmetric, positive definite matrix.
    Computes the rank 1 downdate to a Cholesky factored matrix (upper triangular).
    Computes the rank 1 update to a Cholesky factored matrix (upper triangular).
    Computes the determinant of a square matrix.
    Multiplies a diagonal matrix with another matrix or array.
    -
    Computes the eigenvalues, and optionally the eigenvectors, of a matrix.
    +
    Computes the eigenvalues, and optionally the eigenvectors, of a matrix.
    Extracts the L and U matrices from the condensed [L\U] storage format used by the lu_factor.
    Forms the full M-by-M orthogonal matrix Q from the elementary reflectors returned by the base QR fact...
    Computes the LU factorization of an M-by-N matrix.
    -
    Computes the inverse of a square matrix.
    +
    Computes the inverse of a square matrix.
    Performs the matrix operation: .
    -
    Computes the Moore-Penrose pseudo-inverse of a M-by-N matrix using the singular value decomposition o...
    +
    Computes the Moore-Penrose pseudo-inverse of a M-by-N matrix using the singular value decomposition o...
    Computes the rank of a matrix.
    Multiplies a general matrix by the orthogonal matrix Q from a QR factorization.
    -
    Multiplies a general matrix by the orthogonal matrix Z from an RZ factorization.
    +
    Multiplies a general matrix by the orthogonal matrix Z from an RZ factorization.
    Computes the QR factorization of an M-by-N matrix.
    Computes the rank 1 update to an M-by-N QR factored matrix A (M >= N) where , and such that .
    Performs the rank-1 update to matrix A such that: , where is an M-by-N matrix, is a scalar,...
    Multiplies a vector by the reciprocal of a real scalar.
    -
    Factors an upper trapezoidal matrix by means of orthogonal transformations such that A = R * Z = (R 0...
    -
    Solves a system of Cholesky factored equations.
    -
    Solves the overdetermined or underdetermined system (A*X = B) of M equations of N unknowns,...
    -
    Solves the overdetermined or underdetermined system (A*X = B) of M equations of N unknowns using a si...
    -
    Solves the overdetermined or underdetermined system (A*X = B) of M equations of N unknowns.
    -
    Solves a system of LU-factored equations.
    -
    Solves a system of M QR-factored equations of N unknowns.
    -
    Solves a triangular system of equations.
    -
    Sorts an array.
    -
    Computes the singular value decomposition of a matrix A. The SVD is defined as: A = U * S * V**T,...
    +
    Factors an upper trapezoidal matrix by means of orthogonal transformations such that ....
    +
    Solves a system of Cholesky factored equations.
    +
    Solves the overdetermined or underdetermined system (A*X = B) of M equations of N unknowns,...
    +
    Solves the overdetermined or underdetermined system (A*X = B) of M equations of N unknowns using a si...
    +
    Solves the overdetermined or underdetermined system (A*X = B) of M equations of N unknowns.
    +
    Solves a system of LU-factored equations.
    +
    Solves a system of M QR-factored equations of N unknowns.
    +
    Solves a triangular system of equations.
    +
    Sorts an array.
    +
    Computes the singular value decomposition of a matrix A. The SVD is defined as: , where is an M-by-M...
    Swaps the contents of two arrays.
    Computes the trace of a matrix (the sum of the main diagonal elements).
    Computes the triangular matrix operation: , or , where A is a triangular matrix.
    diff --git a/doc/html/linalg__immutable_8f90_source.html b/doc/html/linalg__immutable_8f90_source.html index b31016a6..65aae3a8 100644 --- a/doc/html/linalg__immutable_8f90_source.html +++ b/doc/html/linalg__immutable_8f90_source.html @@ -850,18 +850,18 @@
    Computes the rank 1 update to a Cholesky factored matrix (upper triangular).
    Computes the determinant of a square matrix.
    Multiplies a diagonal matrix with another matrix or array.
    -
    Computes the eigenvalues, and optionally the eigenvectors, of a matrix.
    +
    Computes the eigenvalues, and optionally the eigenvectors, of a matrix.
    Extracts the L and U matrices from the condensed [L\U] storage format used by the lu_factor.
    Forms the full M-by-M orthogonal matrix Q from the elementary reflectors returned by the base QR fact...
    Computes the LU factorization of an M-by-N matrix.
    -
    Computes the inverse of a square matrix.
    -
    Computes the Moore-Penrose pseudo-inverse of a M-by-N matrix using the singular value decomposition o...
    +
    Computes the inverse of a square matrix.
    +
    Computes the Moore-Penrose pseudo-inverse of a M-by-N matrix using the singular value decomposition o...
    Computes the QR factorization of an M-by-N matrix.
    Computes the rank 1 update to an M-by-N QR factored matrix A (M >= N) where , and such that .
    Performs the rank-1 update to matrix A such that: , where is an M-by-N matrix, is a scalar,...
    -
    Solves a triangular system of equations.
    -
    Sorts an array.
    -
    Computes the singular value decomposition of a matrix A. The SVD is defined as: A = U * S * V**T,...
    +
    Solves a triangular system of equations.
    +
    Sorts an array.
    +
    Computes the singular value decomposition of a matrix A. The SVD is defined as: , where is an M-by-M...
    Computes the eigenvalues and eigenvectors (right) of a general N-by-N matrix.
    Computes the LU factorization of a square matrix. Notice, partial row pivoting is utilized.
    Computes the matrix operation: C = A * B, where A is a diagonal matrix.
    diff --git a/doc/html/namespacelinalg__core.html b/doc/html/namespacelinalg__core.html index 18cb1ef0..c7387077 100644 --- a/doc/html/namespacelinalg__core.html +++ b/doc/html/namespacelinalg__core.html @@ -166,7 +166,7 @@  Multiplies a vector by the reciprocal of a real scalar. More...
      interface  rz_factor - Factors an upper trapezoidal matrix by means of orthogonal transformations such that A = R * Z = (R 0) * Z. Z is an orthogonal matrix of dimension N-by-N, and R is an M-by-M upper triangular matrix. More...
    + Factors an upper trapezoidal matrix by means of orthogonal transformations such that \( A = R Z = (R 0) Z \). Z is an orthogonal matrix of dimension N-by-N, and R is an M-by-M upper triangular matrix. More...
      interface  solve_cholesky  Solves a system of Cholesky factored equations. More...
    @@ -193,7 +193,7 @@  Sorts an array. More...
      interface  svd - Computes the singular value decomposition of a matrix A. The SVD is defined as: A = U * S * V**T, where U is an M-by-M orthogonal matrix, S is an M-by-N diagonal matrix, and V is an N-by-N orthogonal matrix. More...
    + Computes the singular value decomposition of a matrix A. The SVD is defined as: \( A = U S V^T \), where \( U \) is an M-by-M orthogonal matrix, \( S \) is an M-by-N diagonal matrix, and \( V \) is an N-by-N orthogonal matrix. More...
      interface  swap  Swaps the contents of two arrays. More...
    diff --git a/doc/html/namespaces.html b/doc/html/namespaces.html index d70b1681..7a5c9bd8 100644 --- a/doc/html/namespaces.html +++ b/doc/html/namespaces.html @@ -124,7 +124,7 @@  Cqr_rank1_updateComputes the rank 1 update to an M-by-N QR factored matrix A (M >= N) where \( A = Q R \), and \( A1 = A + U V^T \) such that \( A1 = Q1 R1 \)  Crank1_updatePerforms the rank-1 update to matrix A such that: \( A = \alpha X Y^T + A \), where \( A \) is an M-by-N matrix, \( \alpha \)is a scalar, \( X \) is an M-element array, and \( Y \) is an N-element array. In the event that \( Y \) is complex, \( Y^H \) is used instead of \( Y^T \)  Crecip_mult_arrayMultiplies a vector by the reciprocal of a real scalar - Crz_factorFactors an upper trapezoidal matrix by means of orthogonal transformations such that A = R * Z = (R 0) * Z. Z is an orthogonal matrix of dimension N-by-N, and R is an M-by-M upper triangular matrix + Crz_factorFactors an upper trapezoidal matrix by means of orthogonal transformations such that \( A = R Z = (R 0) Z \). Z is an orthogonal matrix of dimension N-by-N, and R is an M-by-M upper triangular matrix  Csolve_choleskySolves a system of Cholesky factored equations  Csolve_least_squaresSolves the overdetermined or underdetermined system (A*X = B) of M equations of N unknowns  Csolve_least_squares_fullSolves the overdetermined or underdetermined system (A*X = B) of M equations of N unknowns, but uses a full orthogonal factorization of the system @@ -133,7 +133,7 @@  Csolve_qrSolves a system of M QR-factored equations of N unknowns  Csolve_triangular_systemSolves a triangular system of equations  CsortSorts an array - CsvdComputes the singular value decomposition of a matrix A. The SVD is defined as: A = U * S * V**T, where U is an M-by-M orthogonal matrix, S is an M-by-N diagonal matrix, and V is an N-by-N orthogonal matrix + CsvdComputes the singular value decomposition of a matrix A. The SVD is defined as: \( A = U S V^T \), where \( U \) is an M-by-M orthogonal matrix, \( S \) is an M-by-N diagonal matrix, and \( V \) is an N-by-N orthogonal matrix  CswapSwaps the contents of two arrays  CtraceComputes the trace of a matrix (the sum of the main diagonal elements)  Ctri_mtx_multComputes the triangular matrix operation: \( B = \alpha A^T A + \beta B \), or \( B = \alpha A A^T + \beta B \), where A is a triangular matrix diff --git a/src/linalg_core.f90 b/src/linalg_core.f90 index e03b91d1..eb657c3e 100644 --- a/src/linalg_core.f90 +++ b/src/linalg_core.f90 @@ -1603,9 +1603,72 @@ module linalg_core ! ------------------------------------------------------------------------------ !> @brief Factors an upper trapezoidal matrix by means of orthogonal -!! transformations such that A = R * Z = (R 0) * Z. Z is an orthogonal +!! transformations such that \f$ A = R Z = (R 0) Z \f$. Z is an orthogonal !! matrix of dimension N-by-N, and R is an M-by-M upper triangular !! matrix. +!! +!! @par Syntax +!! @code{.f90} +!! subroutine rz_factor(real(real64) a(:,:), real(real64) tau(:), optional real(real64) work(:), optional integer(int32) olwork, optional class(errors) err) +!! subroutine rz_factor(complex(real64) a(:,:), complex(real64) tau(:), optional complex(real64) work(:), optional integer(int32) olwork, optional class(errors) err) +!! @endcode +!! +!! @param[in,out] a On input, the M-by-N upper trapezoidal matrix to factor. +!! On output, the leading M-by-M upper triangular part of the matrix +!! contains the upper triangular matrix R, and elements N-L+1 to N of the +!! first M rows of A, with the array @p tau, represent the orthogonal +!! matrix Z as a product of M elementary reflectors. +!! @param[out] tau An M-element array used to store the scalar +!! factors of the elementary reflectors. +!! @param[out] work An optional input, that if provided, prevents any local +!! memory allocation. If not provided, the memory required is allocated +!! within. If provided, the length of the array must be at least +!! @p olwork. +!! @param[out] olwork An optional output used to determine workspace size. +!! If supplied, the routine determines the optimal size for @p work, and +!! returns without performing any actual calculations. +!! @param[in,out] err An optional errors-based object that if provided can be +!! used to retrieve information relating to any errors encountered during +!! execution. If not provided, a default implementation of the errors +!! class is used internally to provide error handling. Possible errors and +!! warning messages that may be encountered are as follows. +!! - LA_ARRAY_SIZE_ERROR: Occurs if any of the input arrays are not sized +!! appropriately. +!! - LA_OUT_OF_MEMORY_ERROR: Occurs if local memory must be allocated, and +!! there is insufficient memory available. +!! +!! @par Further Details +!! The factorization is obtained by Householder's method. The kth +!! transformation matrix, Z( k ), which is used to introduce zeros into +!! the ( m - k + 1 )th row of A, is given in the form +!! @verbatim +!! Z( k ) = ( I 0 ), +!! ( 0 T( k ) ) +!! @endverbatim +!! where +!! @verbatim +!! T( k ) = I - tau*u( k )*u( k )**T, u( k ) = ( 1 ), +!! ( 0 ) +!! ( z( k ) ) +!! @endverbatim +!! tau is a scalar and z( k ) is an l element vector. tau and z( k ) +!! are chosen to annihilate the elements of the kth row of A2. +!! +!! The scalar tau is returned in the kth element of TAU and the vector +!! u( k ) in the kth row of A2, such that the elements of z( k ) are +!! in a( k, l + 1 ), ..., a( k, n ). The elements of R are returned in +!! the upper triangular part of A1. +!! +!! Z is given by +!! @verbatim +!! Z = Z( 1 ) * Z( 2 ) * ... * Z( m ). +!! @endverbatim +!! +!! @par Notes +!! This routine is based upon the LAPACK routine DTZRZF. +!! +!! @par See Also +!! - [LAPACK Users Manual](http://netlib.org/lapack/lug/node44.html) interface rz_factor module procedure :: rz_factor_dbl module procedure :: rz_factor_cmplx @@ -1614,6 +1677,89 @@ module linalg_core ! ------------------------------------------------------------------------------ !> @brief Multiplies a general matrix by the orthogonal matrix Z from an !! RZ factorization. +!! +!! @par Syntax 1 +!! Multiplies a general matrix by the orthogonal matrix Z from an +!! RZ factorization such that: \f$ C = op(Z) C \f$ , or \f$ C = C op(Z) \f$. +!! @code{.f90} +!! subroutine mult_rz(logical lside, logical trans, integer(int32) l, real(real64) a(:,:), real(real64) tau(:), real(real64) c(:,:), optional real(real64) work(:), optional integer(int32) olwork, optional class(errors) err) +!! subroutine mult_rz(logical lside, logical trans, integer(int32) l, complex(real64) a(:,:), complex(real64) tau(:), complex(real64) c(:,:), optional complex(real64) work(:), optional integer(int32) olwork, optional class(errors) err) +!! @endcode +!! +!! @param[in] lside Set to true to apply \f$ Z \f$ or \f$ Z^T \f$ from the left; +!! else, set to false to apply \f$ Z \f$ or \f$ Z^T \f$ from the right. +!! @param[in] trans Set to true to apply \f$ Z^T \f$ (\f$ Z^H \f$ in the +!! complex case); else, set to false. +!! @param[in] l The number of columns in matrix @p a containing the +!! meaningful part of the Householder vectors. If @p lside is true, +!! M >= L >= 0; else, if @p lside is false, N >= L >= 0. +!! @param[in,out] a On input the K-by-LTA matrix Z, where LTA = M if +!! @p lside is true; else, LTA = N if @p lside is false. The I-th row must +!! contain the Householder vector in the last k rows. Notice, the contents +!! of this matrix are restored on exit. +!! @param[in] tau A K-element array containing the scalar factors of the +!! elementary reflectors, where M >= K >= 0 if @p lside is true; else, +!! N >= K >= 0 if @p lside is false. +!! @param[in,out] c On input, the M-by-N matrix C. On output, the product +!! of the orthogonal matrix Z and the original matrix C. +!! @param[out] work An optional input, that if provided, prevents any local +!! memory allocation. If not provided, the memory required is allocated +!! within. If provided, the length of the array must be at least +!! @p olwork. +!! @param[out] olwork An optional output used to determine workspace size. +!! If supplied, the routine determines the optimal size for @p work, and +!! returns without performing any actual calculations. +!! @param[in,out] err An optional errors-based object that if provided can be +!! used to retrieve information relating to any errors encountered during +!! execution. If not provided, a default implementation of the errors +!! class is used internally to provide error handling. Possible errors and +!! warning messages that may be encountered are as follows. +!! - LA_ARRAY_SIZE_ERROR: Occurs if any of the input arrays are not sized +!! appropriately. +!! - LA_OUT_OF_MEMORY_ERROR: Occurs if local memory must be allocated, and +!! there is insufficient memory available. +!! +!! @par Syntax 2 +!! Multiplies a general matrix by the orthogonal matrix Z from an +!! RZ factorization such that: \f$ C = op(Z) C \f$, or \f$ C = C op(Z) \f$. +!! @code{.f90} +!! subroutine mult_rz(logical trans, integer(int32) l, real(real64) a(:,:), real(real64) tau(:), real(real64) c(:), optional real(real64) work(:), optional integer(int32) olwork, optional class(errors) err) +!! subroutine mult_rz(logical trans, integer(int32) l, complex(real64) a(:,:), complex(real64) tau(:), complex(real64) c(:), optional complex(real64) work(:), optional integer(int32) olwork, optional class(errors) err) +!! @endcode +!! +!! @param[in] trans Set to true to apply \f$ Z^T \f$ (\f$ Z^H \f$ in the +!! complex case); else, set to false. +!! @param[in] l The number of columns in matrix @p a containing the +!! meaningful part of the Householder vectors. If @p lside is true, +!! M >= L >= 0; else, if @p lside is false, N >= L >= 0. +!! @param[in,out] a On input the K-by-LTA matrix Z, where LTA = M if +!! @p lside is true; else, LTA = N if @p lside is false. The I-th row must +!! contain the Householder vector in the last k rows. Notice, the contents +!! of this matrix are restored on exit. +!! @param[in] tau A K-element array containing the scalar factors of the +!! elementary reflectors, where M >= K >= 0 if @p lside is true; else, +!! N >= K >= 0 if @p lside is false. +!! @param[in,out] c On input, the M-element array C. On output, the product +!! of the orthogonal matrix Z and the original array C. +!! @param[out] work An optional input, that if provided, prevents any local +!! memory allocation. If not provided, the memory required is allocated +!! within. If provided, the length of the array must be at least +!! @p olwork. +!! @param[out] olwork An optional output used to determine workspace size. +!! If supplied, the routine determines the optimal size for @p work, and +!! returns without performing any actual calculations. +!! @param[in,out] err An optional errors-based object that if provided can be +!! used to retrieve information relating to any errors encountered during +!! execution. If not provided, a default implementation of the errors +!! class is used internally to provide error handling. Possible errors and +!! warning messages that may be encountered are as follows. +!! - LA_ARRAY_SIZE_ERROR: Occurs if any of the input arrays are not sized +!! appropriately. +!! - LA_OUT_OF_MEMORY_ERROR: Occurs if local memory must be allocated, and +!! there is insufficient memory available. +!! +!! @par Notes +!! This routine utilizes the LAPACK routine DORMRZ (ZUNMRZ in the complex case). interface mult_rz module procedure :: mult_rz_mtx module procedure :: mult_rz_mtx_cmplx @@ -1623,9 +1769,57 @@ module linalg_core ! ------------------------------------------------------------------------------ !> @brief Computes the singular value decomposition of a matrix A. The -!! SVD is defined as: A = U * S * V**T, where U is an M-by-M orthogonal -!! matrix, S is an M-by-N diagonal matrix, and V is an N-by-N orthogonal -!! matrix. +!! SVD is defined as: \f$ A = U S V^T \f$, where \f$ U \f$ is an M-by-M +!! orthogonal matrix, \f$ S \f$ is an M-by-N diagonal matrix, and \f$ V \f$ is +!! an N-by-N orthogonal matrix. +!! +!! @par Syntax +!! @code{.f90} +!! subroutine svd(real(real64) a(:,:), real(real64) s(:), optional real(real64) u(:,:), optional real(real64) vt(:,:), optional real(real64) work(:), optional integer(int32) olwork, optional class(errors) err) +!! subroutine svd(complex(real64) a(:,:), real(real64) s(:), optional complex(real64) u(:,:), optional complex(real64) vt(:,:), optional complex(real64) work(:), optional integer(int32) olwork, optional real(real64) rwork(:), optional class(errors) err) +!! @endcode +!! +!! @param[in,out] a On input, the M-by-N matrix to factor. The matrix is +!! overwritten on output. +!! @param[out] s A MIN(M, N)-element array containing the singular values +!! of @p a sorted in descending order. +!! @param[out] u An optional argument, that if supplied, is used to contain +!! the orthogonal matrix U from the decomposition. The matrix U contains +!! the left singular vectors, and can be either M-by-M (all left singular +!! vectors are computed), or M-by-MIN(M,N) (only the first MIN(M, N) left +!! singular vectors are computed). +!! @param[out] vt An optional argument, that if supplied, is used to contain +!! the conjugate transpose of the N-by-N orthogonal matrix V. The matrix +!! V contains the right singular vectors. +!! @param[out] work An optional input, that if provided, prevents any local +!! memory allocation for complex-valued workspaces. If not provided, the +!! memory required is allocated within. If provided, the length of the +!! array must be at least @p olwork. +!! @param[out] olwork An optional output used to determine workspace size. +!! If supplied, the routine determines the optimal size for @p work, and +!! returns without performing any actual calculations. +!! @param[out] rwork An optional input, that if provided, prevents any local +!! memory allocation for real-valued workspaces. If not provided, the +!! memory required is allocated within. If provided, the length of the +!! array must be at least 5 * MIN(M, N). +!! @param[in,out] err An optional errors-based object that if provided can be +!! used to retrieve information relating to any errors encountered during +!! execution. If not provided, a default implementation of the errors +!! class is used internally to provide error handling. Possible errors and +!! warning messages that may be encountered are as follows. +!! - LA_ARRAY_SIZE_ERROR: Occurs if any of the input arrays are not sized +!! appropriately. +!! - LA_OUT_OF_MEMORY_ERROR: Occurs if local memory must be allocated, and +!! there is insufficient memory available. +!! - LA_CONVERGENCE_ERROR: Occurs as a warning if the QR iteration process +!! could not converge to a zero value. +!! +!! @par Notes +!! This routine utilizes the LAPACK routine DGESVD (ZGESVD in the complex case). +!! +!! @par See Also +!! - [Wikipedia](https://en.wikipedia.org/wiki/Singular_value_decomposition) +!! - [Wolfram MathWorld](http://mathworld.wolfram.com/SingularValueDecomposition.html) !! !! @par Usage !! The following example illustrates the calculation of the singular value @@ -1664,7 +1858,7 @@ module linalg_core !! print *, vt(i,:) !! end do !! -!! ! Compute U * S * V**T, but first establish S in full form +!! ! Compute U * S * V**T !! call diag_mtx_mult(.true., 1.0d0, s, vt) ! Compute: VT = S * V**T !! ac = matmul(u(:,1:2), vt) !! print '(A)', "U * S * V**T =" @@ -2778,69 +2972,7 @@ module subroutine cholesky_rank1_downdate_cmplx(r, u, work, err) real(real64), intent(out), target, optional, dimension(:) :: work class(errors), intent(inout), optional, target :: err end subroutine - - !> @brief Factors an upper trapezoidal matrix by means of orthogonal - !! transformations such that A = R * Z = (R 0) * Z. Z is an orthogonal - !! matrix of dimension N-by-N, and R is an M-by-M upper triangular - !! matrix. - !! - !! @param[in,out] a On input, the M-by-N upper trapezoidal matrix to factor. - !! On output, the leading M-by-M upper triangular part of the matrix - !! contains the upper triangular matrix R, and elements N-L+1 to N of the - !! first M rows of A, with the array @p tau, represent the orthogonal - !! matrix Z as a product of M elementary reflectors. - !! @param[out] tau An M-element array used to store the scalar - !! factors of the elementary reflectors. - !! @param[out] work An optional input, that if provided, prevents any local - !! memory allocation. If not provided, the memory required is allocated - !! within. If provided, the length of the array must be at least - !! @p olwork. - !! @param[out] olwork An optional output used to determine workspace size. - !! If supplied, the routine determines the optimal size for @p work, and - !! returns without performing any actual calculations. - !! @param[out] err An optional errors-based object that if provided can be - !! used to retrieve information relating to any errors encountered during - !! execution. If not provided, a default implementation of the errors - !! class is used internally to provide error handling. Possible errors and - !! warning messages that may be encountered are as follows. - !! - LA_ARRAY_SIZE_ERROR: Occurs if any of the input arrays are not sized - !! appropriately. - !! - LA_OUT_OF_MEMORY_ERROR: Occurs if local memory must be allocated, and - !! there is insufficient memory available. - !! - !! @par Further Details - !! @verbatim - !! The factorization is obtained by Householder's method. The kth - !! transformation matrix, Z( k ), which is used to introduce zeros into - !! the ( m - k + 1 )th row of A, is given in the form - !! - !! Z( k ) = ( I 0 ), - !! ( 0 T( k ) ) - !! - !! where - !! - !! T( k ) = I - tau*u( k )*u( k )**T, u( k ) = ( 1 ), - !! ( 0 ) - !! ( z( k ) ) - !! - !! tau is a scalar and z( k ) is an l element vector. tau and z( k ) - !! are chosen to annihilate the elements of the kth row of A2. - !! - !! The scalar tau is returned in the kth element of TAU and the vector - !! u( k ) in the kth row of A2, such that the elements of z( k ) are - !! in a( k, l + 1 ), ..., a( k, n ). The elements of R are returned in - !! the upper triangular part of A1. - !! - !! Z is given by - !! - !! Z = Z( 1 ) * Z( 2 ) * ... * Z( m ). - !! @endverbatim - !! - !! @par Notes - !! This routine is based upon the LAPACK routine DTZRZF. - !! - !! @par See Also - !! - [LAPACK Users Manual](http://netlib.org/lapack/lug/node44.html) + module subroutine rz_factor_dbl(a, tau, work, olwork, err) real(real64), intent(inout), dimension(:,:) :: a real(real64), intent(out), dimension(:) :: tau @@ -2848,69 +2980,7 @@ module subroutine rz_factor_dbl(a, tau, work, olwork, err) integer(int32), intent(out), optional :: olwork class(errors), intent(inout), optional, target :: err end subroutine - - !> @brief Factors an upper trapezoidal matrix by means of orthogonal - !! transformations such that A = R * Z = (R 0) * Z. Z is an orthogonal - !! matrix of dimension N-by-N, and R is an M-by-M upper triangular - !! matrix. - !! - !! @param[in,out] a On input, the M-by-N upper trapezoidal matrix to factor. - !! On output, the leading M-by-M upper triangular part of the matrix - !! contains the upper triangular matrix R, and elements N-L+1 to N of the - !! first M rows of A, with the array @p tau, represent the orthogonal - !! matrix Z as a product of M elementary reflectors. - !! @param[out] tau An M-element array used to store the scalar - !! factors of the elementary reflectors. - !! @param[out] work An optional input, that if provided, prevents any local - !! memory allocation. If not provided, the memory required is allocated - !! within. If provided, the length of the array must be at least - !! @p olwork. - !! @param[out] olwork An optional output used to determine workspace size. - !! If supplied, the routine determines the optimal size for @p work, and - !! returns without performing any actual calculations. - !! @param[out] err An optional errors-based object that if provided can be - !! used to retrieve information relating to any errors encountered during - !! execution. If not provided, a default implementation of the errors - !! class is used internally to provide error handling. Possible errors and - !! warning messages that may be encountered are as follows. - !! - LA_ARRAY_SIZE_ERROR: Occurs if any of the input arrays are not sized - !! appropriately. - !! - LA_OUT_OF_MEMORY_ERROR: Occurs if local memory must be allocated, and - !! there is insufficient memory available. - !! - !! @par Further Details - !! @verbatim - !! The factorization is obtained by Householder's method. The kth - !! transformation matrix, Z( k ), which is used to introduce zeros into - !! the ( m - k + 1 )th row of A, is given in the form - !! - !! Z( k ) = ( I 0 ), - !! ( 0 T( k ) ) - !! - !! where - !! - !! T( k ) = I - tau*u( k )*u( k )**T, u( k ) = ( 1 ), - !! ( 0 ) - !! ( z( k ) ) - !! - !! tau is a scalar and z( k ) is an l element vector. tau and z( k ) - !! are chosen to annihilate the elements of the kth row of A2. - !! - !! The scalar tau is returned in the kth element of TAU and the vector - !! u( k ) in the kth row of A2, such that the elements of z( k ) are - !! in a( k, l + 1 ), ..., a( k, n ). The elements of R are returned in - !! the upper triangular part of A1. - !! - !! Z is given by - !! - !! Z = Z( 1 ) * Z( 2 ) * ... * Z( m ). - !! @endverbatim - !! - !! @par Notes - !! This routine is based upon the LAPACK routine ZTZRZF. - !! - !! @par See Also - !! - [LAPACK Users Manual](http://netlib.org/lapack/lug/node44.html) + module subroutine rz_factor_cmplx(a, tau, work, olwork, err) complex(real64), intent(inout), dimension(:,:) :: a complex(real64), intent(out), dimension(:) :: tau @@ -2918,44 +2988,7 @@ module subroutine rz_factor_cmplx(a, tau, work, olwork, err) integer(int32), intent(out), optional :: olwork class(errors), intent(inout), optional, target :: err end subroutine - - !> @brief Multiplies a general matrix by the orthogonal matrix Z from an - !! RZ factorization such that: C = op(Z) * C, or C = C * op(Z). - !! - !! @param[in] lside Set to true to apply Z or Z**T from the left; else, set - !! to false to apply Z or Z**T from the right. - !! @param[in] trans Set to true to apply Z**T; else, set to false. - !! @param[in] l The number of columns in matrix @p a containing the - !! meaningful part of the Householder vectors. If @p lside is true, - !! M >= L >= 0; else, if @p lside is false, N >= L >= 0. - !! @param[in,out] a On input the K-by-LTA matrix Z, where LTA = M if - !! @p lside is true; else, LTA = N if @p lside is false. The I-th row must - !! contain the Householder vector in the last k rows. Notice, the contents - !! of this matrix are restored on exit. - !! @param[in] tau A K-element array containing the scalar factors of the - !! elementary reflectors, where M >= K >= 0 if @p lside is true; else, - !! N >= K >= 0 if @p lside is false. - !! @param[in,out] c On input, the M-by-N matrix C. On output, the product - !! of the orthogonal matrix Z and the original matrix C. - !! @param[out] work An optional input, that if provided, prevents any local - !! memory allocation. If not provided, the memory required is allocated - !! within. If provided, the length of the array must be at least - !! @p olwork. - !! @param[out] olwork An optional output used to determine workspace size. - !! If supplied, the routine determines the optimal size for @p work, and - !! returns without performing any actual calculations. - !! @param[out] err An optional errors-based object that if provided can be - !! used to retrieve information relating to any errors encountered during - !! execution. If not provided, a default implementation of the errors - !! class is used internally to provide error handling. Possible errors and - !! warning messages that may be encountered are as follows. - !! - LA_ARRAY_SIZE_ERROR: Occurs if any of the input arrays are not sized - !! appropriately. - !! - LA_OUT_OF_MEMORY_ERROR: Occurs if local memory must be allocated, and - !! there is insufficient memory available. - !! - !! @par Notes - !! This routine utilizes the LAPACK routine DORMRZ. + module subroutine mult_rz_mtx(lside, trans, l, a, tau, c, work, olwork, err) logical, intent(in) :: lside, trans integer(int32), intent(in) :: l @@ -2965,44 +2998,7 @@ module subroutine mult_rz_mtx(lside, trans, l, a, tau, c, work, olwork, err) integer(int32), intent(out), optional :: olwork class(errors), intent(inout), optional, target :: err end subroutine - - !> @brief Multiplies a general matrix by the orthogonal matrix Z from an - !! RZ factorization such that: C = op(Z) * C, or C = C * op(Z). - !! - !! @param[in] lside Set to true to apply Z or Z**T from the left; else, set - !! to false to apply Z or Z**T from the right. - !! @param[in] trans Set to true to apply Z**H; else, set to false. - !! @param[in] l The number of columns in matrix @p a containing the - !! meaningful part of the Householder vectors. If @p lside is true, - !! M >= L >= 0; else, if @p lside is false, N >= L >= 0. - !! @param[in,out] a On input the K-by-LTA matrix Z, where LTA = M if - !! @p lside is true; else, LTA = N if @p lside is false. The I-th row must - !! contain the Householder vector in the last k rows. Notice, the contents - !! of this matrix are restored on exit. - !! @param[in] tau A K-element array containing the scalar factors of the - !! elementary reflectors, where M >= K >= 0 if @p lside is true; else, - !! N >= K >= 0 if @p lside is false. - !! @param[in,out] c On input, the M-by-N matrix C. On output, the product - !! of the orthogonal matrix Z and the original matrix C. - !! @param[out] work An optional input, that if provided, prevents any local - !! memory allocation. If not provided, the memory required is allocated - !! within. If provided, the length of the array must be at least - !! @p olwork. - !! @param[out] olwork An optional output used to determine workspace size. - !! If supplied, the routine determines the optimal size for @p work, and - !! returns without performing any actual calculations. - !! @param[out] err An optional errors-based object that if provided can be - !! used to retrieve information relating to any errors encountered during - !! execution. If not provided, a default implementation of the errors - !! class is used internally to provide error handling. Possible errors and - !! warning messages that may be encountered are as follows. - !! - LA_ARRAY_SIZE_ERROR: Occurs if any of the input arrays are not sized - !! appropriately. - !! - LA_OUT_OF_MEMORY_ERROR: Occurs if local memory must be allocated, and - !! there is insufficient memory available. - !! - !! @par Notes - !! This routine utilizes the LAPACK routine ZUNMRZ. + module subroutine mult_rz_mtx_cmplx(lside, trans, l, a, tau, c, work, olwork, err) logical, intent(in) :: lside, trans integer(int32), intent(in) :: l @@ -3012,42 +3008,7 @@ module subroutine mult_rz_mtx_cmplx(lside, trans, l, a, tau, c, work, olwork, er integer(int32), intent(out), optional :: olwork class(errors), intent(inout), optional, target :: err end subroutine - - !> @brief Multiplies a vector by the orthogonal matrix Z from an - !! RZ factorization such that: C = op(Z) * C. - !! - !! @param[in] trans Set to true to apply Z**T; else, set to false. - !! @param[in] l The number of columns in matrix @p a containing the - !! meaningful part of the Householder vectors. If @p lside is true, - !! M >= L >= 0; else, if @p lside is false, N >= L >= 0. - !! @param[in,out] a On input the K-by-LTA matrix Z, where LTA = M if - !! @p lside is true; else, LTA = N if @p lside is false. The I-th row must - !! contain the Householder vector in the last k rows. Notice, the contents - !! of this matrix are restored on exit. - !! @param[in] tau A K-element array containing the scalar factors of the - !! elementary reflectors, where M >= K >= 0 if @p lside is true; else, - !! N >= K >= 0 if @p lside is false. - !! @param[in,out] c On input, the M-element array C. On output, the product - !! of the orthogonal matrix Z and the original array C. - !! @param[out] work An optional input, that if provided, prevents any local - !! memory allocation. If not provided, the memory required is allocated - !! within. If provided, the length of the array must be at least - !! @p olwork. - !! @param[out] olwork An optional output used to determine workspace size. - !! If supplied, the routine determines the optimal size for @p work, and - !! returns without performing any actual calculations. - !! @param[out] err An optional errors-based object that if provided can be - !! used to retrieve information relating to any errors encountered during - !! execution. If not provided, a default implementation of the errors - !! class is used internally to provide error handling. Possible errors and - !! warning messages that may be encountered are as follows. - !! - LA_ARRAY_SIZE_ERROR: Occurs if any of the input arrays are not sized - !! appropriately. - !! - LA_OUT_OF_MEMORY_ERROR: Occurs if local memory must be allocated, and - !! there is insufficient memory available. - !! - !! @par Notes - !! This routine utilizes the LAPACK routine DORMRZ. + module subroutine mult_rz_vec(trans, l, a, tau, c, work, olwork, err) logical, intent(in) :: trans integer(int32), intent(in) :: l @@ -3058,42 +3019,7 @@ module subroutine mult_rz_vec(trans, l, a, tau, c, work, olwork, err) integer(int32), intent(out), optional :: olwork class(errors), intent(inout), optional, target :: err end subroutine - - !> @brief Multiplies a vector by the orthogonal matrix Z from an - !! RZ factorization such that: C = op(Z) * C. - !! - !! @param[in] trans Set to true to apply Z**T; else, set to false. - !! @param[in] l The number of columns in matrix @p a containing the - !! meaningful part of the Householder vectors. If @p lside is true, - !! M >= L >= 0; else, if @p lside is false, N >= L >= 0. - !! @param[in,out] a On input the K-by-LTA matrix Z, where LTA = M if - !! @p lside is true; else, LTA = N if @p lside is false. The I-th row must - !! contain the Householder vector in the last k rows. Notice, the contents - !! of this matrix are restored on exit. - !! @param[in] tau A K-element array containing the scalar factors of the - !! elementary reflectors, where M >= K >= 0 if @p lside is true; else, - !! N >= K >= 0 if @p lside is false. - !! @param[in,out] c On input, the M-element array C. On output, the product - !! of the orthogonal matrix Z and the original array C. - !! @param[out] work An optional input, that if provided, prevents any local - !! memory allocation. If not provided, the memory required is allocated - !! within. If provided, the length of the array must be at least - !! @p olwork. - !! @param[out] olwork An optional output used to determine workspace size. - !! If supplied, the routine determines the optimal size for @p work, and - !! returns without performing any actual calculations. - !! @param[out] err An optional errors-based object that if provided can be - !! used to retrieve information relating to any errors encountered during - !! execution. If not provided, a default implementation of the errors - !! class is used internally to provide error handling. Possible errors and - !! warning messages that may be encountered are as follows. - !! - LA_ARRAY_SIZE_ERROR: Occurs if any of the input arrays are not sized - !! appropriately. - !! - LA_OUT_OF_MEMORY_ERROR: Occurs if local memory must be allocated, and - !! there is insufficient memory available. - !! - !! @par Notes - !! This routine utilizes the LAPACK routine ZUNMRZ. + module subroutine mult_rz_vec_cmplx(trans, l, a, tau, c, work, olwork, err) logical, intent(in) :: trans integer(int32), intent(in) :: l From 3a2930821a396d6c9b615a33fb6c114fbe369adb Mon Sep 17 00:00:00 2001 From: jchristopherson Date: Wed, 14 Dec 2022 07:22:22 -0600 Subject: [PATCH 19/65] Update comments --- src/linalg_core.f90 | 92 +-------------------------------------------- 1 file changed, 2 insertions(+), 90 deletions(-) diff --git a/src/linalg_core.f90 b/src/linalg_core.f90 index eb657c3e..542d9961 100644 --- a/src/linalg_core.f90 +++ b/src/linalg_core.f90 @@ -3030,49 +3030,7 @@ module subroutine mult_rz_vec_cmplx(trans, l, a, tau, c, work, olwork, err) integer(int32), intent(out), optional :: olwork class(errors), intent(inout), optional, target :: err end subroutine - - !> @brief Computes the singular value decomposition of a matrix A. The - !! SVD is defined as: A = U * S * V**T, where U is an M-by-M orthogonal - !! matrix, S is an M-by-N diagonal matrix, and V is an N-by-N orthogonal - !! matrix. - !! - !! @param[in,out] a On input, the M-by-N matrix to factor. The matrix is - !! overwritten on output. - !! @param[out] s A MIN(M, N)-element array containing the singular values - !! of @p a sorted in descending order. - !! @param[out] u An optional argument, that if supplied, is used to contain - !! the orthogonal matrix U from the decomposition. The matrix U contains - !! the left singular vectors, and can be either M-by-M (all left singular - !! vectors are computed), or M-by-MIN(M,N) (only the first MIN(M, N) left - !! singular vectors are computed). - !! @param[out] vt An optional argument, that if supplied, is used to contain - !! the transpose of the N-by-N orthogonal matrix V. The matrix V contains - !! the right singular vectors. - !! @param[out] work An optional input, that if provided, prevents any local - !! memory allocation. If not provided, the memory required is allocated - !! within. If provided, the length of the array must be at least - !! @p olwork. - !! @param[out] olwork An optional output used to determine workspace size. - !! If supplied, the routine determines the optimal size for @p work, and - !! returns without performing any actual calculations. - !! @param[out] err An optional errors-based object that if provided can be - !! used to retrieve information relating to any errors encountered during - !! execution. If not provided, a default implementation of the errors - !! class is used internally to provide error handling. Possible errors and - !! warning messages that may be encountered are as follows. - !! - LA_ARRAY_SIZE_ERROR: Occurs if any of the input arrays are not sized - !! appropriately. - !! - LA_OUT_OF_MEMORY_ERROR: Occurs if local memory must be allocated, and - !! there is insufficient memory available. - !! - LA_CONVERGENCE_ERROR: Occurs as a warning if the QR iteration process - !! could not converge to a zero value. - !! - !! @par Notes - !! This routine utilizes the LAPACK routine DGESVD. - !! - !! @par See Also - !! - [Wikipedia](https://en.wikipedia.org/wiki/Singular_value_decomposition) - !! - [Wolfram MathWorld](http://mathworld.wolfram.com/SingularValueDecomposition.html) + module subroutine svd_dbl(a, s, u, vt, work, olwork, err) real(real64), intent(inout), dimension(:,:) :: a real(real64), intent(out), dimension(:) :: s @@ -3081,53 +3039,7 @@ module subroutine svd_dbl(a, s, u, vt, work, olwork, err) integer(int32), intent(out), optional :: olwork class(errors), intent(inout), optional, target :: err end subroutine - - !> @brief Computes the singular value decomposition of a matrix A. The - !! SVD is defined as: A = U * S * V**H, where U is an M-by-M orthogonal - !! matrix, S is an M-by-N diagonal matrix, and V is an N-by-N orthogonal - !! matrix. - !! - !! @param[in,out] a On input, the M-by-N matrix to factor. The matrix is - !! overwritten on output. - !! @param[out] s A MIN(M, N)-element array containing the singular values - !! of @p a sorted in descending order. - !! @param[out] u An optional argument, that if supplied, is used to contain - !! the orthogonal matrix U from the decomposition. The matrix U contains - !! the left singular vectors, and can be either M-by-M (all left singular - !! vectors are computed), or M-by-MIN(M,N) (only the first MIN(M, N) left - !! singular vectors are computed). - !! @param[out] vt An optional argument, that if supplied, is used to contain - !! the conjugate transpose of the N-by-N orthogonal matrix V. The matrix - !! V contains the right singular vectors. - !! @param[out] work An optional input, that if provided, prevents any local - !! memory allocation for complex-valued workspaces. If not provided, the - !! memory required is allocated within. If provided, the length of the - !! array must be at least @p olwork. - !! @param[out] olwork An optional output used to determine workspace size. - !! If supplied, the routine determines the optimal size for @p work, and - !! returns without performing any actual calculations. - !! @param[out] rwork An optional input, that if provided, prevents any local - !! memory allocation for real-valued workspaces. If not provided, the - !! memory required is allocated within. If provided, the length of the - !! array must be at least 5 * MIN(M, N). - !! @param[out] err An optional errors-based object that if provided can be - !! used to retrieve information relating to any errors encountered during - !! execution. If not provided, a default implementation of the errors - !! class is used internally to provide error handling. Possible errors and - !! warning messages that may be encountered are as follows. - !! - LA_ARRAY_SIZE_ERROR: Occurs if any of the input arrays are not sized - !! appropriately. - !! - LA_OUT_OF_MEMORY_ERROR: Occurs if local memory must be allocated, and - !! there is insufficient memory available. - !! - LA_CONVERGENCE_ERROR: Occurs as a warning if the QR iteration process - !! could not converge to a zero value. - !! - !! @par Notes - !! This routine utilizes the LAPACK routine ZGESVD. - !! - !! @par See Also - !! - [Wikipedia](https://en.wikipedia.org/wiki/Singular_value_decomposition) - !! - [Wolfram MathWorld](http://mathworld.wolfram.com/SingularValueDecomposition.html) + module subroutine svd_cmplx(a, s, u, vt, work, olwork, rwork, err) complex(real64), intent(inout), dimension(:,:) :: a real(real64), intent(out), dimension(:) :: s From 044939ace43ce42c6593101499454aa205380455 Mon Sep 17 00:00:00 2001 From: jchristopherson Date: Wed, 14 Dec 2022 08:53:31 -0600 Subject: [PATCH 20/65] Update documentation --- ...rfacelinalg__core_1_1cholesky__factor.html | 4 +- doc/html/interfacelinalg__core_1_1eigen.html | 4 +- .../interfacelinalg__core_1_1form__lu.html | 2 +- .../interfacelinalg__core_1_1form__qr.html | 2 +- .../interfacelinalg__core_1_1lu__factor.html | 2 +- ...interfacelinalg__core_1_1mtx__inverse.html | 4 +- ...nterfacelinalg__core_1_1mtx__pinverse.html | 4 +- .../interfacelinalg__core_1_1mult__qr.html | 2 +- .../interfacelinalg__core_1_1qr__factor.html | 2 +- ...erfacelinalg__core_1_1solve__cholesky.html | 6 +- ...linalg__core_1_1solve__least__squares.html | 4 +- ...__core_1_1solve__least__squares__full.html | 4 +- ...g__core_1_1solve__least__squares__svd.html | 4 +- .../interfacelinalg__core_1_1solve__lu.html | 4 +- .../interfacelinalg__core_1_1solve__qr.html | 4 +- ...lg__core_1_1solve__triangular__system.html | 40 +- doc/html/interfacelinalg__core_1_1sort.html | 2 +- doc/html/linalg__c__api_8f90_source.html | 18 +- doc/html/linalg__core_8f90_source.html | 1939 ++++++++--------- doc/html/linalg__immutable_8f90_source.html | 10 +- src/linalg_core.f90 | 212 +- 21 files changed, 1114 insertions(+), 1159 deletions(-) diff --git a/doc/html/interfacelinalg__core_1_1cholesky__factor.html b/doc/html/interfacelinalg__core_1_1cholesky__factor.html index 978278ef..838babc6 100644 --- a/doc/html/interfacelinalg__core_1_1cholesky__factor.html +++ b/doc/html/interfacelinalg__core_1_1cholesky__factor.html @@ -174,8 +174,8 @@
    print '(F8.4)', (bu(i), i = 1, size(bu))
    end program
    Computes the Cholesky factorization of a symmetric, positive definite matrix.
    -
    Solves a system of Cholesky factored equations.
    -
    Solves a triangular system of equations.
    +
    Solves a system of Cholesky factored equations.
    +
    Solves a triangular system of equations.
    Provides a set of common linear algebra routines.
    Definition: linalg_core.f90:15
    The above program produces the following output.
    Cholesky Solution: X =
    239.5833
    diff --git a/doc/html/interfacelinalg__core_1_1eigen.html b/doc/html/interfacelinalg__core_1_1eigen.html index 8514fbaf..608b5fa6 100644 --- a/doc/html/interfacelinalg__core_1_1eigen.html +++ b/doc/html/interfacelinalg__core_1_1eigen.html @@ -164,7 +164,7 @@
    print '(F10.3)', (real(modeshapes(j,i)), j = 1, size(natfreq))
    end do
    end program
    -
    Computes the eigenvalues, and optionally the eigenvectors, of a matrix.
    +
    Computes the eigenvalues, and optionally the eigenvectors, of a matrix.
    Provides a set of common linear algebra routines.
    Definition: linalg_core.f90:15
    The above program produces the following output.
    Modal Information:
    Mode 1: (232.9225 Hz)
    @@ -187,7 +187,7 @@ -

    Definition at line 2547 of file linalg_core.f90.

    +

    Definition at line 2611 of file linalg_core.f90.


    The documentation for this interface was generated from the following file: diff --git a/doc/html/interfacelinalg__core_1_1form__lu.html b/doc/html/interfacelinalg__core_1_1form__lu.html index 6f2f7865..a9881531 100644 --- a/doc/html/interfacelinalg__core_1_1form__lu.html +++ b/doc/html/interfacelinalg__core_1_1form__lu.html @@ -199,7 +199,7 @@
    end program
    Extracts the L and U matrices from the condensed [L\U] storage format used by the lu_factor.
    Computes the LU factorization of an M-by-N matrix.
    -
    Solves a triangular system of equations.
    +
    Solves a triangular system of equations.
    Provides a set of common linear algebra routines.
    Definition: linalg_core.f90:15
    The above program produces the following output.
    LU Solution: X =
    0.3333
    diff --git a/doc/html/interfacelinalg__core_1_1form__qr.html b/doc/html/interfacelinalg__core_1_1form__qr.html index 727823f4..53668f5d 100644 --- a/doc/html/interfacelinalg__core_1_1form__qr.html +++ b/doc/html/interfacelinalg__core_1_1form__qr.html @@ -204,7 +204,7 @@
    end program
    Forms the full M-by-M orthogonal matrix Q from the elementary reflectors returned by the base QR fact...
    Computes the QR factorization of an M-by-N matrix.
    -
    Solves a triangular system of equations.
    +
    Solves a triangular system of equations.
    Provides a set of common linear algebra routines.
    Definition: linalg_core.f90:15
    The above program produces the following output.
    QR Solution: X =
    0.3333
    diff --git a/doc/html/interfacelinalg__core_1_1lu__factor.html b/doc/html/interfacelinalg__core_1_1lu__factor.html index 5eb731ed..2858b577 100644 --- a/doc/html/interfacelinalg__core_1_1lu__factor.html +++ b/doc/html/interfacelinalg__core_1_1lu__factor.html @@ -167,7 +167,7 @@
    print '(F8.4)', (b(i), i = 1, size(b))
    end program
    Computes the LU factorization of an M-by-N matrix.
    -
    Solves a system of LU-factored equations.
    +
    Solves a system of LU-factored equations.
    Provides a set of common linear algebra routines.
    Definition: linalg_core.f90:15
    The program generates the following output.
    LU Solution: X =
    0.3333
    diff --git a/doc/html/interfacelinalg__core_1_1mtx__inverse.html b/doc/html/interfacelinalg__core_1_1mtx__inverse.html index a8887619..5fbdeef5 100644 --- a/doc/html/interfacelinalg__core_1_1mtx__inverse.html +++ b/doc/html/interfacelinalg__core_1_1mtx__inverse.html @@ -143,7 +143,7 @@
    print *, c(i,:)
    end do
    end program
    -
    Computes the inverse of a square matrix.
    +
    Computes the inverse of a square matrix.
    Provides a set of common linear algebra routines.
    Definition: linalg_core.f90:15
    The above program produces the following output.
    Inverse:
    -1.7777777777777777 0.88888888888888884 -0.11111111111111110
    @@ -155,7 +155,7 @@
    1.7763568394002505E-015 -8.8817841970012523E-016 1.0000000000000000
    -

    Definition at line 2392 of file linalg_core.f90.

    +

    Definition at line 2456 of file linalg_core.f90.


    The documentation for this interface was generated from the following file: diff --git a/doc/html/interfacelinalg__core_1_1mtx__pinverse.html b/doc/html/interfacelinalg__core_1_1mtx__pinverse.html index 3d60d82c..cb141ad2 100644 --- a/doc/html/interfacelinalg__core_1_1mtx__pinverse.html +++ b/doc/html/interfacelinalg__core_1_1mtx__pinverse.html @@ -145,7 +145,7 @@
    print *, c(i,:)
    end do
    end program
    -
    Computes the Moore-Penrose pseudo-inverse of a M-by-N matrix using the singular value decomposition o...
    +
    Computes the Moore-Penrose pseudo-inverse of a M-by-N matrix using the singular value decomposition o...
    Provides a set of common linear algebra routines.
    Definition: linalg_core.f90:15
    The above program produces the following output.
    Inverse:
    1.0000000000000000 0.0000000000000000 0.0000000000000000
    @@ -155,7 +155,7 @@
    0.0000000000000000 0.99999999999999967
    -

    Definition at line 2453 of file linalg_core.f90.

    +

    Definition at line 2517 of file linalg_core.f90.


    The documentation for this interface was generated from the following file: diff --git a/doc/html/interfacelinalg__core_1_1mult__qr.html b/doc/html/interfacelinalg__core_1_1mult__qr.html index af7f3b13..c4d64057 100644 --- a/doc/html/interfacelinalg__core_1_1mult__qr.html +++ b/doc/html/interfacelinalg__core_1_1mult__qr.html @@ -203,7 +203,7 @@
    end program
    Multiplies a general matrix by the orthogonal matrix Q from a QR factorization.
    Computes the QR factorization of an M-by-N matrix.
    -
    Solves a triangular system of equations.
    +
    Solves a triangular system of equations.
    Provides a set of common linear algebra routines.
    Definition: linalg_core.f90:15
    The above program produces the following output.
    QR Solution: X =
    0.3333
    diff --git a/doc/html/interfacelinalg__core_1_1qr__factor.html b/doc/html/interfacelinalg__core_1_1qr__factor.html index 689f50ef..a41570cd 100644 --- a/doc/html/interfacelinalg__core_1_1qr__factor.html +++ b/doc/html/interfacelinalg__core_1_1qr__factor.html @@ -190,7 +190,7 @@
    ! tracking array).
    end program
    Computes the QR factorization of an M-by-N matrix.
    -
    Solves a system of M QR-factored equations of N unknowns.
    +
    Solves a system of M QR-factored equations of N unknowns.
    Provides a set of common linear algebra routines.
    Definition: linalg_core.f90:15
    The above program produces the following output.
    QR Solution: X =
    0.3333
    diff --git a/doc/html/interfacelinalg__core_1_1solve__cholesky.html b/doc/html/interfacelinalg__core_1_1solve__cholesky.html index b82c59c1..179d56cd 100644 --- a/doc/html/interfacelinalg__core_1_1solve__cholesky.html +++ b/doc/html/interfacelinalg__core_1_1solve__cholesky.html @@ -158,8 +158,8 @@
    print '(F8.4)', (bu(i), i = 1, size(bu))
    end program
    Computes the Cholesky factorization of a symmetric, positive definite matrix.
    -
    Solves a system of Cholesky factored equations.
    -
    Solves a triangular system of equations.
    +
    Solves a system of Cholesky factored equations.
    +
    Solves a triangular system of equations.
    Provides a set of common linear algebra routines.
    Definition: linalg_core.f90:15
    The above program produces the following output.
    Cholesky Solution: X =
    239.5833
    @@ -171,7 +171,7 @@
    10.3333
    -

    Definition at line 2169 of file linalg_core.f90.

    +

    Definition at line 2233 of file linalg_core.f90.


    The documentation for this interface was generated from the following file: diff --git a/doc/html/interfacelinalg__core_1_1solve__least__squares.html b/doc/html/interfacelinalg__core_1_1solve__least__squares.html index be270fa2..09f23324 100644 --- a/doc/html/interfacelinalg__core_1_1solve__least__squares.html +++ b/doc/html/interfacelinalg__core_1_1solve__least__squares.html @@ -139,14 +139,14 @@
    print '(A)', "Least Squares Solution: X = "
    print '(F9.5)', (b(i), i = 1, size(a, 2))
    end program
    -
    Solves the overdetermined or underdetermined system (A*X = B) of M equations of N unknowns.
    +
    Solves the overdetermined or underdetermined system (A*X = B) of M equations of N unknowns.
    Provides a set of common linear algebra routines.
    Definition: linalg_core.f90:15
    The above program produces the following output.
    Least Squares Solution: X =
    0.13158
    -0.57895
    -

    Definition at line 2223 of file linalg_core.f90.

    +

    Definition at line 2287 of file linalg_core.f90.


    The documentation for this interface was generated from the following file: diff --git a/doc/html/interfacelinalg__core_1_1solve__least__squares__full.html b/doc/html/interfacelinalg__core_1_1solve__least__squares__full.html index d0c347b9..bd32a35f 100644 --- a/doc/html/interfacelinalg__core_1_1solve__least__squares__full.html +++ b/doc/html/interfacelinalg__core_1_1solve__least__squares__full.html @@ -139,14 +139,14 @@
    print '(A)', "Least Squares Solution: X = "
    print '(F9.5)', (b(i), i = 1, size(a, 2))
    end program
    -
    Solves the overdetermined or underdetermined system (A*X = B) of M equations of N unknowns,...
    +
    Solves the overdetermined or underdetermined system (A*X = B) of M equations of N unknowns,...
    Provides a set of common linear algebra routines.
    Definition: linalg_core.f90:15
    The above program produces the following output.
    Least Squares Solution: X =
    0.13158
    -0.57895
    -

    Definition at line 2278 of file linalg_core.f90.

    +

    Definition at line 2342 of file linalg_core.f90.


    The documentation for this interface was generated from the following file: diff --git a/doc/html/interfacelinalg__core_1_1solve__least__squares__svd.html b/doc/html/interfacelinalg__core_1_1solve__least__squares__svd.html index 226c1444..e62645de 100644 --- a/doc/html/interfacelinalg__core_1_1solve__least__squares__svd.html +++ b/doc/html/interfacelinalg__core_1_1solve__least__squares__svd.html @@ -139,14 +139,14 @@
    print '(A)', "Least Squares Solution: X = "
    print '(F9.5)', (b(i), i = 1, size(a, 2))
    end program
    -
    Solves the overdetermined or underdetermined system (A*X = B) of M equations of N unknowns using a si...
    +
    Solves the overdetermined or underdetermined system (A*X = B) of M equations of N unknowns using a si...
    Provides a set of common linear algebra routines.
    Definition: linalg_core.f90:15
    The above program produces the following output.
    Least Squares Solution: X =
    0.13158
    -0.57895
    -

    Definition at line 2333 of file linalg_core.f90.

    +

    Definition at line 2397 of file linalg_core.f90.


    The documentation for this interface was generated from the following file: diff --git a/doc/html/interfacelinalg__core_1_1solve__lu.html b/doc/html/interfacelinalg__core_1_1solve__lu.html index 2253ee39..8ef54568 100644 --- a/doc/html/interfacelinalg__core_1_1solve__lu.html +++ b/doc/html/interfacelinalg__core_1_1solve__lu.html @@ -146,7 +146,7 @@
    print '(F8.4)', (b(i), i = 1, size(b))
    end program
    Computes the LU factorization of an M-by-N matrix.
    -
    Solves a system of LU-factored equations.
    +
    Solves a system of LU-factored equations.
    Provides a set of common linear algebra routines.
    Definition: linalg_core.f90:15
    The program generates the following output.
    LU Solution: X =
    0.3333
    @@ -159,7 +159,7 @@ -

    Definition at line 2020 of file linalg_core.f90.

    +

    Definition at line 2084 of file linalg_core.f90.


    The documentation for this interface was generated from the following file: diff --git a/doc/html/interfacelinalg__core_1_1solve__qr.html b/doc/html/interfacelinalg__core_1_1solve__qr.html index bda68b55..84e38cd5 100644 --- a/doc/html/interfacelinalg__core_1_1solve__qr.html +++ b/doc/html/interfacelinalg__core_1_1solve__qr.html @@ -151,7 +151,7 @@
    ! tracking array).
    end program
    Computes the QR factorization of an M-by-N matrix.
    -
    Solves a system of M QR-factored equations of N unknowns.
    +
    Solves a system of M QR-factored equations of N unknowns.
    Provides a set of common linear algebra routines.
    Definition: linalg_core.f90:15
    The above program produces the following output.
    QR Solution: X =
    0.3333
    @@ -164,7 +164,7 @@ -

    Definition at line 2089 of file linalg_core.f90.

    +

    Definition at line 2153 of file linalg_core.f90.


    The documentation for this interface was generated from the following file: diff --git a/doc/html/interfacelinalg__core_1_1solve__triangular__system.html b/doc/html/interfacelinalg__core_1_1solve__triangular__system.html index 0b19b1bf..90e15921 100644 --- a/doc/html/interfacelinalg__core_1_1solve__triangular__system.html +++ b/doc/html/interfacelinalg__core_1_1solve__triangular__system.html @@ -107,6 +107,42 @@ More...

    Detailed Description

    Solves a triangular system of equations.

    +
    Syntax 1
    Solves one of the matrix equations: \( op(A) X = \alpha B \), or \( X op(A) = \alpha B \), where \( A \) is a triangular matrix.
    subroutine solve_triangular_system(logical lside, logical upper, logical trans, logical nounit, real(real64) alpha, real(real64) a(:,:), real(real64) b(:,:), optional class(errors) err)
    +
    subroutine solve_triangular_system(logical lside, logical upper, logical trans, logical nounit, complex(real64) alpha, complex(real64) a(:,:), complex(real64) b(:,:), optional class(errors) err)
    +
    +
    Parameters
    + + + + + + + + + +
    [in]lsideSet to true to solve \( op(A) X = \alpha B \); else, set to false to solve \( X op(A) = \alpha B \).
    [in]upperSet to true if A is an upper triangular matrix; else, set to false if A is a lower triangular matrix.
    [in]transSet to true if \( op(A) = A^T \) ( \( op(A) = A^H \) in the complex case); else, set to false if \( op(A) = A \).
    [in]nounitSet to true if A is not a unit-diagonal matrix (ones on every diagonal element); else, set to false if A is a unit-diagonal matrix.
    [in]alphaThe scalar multiplier to B.
    [in]aIf lside is true, the M-by-M triangular matrix on which to operate; else, if lside is false, the N-by-N triangular matrix on which to operate.
    [in,out]bOn input, the M-by-N right-hand-side. On output, the M-by-N solution.
    [in,out]errAn optional errors-based object that if provided can be used to retrieve information relating to any errors encountered during execution. If not provided, a default implementation of the errors class is used internally to provide error handling. Possible errors and warning messages that may be encountered are as follows.
      +
    • LA_ARRAY_SIZE_ERROR: Occurs if a is not square, or if the sizes of a and b are not compatible.
    • +
    +
    +
    +
    +
    Notes
    This routine is based upon the BLAS routine DTRSM (ZTRSM in the complex case).
    +
    Syntax 2
    Solves the system of equations: \( op(A) X = B \), where \( A \) is a triangular matrix.
    +
    Parameters
    + + + + + + + +
    [in]upperSet to true if A is an upper triangular matrix; else, set to false if A is a lower triangular matrix.
    [in]transSet to true if \( op(A) = A^T \) ( \( op(A) = A^H \) in the complex case); else, set to false if \( op(A) = A \).
    [in]nounitSet to true if A is not a unit-diagonal matrix (ones on every diagonal element); else, set to false if A is a unit-diagonal matrix.
    [in]aThe N-by-N triangular matrix.
    [in,out]xOn input, the N-element right-hand-side array. On output, the N-element solution array.
    [out]errAn optional errors-based object that if provided can be used to retrieve information relating to any errors encountered during execution. If not provided, a default implementation of the errors class is used internally to provide error handling. Possible errors and warning messages that may be encountered are as follows.
      +
    • LA_ARRAY_SIZE_ERROR: Occurs if a is not square, or if the sizes of a and b are not compatible.
    • +
    +
    +
    +
    +
    Notes
    This routine is based upon the BLAS routine DTRSV (ZTRSV in the complex case).
    Usage
    The following example illustrates the solution of two triangular systems to solve a system of LU factored equations.
    program example
    use iso_fortran_env, only : real64, int32
    @@ -158,7 +194,7 @@
    end program
    Extracts the L and U matrices from the condensed [L\U] storage format used by the lu_factor.
    Computes the LU factorization of an M-by-N matrix.
    -
    Solves a triangular system of equations.
    +
    Solves a triangular system of equations.
    Provides a set of common linear algebra routines.
    Definition: linalg_core.f90:15
    The above program produces the following output.
    LU Solution: X =
    0.3333
    @@ -166,7 +202,7 @@
    0.0000
    -

    Definition at line 1956 of file linalg_core.f90.

    +

    Definition at line 2020 of file linalg_core.f90.


    The documentation for this interface was generated from the following file: diff --git a/doc/html/interfacelinalg__core_1_1sort.html b/doc/html/interfacelinalg__core_1_1sort.html index d9949eb6..38607ac8 100644 --- a/doc/html/interfacelinalg__core_1_1sort.html +++ b/doc/html/interfacelinalg__core_1_1sort.html @@ -108,7 +108,7 @@

    Detailed Description

    Sorts an array.

    -

    Definition at line 2556 of file linalg_core.f90.

    +

    Definition at line 2620 of file linalg_core.f90.


    The documentation for this interface was generated from the following file: diff --git a/doc/html/linalg__c__api_8f90_source.html b/doc/html/linalg__c__api_8f90_source.html index 311bdbf5..28890125 100644 --- a/doc/html/linalg__c__api_8f90_source.html +++ b/doc/html/linalg__c__api_8f90_source.html @@ -2027,23 +2027,23 @@
    Computes the rank 1 update to a Cholesky factored matrix (upper triangular).
    Computes the determinant of a square matrix.
    Multiplies a diagonal matrix with another matrix or array.
    -
    Computes the eigenvalues, and optionally the eigenvectors, of a matrix.
    +
    Computes the eigenvalues, and optionally the eigenvectors, of a matrix.
    Extracts the L and U matrices from the condensed [L\U] storage format used by the lu_factor.
    Forms the full M-by-M orthogonal matrix Q from the elementary reflectors returned by the base QR fact...
    Computes the LU factorization of an M-by-N matrix.
    -
    Computes the inverse of a square matrix.
    -
    Computes the Moore-Penrose pseudo-inverse of a M-by-N matrix using the singular value decomposition o...
    +
    Computes the inverse of a square matrix.
    +
    Computes the Moore-Penrose pseudo-inverse of a M-by-N matrix using the singular value decomposition o...
    Computes the rank of a matrix.
    Multiplies a general matrix by the orthogonal matrix Q from a QR factorization.
    Computes the QR factorization of an M-by-N matrix.
    Computes the rank 1 update to an M-by-N QR factored matrix A (M >= N) where , and such that .
    Performs the rank-1 update to matrix A such that: , where is an M-by-N matrix, is a scalar,...
    -
    Solves a system of Cholesky factored equations.
    -
    Solves the overdetermined or underdetermined system (A*X = B) of M equations of N unknowns.
    -
    Solves a system of LU-factored equations.
    -
    Solves a system of M QR-factored equations of N unknowns.
    -
    Solves a triangular system of equations.
    -
    Sorts an array.
    +
    Solves a system of Cholesky factored equations.
    +
    Solves the overdetermined or underdetermined system (A*X = B) of M equations of N unknowns.
    +
    Solves a system of LU-factored equations.
    +
    Solves a system of M QR-factored equations of N unknowns.
    +
    Solves a triangular system of equations.
    +
    Sorts an array.
    Computes the singular value decomposition of a matrix A. The SVD is defined as: , where is an M-by-M...
    Computes the trace of a matrix (the sum of the main diagonal elements).
    Computes the triangular matrix operation: , or , where A is a triangular matrix.
    diff --git a/doc/html/linalg__core_8f90_source.html b/doc/html/linalg__core_8f90_source.html index 21e6dba8..458e0c6a 100644 --- a/doc/html/linalg__core_8f90_source.html +++ b/doc/html/linalg__core_8f90_source.html @@ -290,996 +290,995 @@
    1890end interface
    1891
    1892! ------------------------------------------------------------------------------
    - -
    1957 module procedure :: solve_tri_mtx
    -
    1958 module procedure :: solve_tri_mtx_cmplx
    -
    1959 module procedure :: solve_tri_vec
    -
    1960 module procedure :: solve_tri_vec_cmplx
    -
    1961end interface
    -
    1962
    -
    1963! ------------------------------------------------------------------------------
    -
    2020interface solve_lu
    -
    2021 module procedure :: solve_lu_mtx
    -
    2022 module procedure :: solve_lu_mtx_cmplx
    -
    2023 module procedure :: solve_lu_vec
    -
    2024 module procedure :: solve_lu_vec_cmplx
    + +
    2021 module procedure :: solve_tri_mtx
    +
    2022 module procedure :: solve_tri_mtx_cmplx
    +
    2023 module procedure :: solve_tri_vec
    +
    2024 module procedure :: solve_tri_vec_cmplx
    2025end interface
    2026
    2027! ------------------------------------------------------------------------------
    -
    2089interface solve_qr
    -
    2090 module procedure :: solve_qr_no_pivot_mtx
    -
    2091 module procedure :: solve_qr_no_pivot_mtx_cmplx
    -
    2092 module procedure :: solve_qr_no_pivot_vec
    -
    2093 module procedure :: solve_qr_no_pivot_vec_cmplx
    -
    2094 module procedure :: solve_qr_pivot_mtx
    -
    2095 module procedure :: solve_qr_pivot_mtx_cmplx
    -
    2096 module procedure :: solve_qr_pivot_vec
    -
    2097 module procedure :: solve_qr_pivot_vec_cmplx
    -
    2098end interface
    -
    2099
    -
    2100! ------------------------------------------------------------------------------
    - -
    2170 module procedure :: solve_cholesky_mtx
    -
    2171 module procedure :: solve_cholesky_mtx_cmplx
    -
    2172 module procedure :: solve_cholesky_vec
    -
    2173 module procedure :: solve_cholesky_vec_cmplx
    -
    2174end interface
    -
    2175
    -
    2176! ------------------------------------------------------------------------------
    - -
    2224 module procedure :: solve_least_squares_mtx
    -
    2225 module procedure :: solve_least_squares_mtx_cmplx
    -
    2226 module procedure :: solve_least_squares_vec
    -
    2227 module procedure :: solve_least_squares_vec_cmplx
    -
    2228end interface
    -
    2229
    -
    2230! ------------------------------------------------------------------------------
    - -
    2279 module procedure :: solve_least_squares_mtx_pvt
    -
    2280 module procedure :: solve_least_squares_mtx_pvt_cmplx
    -
    2281 module procedure :: solve_least_squares_vec_pvt
    -
    2282 module procedure :: solve_least_squares_vec_pvt_cmplx
    -
    2283end interface
    -
    2284
    -
    2285! ------------------------------------------------------------------------------
    - -
    2334 module procedure :: solve_least_squares_mtx_svd
    -
    2335 module procedure :: solve_least_squares_vec_svd
    -
    2336end interface
    -
    2337
    -
    2338! ------------------------------------------------------------------------------
    - -
    2393 module procedure :: mtx_inverse_dbl
    -
    2394 module procedure :: mtx_inverse_cmplx
    -
    2395end interface
    -
    2396
    -
    2397! ------------------------------------------------------------------------------
    - -
    2454 module procedure :: mtx_pinverse_dbl
    -
    2455 module procedure :: mtx_pinverse_cmplx
    -
    2456end interface
    -
    2457
    -
    2458! ------------------------------------------------------------------------------
    -
    2547interface eigen
    -
    2548 module procedure :: eigen_symm
    -
    2549 module procedure :: eigen_asymm
    -
    2550 module procedure :: eigen_gen
    -
    2551 module procedure :: eigen_cmplx
    -
    2552end interface
    -
    2553
    -
    2554! ------------------------------------------------------------------------------
    -
    2556interface sort
    -
    2557 module procedure :: sort_dbl_array
    -
    2558 module procedure :: sort_dbl_array_ind
    -
    2559 module procedure :: sort_cmplx_array
    -
    2560 module procedure :: sort_cmplx_array_ind
    -
    2561 module procedure :: sort_eigen_cmplx
    -
    2562 module procedure :: sort_eigen_dbl
    -
    2563end interface
    -
    2564
    -
    2565
    -
    2566! ******************************************************************************
    -
    2567! LINALG_BASIC.F90
    -
    2568! ------------------------------------------------------------------------------
    -
    2569interface
    -
    2570 module subroutine mtx_mult_mtx(transa, transb, alpha, a, b, beta, c, err)
    -
    2571 logical, intent(in) :: transa, transb
    -
    2572 real(real64), intent(in) :: alpha, beta
    -
    2573 real(real64), intent(in), dimension(:,:) :: a, b
    -
    2574 real(real64), intent(inout), dimension(:,:) :: c
    -
    2575 class(errors), intent(inout), optional, target :: err
    -
    2576 end subroutine
    -
    2577
    -
    2578 module subroutine mtx_mult_vec(trans, alpha, a, b, beta, c, err)
    -
    2579 logical, intent(in) :: trans
    -
    2580 real(real64), intent(in) :: alpha, beta
    -
    2581 real(real64), intent(in), dimension(:,:) :: a
    -
    2582 real(real64), intent(in), dimension(:) :: b
    -
    2583 real(real64), intent(inout), dimension(:) :: c
    -
    2584 class(errors), intent(inout), optional, target :: err
    -
    2585 end subroutine
    -
    2586
    -
    2587 module subroutine cmtx_mult_mtx(opa, opb, alpha, a, b, beta, c, err)
    -
    2588 integer(int32), intent(in) :: opa, opb
    -
    2589 complex(real64), intent(in) :: alpha, beta
    -
    2590 complex(real64), intent(in), dimension(:,:) :: a, b
    -
    2591 complex(real64), intent(inout), dimension(:,:) :: c
    -
    2592 class(errors), intent(inout), optional, target :: err
    -
    2593 end subroutine
    -
    2594
    -
    2595 module subroutine cmtx_mult_vec(opa, alpha, a, b, beta, c, err)
    -
    2596 integer(int32), intent(in) :: opa
    -
    2597 complex(real64), intent(in) :: alpha, beta
    -
    2598 complex(real64), intent(in), dimension(:,:) :: a
    -
    2599 complex(real64), intent(in), dimension(:) :: b
    -
    2600 complex(real64), intent(inout), dimension(:) :: c
    -
    2601 class(errors), intent(inout), optional, target :: err
    -
    2602 end subroutine
    -
    2603
    -
    2604 module subroutine rank1_update_dbl(alpha, x, y, a, err)
    -
    2605 real(real64), intent(in) :: alpha
    -
    2606 real(real64), intent(in), dimension(:) :: x, y
    -
    2607 real(real64), intent(inout), dimension(:,:) :: a
    -
    2608 class(errors), intent(inout), optional, target :: err
    -
    2609 end subroutine
    -
    2610
    -
    2611 module subroutine rank1_update_cmplx(alpha, x, y, a, err)
    -
    2612 complex(real64), intent(in) :: alpha
    -
    2613 complex(real64), intent(in), dimension(:) :: x, y
    -
    2614 complex(real64), intent(inout), dimension(:,:) :: a
    -
    2615 class(errors), intent(inout), optional, target :: err
    -
    2616 end subroutine
    -
    2617
    -
    2618 module subroutine diag_mtx_mult_mtx(lside, trans, alpha, a, b, beta, c, err)
    -
    2619 logical, intent(in) :: lside, trans
    -
    2620 real(real64) :: alpha, beta
    -
    2621 real(real64), intent(in), dimension(:) :: a
    -
    2622 real(real64), intent(in), dimension(:,:) :: b
    -
    2623 real(real64), intent(inout), dimension(:,:) :: c
    -
    2624 class(errors), intent(inout), optional, target :: err
    -
    2625 end subroutine
    -
    2626
    -
    2627 module subroutine diag_mtx_mult_mtx2(lside, alpha, a, b, err)
    -
    2628 logical, intent(in) :: lside
    -
    2629 real(real64), intent(in) :: alpha
    -
    2630 real(real64), intent(in), dimension(:) :: a
    -
    2631 real(real64), intent(inout), dimension(:,:) :: b
    -
    2632 class(errors), intent(inout), optional, target :: err
    -
    2633 end subroutine
    -
    2634
    -
    2635 module subroutine diag_mtx_mult_mtx3(lside, trans, alpha, a, b, beta, c, err)
    -
    2636 logical, intent(in) :: lside, trans
    -
    2637 real(real64) :: alpha, beta
    -
    2638 complex(real64), intent(in), dimension(:) :: a
    -
    2639 real(real64), intent(in), dimension(:,:) :: b
    -
    2640 complex(real64), intent(inout), dimension(:,:) :: c
    -
    2641 class(errors), intent(inout), optional, target :: err
    -
    2642 end subroutine
    -
    2643
    -
    2644 module subroutine diag_mtx_mult_mtx4(lside, opb, alpha, a, b, beta, c, err)
    -
    2645 logical, intent(in) :: lside
    -
    2646 integer(int32), intent(in) :: opb
    -
    2647 real(real64) :: alpha, beta
    -
    2648 complex(real64), intent(in), dimension(:) :: a
    -
    2649 complex(real64), intent(in), dimension(:,:) :: b
    -
    2650 complex(real64), intent(inout), dimension(:,:) :: c
    -
    2651 class(errors), intent(inout), optional, target :: err
    -
    2652 end subroutine
    -
    2653
    -
    2654 module subroutine diag_mtx_mult_mtx_cmplx(lside, opb, alpha, a, b, beta, c, err)
    -
    2655 logical, intent(in) :: lside
    -
    2656 integer(int32), intent(in) :: opb
    -
    2657 complex(real64) :: alpha, beta
    -
    2658 complex(real64), intent(in), dimension(:) :: a
    -
    2659 complex(real64), intent(in), dimension(:,:) :: b
    -
    2660 complex(real64), intent(inout), dimension(:,:) :: c
    -
    2661 class(errors), intent(inout), optional, target :: err
    -
    2662 end subroutine
    -
    2663
    -
    2664 module subroutine diag_mtx_mult_mtx2_cmplx(lside, alpha, a, b, err)
    -
    2665 logical, intent(in) :: lside
    -
    2666 complex(real64), intent(in) :: alpha
    -
    2667 complex(real64), intent(in), dimension(:) :: a
    -
    2668 complex(real64), intent(inout), dimension(:,:) :: b
    -
    2669 class(errors), intent(inout), optional, target :: err
    -
    2670 end subroutine
    -
    2671
    -
    2672 module subroutine diag_mtx_mult_mtx_mix(lside, opb, alpha, a, b, beta, c, err)
    -
    2673 logical, intent(in) :: lside
    -
    2674 integer(int32), intent(in) :: opb
    -
    2675 complex(real64) :: alpha, beta
    -
    2676 real(real64), intent(in), dimension(:) :: a
    -
    2677 complex(real64), intent(in), dimension(:,:) :: b
    -
    2678 complex(real64), intent(inout), dimension(:,:) :: c
    +
    2084interface solve_lu
    +
    2085 module procedure :: solve_lu_mtx
    +
    2086 module procedure :: solve_lu_mtx_cmplx
    +
    2087 module procedure :: solve_lu_vec
    +
    2088 module procedure :: solve_lu_vec_cmplx
    +
    2089end interface
    +
    2090
    +
    2091! ------------------------------------------------------------------------------
    +
    2153interface solve_qr
    +
    2154 module procedure :: solve_qr_no_pivot_mtx
    +
    2155 module procedure :: solve_qr_no_pivot_mtx_cmplx
    +
    2156 module procedure :: solve_qr_no_pivot_vec
    +
    2157 module procedure :: solve_qr_no_pivot_vec_cmplx
    +
    2158 module procedure :: solve_qr_pivot_mtx
    +
    2159 module procedure :: solve_qr_pivot_mtx_cmplx
    +
    2160 module procedure :: solve_qr_pivot_vec
    +
    2161 module procedure :: solve_qr_pivot_vec_cmplx
    +
    2162end interface
    +
    2163
    +
    2164! ------------------------------------------------------------------------------
    + +
    2234 module procedure :: solve_cholesky_mtx
    +
    2235 module procedure :: solve_cholesky_mtx_cmplx
    +
    2236 module procedure :: solve_cholesky_vec
    +
    2237 module procedure :: solve_cholesky_vec_cmplx
    +
    2238end interface
    +
    2239
    +
    2240! ------------------------------------------------------------------------------
    + +
    2288 module procedure :: solve_least_squares_mtx
    +
    2289 module procedure :: solve_least_squares_mtx_cmplx
    +
    2290 module procedure :: solve_least_squares_vec
    +
    2291 module procedure :: solve_least_squares_vec_cmplx
    +
    2292end interface
    +
    2293
    +
    2294! ------------------------------------------------------------------------------
    + +
    2343 module procedure :: solve_least_squares_mtx_pvt
    +
    2344 module procedure :: solve_least_squares_mtx_pvt_cmplx
    +
    2345 module procedure :: solve_least_squares_vec_pvt
    +
    2346 module procedure :: solve_least_squares_vec_pvt_cmplx
    +
    2347end interface
    +
    2348
    +
    2349! ------------------------------------------------------------------------------
    + +
    2398 module procedure :: solve_least_squares_mtx_svd
    +
    2399 module procedure :: solve_least_squares_vec_svd
    +
    2400end interface
    +
    2401
    +
    2402! ------------------------------------------------------------------------------
    + +
    2457 module procedure :: mtx_inverse_dbl
    +
    2458 module procedure :: mtx_inverse_cmplx
    +
    2459end interface
    +
    2460
    +
    2461! ------------------------------------------------------------------------------
    + +
    2518 module procedure :: mtx_pinverse_dbl
    +
    2519 module procedure :: mtx_pinverse_cmplx
    +
    2520end interface
    +
    2521
    +
    2522! ------------------------------------------------------------------------------
    +
    2611interface eigen
    +
    2612 module procedure :: eigen_symm
    +
    2613 module procedure :: eigen_asymm
    +
    2614 module procedure :: eigen_gen
    +
    2615 module procedure :: eigen_cmplx
    +
    2616end interface
    +
    2617
    +
    2618! ------------------------------------------------------------------------------
    +
    2620interface sort
    +
    2621 module procedure :: sort_dbl_array
    +
    2622 module procedure :: sort_dbl_array_ind
    +
    2623 module procedure :: sort_cmplx_array
    +
    2624 module procedure :: sort_cmplx_array_ind
    +
    2625 module procedure :: sort_eigen_cmplx
    +
    2626 module procedure :: sort_eigen_dbl
    +
    2627end interface
    +
    2628
    +
    2629
    +
    2630! ******************************************************************************
    +
    2631! LINALG_BASIC.F90
    +
    2632! ------------------------------------------------------------------------------
    +
    2633interface
    +
    2634 module subroutine mtx_mult_mtx(transa, transb, alpha, a, b, beta, c, err)
    +
    2635 logical, intent(in) :: transa, transb
    +
    2636 real(real64), intent(in) :: alpha, beta
    +
    2637 real(real64), intent(in), dimension(:,:) :: a, b
    +
    2638 real(real64), intent(inout), dimension(:,:) :: c
    +
    2639 class(errors), intent(inout), optional, target :: err
    +
    2640 end subroutine
    +
    2641
    +
    2642 module subroutine mtx_mult_vec(trans, alpha, a, b, beta, c, err)
    +
    2643 logical, intent(in) :: trans
    +
    2644 real(real64), intent(in) :: alpha, beta
    +
    2645 real(real64), intent(in), dimension(:,:) :: a
    +
    2646 real(real64), intent(in), dimension(:) :: b
    +
    2647 real(real64), intent(inout), dimension(:) :: c
    +
    2648 class(errors), intent(inout), optional, target :: err
    +
    2649 end subroutine
    +
    2650
    +
    2651 module subroutine cmtx_mult_mtx(opa, opb, alpha, a, b, beta, c, err)
    +
    2652 integer(int32), intent(in) :: opa, opb
    +
    2653 complex(real64), intent(in) :: alpha, beta
    +
    2654 complex(real64), intent(in), dimension(:,:) :: a, b
    +
    2655 complex(real64), intent(inout), dimension(:,:) :: c
    +
    2656 class(errors), intent(inout), optional, target :: err
    +
    2657 end subroutine
    +
    2658
    +
    2659 module subroutine cmtx_mult_vec(opa, alpha, a, b, beta, c, err)
    +
    2660 integer(int32), intent(in) :: opa
    +
    2661 complex(real64), intent(in) :: alpha, beta
    +
    2662 complex(real64), intent(in), dimension(:,:) :: a
    +
    2663 complex(real64), intent(in), dimension(:) :: b
    +
    2664 complex(real64), intent(inout), dimension(:) :: c
    +
    2665 class(errors), intent(inout), optional, target :: err
    +
    2666 end subroutine
    +
    2667
    +
    2668 module subroutine rank1_update_dbl(alpha, x, y, a, err)
    +
    2669 real(real64), intent(in) :: alpha
    +
    2670 real(real64), intent(in), dimension(:) :: x, y
    +
    2671 real(real64), intent(inout), dimension(:,:) :: a
    +
    2672 class(errors), intent(inout), optional, target :: err
    +
    2673 end subroutine
    +
    2674
    +
    2675 module subroutine rank1_update_cmplx(alpha, x, y, a, err)
    +
    2676 complex(real64), intent(in) :: alpha
    +
    2677 complex(real64), intent(in), dimension(:) :: x, y
    +
    2678 complex(real64), intent(inout), dimension(:,:) :: a
    2679 class(errors), intent(inout), optional, target :: err
    2680 end subroutine
    2681
    -
    2682 module subroutine diag_mtx_mult_mtx2_mix(lside, alpha, a, b, err)
    -
    2683 logical, intent(in) :: lside
    -
    2684 complex(real64), intent(in) :: alpha
    +
    2682 module subroutine diag_mtx_mult_mtx(lside, trans, alpha, a, b, beta, c, err)
    +
    2683 logical, intent(in) :: lside, trans
    +
    2684 real(real64) :: alpha, beta
    2685 real(real64), intent(in), dimension(:) :: a
    -
    2686 complex(real64), intent(inout), dimension(:,:) :: b
    -
    2687 class(errors), intent(inout), optional, target :: err
    -
    2688 end subroutine
    -
    2689
    -
    2690 pure module function trace_dbl(x) result(y)
    -
    2691 real(real64), intent(in), dimension(:,:) :: x
    -
    2692 real(real64) :: y
    -
    2693 end function
    -
    2694
    -
    2695 pure module function trace_cmplx(x) result(y)
    -
    2696 complex(real64), intent(in), dimension(:,:) :: x
    -
    2697 complex(real64) :: y
    -
    2698 end function
    -
    2699
    -
    2700 module function mtx_rank_dbl(a, tol, work, olwork, err) result(rnk)
    -
    2701 real(real64), intent(inout), dimension(:,:) :: a
    -
    2702 real(real64), intent(in), optional :: tol
    -
    2703 real(real64), intent(out), target, optional, dimension(:) :: work
    -
    2704 integer(int32), intent(out), optional :: olwork
    +
    2686 real(real64), intent(in), dimension(:,:) :: b
    +
    2687 real(real64), intent(inout), dimension(:,:) :: c
    +
    2688 class(errors), intent(inout), optional, target :: err
    +
    2689 end subroutine
    +
    2690
    +
    2691 module subroutine diag_mtx_mult_mtx2(lside, alpha, a, b, err)
    +
    2692 logical, intent(in) :: lside
    +
    2693 real(real64), intent(in) :: alpha
    +
    2694 real(real64), intent(in), dimension(:) :: a
    +
    2695 real(real64), intent(inout), dimension(:,:) :: b
    +
    2696 class(errors), intent(inout), optional, target :: err
    +
    2697 end subroutine
    +
    2698
    +
    2699 module subroutine diag_mtx_mult_mtx3(lside, trans, alpha, a, b, beta, c, err)
    +
    2700 logical, intent(in) :: lside, trans
    +
    2701 real(real64) :: alpha, beta
    +
    2702 complex(real64), intent(in), dimension(:) :: a
    +
    2703 real(real64), intent(in), dimension(:,:) :: b
    +
    2704 complex(real64), intent(inout), dimension(:,:) :: c
    2705 class(errors), intent(inout), optional, target :: err
    -
    2706 integer(int32) :: rnk
    -
    2707 end function
    -
    2708
    -
    2709 module function mtx_rank_cmplx(a, tol, work, olwork, rwork, err) result(rnk)
    -
    2710 complex(real64), intent(inout), dimension(:,:) :: a
    -
    2711 real(real64), intent(in), optional :: tol
    -
    2712 complex(real64), intent(out), target, optional, dimension(:) :: work
    -
    2713 integer(int32), intent(out), optional :: olwork
    -
    2714 real(real64), intent(out), target, optional, dimension(:) :: rwork
    +
    2706 end subroutine
    +
    2707
    +
    2708 module subroutine diag_mtx_mult_mtx4(lside, opb, alpha, a, b, beta, c, err)
    +
    2709 logical, intent(in) :: lside
    +
    2710 integer(int32), intent(in) :: opb
    +
    2711 real(real64) :: alpha, beta
    +
    2712 complex(real64), intent(in), dimension(:) :: a
    +
    2713 complex(real64), intent(in), dimension(:,:) :: b
    +
    2714 complex(real64), intent(inout), dimension(:,:) :: c
    2715 class(errors), intent(inout), optional, target :: err
    -
    2716 integer(int32) :: rnk
    -
    2717 end function
    -
    2718
    -
    2719 module function det_dbl(a, iwork, err) result(x)
    -
    2720 real(real64), intent(inout), dimension(:,:) :: a
    -
    2721 integer(int32), intent(out), target, optional, dimension(:) :: iwork
    -
    2722 class(errors), intent(inout), optional, target :: err
    -
    2723 real(real64) :: x
    -
    2724 end function
    -
    2725
    -
    2726 module function det_cmplx(a, iwork, err) result(x)
    -
    2727 complex(real64), intent(inout), dimension(:,:) :: a
    -
    2728 integer(int32), intent(out), target, optional, dimension(:) :: iwork
    -
    2729 class(errors), intent(inout), optional, target :: err
    -
    2730 complex(real64) :: x
    -
    2731 end function
    -
    2732
    -
    2733 module subroutine swap_dbl(x, y, err)
    -
    2734 real(real64), intent(inout), dimension(:) :: x, y
    -
    2735 class(errors), intent(inout), optional, target :: err
    -
    2736 end subroutine
    -
    2737
    -
    2738 module subroutine swap_cmplx(x, y, err)
    -
    2739 complex(real64), intent(inout), dimension(:) :: x, y
    -
    2740 class(errors), intent(inout), optional, target :: err
    -
    2741 end subroutine
    -
    2742
    -
    2743 module subroutine recip_mult_array_dbl(a, x)
    -
    2744 real(real64), intent(in) :: a
    -
    2745 real(real64), intent(inout), dimension(:) :: x
    -
    2746 end subroutine
    -
    2747
    -
    2748 module subroutine tri_mtx_mult_dbl(upper, alpha, a, beta, b, err)
    -
    2749 logical, intent(in) :: upper
    -
    2750 real(real64), intent(in) :: alpha, beta
    -
    2751 real(real64), intent(in), dimension(:,:) :: a
    -
    2752 real(real64), intent(inout), dimension(:,:) :: b
    -
    2753 class(errors), intent(inout), optional, target :: err
    -
    2754 end subroutine
    -
    2755
    -
    2756 module subroutine tri_mtx_mult_cmplx(upper, alpha, a, beta, b, err)
    -
    2757 logical, intent(in) :: upper
    -
    2758 complex(real64), intent(in) :: alpha, beta
    -
    2759 complex(real64), intent(in), dimension(:,:) :: a
    -
    2760 complex(real64), intent(inout), dimension(:,:) :: b
    -
    2761 class(errors), intent(inout), optional, target :: err
    -
    2762 end subroutine
    -
    2763
    -
    2764end interface
    -
    2765
    -
    2766! ******************************************************************************
    -
    2767! LINALG_FACTOR.F90
    -
    2768! ------------------------------------------------------------------------------
    -
    2769interface
    -
    2770 module subroutine lu_factor_dbl(a, ipvt, err)
    -
    2771 real(real64), intent(inout), dimension(:,:) :: a
    -
    2772 integer(int32), intent(out), dimension(:) :: ipvt
    -
    2773 class(errors), intent(inout), optional, target :: err
    -
    2774 end subroutine
    -
    2775
    -
    2776 module subroutine lu_factor_cmplx(a, ipvt, err)
    -
    2777 complex(real64), intent(inout), dimension(:,:) :: a
    -
    2778 integer(int32), intent(out), dimension(:) :: ipvt
    +
    2716 end subroutine
    +
    2717
    +
    2718 module subroutine diag_mtx_mult_mtx_cmplx(lside, opb, alpha, a, b, beta, c, err)
    +
    2719 logical, intent(in) :: lside
    +
    2720 integer(int32), intent(in) :: opb
    +
    2721 complex(real64) :: alpha, beta
    +
    2722 complex(real64), intent(in), dimension(:) :: a
    +
    2723 complex(real64), intent(in), dimension(:,:) :: b
    +
    2724 complex(real64), intent(inout), dimension(:,:) :: c
    +
    2725 class(errors), intent(inout), optional, target :: err
    +
    2726 end subroutine
    +
    2727
    +
    2728 module subroutine diag_mtx_mult_mtx2_cmplx(lside, alpha, a, b, err)
    +
    2729 logical, intent(in) :: lside
    +
    2730 complex(real64), intent(in) :: alpha
    +
    2731 complex(real64), intent(in), dimension(:) :: a
    +
    2732 complex(real64), intent(inout), dimension(:,:) :: b
    +
    2733 class(errors), intent(inout), optional, target :: err
    +
    2734 end subroutine
    +
    2735
    +
    2736 module subroutine diag_mtx_mult_mtx_mix(lside, opb, alpha, a, b, beta, c, err)
    +
    2737 logical, intent(in) :: lside
    +
    2738 integer(int32), intent(in) :: opb
    +
    2739 complex(real64) :: alpha, beta
    +
    2740 real(real64), intent(in), dimension(:) :: a
    +
    2741 complex(real64), intent(in), dimension(:,:) :: b
    +
    2742 complex(real64), intent(inout), dimension(:,:) :: c
    +
    2743 class(errors), intent(inout), optional, target :: err
    +
    2744 end subroutine
    +
    2745
    +
    2746 module subroutine diag_mtx_mult_mtx2_mix(lside, alpha, a, b, err)
    +
    2747 logical, intent(in) :: lside
    +
    2748 complex(real64), intent(in) :: alpha
    +
    2749 real(real64), intent(in), dimension(:) :: a
    +
    2750 complex(real64), intent(inout), dimension(:,:) :: b
    +
    2751 class(errors), intent(inout), optional, target :: err
    +
    2752 end subroutine
    +
    2753
    +
    2754 pure module function trace_dbl(x) result(y)
    +
    2755 real(real64), intent(in), dimension(:,:) :: x
    +
    2756 real(real64) :: y
    +
    2757 end function
    +
    2758
    +
    2759 pure module function trace_cmplx(x) result(y)
    +
    2760 complex(real64), intent(in), dimension(:,:) :: x
    +
    2761 complex(real64) :: y
    +
    2762 end function
    +
    2763
    +
    2764 module function mtx_rank_dbl(a, tol, work, olwork, err) result(rnk)
    +
    2765 real(real64), intent(inout), dimension(:,:) :: a
    +
    2766 real(real64), intent(in), optional :: tol
    +
    2767 real(real64), intent(out), target, optional, dimension(:) :: work
    +
    2768 integer(int32), intent(out), optional :: olwork
    +
    2769 class(errors), intent(inout), optional, target :: err
    +
    2770 integer(int32) :: rnk
    +
    2771 end function
    +
    2772
    +
    2773 module function mtx_rank_cmplx(a, tol, work, olwork, rwork, err) result(rnk)
    +
    2774 complex(real64), intent(inout), dimension(:,:) :: a
    +
    2775 real(real64), intent(in), optional :: tol
    +
    2776 complex(real64), intent(out), target, optional, dimension(:) :: work
    +
    2777 integer(int32), intent(out), optional :: olwork
    +
    2778 real(real64), intent(out), target, optional, dimension(:) :: rwork
    2779 class(errors), intent(inout), optional, target :: err
    -
    2780 end subroutine
    -
    2781
    -
    2782 module subroutine form_lu_all(lu, ipvt, u, p, err)
    -
    2783 real(real64), intent(inout), dimension(:,:) :: lu
    -
    2784 integer(int32), intent(in), dimension(:) :: ipvt
    -
    2785 real(real64), intent(out), dimension(:,:) :: u, p
    +
    2780 integer(int32) :: rnk
    +
    2781 end function
    +
    2782
    +
    2783 module function det_dbl(a, iwork, err) result(x)
    +
    2784 real(real64), intent(inout), dimension(:,:) :: a
    +
    2785 integer(int32), intent(out), target, optional, dimension(:) :: iwork
    2786 class(errors), intent(inout), optional, target :: err
    -
    2787 end subroutine
    -
    2788
    -
    2789 module subroutine form_lu_all_cmplx(lu, ipvt, u, p, err)
    -
    2790 complex(real64), intent(inout), dimension(:,:) :: lu
    -
    2791 integer(int32), intent(in), dimension(:) :: ipvt
    -
    2792 complex(real64), intent(out), dimension(:,:) :: u
    -
    2793 real(real64), intent(out), dimension(:,:) :: p
    -
    2794 class(errors), intent(inout), optional, target :: err
    -
    2795 end subroutine
    +
    2787 real(real64) :: x
    +
    2788 end function
    +
    2789
    +
    2790 module function det_cmplx(a, iwork, err) result(x)
    +
    2791 complex(real64), intent(inout), dimension(:,:) :: a
    +
    2792 integer(int32), intent(out), target, optional, dimension(:) :: iwork
    +
    2793 class(errors), intent(inout), optional, target :: err
    +
    2794 complex(real64) :: x
    +
    2795 end function
    2796
    -
    2797 module subroutine form_lu_only(lu, u, err)
    -
    2798 real(real64), intent(inout), dimension(:,:) :: lu
    -
    2799 real(real64), intent(out), dimension(:,:) :: u
    -
    2800 class(errors), intent(inout), optional, target :: err
    -
    2801 end subroutine
    -
    2802
    -
    2803 module subroutine form_lu_only_cmplx(lu, u, err)
    -
    2804 complex(real64), intent(inout), dimension(:,:) :: lu
    -
    2805 complex(real64), intent(out), dimension(:,:) :: u
    -
    2806 class(errors), intent(inout), optional, target :: err
    -
    2807 end subroutine
    -
    2808
    -
    2809 module subroutine qr_factor_no_pivot(a, tau, work, olwork, err)
    -
    2810 real(real64), intent(inout), dimension(:,:) :: a
    -
    2811 real(real64), intent(out), dimension(:) :: tau
    -
    2812 real(real64), intent(out), target, dimension(:), optional :: work
    -
    2813 integer(int32), intent(out), optional :: olwork
    -
    2814 class(errors), intent(inout), optional, target :: err
    -
    2815 end subroutine
    -
    2816
    -
    2817 module subroutine qr_factor_no_pivot_cmplx(a, tau, work, olwork, err)
    -
    2818 complex(real64), intent(inout), dimension(:,:) :: a
    -
    2819 complex(real64), intent(out), dimension(:) :: tau
    -
    2820 complex(real64), intent(out), target, dimension(:), optional :: work
    -
    2821 integer(int32), intent(out), optional :: olwork
    -
    2822 class(errors), intent(inout), optional, target :: err
    -
    2823 end subroutine
    -
    2824
    -
    2825 module subroutine qr_factor_pivot(a, tau, jpvt, work, olwork, err)
    -
    2826 real(real64), intent(inout), dimension(:,:) :: a
    -
    2827 real(real64), intent(out), dimension(:) :: tau
    -
    2828 integer(int32), intent(inout), dimension(:) :: jpvt
    -
    2829 real(real64), intent(out), target, dimension(:), optional :: work
    -
    2830 integer(int32), intent(out), optional :: olwork
    -
    2831 class(errors), intent(inout), optional, target :: err
    -
    2832 end subroutine
    -
    2833
    -
    2834 module subroutine qr_factor_pivot_cmplx(a, tau, jpvt, work, olwork, rwork, &
    -
    2835 err)
    -
    2836 complex(real64), intent(inout), dimension(:,:) :: a
    -
    2837 complex(real64), intent(out), dimension(:) :: tau
    -
    2838 integer(int32), intent(inout), dimension(:) :: jpvt
    -
    2839 complex(real64), intent(out), target, dimension(:), optional :: work
    -
    2840 integer(int32), intent(out), optional :: olwork
    -
    2841 real(real64), intent(out), target, dimension(:), optional :: rwork
    -
    2842 class(errors), intent(inout), optional, target :: err
    -
    2843 end subroutine
    -
    2844
    -
    2845 module subroutine form_qr_no_pivot(r, tau, q, work, olwork, err)
    -
    2846 real(real64), intent(inout), dimension(:,:) :: r
    -
    2847 real(real64), intent(in), dimension(:) :: tau
    -
    2848 real(real64), intent(out), dimension(:,:) :: q
    -
    2849 real(real64), intent(out), target, dimension(:), optional :: work
    -
    2850 integer(int32), intent(out), optional :: olwork
    -
    2851 class(errors), intent(inout), optional, target :: err
    -
    2852 end subroutine
    -
    2853
    -
    2854 module subroutine form_qr_no_pivot_cmplx(r, tau, q, work, olwork, err)
    -
    2855 complex(real64), intent(inout), dimension(:,:) :: r
    -
    2856 complex(real64), intent(in), dimension(:) :: tau
    -
    2857 complex(real64), intent(out), dimension(:,:) :: q
    -
    2858 complex(real64), intent(out), target, dimension(:), optional :: work
    -
    2859 integer(int32), intent(out), optional :: olwork
    -
    2860 class(errors), intent(inout), optional, target :: err
    -
    2861 end subroutine
    -
    2862
    -
    2863 module subroutine form_qr_pivot(r, tau, pvt, q, p, work, olwork, err)
    -
    2864 real(real64), intent(inout), dimension(:,:) :: r
    -
    2865 real(real64), intent(in), dimension(:) :: tau
    -
    2866 integer(int32), intent(in), dimension(:) :: pvt
    -
    2867 real(real64), intent(out), dimension(:,:) :: q, p
    -
    2868 real(real64), intent(out), target, dimension(:), optional :: work
    -
    2869 integer(int32), intent(out), optional :: olwork
    +
    2797 module subroutine swap_dbl(x, y, err)
    +
    2798 real(real64), intent(inout), dimension(:) :: x, y
    +
    2799 class(errors), intent(inout), optional, target :: err
    +
    2800 end subroutine
    +
    2801
    +
    2802 module subroutine swap_cmplx(x, y, err)
    +
    2803 complex(real64), intent(inout), dimension(:) :: x, y
    +
    2804 class(errors), intent(inout), optional, target :: err
    +
    2805 end subroutine
    +
    2806
    +
    2807 module subroutine recip_mult_array_dbl(a, x)
    +
    2808 real(real64), intent(in) :: a
    +
    2809 real(real64), intent(inout), dimension(:) :: x
    +
    2810 end subroutine
    +
    2811
    +
    2812 module subroutine tri_mtx_mult_dbl(upper, alpha, a, beta, b, err)
    +
    2813 logical, intent(in) :: upper
    +
    2814 real(real64), intent(in) :: alpha, beta
    +
    2815 real(real64), intent(in), dimension(:,:) :: a
    +
    2816 real(real64), intent(inout), dimension(:,:) :: b
    +
    2817 class(errors), intent(inout), optional, target :: err
    +
    2818 end subroutine
    +
    2819
    +
    2820 module subroutine tri_mtx_mult_cmplx(upper, alpha, a, beta, b, err)
    +
    2821 logical, intent(in) :: upper
    +
    2822 complex(real64), intent(in) :: alpha, beta
    +
    2823 complex(real64), intent(in), dimension(:,:) :: a
    +
    2824 complex(real64), intent(inout), dimension(:,:) :: b
    +
    2825 class(errors), intent(inout), optional, target :: err
    +
    2826 end subroutine
    +
    2827
    +
    2828end interface
    +
    2829
    +
    2830! ******************************************************************************
    +
    2831! LINALG_FACTOR.F90
    +
    2832! ------------------------------------------------------------------------------
    +
    2833interface
    +
    2834 module subroutine lu_factor_dbl(a, ipvt, err)
    +
    2835 real(real64), intent(inout), dimension(:,:) :: a
    +
    2836 integer(int32), intent(out), dimension(:) :: ipvt
    +
    2837 class(errors), intent(inout), optional, target :: err
    +
    2838 end subroutine
    +
    2839
    +
    2840 module subroutine lu_factor_cmplx(a, ipvt, err)
    +
    2841 complex(real64), intent(inout), dimension(:,:) :: a
    +
    2842 integer(int32), intent(out), dimension(:) :: ipvt
    +
    2843 class(errors), intent(inout), optional, target :: err
    +
    2844 end subroutine
    +
    2845
    +
    2846 module subroutine form_lu_all(lu, ipvt, u, p, err)
    +
    2847 real(real64), intent(inout), dimension(:,:) :: lu
    +
    2848 integer(int32), intent(in), dimension(:) :: ipvt
    +
    2849 real(real64), intent(out), dimension(:,:) :: u, p
    +
    2850 class(errors), intent(inout), optional, target :: err
    +
    2851 end subroutine
    +
    2852
    +
    2853 module subroutine form_lu_all_cmplx(lu, ipvt, u, p, err)
    +
    2854 complex(real64), intent(inout), dimension(:,:) :: lu
    +
    2855 integer(int32), intent(in), dimension(:) :: ipvt
    +
    2856 complex(real64), intent(out), dimension(:,:) :: u
    +
    2857 real(real64), intent(out), dimension(:,:) :: p
    +
    2858 class(errors), intent(inout), optional, target :: err
    +
    2859 end subroutine
    +
    2860
    +
    2861 module subroutine form_lu_only(lu, u, err)
    +
    2862 real(real64), intent(inout), dimension(:,:) :: lu
    +
    2863 real(real64), intent(out), dimension(:,:) :: u
    +
    2864 class(errors), intent(inout), optional, target :: err
    +
    2865 end subroutine
    +
    2866
    +
    2867 module subroutine form_lu_only_cmplx(lu, u, err)
    +
    2868 complex(real64), intent(inout), dimension(:,:) :: lu
    +
    2869 complex(real64), intent(out), dimension(:,:) :: u
    2870 class(errors), intent(inout), optional, target :: err
    2871 end subroutine
    -
    2872
    -
    2873 module subroutine form_qr_pivot_cmplx(r, tau, pvt, q, p, work, olwork, err)
    -
    2874 complex(real64), intent(inout), dimension(:,:) :: r
    -
    2875 complex(real64), intent(in), dimension(:) :: tau
    -
    2876 integer(int32), intent(in), dimension(:) :: pvt
    -
    2877 complex(real64), intent(out), dimension(:,:) :: q, p
    -
    2878 complex(real64), intent(out), target, dimension(:), optional :: work
    -
    2879 integer(int32), intent(out), optional :: olwork
    -
    2880 class(errors), intent(inout), optional, target :: err
    -
    2881 end subroutine
    -
    2882
    -
    2883 module subroutine mult_qr_mtx(lside, trans, a, tau, c, work, olwork, err)
    -
    2884 logical, intent(in) :: lside, trans
    -
    2885 real(real64), intent(in), dimension(:) :: tau
    -
    2886 real(real64), intent(inout), dimension(:,:) :: a, c
    -
    2887 real(real64), intent(out), target, dimension(:), optional :: work
    -
    2888 integer(int32), intent(out), optional :: olwork
    -
    2889 class(errors), intent(inout), optional, target :: err
    -
    2890 end subroutine
    -
    2891
    -
    2892 module subroutine mult_qr_mtx_cmplx(lside, trans, a, tau, c, work, olwork, err)
    -
    2893 logical, intent(in) :: lside, trans
    -
    2894 complex(real64), intent(in), dimension(:) :: tau
    -
    2895 complex(real64), intent(inout), dimension(:,:) :: a, c
    -
    2896 complex(real64), intent(out), target, dimension(:), optional :: work
    -
    2897 integer(int32), intent(out), optional :: olwork
    -
    2898 class(errors), intent(inout), optional, target :: err
    -
    2899 end subroutine
    -
    2900
    -
    2901 module subroutine mult_qr_vec(trans, a, tau, c, work, olwork, err)
    -
    2902 logical, intent(in) :: trans
    -
    2903 real(real64), intent(inout), dimension(:,:) :: a
    -
    2904 real(real64), intent(in), dimension(:) :: tau
    -
    2905 real(real64), intent(inout), dimension(:) :: c
    -
    2906 real(real64), intent(out), target, dimension(:), optional :: work
    -
    2907 integer(int32), intent(out), optional :: olwork
    -
    2908 class(errors), intent(inout), optional, target :: err
    -
    2909 end subroutine
    -
    2910
    -
    2911 module subroutine mult_qr_vec_cmplx(trans, a, tau, c, work, olwork, err)
    -
    2912 logical, intent(in) :: trans
    -
    2913 complex(real64), intent(inout), dimension(:,:) :: a
    -
    2914 complex(real64), intent(in), dimension(:) :: tau
    -
    2915 complex(real64), intent(inout), dimension(:) :: c
    -
    2916 complex(real64), intent(out), target, dimension(:), optional :: work
    -
    2917 integer(int32), intent(out), optional :: olwork
    -
    2918 class(errors), intent(inout), optional, target :: err
    -
    2919 end subroutine
    -
    2920
    -
    2921 module subroutine qr_rank1_update_dbl(q, r, u, v, work, err)
    -
    2922 real(real64), intent(inout), dimension(:,:) :: q, r
    -
    2923 real(real64), intent(inout), dimension(:) :: u, v
    -
    2924 real(real64), intent(out), target, optional, dimension(:) :: work
    -
    2925 class(errors), intent(inout), optional, target :: err
    -
    2926 end subroutine
    -
    2927
    -
    2928 module subroutine qr_rank1_update_cmplx(q, r, u, v, work, rwork, err)
    -
    2929 complex(real64), intent(inout), dimension(:,:) :: q, r
    -
    2930 complex(real64), intent(inout), dimension(:) :: u, v
    -
    2931 complex(real64), intent(out), target, optional, dimension(:) :: work
    -
    2932 real(real64), intent(out), target, optional, dimension(:) :: rwork
    -
    2933 class(errors), intent(inout), optional, target :: err
    -
    2934 end subroutine
    -
    2935
    -
    2936 module subroutine cholesky_factor_dbl(a, upper, err)
    -
    2937 real(real64), intent(inout), dimension(:,:) :: a
    -
    2938 logical, intent(in), optional :: upper
    -
    2939 class(errors), intent(inout), optional, target :: err
    -
    2940 end subroutine
    -
    2941
    -
    2942 module subroutine cholesky_factor_cmplx(a, upper, err)
    -
    2943 complex(real64), intent(inout), dimension(:,:) :: a
    -
    2944 logical, intent(in), optional :: upper
    -
    2945 class(errors), intent(inout), optional, target :: err
    -
    2946 end subroutine
    -
    2947
    -
    2948 module subroutine cholesky_rank1_update_dbl(r, u, work, err)
    -
    2949 real(real64), intent(inout), dimension(:,:) :: r
    -
    2950 real(real64), intent(inout), dimension(:) :: u
    -
    2951 real(real64), intent(out), target, optional, dimension(:) :: work
    -
    2952 class(errors), intent(inout), optional, target :: err
    -
    2953 end subroutine
    -
    2954
    -
    2955 module subroutine cholesky_rank1_update_cmplx(r, u, work, err)
    -
    2956 complex(real64), intent(inout), dimension(:,:) :: r
    -
    2957 complex(real64), intent(inout), dimension(:) :: u
    -
    2958 real(real64), intent(out), target, optional, dimension(:) :: work
    -
    2959 class(errors), intent(inout), optional, target :: err
    -
    2960 end subroutine
    -
    2961
    -
    2962 module subroutine cholesky_rank1_downdate_dbl(r, u, work, err)
    -
    2963 real(real64), intent(inout), dimension(:,:) :: r
    -
    2964 real(real64), intent(inout), dimension(:) :: u
    -
    2965 real(real64), intent(out), target, optional, dimension(:) :: work
    -
    2966 class(errors), intent(inout), optional, target :: err
    -
    2967 end subroutine
    -
    2968
    -
    2969 module subroutine cholesky_rank1_downdate_cmplx(r, u, work, err)
    -
    2970 complex(real64), intent(inout), dimension(:,:) :: r
    -
    2971 complex(real64), intent(inout), dimension(:) :: u
    -
    2972 real(real64), intent(out), target, optional, dimension(:) :: work
    -
    2973 class(errors), intent(inout), optional, target :: err
    -
    2974 end subroutine
    -
    2975
    -
    2976 module subroutine rz_factor_dbl(a, tau, work, olwork, err)
    -
    2977 real(real64), intent(inout), dimension(:,:) :: a
    -
    2978 real(real64), intent(out), dimension(:) :: tau
    -
    2979 real(real64), intent(out), target, optional, dimension(:) :: work
    -
    2980 integer(int32), intent(out), optional :: olwork
    -
    2981 class(errors), intent(inout), optional, target :: err
    -
    2982 end subroutine
    -
    2983
    -
    2984 module subroutine rz_factor_cmplx(a, tau, work, olwork, err)
    -
    2985 complex(real64), intent(inout), dimension(:,:) :: a
    -
    2986 complex(real64), intent(out), dimension(:) :: tau
    -
    2987 complex(real64), intent(out), target, optional, dimension(:) :: work
    -
    2988 integer(int32), intent(out), optional :: olwork
    +
    2872
    +
    2873 module subroutine qr_factor_no_pivot(a, tau, work, olwork, err)
    +
    2874 real(real64), intent(inout), dimension(:,:) :: a
    +
    2875 real(real64), intent(out), dimension(:) :: tau
    +
    2876 real(real64), intent(out), target, dimension(:), optional :: work
    +
    2877 integer(int32), intent(out), optional :: olwork
    +
    2878 class(errors), intent(inout), optional, target :: err
    +
    2879 end subroutine
    +
    2880
    +
    2881 module subroutine qr_factor_no_pivot_cmplx(a, tau, work, olwork, err)
    +
    2882 complex(real64), intent(inout), dimension(:,:) :: a
    +
    2883 complex(real64), intent(out), dimension(:) :: tau
    +
    2884 complex(real64), intent(out), target, dimension(:), optional :: work
    +
    2885 integer(int32), intent(out), optional :: olwork
    +
    2886 class(errors), intent(inout), optional, target :: err
    +
    2887 end subroutine
    +
    2888
    +
    2889 module subroutine qr_factor_pivot(a, tau, jpvt, work, olwork, err)
    +
    2890 real(real64), intent(inout), dimension(:,:) :: a
    +
    2891 real(real64), intent(out), dimension(:) :: tau
    +
    2892 integer(int32), intent(inout), dimension(:) :: jpvt
    +
    2893 real(real64), intent(out), target, dimension(:), optional :: work
    +
    2894 integer(int32), intent(out), optional :: olwork
    +
    2895 class(errors), intent(inout), optional, target :: err
    +
    2896 end subroutine
    +
    2897
    +
    2898 module subroutine qr_factor_pivot_cmplx(a, tau, jpvt, work, olwork, rwork, &
    +
    2899 err)
    +
    2900 complex(real64), intent(inout), dimension(:,:) :: a
    +
    2901 complex(real64), intent(out), dimension(:) :: tau
    +
    2902 integer(int32), intent(inout), dimension(:) :: jpvt
    +
    2903 complex(real64), intent(out), target, dimension(:), optional :: work
    +
    2904 integer(int32), intent(out), optional :: olwork
    +
    2905 real(real64), intent(out), target, dimension(:), optional :: rwork
    +
    2906 class(errors), intent(inout), optional, target :: err
    +
    2907 end subroutine
    +
    2908
    +
    2909 module subroutine form_qr_no_pivot(r, tau, q, work, olwork, err)
    +
    2910 real(real64), intent(inout), dimension(:,:) :: r
    +
    2911 real(real64), intent(in), dimension(:) :: tau
    +
    2912 real(real64), intent(out), dimension(:,:) :: q
    +
    2913 real(real64), intent(out), target, dimension(:), optional :: work
    +
    2914 integer(int32), intent(out), optional :: olwork
    +
    2915 class(errors), intent(inout), optional, target :: err
    +
    2916 end subroutine
    +
    2917
    +
    2918 module subroutine form_qr_no_pivot_cmplx(r, tau, q, work, olwork, err)
    +
    2919 complex(real64), intent(inout), dimension(:,:) :: r
    +
    2920 complex(real64), intent(in), dimension(:) :: tau
    +
    2921 complex(real64), intent(out), dimension(:,:) :: q
    +
    2922 complex(real64), intent(out), target, dimension(:), optional :: work
    +
    2923 integer(int32), intent(out), optional :: olwork
    +
    2924 class(errors), intent(inout), optional, target :: err
    +
    2925 end subroutine
    +
    2926
    +
    2927 module subroutine form_qr_pivot(r, tau, pvt, q, p, work, olwork, err)
    +
    2928 real(real64), intent(inout), dimension(:,:) :: r
    +
    2929 real(real64), intent(in), dimension(:) :: tau
    +
    2930 integer(int32), intent(in), dimension(:) :: pvt
    +
    2931 real(real64), intent(out), dimension(:,:) :: q, p
    +
    2932 real(real64), intent(out), target, dimension(:), optional :: work
    +
    2933 integer(int32), intent(out), optional :: olwork
    +
    2934 class(errors), intent(inout), optional, target :: err
    +
    2935 end subroutine
    +
    2936
    +
    2937 module subroutine form_qr_pivot_cmplx(r, tau, pvt, q, p, work, olwork, err)
    +
    2938 complex(real64), intent(inout), dimension(:,:) :: r
    +
    2939 complex(real64), intent(in), dimension(:) :: tau
    +
    2940 integer(int32), intent(in), dimension(:) :: pvt
    +
    2941 complex(real64), intent(out), dimension(:,:) :: q, p
    +
    2942 complex(real64), intent(out), target, dimension(:), optional :: work
    +
    2943 integer(int32), intent(out), optional :: olwork
    +
    2944 class(errors), intent(inout), optional, target :: err
    +
    2945 end subroutine
    +
    2946
    +
    2947 module subroutine mult_qr_mtx(lside, trans, a, tau, c, work, olwork, err)
    +
    2948 logical, intent(in) :: lside, trans
    +
    2949 real(real64), intent(in), dimension(:) :: tau
    +
    2950 real(real64), intent(inout), dimension(:,:) :: a, c
    +
    2951 real(real64), intent(out), target, dimension(:), optional :: work
    +
    2952 integer(int32), intent(out), optional :: olwork
    +
    2953 class(errors), intent(inout), optional, target :: err
    +
    2954 end subroutine
    +
    2955
    +
    2956 module subroutine mult_qr_mtx_cmplx(lside, trans, a, tau, c, work, olwork, err)
    +
    2957 logical, intent(in) :: lside, trans
    +
    2958 complex(real64), intent(in), dimension(:) :: tau
    +
    2959 complex(real64), intent(inout), dimension(:,:) :: a, c
    +
    2960 complex(real64), intent(out), target, dimension(:), optional :: work
    +
    2961 integer(int32), intent(out), optional :: olwork
    +
    2962 class(errors), intent(inout), optional, target :: err
    +
    2963 end subroutine
    +
    2964
    +
    2965 module subroutine mult_qr_vec(trans, a, tau, c, work, olwork, err)
    +
    2966 logical, intent(in) :: trans
    +
    2967 real(real64), intent(inout), dimension(:,:) :: a
    +
    2968 real(real64), intent(in), dimension(:) :: tau
    +
    2969 real(real64), intent(inout), dimension(:) :: c
    +
    2970 real(real64), intent(out), target, dimension(:), optional :: work
    +
    2971 integer(int32), intent(out), optional :: olwork
    +
    2972 class(errors), intent(inout), optional, target :: err
    +
    2973 end subroutine
    +
    2974
    +
    2975 module subroutine mult_qr_vec_cmplx(trans, a, tau, c, work, olwork, err)
    +
    2976 logical, intent(in) :: trans
    +
    2977 complex(real64), intent(inout), dimension(:,:) :: a
    +
    2978 complex(real64), intent(in), dimension(:) :: tau
    +
    2979 complex(real64), intent(inout), dimension(:) :: c
    +
    2980 complex(real64), intent(out), target, dimension(:), optional :: work
    +
    2981 integer(int32), intent(out), optional :: olwork
    +
    2982 class(errors), intent(inout), optional, target :: err
    +
    2983 end subroutine
    +
    2984
    +
    2985 module subroutine qr_rank1_update_dbl(q, r, u, v, work, err)
    +
    2986 real(real64), intent(inout), dimension(:,:) :: q, r
    +
    2987 real(real64), intent(inout), dimension(:) :: u, v
    +
    2988 real(real64), intent(out), target, optional, dimension(:) :: work
    2989 class(errors), intent(inout), optional, target :: err
    2990 end subroutine
    2991
    -
    2992 module subroutine mult_rz_mtx(lside, trans, l, a, tau, c, work, olwork, err)
    -
    2993 logical, intent(in) :: lside, trans
    -
    2994 integer(int32), intent(in) :: l
    -
    2995 real(real64), intent(inout), dimension(:,:) :: a, c
    -
    2996 real(real64), intent(in), dimension(:) :: tau
    -
    2997 real(real64), intent(out), target, optional, dimension(:) :: work
    -
    2998 integer(int32), intent(out), optional :: olwork
    -
    2999 class(errors), intent(inout), optional, target :: err
    -
    3000 end subroutine
    -
    3001
    -
    3002 module subroutine mult_rz_mtx_cmplx(lside, trans, l, a, tau, c, work, olwork, err)
    -
    3003 logical, intent(in) :: lside, trans
    -
    3004 integer(int32), intent(in) :: l
    -
    3005 complex(real64), intent(inout), dimension(:,:) :: a, c
    -
    3006 complex(real64), intent(in), dimension(:) :: tau
    -
    3007 complex(real64), intent(out), target, optional, dimension(:) :: work
    -
    3008 integer(int32), intent(out), optional :: olwork
    +
    2992 module subroutine qr_rank1_update_cmplx(q, r, u, v, work, rwork, err)
    +
    2993 complex(real64), intent(inout), dimension(:,:) :: q, r
    +
    2994 complex(real64), intent(inout), dimension(:) :: u, v
    +
    2995 complex(real64), intent(out), target, optional, dimension(:) :: work
    +
    2996 real(real64), intent(out), target, optional, dimension(:) :: rwork
    +
    2997 class(errors), intent(inout), optional, target :: err
    +
    2998 end subroutine
    +
    2999
    +
    3000 module subroutine cholesky_factor_dbl(a, upper, err)
    +
    3001 real(real64), intent(inout), dimension(:,:) :: a
    +
    3002 logical, intent(in), optional :: upper
    +
    3003 class(errors), intent(inout), optional, target :: err
    +
    3004 end subroutine
    +
    3005
    +
    3006 module subroutine cholesky_factor_cmplx(a, upper, err)
    +
    3007 complex(real64), intent(inout), dimension(:,:) :: a
    +
    3008 logical, intent(in), optional :: upper
    3009 class(errors), intent(inout), optional, target :: err
    3010 end subroutine
    -
    3011
    -
    3012 module subroutine mult_rz_vec(trans, l, a, tau, c, work, olwork, err)
    -
    3013 logical, intent(in) :: trans
    -
    3014 integer(int32), intent(in) :: l
    -
    3015 real(real64), intent(inout), dimension(:,:) :: a
    -
    3016 real(real64), intent(in), dimension(:) :: tau
    -
    3017 real(real64), intent(inout), dimension(:) :: c
    -
    3018 real(real64), intent(out), target, optional, dimension(:) :: work
    -
    3019 integer(int32), intent(out), optional :: olwork
    -
    3020 class(errors), intent(inout), optional, target :: err
    -
    3021 end subroutine
    -
    3022
    -
    3023 module subroutine mult_rz_vec_cmplx(trans, l, a, tau, c, work, olwork, err)
    -
    3024 logical, intent(in) :: trans
    -
    3025 integer(int32), intent(in) :: l
    -
    3026 complex(real64), intent(inout), dimension(:,:) :: a
    -
    3027 complex(real64), intent(in), dimension(:) :: tau
    -
    3028 complex(real64), intent(inout), dimension(:) :: c
    -
    3029 complex(real64), intent(out), target, optional, dimension(:) :: work
    -
    3030 integer(int32), intent(out), optional :: olwork
    -
    3031 class(errors), intent(inout), optional, target :: err
    -
    3032 end subroutine
    -
    3033
    -
    3076 module subroutine svd_dbl(a, s, u, vt, work, olwork, err)
    -
    3077 real(real64), intent(inout), dimension(:,:) :: a
    -
    3078 real(real64), intent(out), dimension(:) :: s
    -
    3079 real(real64), intent(out), optional, dimension(:,:) :: u, vt
    -
    3080 real(real64), intent(out), target, optional, dimension(:) :: work
    -
    3081 integer(int32), intent(out), optional :: olwork
    -
    3082 class(errors), intent(inout), optional, target :: err
    -
    3083 end subroutine
    -
    3084
    -
    3131 module subroutine svd_cmplx(a, s, u, vt, work, olwork, rwork, err)
    -
    3132 complex(real64), intent(inout), dimension(:,:) :: a
    -
    3133 real(real64), intent(out), dimension(:) :: s
    -
    3134 complex(real64), intent(out), optional, dimension(:,:) :: u, vt
    -
    3135 complex(real64), intent(out), target, optional, dimension(:) :: work
    -
    3136 integer(int32), intent(out), optional :: olwork
    -
    3137 real(real64), intent(out), target, optional, dimension(:) :: rwork
    -
    3138 class(errors), intent(inout), optional, target :: err
    -
    3139 end subroutine
    -
    3140end interface
    -
    3141
    -
    3142! ******************************************************************************
    -
    3143! LINALG_SOLVE.F90
    -
    3144! ------------------------------------------------------------------------------
    -
    3145interface
    -
    3146
    -
    3174 module subroutine solve_tri_mtx(lside, upper, trans, nounit, alpha, a, b, err)
    -
    3175 logical, intent(in) :: lside, upper, trans, nounit
    -
    3176 real(real64), intent(in) :: alpha
    -
    3177 real(real64), intent(in), dimension(:,:) :: a
    -
    3178 real(real64), intent(inout), dimension(:,:) :: b
    -
    3179 class(errors), intent(inout), optional, target :: err
    -
    3180 end subroutine
    -
    3181
    -
    3210 module subroutine solve_tri_mtx_cmplx(lside, upper, trans, nounit, alpha, a, b, err)
    -
    3211 logical, intent(in) :: lside, upper, trans, nounit
    -
    3212 complex(real64), intent(in) :: alpha
    -
    3213 complex(real64), intent(in), dimension(:,:) :: a
    -
    3214 complex(real64), intent(inout), dimension(:,:) :: b
    -
    3215 class(errors), intent(inout), optional, target :: err
    -
    3216 end subroutine
    -
    3217
    -
    3262 module subroutine solve_tri_vec(upper, trans, nounit, a, x, err)
    -
    3263 logical, intent(in) :: upper, trans, nounit
    -
    3264 real(real64), intent(in), dimension(:,:) :: a
    -
    3265 real(real64), intent(inout), dimension(:) :: x
    -
    3266 class(errors), intent(inout), optional, target :: err
    -
    3267 end subroutine
    -
    3268
    -
    3313 module subroutine solve_tri_vec_cmplx(upper, trans, nounit, a, x, err)
    -
    3314 logical, intent(in) :: upper, trans, nounit
    -
    3315 complex(real64), intent(in), dimension(:,:) :: a
    -
    3316 complex(real64), intent(inout), dimension(:) :: x
    -
    3317 class(errors), intent(inout), optional, target :: err
    -
    3318 end subroutine
    -
    3319
    -
    3336 module subroutine solve_lu_mtx(a, ipvt, b, err)
    -
    3337 real(real64), intent(in), dimension(:,:) :: a
    -
    3338 integer(int32), intent(in), dimension(:) :: ipvt
    -
    3339 real(real64), intent(inout), dimension(:,:) :: b
    -
    3340 class(errors), intent(inout), optional, target :: err
    -
    3341 end subroutine
    -
    3342
    -
    3359 module subroutine solve_lu_mtx_cmplx(a, ipvt, b, err)
    -
    3360 complex(real64), intent(in), dimension(:,:) :: a
    -
    3361 integer(int32), intent(in), dimension(:) :: ipvt
    -
    3362 complex(real64), intent(inout), dimension(:,:) :: b
    -
    3363 class(errors), intent(inout), optional, target :: err
    -
    3364 end subroutine
    -
    3365
    -
    3382 module subroutine solve_lu_vec(a, ipvt, b, err)
    -
    3383 real(real64), intent(in), dimension(:,:) :: a
    -
    3384 integer(int32), intent(in), dimension(:) :: ipvt
    -
    3385 real(real64), intent(inout), dimension(:) :: b
    -
    3386 class(errors), intent(inout), optional, target :: err
    -
    3387 end subroutine
    -
    3388
    -
    3405 module subroutine solve_lu_vec_cmplx(a, ipvt, b, err)
    -
    3406 complex(real64), intent(in), dimension(:,:) :: a
    -
    3407 integer(int32), intent(in), dimension(:) :: ipvt
    -
    3408 complex(real64), intent(inout), dimension(:) :: b
    -
    3409 class(errors), intent(inout), optional, target :: err
    -
    3410 end subroutine
    -
    3411
    -
    3441 module subroutine solve_qr_no_pivot_mtx(a, tau, b, work, olwork, err)
    -
    3442 real(real64), intent(inout), dimension(:,:) :: a, b
    -
    3443 real(real64), intent(in), dimension(:) :: tau
    -
    3444 real(real64), intent(out), target, optional, dimension(:) :: work
    -
    3445 integer(int32), intent(out), optional :: olwork
    -
    3446 class(errors), intent(inout), optional, target :: err
    -
    3447 end subroutine
    -
    3448
    -
    3478 module subroutine solve_qr_no_pivot_mtx_cmplx(a, tau, b, work, olwork, err)
    -
    3479 complex(real64), intent(inout), dimension(:,:) :: a, b
    -
    3480 complex(real64), intent(in), dimension(:) :: tau
    -
    3481 complex(real64), intent(out), target, optional, dimension(:) :: work
    -
    3482 integer(int32), intent(out), optional :: olwork
    -
    3483 class(errors), intent(inout), optional, target :: err
    -
    3484 end subroutine
    -
    3485
    -
    3515 module subroutine solve_qr_no_pivot_vec(a, tau, b, work, olwork, err)
    -
    3516 real(real64), intent(inout), dimension(:,:) :: a
    -
    3517 real(real64), intent(in), dimension(:) :: tau
    -
    3518 real(real64), intent(inout), dimension(:) :: b
    -
    3519 real(real64), intent(out), target, optional, dimension(:) :: work
    -
    3520 integer(int32), intent(out), optional :: olwork
    -
    3521 class(errors), intent(inout), optional, target :: err
    -
    3522 end subroutine
    -
    3523
    -
    3553 module subroutine solve_qr_no_pivot_vec_cmplx(a, tau, b, work, olwork, err)
    -
    3554 complex(real64), intent(inout), dimension(:,:) :: a
    -
    3555 complex(real64), intent(in), dimension(:) :: tau
    -
    3556 complex(real64), intent(inout), dimension(:) :: b
    -
    3557 complex(real64), intent(out), target, optional, dimension(:) :: work
    -
    3558 integer(int32), intent(out), optional :: olwork
    -
    3559 class(errors), intent(inout), optional, target :: err
    -
    3560 end subroutine
    -
    3561
    -
    3593 module subroutine solve_qr_pivot_mtx(a, tau, jpvt, b, work, olwork, err)
    -
    3594 real(real64), intent(inout), dimension(:,:) :: a
    -
    3595 real(real64), intent(in), dimension(:) :: tau
    -
    3596 integer(int32), intent(in), dimension(:) :: jpvt
    -
    3597 real(real64), intent(inout), dimension(:,:) :: b
    -
    3598 real(real64), intent(out), target, optional, dimension(:) :: work
    -
    3599 integer(int32), intent(out), optional :: olwork
    -
    3600 class(errors), intent(inout), optional, target :: err
    -
    3601 end subroutine
    -
    3602
    -
    3634 module subroutine solve_qr_pivot_mtx_cmplx(a, tau, jpvt, b, work, olwork, err)
    -
    3635 complex(real64), intent(inout), dimension(:,:) :: a
    -
    3636 complex(real64), intent(in), dimension(:) :: tau
    -
    3637 integer(int32), intent(in), dimension(:) :: jpvt
    -
    3638 complex(real64), intent(inout), dimension(:,:) :: b
    -
    3639 complex(real64), intent(out), target, optional, dimension(:) :: work
    -
    3640 integer(int32), intent(out), optional :: olwork
    -
    3641 class(errors), intent(inout), optional, target :: err
    -
    3642 end subroutine
    -
    3643
    -
    3675 module subroutine solve_qr_pivot_vec(a, tau, jpvt, b, work, olwork, err)
    -
    3676 real(real64), intent(inout), dimension(:,:) :: a
    -
    3677 real(real64), intent(in), dimension(:) :: tau
    -
    3678 integer(int32), intent(in), dimension(:) :: jpvt
    -
    3679 real(real64), intent(inout), dimension(:) :: b
    -
    3680 real(real64), intent(out), target, optional, dimension(:) :: work
    -
    3681 integer(int32), intent(out), optional :: olwork
    -
    3682 class(errors), intent(inout), optional, target :: err
    -
    3683 end subroutine
    -
    3684
    -
    3716 module subroutine solve_qr_pivot_vec_cmplx(a, tau, jpvt, b, work, olwork, err)
    -
    3717 complex(real64), intent(inout), dimension(:,:) :: a
    -
    3718 complex(real64), intent(in), dimension(:) :: tau
    -
    3719 integer(int32), intent(in), dimension(:) :: jpvt
    -
    3720 complex(real64), intent(inout), dimension(:) :: b
    -
    3721 complex(real64), intent(out), target, optional, dimension(:) :: work
    -
    3722 integer(int32), intent(out), optional :: olwork
    -
    3723 class(errors), intent(inout), optional, target :: err
    -
    3724 end subroutine
    -
    3725
    -
    3744 module subroutine solve_cholesky_mtx(upper, a, b, err)
    -
    3745 logical, intent(in) :: upper
    -
    3746 real(real64), intent(in), dimension(:,:) :: a
    -
    3747 real(real64), intent(inout), dimension(:,:) :: b
    -
    3748 class(errors), intent(inout), optional, target :: err
    -
    3749 end subroutine
    -
    3750
    -
    3769 module subroutine solve_cholesky_mtx_cmplx(upper, a, b, err)
    -
    3770 logical, intent(in) :: upper
    -
    3771 complex(real64), intent(in), dimension(:,:) :: a
    -
    3772 complex(real64), intent(inout), dimension(:,:) :: b
    -
    3773 class(errors), intent(inout), optional, target :: err
    -
    3774 end subroutine
    -
    3775
    -
    3794 module subroutine solve_cholesky_vec(upper, a, b, err)
    -
    3795 logical, intent(in) :: upper
    -
    3796 real(real64), intent(in), dimension(:,:) :: a
    -
    3797 real(real64), intent(inout), dimension(:) :: b
    -
    3798 class(errors), intent(inout), optional, target :: err
    -
    3799 end subroutine
    -
    3800
    -
    3819 module subroutine solve_cholesky_vec_cmplx(upper, a, b, err)
    -
    3820 logical, intent(in) :: upper
    -
    3821 complex(real64), intent(in), dimension(:,:) :: a
    -
    3822 complex(real64), intent(inout), dimension(:) :: b
    -
    3823 class(errors), intent(inout), optional, target :: err
    -
    3824 end subroutine
    -
    3825
    -
    3857 module subroutine solve_least_squares_mtx(a, b, work, olwork, err)
    -
    3858 real(real64), intent(inout), dimension(:,:) :: a, b
    -
    3859 real(real64), intent(out), target, optional, dimension(:) :: work
    -
    3860 integer(int32), intent(out), optional :: olwork
    -
    3861 class(errors), intent(inout), optional, target :: err
    -
    3862 end subroutine
    -
    3863
    -
    3895 module subroutine solve_least_squares_mtx_cmplx(a, b, work, olwork, err)
    -
    3896 complex(real64), intent(inout), dimension(:,:) :: a, b
    -
    3897 complex(real64), intent(out), target, optional, dimension(:) :: work
    -
    3898 integer(int32), intent(out), optional :: olwork
    -
    3899 class(errors), intent(inout), optional, target :: err
    -
    3900 end subroutine
    -
    3901
    -
    3933 module subroutine solve_least_squares_vec(a, b, work, olwork, err)
    -
    3934 real(real64), intent(inout), dimension(:,:) :: a
    -
    3935 real(real64), intent(inout), dimension(:) :: b
    -
    3936 real(real64), intent(out), target, optional, dimension(:) :: work
    -
    3937 integer(int32), intent(out), optional :: olwork
    -
    3938 class(errors), intent(inout), optional, target :: err
    -
    3939 end subroutine
    -
    3940
    -
    3972 module subroutine solve_least_squares_vec_cmplx(a, b, work, olwork, err)
    -
    3973 complex(real64), intent(inout), dimension(:,:) :: a
    -
    3974 complex(real64), intent(inout), dimension(:) :: b
    -
    3975 complex(real64), intent(out), target, optional, dimension(:) :: work
    -
    3976 integer(int32), intent(out), optional :: olwork
    -
    3977 class(errors), intent(inout), optional, target :: err
    -
    3978 end subroutine
    -
    3979
    -
    4017 module subroutine solve_least_squares_mtx_pvt(a, b, ipvt, arnk, work, olwork, err)
    -
    4018 real(real64), intent(inout), dimension(:,:) :: a, b
    -
    4019 integer(int32), intent(inout), target, optional, dimension(:) :: ipvt
    -
    4020 integer(int32), intent(out), optional :: arnk
    -
    4021 real(real64), intent(out), target, optional, dimension(:) :: work
    -
    4022 integer(int32), intent(out), optional :: olwork
    -
    4023 class(errors), intent(inout), optional, target :: err
    -
    4024 end subroutine
    -
    4025
    -
    4067 module subroutine solve_least_squares_mtx_pvt_cmplx(a, b, ipvt, arnk, &
    -
    4068 work, olwork, rwork, err)
    -
    4069 complex(real64), intent(inout), dimension(:,:) :: a, b
    -
    4070 integer(int32), intent(inout), target, optional, dimension(:) :: ipvt
    -
    4071 integer(int32), intent(out), optional :: arnk
    -
    4072 complex(real64), intent(out), target, optional, dimension(:) :: work
    -
    4073 integer(int32), intent(out), optional :: olwork
    -
    4074 real(real64), intent(out), target, optional, dimension(:) :: rwork
    -
    4075 class(errors), intent(inout), optional, target :: err
    -
    4076 end subroutine
    -
    4077
    -
    4115 module subroutine solve_least_squares_vec_pvt(a, b, ipvt, arnk, work, olwork, err)
    -
    4116 real(real64), intent(inout), dimension(:,:) :: a
    -
    4117 real(real64), intent(inout), dimension(:) :: b
    -
    4118 integer(int32), intent(inout), target, optional, dimension(:) :: ipvt
    -
    4119 integer(int32), intent(out), optional :: arnk
    -
    4120 real(real64), intent(out), target, optional, dimension(:) :: work
    -
    4121 integer(int32), intent(out), optional :: olwork
    -
    4122 class(errors), intent(inout), optional, target :: err
    -
    4123 end subroutine
    -
    4124
    -
    4166 module subroutine solve_least_squares_vec_pvt_cmplx(a, b, ipvt, arnk, &
    -
    4167 work, olwork, rwork, err)
    -
    4168 complex(real64), intent(inout), dimension(:,:) :: a
    -
    4169 complex(real64), intent(inout), dimension(:) :: b
    -
    4170 integer(int32), intent(inout), target, optional, dimension(:) :: ipvt
    -
    4171 integer(int32), intent(out), optional :: arnk
    -
    4172 complex(real64), intent(out), target, optional, dimension(:) :: work
    -
    4173 integer(int32), intent(out), optional :: olwork
    -
    4174 real(real64), intent(out), target, optional, dimension(:) :: rwork
    -
    4175 class(errors), intent(inout), optional, target :: err
    -
    4176 end subroutine
    -
    4177
    -
    4216 module subroutine solve_least_squares_mtx_svd(a, b, s, arnk, work, olwork, err)
    -
    4217 real(real64), intent(inout), dimension(:,:) :: a, b
    -
    4218 integer(int32), intent(out), optional :: arnk
    -
    4219 real(real64), intent(out), target, optional, dimension(:) :: work, s
    -
    4220 integer(int32), intent(out), optional :: olwork
    -
    4221 class(errors), intent(inout), optional, target :: err
    -
    4222 end subroutine
    -
    4223
    -
    4266 module subroutine solve_least_squares_mtx_svd_cmplx(a, b, s, arnk, work, &
    -
    4267 olwork, rwork, err)
    -
    4268 complex(real64), intent(inout), dimension(:,:) :: a, b
    -
    4269 integer(int32), intent(out), optional :: arnk
    -
    4270 complex(real64), intent(out), target, optional, dimension(:) :: work
    -
    4271 real(real64), intent(out), target, optional, dimension(:) :: rwork, s
    -
    4272 integer(int32), intent(out), optional :: olwork
    -
    4273 class(errors), intent(inout), optional, target :: err
    -
    4274 end subroutine
    -
    4275
    -
    4312 module subroutine solve_least_squares_vec_svd(a, b, s, arnk, work, olwork, err)
    -
    4313 real(real64), intent(inout), dimension(:,:) :: a
    -
    4314 real(real64), intent(inout), dimension(:) :: b
    -
    4315 integer(int32), intent(out), optional :: arnk
    -
    4316 real(real64), intent(out), target, optional, dimension(:) :: work, s
    -
    4317 integer(int32), intent(out), optional :: olwork
    -
    4318 class(errors), intent(inout), optional, target :: err
    -
    4319 end subroutine
    -
    4320
    -
    4361 module subroutine solve_least_squares_vec_svd_cmplx(a, b, s, arnk, work, &
    -
    4362 olwork, rwork, err)
    -
    4363 complex(real64), intent(inout), dimension(:,:) :: a
    -
    4364 complex(real64), intent(inout), dimension(:) :: b
    -
    4365 integer(int32), intent(out), optional :: arnk
    -
    4366 complex(real64), intent(out), target, optional, dimension(:) :: work
    -
    4367 real(real64), intent(out), target, optional, dimension(:) :: rwork, s
    -
    4368 integer(int32), intent(out), optional :: olwork
    -
    4369 class(errors), intent(inout), optional, target :: err
    -
    4370 end subroutine
    -
    4371
    -
    4403 module subroutine mtx_inverse_dbl(a, iwork, work, olwork, err)
    -
    4404 real(real64), intent(inout), dimension(:,:) :: a
    -
    4405 integer(int32), intent(out), target, optional, dimension(:) :: iwork
    -
    4406 real(real64), intent(out), target, optional, dimension(:) :: work
    -
    4407 integer(int32), intent(out), optional :: olwork
    -
    4408 class(errors), intent(inout), optional, target :: err
    -
    4409 end subroutine
    -
    4410
    -
    4442 module subroutine mtx_inverse_cmplx(a, iwork, work, olwork, err)
    -
    4443 complex(real64), intent(inout), dimension(:,:) :: a
    -
    4444 integer(int32), intent(out), target, optional, dimension(:) :: iwork
    -
    4445 complex(real64), intent(out), target, optional, dimension(:) :: work
    -
    4446 integer(int32), intent(out), optional :: olwork
    -
    4447 class(errors), intent(inout), optional, target :: err
    -
    4448 end subroutine
    -
    4449
    -
    4487 module subroutine mtx_pinverse_dbl(a, ainv, tol, work, olwork, err)
    -
    4488 real(real64), intent(inout), dimension(:,:) :: a
    -
    4489 real(real64), intent(out), dimension(:,:) :: ainv
    -
    4490 real(real64), intent(in), optional :: tol
    -
    4491 real(real64), intent(out), target, dimension(:), optional :: work
    -
    4492 integer(int32), intent(out), optional :: olwork
    -
    4493 class(errors), intent(inout), optional, target :: err
    -
    4494 end subroutine
    -
    4495
    -
    4537 module subroutine mtx_pinverse_cmplx(a, ainv, tol, work, olwork, rwork, err)
    -
    4538 complex(real64), intent(inout), dimension(:,:) :: a
    -
    4539 complex(real64), intent(out), dimension(:,:) :: ainv
    -
    4540 real(real64), intent(in), optional :: tol
    -
    4541 complex(real64), intent(out), target, dimension(:), optional :: work
    -
    4542 integer(int32), intent(out), optional :: olwork
    -
    4543 real(real64), intent(out), target, dimension(:), optional :: rwork
    -
    4544 class(errors), intent(inout), optional, target :: err
    -
    4545 end subroutine
    -
    4546
    -
    4547end interface
    -
    4548
    -
    4549! ******************************************************************************
    -
    4550! LINALG_EIGEN.F90
    -
    4551! ------------------------------------------------------------------------------
    -
    4552interface
    -
    4553
    -
    4585 module subroutine eigen_symm(vecs, a, vals, work, olwork, err)
    -
    4586 logical, intent(in) :: vecs
    -
    4587 real(real64), intent(inout), dimension(:,:) :: a
    -
    4588 real(real64), intent(out), dimension(:) :: vals
    -
    4589 real(real64), intent(out), pointer, optional, dimension(:) :: work
    -
    4590 integer(int32), intent(out), optional :: olwork
    -
    4591 class(errors), intent(inout), optional, target :: err
    -
    4592 end subroutine
    -
    4593
    -
    4624 module subroutine eigen_asymm(a, vals, vecs, work, olwork, err)
    -
    4625 real(real64), intent(inout), dimension(:,:) :: a
    -
    4626 complex(real64), intent(out), dimension(:) :: vals
    -
    4627 complex(real64), intent(out), optional, dimension(:,:) :: vecs
    -
    4628 real(real64), intent(out), pointer, optional, dimension(:) :: work
    -
    4629 integer(int32), intent(out), optional :: olwork
    -
    4630 class(errors), intent(inout), optional, target :: err
    -
    4631 end subroutine
    -
    4632
    -
    4675 module subroutine eigen_gen(a, b, alpha, beta, vecs, work, olwork, err)
    -
    4676 real(real64), intent(inout), dimension(:,:) :: a, b
    -
    4677 complex(real64), intent(out), dimension(:) :: alpha
    -
    4678 real(real64), intent(out), optional, dimension(:) :: beta
    -
    4679 complex(real64), intent(out), optional, dimension(:,:) :: vecs
    -
    4680 real(real64), intent(out), optional, pointer, dimension(:) :: work
    -
    4681 integer(int32), intent(out), optional :: olwork
    -
    4682 class(errors), intent(inout), optional, target :: err
    -
    4683 end subroutine
    -
    4684
    -
    4715 module subroutine eigen_cmplx(a, vals, vecs, work, olwork, rwork, err)
    -
    4716 complex(real64), intent(inout), dimension(:,:) :: a
    -
    4717 complex(real64), intent(out), dimension(:) :: vals
    -
    4718 complex(real64), intent(out), optional, dimension(:,:) :: vecs
    -
    4719 complex(real64), intent(out), target, optional, dimension(:) :: work
    -
    4720 real(real64), intent(out), target, optional, dimension(:) :: rwork
    -
    4721 integer(int32), intent(out), optional :: olwork
    -
    4722 class(errors), intent(inout), optional, target :: err
    -
    4723 end subroutine
    -
    4724end interface
    -
    4725
    -
    4726! ******************************************************************************
    -
    4727! LINALG_SORTING.F90
    -
    4728! ------------------------------------------------------------------------------
    -
    4729interface
    -
    4730
    -
    4745 module subroutine sort_dbl_array(x, ascend)
    -
    4746 real(real64), intent(inout), dimension(:) :: x
    -
    4747 logical, intent(in), optional :: ascend
    -
    4748 end subroutine
    -
    4749
    -
    4774 module subroutine sort_dbl_array_ind(x, ind, ascend, err)
    -
    4775 real(real64), intent(inout), dimension(:) :: x
    -
    4776 integer(int32), intent(inout), dimension(:) :: ind
    -
    4777 logical, intent(in), optional :: ascend
    -
    4778 class(errors), intent(inout), optional, target :: err
    -
    4779 end subroutine
    -
    4780
    -
    4797 module subroutine sort_cmplx_array(x, ascend)
    -
    4798 complex(real64), intent(inout), dimension(:) :: x
    -
    4799 logical, intent(in), optional :: ascend
    -
    4800 end subroutine
    -
    4801
    -
    4831 module subroutine sort_cmplx_array_ind(x, ind, ascend, err)
    -
    4832 complex(real64), intent(inout), dimension(:) :: x
    -
    4833 integer(int32), intent(inout), dimension(:) :: ind
    -
    4834 logical, intent(in), optional :: ascend
    -
    4835 class(errors), intent(inout), optional, target :: err
    -
    4836 end subroutine
    -
    4837
    -
    4857 module subroutine sort_eigen_cmplx(vals, vecs, ascend, err)
    -
    4858 complex(real64), intent(inout), dimension(:) :: vals
    -
    4859 complex(real64), intent(inout), dimension(:,:) :: vecs
    -
    4860 logical, intent(in), optional :: ascend
    -
    4861 class(errors), intent(inout), optional, target :: err
    -
    4862 end subroutine
    -
    4863
    -
    4883 module subroutine sort_eigen_dbl(vals, vecs, ascend, err)
    -
    4884 real(real64), intent(inout), dimension(:) :: vals
    -
    4885 real(real64), intent(inout), dimension(:,:) :: vecs
    -
    4886 logical, intent(in), optional :: ascend
    -
    4887 class(errors), intent(inout), optional, target :: err
    -
    4888 end subroutine
    -
    4889
    -
    4890end interface
    -
    4891
    -
    4892end module
    +
    3011
    +
    3012 module subroutine cholesky_rank1_update_dbl(r, u, work, err)
    +
    3013 real(real64), intent(inout), dimension(:,:) :: r
    +
    3014 real(real64), intent(inout), dimension(:) :: u
    +
    3015 real(real64), intent(out), target, optional, dimension(:) :: work
    +
    3016 class(errors), intent(inout), optional, target :: err
    +
    3017 end subroutine
    +
    3018
    +
    3019 module subroutine cholesky_rank1_update_cmplx(r, u, work, err)
    +
    3020 complex(real64), intent(inout), dimension(:,:) :: r
    +
    3021 complex(real64), intent(inout), dimension(:) :: u
    +
    3022 real(real64), intent(out), target, optional, dimension(:) :: work
    +
    3023 class(errors), intent(inout), optional, target :: err
    +
    3024 end subroutine
    +
    3025
    +
    3026 module subroutine cholesky_rank1_downdate_dbl(r, u, work, err)
    +
    3027 real(real64), intent(inout), dimension(:,:) :: r
    +
    3028 real(real64), intent(inout), dimension(:) :: u
    +
    3029 real(real64), intent(out), target, optional, dimension(:) :: work
    +
    3030 class(errors), intent(inout), optional, target :: err
    +
    3031 end subroutine
    +
    3032
    +
    3033 module subroutine cholesky_rank1_downdate_cmplx(r, u, work, err)
    +
    3034 complex(real64), intent(inout), dimension(:,:) :: r
    +
    3035 complex(real64), intent(inout), dimension(:) :: u
    +
    3036 real(real64), intent(out), target, optional, dimension(:) :: work
    +
    3037 class(errors), intent(inout), optional, target :: err
    +
    3038 end subroutine
    +
    3039
    +
    3040 module subroutine rz_factor_dbl(a, tau, work, olwork, err)
    +
    3041 real(real64), intent(inout), dimension(:,:) :: a
    +
    3042 real(real64), intent(out), dimension(:) :: tau
    +
    3043 real(real64), intent(out), target, optional, dimension(:) :: work
    +
    3044 integer(int32), intent(out), optional :: olwork
    +
    3045 class(errors), intent(inout), optional, target :: err
    +
    3046 end subroutine
    +
    3047
    +
    3048 module subroutine rz_factor_cmplx(a, tau, work, olwork, err)
    +
    3049 complex(real64), intent(inout), dimension(:,:) :: a
    +
    3050 complex(real64), intent(out), dimension(:) :: tau
    +
    3051 complex(real64), intent(out), target, optional, dimension(:) :: work
    +
    3052 integer(int32), intent(out), optional :: olwork
    +
    3053 class(errors), intent(inout), optional, target :: err
    +
    3054 end subroutine
    +
    3055
    +
    3056 module subroutine mult_rz_mtx(lside, trans, l, a, tau, c, work, olwork, err)
    +
    3057 logical, intent(in) :: lside, trans
    +
    3058 integer(int32), intent(in) :: l
    +
    3059 real(real64), intent(inout), dimension(:,:) :: a, c
    +
    3060 real(real64), intent(in), dimension(:) :: tau
    +
    3061 real(real64), intent(out), target, optional, dimension(:) :: work
    +
    3062 integer(int32), intent(out), optional :: olwork
    +
    3063 class(errors), intent(inout), optional, target :: err
    +
    3064 end subroutine
    +
    3065
    +
    3066 module subroutine mult_rz_mtx_cmplx(lside, trans, l, a, tau, c, work, olwork, err)
    +
    3067 logical, intent(in) :: lside, trans
    +
    3068 integer(int32), intent(in) :: l
    +
    3069 complex(real64), intent(inout), dimension(:,:) :: a, c
    +
    3070 complex(real64), intent(in), dimension(:) :: tau
    +
    3071 complex(real64), intent(out), target, optional, dimension(:) :: work
    +
    3072 integer(int32), intent(out), optional :: olwork
    +
    3073 class(errors), intent(inout), optional, target :: err
    +
    3074 end subroutine
    +
    3075
    +
    3076 module subroutine mult_rz_vec(trans, l, a, tau, c, work, olwork, err)
    +
    3077 logical, intent(in) :: trans
    +
    3078 integer(int32), intent(in) :: l
    +
    3079 real(real64), intent(inout), dimension(:,:) :: a
    +
    3080 real(real64), intent(in), dimension(:) :: tau
    +
    3081 real(real64), intent(inout), dimension(:) :: c
    +
    3082 real(real64), intent(out), target, optional, dimension(:) :: work
    +
    3083 integer(int32), intent(out), optional :: olwork
    +
    3084 class(errors), intent(inout), optional, target :: err
    +
    3085 end subroutine
    +
    3086
    +
    3087 module subroutine mult_rz_vec_cmplx(trans, l, a, tau, c, work, olwork, err)
    +
    3088 logical, intent(in) :: trans
    +
    3089 integer(int32), intent(in) :: l
    +
    3090 complex(real64), intent(inout), dimension(:,:) :: a
    +
    3091 complex(real64), intent(in), dimension(:) :: tau
    +
    3092 complex(real64), intent(inout), dimension(:) :: c
    +
    3093 complex(real64), intent(out), target, optional, dimension(:) :: work
    +
    3094 integer(int32), intent(out), optional :: olwork
    +
    3095 class(errors), intent(inout), optional, target :: err
    +
    3096 end subroutine
    +
    3097
    +
    3098 module subroutine svd_dbl(a, s, u, vt, work, olwork, err)
    +
    3099 real(real64), intent(inout), dimension(:,:) :: a
    +
    3100 real(real64), intent(out), dimension(:) :: s
    +
    3101 real(real64), intent(out), optional, dimension(:,:) :: u, vt
    +
    3102 real(real64), intent(out), target, optional, dimension(:) :: work
    +
    3103 integer(int32), intent(out), optional :: olwork
    +
    3104 class(errors), intent(inout), optional, target :: err
    +
    3105 end subroutine
    +
    3106
    +
    3107 module subroutine svd_cmplx(a, s, u, vt, work, olwork, rwork, err)
    +
    3108 complex(real64), intent(inout), dimension(:,:) :: a
    +
    3109 real(real64), intent(out), dimension(:) :: s
    +
    3110 complex(real64), intent(out), optional, dimension(:,:) :: u, vt
    +
    3111 complex(real64), intent(out), target, optional, dimension(:) :: work
    +
    3112 integer(int32), intent(out), optional :: olwork
    +
    3113 real(real64), intent(out), target, optional, dimension(:) :: rwork
    +
    3114 class(errors), intent(inout), optional, target :: err
    +
    3115 end subroutine
    +
    3116end interface
    +
    3117
    +
    3118! ******************************************************************************
    +
    3119! LINALG_SOLVE.F90
    +
    3120! ------------------------------------------------------------------------------
    +
    3121interface
    +
    3122 module subroutine solve_tri_mtx(lside, upper, trans, nounit, alpha, a, b, err)
    +
    3123 logical, intent(in) :: lside, upper, trans, nounit
    +
    3124 real(real64), intent(in) :: alpha
    +
    3125 real(real64), intent(in), dimension(:,:) :: a
    +
    3126 real(real64), intent(inout), dimension(:,:) :: b
    +
    3127 class(errors), intent(inout), optional, target :: err
    +
    3128 end subroutine
    +
    3129
    +
    3130 module subroutine solve_tri_mtx_cmplx(lside, upper, trans, nounit, alpha, a, b, err)
    +
    3131 logical, intent(in) :: lside, upper, trans, nounit
    +
    3132 complex(real64), intent(in) :: alpha
    +
    3133 complex(real64), intent(in), dimension(:,:) :: a
    +
    3134 complex(real64), intent(inout), dimension(:,:) :: b
    +
    3135 class(errors), intent(inout), optional, target :: err
    +
    3136 end subroutine
    +
    3137
    +
    3138 module subroutine solve_tri_vec(upper, trans, nounit, a, x, err)
    +
    3139 logical, intent(in) :: upper, trans, nounit
    +
    3140 real(real64), intent(in), dimension(:,:) :: a
    +
    3141 real(real64), intent(inout), dimension(:) :: x
    +
    3142 class(errors), intent(inout), optional, target :: err
    +
    3143 end subroutine
    +
    3144
    +
    3145 module subroutine solve_tri_vec_cmplx(upper, trans, nounit, a, x, err)
    +
    3146 logical, intent(in) :: upper, trans, nounit
    +
    3147 complex(real64), intent(in), dimension(:,:) :: a
    +
    3148 complex(real64), intent(inout), dimension(:) :: x
    +
    3149 class(errors), intent(inout), optional, target :: err
    +
    3150 end subroutine
    +
    3151
    +
    3168 module subroutine solve_lu_mtx(a, ipvt, b, err)
    +
    3169 real(real64), intent(in), dimension(:,:) :: a
    +
    3170 integer(int32), intent(in), dimension(:) :: ipvt
    +
    3171 real(real64), intent(inout), dimension(:,:) :: b
    +
    3172 class(errors), intent(inout), optional, target :: err
    +
    3173 end subroutine
    +
    3174
    +
    3191 module subroutine solve_lu_mtx_cmplx(a, ipvt, b, err)
    +
    3192 complex(real64), intent(in), dimension(:,:) :: a
    +
    3193 integer(int32), intent(in), dimension(:) :: ipvt
    +
    3194 complex(real64), intent(inout), dimension(:,:) :: b
    +
    3195 class(errors), intent(inout), optional, target :: err
    +
    3196 end subroutine
    +
    3197
    +
    3214 module subroutine solve_lu_vec(a, ipvt, b, err)
    +
    3215 real(real64), intent(in), dimension(:,:) :: a
    +
    3216 integer(int32), intent(in), dimension(:) :: ipvt
    +
    3217 real(real64), intent(inout), dimension(:) :: b
    +
    3218 class(errors), intent(inout), optional, target :: err
    +
    3219 end subroutine
    +
    3220
    +
    3237 module subroutine solve_lu_vec_cmplx(a, ipvt, b, err)
    +
    3238 complex(real64), intent(in), dimension(:,:) :: a
    +
    3239 integer(int32), intent(in), dimension(:) :: ipvt
    +
    3240 complex(real64), intent(inout), dimension(:) :: b
    +
    3241 class(errors), intent(inout), optional, target :: err
    +
    3242 end subroutine
    +
    3243
    +
    3273 module subroutine solve_qr_no_pivot_mtx(a, tau, b, work, olwork, err)
    +
    3274 real(real64), intent(inout), dimension(:,:) :: a, b
    +
    3275 real(real64), intent(in), dimension(:) :: tau
    +
    3276 real(real64), intent(out), target, optional, dimension(:) :: work
    +
    3277 integer(int32), intent(out), optional :: olwork
    +
    3278 class(errors), intent(inout), optional, target :: err
    +
    3279 end subroutine
    +
    3280
    +
    3310 module subroutine solve_qr_no_pivot_mtx_cmplx(a, tau, b, work, olwork, err)
    +
    3311 complex(real64), intent(inout), dimension(:,:) :: a, b
    +
    3312 complex(real64), intent(in), dimension(:) :: tau
    +
    3313 complex(real64), intent(out), target, optional, dimension(:) :: work
    +
    3314 integer(int32), intent(out), optional :: olwork
    +
    3315 class(errors), intent(inout), optional, target :: err
    +
    3316 end subroutine
    +
    3317
    +
    3347 module subroutine solve_qr_no_pivot_vec(a, tau, b, work, olwork, err)
    +
    3348 real(real64), intent(inout), dimension(:,:) :: a
    +
    3349 real(real64), intent(in), dimension(:) :: tau
    +
    3350 real(real64), intent(inout), dimension(:) :: b
    +
    3351 real(real64), intent(out), target, optional, dimension(:) :: work
    +
    3352 integer(int32), intent(out), optional :: olwork
    +
    3353 class(errors), intent(inout), optional, target :: err
    +
    3354 end subroutine
    +
    3355
    +
    3385 module subroutine solve_qr_no_pivot_vec_cmplx(a, tau, b, work, olwork, err)
    +
    3386 complex(real64), intent(inout), dimension(:,:) :: a
    +
    3387 complex(real64), intent(in), dimension(:) :: tau
    +
    3388 complex(real64), intent(inout), dimension(:) :: b
    +
    3389 complex(real64), intent(out), target, optional, dimension(:) :: work
    +
    3390 integer(int32), intent(out), optional :: olwork
    +
    3391 class(errors), intent(inout), optional, target :: err
    +
    3392 end subroutine
    +
    3393
    +
    3425 module subroutine solve_qr_pivot_mtx(a, tau, jpvt, b, work, olwork, err)
    +
    3426 real(real64), intent(inout), dimension(:,:) :: a
    +
    3427 real(real64), intent(in), dimension(:) :: tau
    +
    3428 integer(int32), intent(in), dimension(:) :: jpvt
    +
    3429 real(real64), intent(inout), dimension(:,:) :: b
    +
    3430 real(real64), intent(out), target, optional, dimension(:) :: work
    +
    3431 integer(int32), intent(out), optional :: olwork
    +
    3432 class(errors), intent(inout), optional, target :: err
    +
    3433 end subroutine
    +
    3434
    +
    3466 module subroutine solve_qr_pivot_mtx_cmplx(a, tau, jpvt, b, work, olwork, err)
    +
    3467 complex(real64), intent(inout), dimension(:,:) :: a
    +
    3468 complex(real64), intent(in), dimension(:) :: tau
    +
    3469 integer(int32), intent(in), dimension(:) :: jpvt
    +
    3470 complex(real64), intent(inout), dimension(:,:) :: b
    +
    3471 complex(real64), intent(out), target, optional, dimension(:) :: work
    +
    3472 integer(int32), intent(out), optional :: olwork
    +
    3473 class(errors), intent(inout), optional, target :: err
    +
    3474 end subroutine
    +
    3475
    +
    3507 module subroutine solve_qr_pivot_vec(a, tau, jpvt, b, work, olwork, err)
    +
    3508 real(real64), intent(inout), dimension(:,:) :: a
    +
    3509 real(real64), intent(in), dimension(:) :: tau
    +
    3510 integer(int32), intent(in), dimension(:) :: jpvt
    +
    3511 real(real64), intent(inout), dimension(:) :: b
    +
    3512 real(real64), intent(out), target, optional, dimension(:) :: work
    +
    3513 integer(int32), intent(out), optional :: olwork
    +
    3514 class(errors), intent(inout), optional, target :: err
    +
    3515 end subroutine
    +
    3516
    +
    3548 module subroutine solve_qr_pivot_vec_cmplx(a, tau, jpvt, b, work, olwork, err)
    +
    3549 complex(real64), intent(inout), dimension(:,:) :: a
    +
    3550 complex(real64), intent(in), dimension(:) :: tau
    +
    3551 integer(int32), intent(in), dimension(:) :: jpvt
    +
    3552 complex(real64), intent(inout), dimension(:) :: b
    +
    3553 complex(real64), intent(out), target, optional, dimension(:) :: work
    +
    3554 integer(int32), intent(out), optional :: olwork
    +
    3555 class(errors), intent(inout), optional, target :: err
    +
    3556 end subroutine
    +
    3557
    +
    3576 module subroutine solve_cholesky_mtx(upper, a, b, err)
    +
    3577 logical, intent(in) :: upper
    +
    3578 real(real64), intent(in), dimension(:,:) :: a
    +
    3579 real(real64), intent(inout), dimension(:,:) :: b
    +
    3580 class(errors), intent(inout), optional, target :: err
    +
    3581 end subroutine
    +
    3582
    +
    3601 module subroutine solve_cholesky_mtx_cmplx(upper, a, b, err)
    +
    3602 logical, intent(in) :: upper
    +
    3603 complex(real64), intent(in), dimension(:,:) :: a
    +
    3604 complex(real64), intent(inout), dimension(:,:) :: b
    +
    3605 class(errors), intent(inout), optional, target :: err
    +
    3606 end subroutine
    +
    3607
    +
    3626 module subroutine solve_cholesky_vec(upper, a, b, err)
    +
    3627 logical, intent(in) :: upper
    +
    3628 real(real64), intent(in), dimension(:,:) :: a
    +
    3629 real(real64), intent(inout), dimension(:) :: b
    +
    3630 class(errors), intent(inout), optional, target :: err
    +
    3631 end subroutine
    +
    3632
    +
    3651 module subroutine solve_cholesky_vec_cmplx(upper, a, b, err)
    +
    3652 logical, intent(in) :: upper
    +
    3653 complex(real64), intent(in), dimension(:,:) :: a
    +
    3654 complex(real64), intent(inout), dimension(:) :: b
    +
    3655 class(errors), intent(inout), optional, target :: err
    +
    3656 end subroutine
    +
    3657
    +
    3689 module subroutine solve_least_squares_mtx(a, b, work, olwork, err)
    +
    3690 real(real64), intent(inout), dimension(:,:) :: a, b
    +
    3691 real(real64), intent(out), target, optional, dimension(:) :: work
    +
    3692 integer(int32), intent(out), optional :: olwork
    +
    3693 class(errors), intent(inout), optional, target :: err
    +
    3694 end subroutine
    +
    3695
    +
    3727 module subroutine solve_least_squares_mtx_cmplx(a, b, work, olwork, err)
    +
    3728 complex(real64), intent(inout), dimension(:,:) :: a, b
    +
    3729 complex(real64), intent(out), target, optional, dimension(:) :: work
    +
    3730 integer(int32), intent(out), optional :: olwork
    +
    3731 class(errors), intent(inout), optional, target :: err
    +
    3732 end subroutine
    +
    3733
    +
    3765 module subroutine solve_least_squares_vec(a, b, work, olwork, err)
    +
    3766 real(real64), intent(inout), dimension(:,:) :: a
    +
    3767 real(real64), intent(inout), dimension(:) :: b
    +
    3768 real(real64), intent(out), target, optional, dimension(:) :: work
    +
    3769 integer(int32), intent(out), optional :: olwork
    +
    3770 class(errors), intent(inout), optional, target :: err
    +
    3771 end subroutine
    +
    3772
    +
    3804 module subroutine solve_least_squares_vec_cmplx(a, b, work, olwork, err)
    +
    3805 complex(real64), intent(inout), dimension(:,:) :: a
    +
    3806 complex(real64), intent(inout), dimension(:) :: b
    +
    3807 complex(real64), intent(out), target, optional, dimension(:) :: work
    +
    3808 integer(int32), intent(out), optional :: olwork
    +
    3809 class(errors), intent(inout), optional, target :: err
    +
    3810 end subroutine
    +
    3811
    +
    3849 module subroutine solve_least_squares_mtx_pvt(a, b, ipvt, arnk, work, olwork, err)
    +
    3850 real(real64), intent(inout), dimension(:,:) :: a, b
    +
    3851 integer(int32), intent(inout), target, optional, dimension(:) :: ipvt
    +
    3852 integer(int32), intent(out), optional :: arnk
    +
    3853 real(real64), intent(out), target, optional, dimension(:) :: work
    +
    3854 integer(int32), intent(out), optional :: olwork
    +
    3855 class(errors), intent(inout), optional, target :: err
    +
    3856 end subroutine
    +
    3857
    +
    3899 module subroutine solve_least_squares_mtx_pvt_cmplx(a, b, ipvt, arnk, &
    +
    3900 work, olwork, rwork, err)
    +
    3901 complex(real64), intent(inout), dimension(:,:) :: a, b
    +
    3902 integer(int32), intent(inout), target, optional, dimension(:) :: ipvt
    +
    3903 integer(int32), intent(out), optional :: arnk
    +
    3904 complex(real64), intent(out), target, optional, dimension(:) :: work
    +
    3905 integer(int32), intent(out), optional :: olwork
    +
    3906 real(real64), intent(out), target, optional, dimension(:) :: rwork
    +
    3907 class(errors), intent(inout), optional, target :: err
    +
    3908 end subroutine
    +
    3909
    +
    3947 module subroutine solve_least_squares_vec_pvt(a, b, ipvt, arnk, work, olwork, err)
    +
    3948 real(real64), intent(inout), dimension(:,:) :: a
    +
    3949 real(real64), intent(inout), dimension(:) :: b
    +
    3950 integer(int32), intent(inout), target, optional, dimension(:) :: ipvt
    +
    3951 integer(int32), intent(out), optional :: arnk
    +
    3952 real(real64), intent(out), target, optional, dimension(:) :: work
    +
    3953 integer(int32), intent(out), optional :: olwork
    +
    3954 class(errors), intent(inout), optional, target :: err
    +
    3955 end subroutine
    +
    3956
    +
    3998 module subroutine solve_least_squares_vec_pvt_cmplx(a, b, ipvt, arnk, &
    +
    3999 work, olwork, rwork, err)
    +
    4000 complex(real64), intent(inout), dimension(:,:) :: a
    +
    4001 complex(real64), intent(inout), dimension(:) :: b
    +
    4002 integer(int32), intent(inout), target, optional, dimension(:) :: ipvt
    +
    4003 integer(int32), intent(out), optional :: arnk
    +
    4004 complex(real64), intent(out), target, optional, dimension(:) :: work
    +
    4005 integer(int32), intent(out), optional :: olwork
    +
    4006 real(real64), intent(out), target, optional, dimension(:) :: rwork
    +
    4007 class(errors), intent(inout), optional, target :: err
    +
    4008 end subroutine
    +
    4009
    +
    4048 module subroutine solve_least_squares_mtx_svd(a, b, s, arnk, work, olwork, err)
    +
    4049 real(real64), intent(inout), dimension(:,:) :: a, b
    +
    4050 integer(int32), intent(out), optional :: arnk
    +
    4051 real(real64), intent(out), target, optional, dimension(:) :: work, s
    +
    4052 integer(int32), intent(out), optional :: olwork
    +
    4053 class(errors), intent(inout), optional, target :: err
    +
    4054 end subroutine
    +
    4055
    +
    4098 module subroutine solve_least_squares_mtx_svd_cmplx(a, b, s, arnk, work, &
    +
    4099 olwork, rwork, err)
    +
    4100 complex(real64), intent(inout), dimension(:,:) :: a, b
    +
    4101 integer(int32), intent(out), optional :: arnk
    +
    4102 complex(real64), intent(out), target, optional, dimension(:) :: work
    +
    4103 real(real64), intent(out), target, optional, dimension(:) :: rwork, s
    +
    4104 integer(int32), intent(out), optional :: olwork
    +
    4105 class(errors), intent(inout), optional, target :: err
    +
    4106 end subroutine
    +
    4107
    +
    4144 module subroutine solve_least_squares_vec_svd(a, b, s, arnk, work, olwork, err)
    +
    4145 real(real64), intent(inout), dimension(:,:) :: a
    +
    4146 real(real64), intent(inout), dimension(:) :: b
    +
    4147 integer(int32), intent(out), optional :: arnk
    +
    4148 real(real64), intent(out), target, optional, dimension(:) :: work, s
    +
    4149 integer(int32), intent(out), optional :: olwork
    +
    4150 class(errors), intent(inout), optional, target :: err
    +
    4151 end subroutine
    +
    4152
    +
    4193 module subroutine solve_least_squares_vec_svd_cmplx(a, b, s, arnk, work, &
    +
    4194 olwork, rwork, err)
    +
    4195 complex(real64), intent(inout), dimension(:,:) :: a
    +
    4196 complex(real64), intent(inout), dimension(:) :: b
    +
    4197 integer(int32), intent(out), optional :: arnk
    +
    4198 complex(real64), intent(out), target, optional, dimension(:) :: work
    +
    4199 real(real64), intent(out), target, optional, dimension(:) :: rwork, s
    +
    4200 integer(int32), intent(out), optional :: olwork
    +
    4201 class(errors), intent(inout), optional, target :: err
    +
    4202 end subroutine
    +
    4203
    +
    4235 module subroutine mtx_inverse_dbl(a, iwork, work, olwork, err)
    +
    4236 real(real64), intent(inout), dimension(:,:) :: a
    +
    4237 integer(int32), intent(out), target, optional, dimension(:) :: iwork
    +
    4238 real(real64), intent(out), target, optional, dimension(:) :: work
    +
    4239 integer(int32), intent(out), optional :: olwork
    +
    4240 class(errors), intent(inout), optional, target :: err
    +
    4241 end subroutine
    +
    4242
    +
    4274 module subroutine mtx_inverse_cmplx(a, iwork, work, olwork, err)
    +
    4275 complex(real64), intent(inout), dimension(:,:) :: a
    +
    4276 integer(int32), intent(out), target, optional, dimension(:) :: iwork
    +
    4277 complex(real64), intent(out), target, optional, dimension(:) :: work
    +
    4278 integer(int32), intent(out), optional :: olwork
    +
    4279 class(errors), intent(inout), optional, target :: err
    +
    4280 end subroutine
    +
    4281
    +
    4319 module subroutine mtx_pinverse_dbl(a, ainv, tol, work, olwork, err)
    +
    4320 real(real64), intent(inout), dimension(:,:) :: a
    +
    4321 real(real64), intent(out), dimension(:,:) :: ainv
    +
    4322 real(real64), intent(in), optional :: tol
    +
    4323 real(real64), intent(out), target, dimension(:), optional :: work
    +
    4324 integer(int32), intent(out), optional :: olwork
    +
    4325 class(errors), intent(inout), optional, target :: err
    +
    4326 end subroutine
    +
    4327
    +
    4369 module subroutine mtx_pinverse_cmplx(a, ainv, tol, work, olwork, rwork, err)
    +
    4370 complex(real64), intent(inout), dimension(:,:) :: a
    +
    4371 complex(real64), intent(out), dimension(:,:) :: ainv
    +
    4372 real(real64), intent(in), optional :: tol
    +
    4373 complex(real64), intent(out), target, dimension(:), optional :: work
    +
    4374 integer(int32), intent(out), optional :: olwork
    +
    4375 real(real64), intent(out), target, dimension(:), optional :: rwork
    +
    4376 class(errors), intent(inout), optional, target :: err
    +
    4377 end subroutine
    +
    4378
    +
    4379end interface
    +
    4380
    +
    4381! ******************************************************************************
    +
    4382! LINALG_EIGEN.F90
    +
    4383! ------------------------------------------------------------------------------
    +
    4384interface
    +
    4385
    +
    4417 module subroutine eigen_symm(vecs, a, vals, work, olwork, err)
    +
    4418 logical, intent(in) :: vecs
    +
    4419 real(real64), intent(inout), dimension(:,:) :: a
    +
    4420 real(real64), intent(out), dimension(:) :: vals
    +
    4421 real(real64), intent(out), pointer, optional, dimension(:) :: work
    +
    4422 integer(int32), intent(out), optional :: olwork
    +
    4423 class(errors), intent(inout), optional, target :: err
    +
    4424 end subroutine
    +
    4425
    +
    4456 module subroutine eigen_asymm(a, vals, vecs, work, olwork, err)
    +
    4457 real(real64), intent(inout), dimension(:,:) :: a
    +
    4458 complex(real64), intent(out), dimension(:) :: vals
    +
    4459 complex(real64), intent(out), optional, dimension(:,:) :: vecs
    +
    4460 real(real64), intent(out), pointer, optional, dimension(:) :: work
    +
    4461 integer(int32), intent(out), optional :: olwork
    +
    4462 class(errors), intent(inout), optional, target :: err
    +
    4463 end subroutine
    +
    4464
    +
    4507 module subroutine eigen_gen(a, b, alpha, beta, vecs, work, olwork, err)
    +
    4508 real(real64), intent(inout), dimension(:,:) :: a, b
    +
    4509 complex(real64), intent(out), dimension(:) :: alpha
    +
    4510 real(real64), intent(out), optional, dimension(:) :: beta
    +
    4511 complex(real64), intent(out), optional, dimension(:,:) :: vecs
    +
    4512 real(real64), intent(out), optional, pointer, dimension(:) :: work
    +
    4513 integer(int32), intent(out), optional :: olwork
    +
    4514 class(errors), intent(inout), optional, target :: err
    +
    4515 end subroutine
    +
    4516
    +
    4547 module subroutine eigen_cmplx(a, vals, vecs, work, olwork, rwork, err)
    +
    4548 complex(real64), intent(inout), dimension(:,:) :: a
    +
    4549 complex(real64), intent(out), dimension(:) :: vals
    +
    4550 complex(real64), intent(out), optional, dimension(:,:) :: vecs
    +
    4551 complex(real64), intent(out), target, optional, dimension(:) :: work
    +
    4552 real(real64), intent(out), target, optional, dimension(:) :: rwork
    +
    4553 integer(int32), intent(out), optional :: olwork
    +
    4554 class(errors), intent(inout), optional, target :: err
    +
    4555 end subroutine
    +
    4556end interface
    +
    4557
    +
    4558! ******************************************************************************
    +
    4559! LINALG_SORTING.F90
    +
    4560! ------------------------------------------------------------------------------
    +
    4561interface
    +
    4562
    +
    4577 module subroutine sort_dbl_array(x, ascend)
    +
    4578 real(real64), intent(inout), dimension(:) :: x
    +
    4579 logical, intent(in), optional :: ascend
    +
    4580 end subroutine
    +
    4581
    +
    4606 module subroutine sort_dbl_array_ind(x, ind, ascend, err)
    +
    4607 real(real64), intent(inout), dimension(:) :: x
    +
    4608 integer(int32), intent(inout), dimension(:) :: ind
    +
    4609 logical, intent(in), optional :: ascend
    +
    4610 class(errors), intent(inout), optional, target :: err
    +
    4611 end subroutine
    +
    4612
    +
    4629 module subroutine sort_cmplx_array(x, ascend)
    +
    4630 complex(real64), intent(inout), dimension(:) :: x
    +
    4631 logical, intent(in), optional :: ascend
    +
    4632 end subroutine
    +
    4633
    +
    4663 module subroutine sort_cmplx_array_ind(x, ind, ascend, err)
    +
    4664 complex(real64), intent(inout), dimension(:) :: x
    +
    4665 integer(int32), intent(inout), dimension(:) :: ind
    +
    4666 logical, intent(in), optional :: ascend
    +
    4667 class(errors), intent(inout), optional, target :: err
    +
    4668 end subroutine
    +
    4669
    +
    4689 module subroutine sort_eigen_cmplx(vals, vecs, ascend, err)
    +
    4690 complex(real64), intent(inout), dimension(:) :: vals
    +
    4691 complex(real64), intent(inout), dimension(:,:) :: vecs
    +
    4692 logical, intent(in), optional :: ascend
    +
    4693 class(errors), intent(inout), optional, target :: err
    +
    4694 end subroutine
    +
    4695
    +
    4715 module subroutine sort_eigen_dbl(vals, vecs, ascend, err)
    +
    4716 real(real64), intent(inout), dimension(:) :: vals
    +
    4717 real(real64), intent(inout), dimension(:,:) :: vecs
    +
    4718 logical, intent(in), optional :: ascend
    +
    4719 class(errors), intent(inout), optional, target :: err
    +
    4720 end subroutine
    +
    4721
    +
    4722end interface
    +
    4723
    +
    4724end module
    Computes the Cholesky factorization of a symmetric, positive definite matrix.
    Computes the rank 1 downdate to a Cholesky factored matrix (upper triangular).
    Computes the rank 1 update to a Cholesky factored matrix (upper triangular).
    Computes the determinant of a square matrix.
    Multiplies a diagonal matrix with another matrix or array.
    -
    Computes the eigenvalues, and optionally the eigenvectors, of a matrix.
    +
    Computes the eigenvalues, and optionally the eigenvectors, of a matrix.
    Extracts the L and U matrices from the condensed [L\U] storage format used by the lu_factor.
    Forms the full M-by-M orthogonal matrix Q from the elementary reflectors returned by the base QR fact...
    Computes the LU factorization of an M-by-N matrix.
    -
    Computes the inverse of a square matrix.
    +
    Computes the inverse of a square matrix.
    Performs the matrix operation: .
    -
    Computes the Moore-Penrose pseudo-inverse of a M-by-N matrix using the singular value decomposition o...
    +
    Computes the Moore-Penrose pseudo-inverse of a M-by-N matrix using the singular value decomposition o...
    Computes the rank of a matrix.
    Multiplies a general matrix by the orthogonal matrix Q from a QR factorization.
    Multiplies a general matrix by the orthogonal matrix Z from an RZ factorization.
    @@ -1288,14 +1287,14 @@
    Performs the rank-1 update to matrix A such that: , where is an M-by-N matrix, is a scalar,...
    Multiplies a vector by the reciprocal of a real scalar.
    Factors an upper trapezoidal matrix by means of orthogonal transformations such that ....
    -
    Solves a system of Cholesky factored equations.
    -
    Solves the overdetermined or underdetermined system (A*X = B) of M equations of N unknowns,...
    -
    Solves the overdetermined or underdetermined system (A*X = B) of M equations of N unknowns using a si...
    -
    Solves the overdetermined or underdetermined system (A*X = B) of M equations of N unknowns.
    -
    Solves a system of LU-factored equations.
    -
    Solves a system of M QR-factored equations of N unknowns.
    -
    Solves a triangular system of equations.
    -
    Sorts an array.
    +
    Solves a system of Cholesky factored equations.
    +
    Solves the overdetermined or underdetermined system (A*X = B) of M equations of N unknowns,...
    +
    Solves the overdetermined or underdetermined system (A*X = B) of M equations of N unknowns using a si...
    +
    Solves the overdetermined or underdetermined system (A*X = B) of M equations of N unknowns.
    +
    Solves a system of LU-factored equations.
    +
    Solves a system of M QR-factored equations of N unknowns.
    +
    Solves a triangular system of equations.
    +
    Sorts an array.
    Computes the singular value decomposition of a matrix A. The SVD is defined as: , where is an M-by-M...
    Swaps the contents of two arrays.
    Computes the trace of a matrix (the sum of the main diagonal elements).
    diff --git a/doc/html/linalg__immutable_8f90_source.html b/doc/html/linalg__immutable_8f90_source.html index 65aae3a8..fea99c3e 100644 --- a/doc/html/linalg__immutable_8f90_source.html +++ b/doc/html/linalg__immutable_8f90_source.html @@ -850,17 +850,17 @@
    Computes the rank 1 update to a Cholesky factored matrix (upper triangular).
    Computes the determinant of a square matrix.
    Multiplies a diagonal matrix with another matrix or array.
    -
    Computes the eigenvalues, and optionally the eigenvectors, of a matrix.
    +
    Computes the eigenvalues, and optionally the eigenvectors, of a matrix.
    Extracts the L and U matrices from the condensed [L\U] storage format used by the lu_factor.
    Forms the full M-by-M orthogonal matrix Q from the elementary reflectors returned by the base QR fact...
    Computes the LU factorization of an M-by-N matrix.
    -
    Computes the inverse of a square matrix.
    -
    Computes the Moore-Penrose pseudo-inverse of a M-by-N matrix using the singular value decomposition o...
    +
    Computes the inverse of a square matrix.
    +
    Computes the Moore-Penrose pseudo-inverse of a M-by-N matrix using the singular value decomposition o...
    Computes the QR factorization of an M-by-N matrix.
    Computes the rank 1 update to an M-by-N QR factored matrix A (M >= N) where , and such that .
    Performs the rank-1 update to matrix A such that: , where is an M-by-N matrix, is a scalar,...
    -
    Solves a triangular system of equations.
    -
    Sorts an array.
    +
    Solves a triangular system of equations.
    +
    Sorts an array.
    Computes the singular value decomposition of a matrix A. The SVD is defined as: , where is an M-by-M...
    Computes the eigenvalues and eigenvectors (right) of a general N-by-N matrix.
    Computes the LU factorization of a square matrix. Notice, partial row pivoting is utilized.
    diff --git a/src/linalg_core.f90 b/src/linalg_core.f90 index 542d9961..39e01a90 100644 --- a/src/linalg_core.f90 +++ b/src/linalg_core.f90 @@ -1892,6 +1892,70 @@ module linalg_core ! ------------------------------------------------------------------------------ !> @brief Solves a triangular system of equations. !! +!! @par Syntax 1 +!! Solves one of the matrix equations: \f$ op(A) X = \alpha B \f$, or +!! \f$ X op(A) = \alpha B \f$, where \f$ A \f$ is a triangular matrix. +!! @code{.f90} +!! subroutine solve_triangular_system(logical lside, logical upper, logical trans, logical nounit, real(real64) alpha, real(real64) a(:,:), real(real64) b(:,:), optional class(errors) err) +!! subroutine solve_triangular_system(logical lside, logical upper, logical trans, logical nounit, complex(real64) alpha, complex(real64) a(:,:), complex(real64) b(:,:), optional class(errors) err) +!! @endcode +!! +!! @param[in] lside Set to true to solve \f$ op(A) X = \alpha B \f$; else, set +!! to false to solve \f$ X op(A) = \alpha B \f$. +!! @param[in] upper Set to true if A is an upper triangular matrix; else, +!! set to false if A is a lower triangular matrix. +!! @param[in] trans Set to true if \f$ op(A) = A^T \f$ (\f$ op(A) = A^H \f$ in +!! the complex case); else, set to false if \f$ op(A) = A \f$. +!! @param[in] nounit Set to true if A is not a unit-diagonal matrix (ones on +!! every diagonal element); else, set to false if A is a unit-diagonal +!! matrix. +!! @param[in] alpha The scalar multiplier to B. +!! @param[in] a If @p lside is true, the M-by-M triangular matrix on which +!! to operate; else, if @p lside is false, the N-by-N triangular matrix on +!! which to operate. +!! @param[in,out] b On input, the M-by-N right-hand-side. On output, the +!! M-by-N solution. +!! @param[in,out] err An optional errors-based object that if provided can be +!! used to retrieve information relating to any errors encountered during +!! execution. If not provided, a default implementation of the errors +!! class is used internally to provide error handling. Possible errors and +!! warning messages that may be encountered are as follows. +!! - LA_ARRAY_SIZE_ERROR: Occurs if @p a is not square, or if the sizes of +!! @p a and @p b are not compatible. +!! +!! @par Notes +!! This routine is based upon the BLAS routine DTRSM (ZTRSM in the complex +!! case). +!! +!! @par Syntax 2 +!! Solves the system of equations: \f$ op(A) X = B \f$, where \f$ A \f$ is a +!! triangular matrix. +!! @code{.f90} +!! +!! @endcode +!! +!! @param[in] upper Set to true if A is an upper triangular matrix; else, +!! set to false if A is a lower triangular matrix. +!! @param[in] trans Set to true if \f$ op(A) = A^T \f$ (\f$ op(A) = A^H \f$ in +!! the complex case); else, set to false if \f$ op(A) = A \f$. +!! @param[in] nounit Set to true if A is not a unit-diagonal matrix (ones on +!! every diagonal element); else, set to false if A is a unit-diagonal +!! matrix. +!! @param[in] a The N-by-N triangular matrix. +!! @param[in,out] x On input, the N-element right-hand-side array. On +!! output, the N-element solution array. +!! @param[out] err An optional errors-based object that if provided can be +!! used to retrieve information relating to any errors encountered during +!! execution. If not provided, a default implementation of the errors +!! class is used internally to provide error handling. Possible errors and +!! warning messages that may be encountered are as follows. +!! - LA_ARRAY_SIZE_ERROR: Occurs if @p a is not square, or if the sizes of +!! @p a and @p b are not compatible. +!! +!! @par Notes +!! This routine is based upon the BLAS routine DTRSV (ZTRSV in the complex +!! case). +!! !! @par Usage !! The following example illustrates the solution of two triangular systems !! to solve a system of LU factored equations. @@ -3055,34 +3119,6 @@ module subroutine svd_cmplx(a, s, u, vt, work, olwork, rwork, err) ! LINALG_SOLVE.F90 ! ------------------------------------------------------------------------------ interface - !> @brief Solves one of the matrix equations: op(A) * X = alpha * B, or - !! X * op(A) = alpha * B, where A is a triangular matrix. - !! - !! @param[in] lside Set to true to solve op(A) * X = alpha * B; else, set to - !! false to solve X * op(A) = alpha * B. - !! @param[in] upper Set to true if A is an upper triangular matrix; else, - !! set to false if A is a lower triangular matrix. - !! @param[in] trans Set to true if op(A) = A**T; else, set to false if - !! op(A) = A. - !! @param[in] nounit Set to true if A is not a unit-diagonal matrix (ones on - !! every diagonal element); else, set to false if A is a unit-diagonal - !! matrix. - !! @param[in] alpha The scalar multiplier to B. - !! @param[in] a If @p lside is true, the M-by-M triangular matrix on which - !! to operate; else, if @p lside is false, the N-by-N triangular matrix on - !! which to operate. - !! @param[in,out] b On input, the M-by-N right-hand-side. On output, the - !! M-by-N solution. - !! @param[out] err An optional errors-based object that if provided can be - !! used to retrieve information relating to any errors encountered during - !! execution. If not provided, a default implementation of the errors - !! class is used internally to provide error handling. Possible errors and - !! warning messages that may be encountered are as follows. - !! - LA_ARRAY_SIZE_ERROR: Occurs if @p a is not square, or if the sizes of - !! @p a and @p b are not compatible. - !! - !! @par Notes - !! This routine is based upon the BLAS routine DTRSM. module subroutine solve_tri_mtx(lside, upper, trans, nounit, alpha, a, b, err) logical, intent(in) :: lside, upper, trans, nounit real(real64), intent(in) :: alpha @@ -3090,35 +3126,7 @@ module subroutine solve_tri_mtx(lside, upper, trans, nounit, alpha, a, b, err) real(real64), intent(inout), dimension(:,:) :: b class(errors), intent(inout), optional, target :: err end subroutine - - !> @brief Solves one of the matrix equations: op(A) * X = alpha * B, or - !! X * op(A) = alpha * B, where A is a triangular matrix. - !! - !! @param[in] lside Set to true to solve op(A) * X = alpha * B; else, set to - !! false to solve X * op(A) = alpha * B. - !! @param[in] upper Set to true if A is an upper triangular matrix; else, - !! set to false if A is a lower triangular matrix. - !! @param[in] trans Set to true if op(A) = A**H; else, set to false if - !! op(A) = A. - !! @param[in] nounit Set to true if A is not a unit-diagonal matrix (ones on - !! every diagonal element); else, set to false if A is a unit-diagonal - !! matrix. - !! @param[in] alpha The scalar multiplier to B. - !! @param[in] a If @p lside is true, the M-by-M triangular matrix on which - !! to operate; else, if @p lside is false, the N-by-N triangular matrix on - !! which to operate. - !! @param[in,out] b On input, the M-by-N right-hand-side. On output, the - !! M-by-N solution. - !! @param[out] err An optional errors-based object that if provided can be - !! used to retrieve information relating to any errors encountered during - !! execution. If not provided, a default implementation of the errors - !! class is used internally to provide error handling. Possible errors and - !! warning messages that may be encountered are as follows. - !! - LA_ARRAY_SIZE_ERROR: Occurs if @p a is not square, or if the sizes of - !! @p a and @p b are not compatible. - !! - !! @par Notes - !! This routine is based upon the BLAS routine ZTRSM. + module subroutine solve_tri_mtx_cmplx(lside, upper, trans, nounit, alpha, a, b, err) logical, intent(in) :: lside, upper, trans, nounit complex(real64), intent(in) :: alpha @@ -3127,101 +3135,13 @@ module subroutine solve_tri_mtx_cmplx(lside, upper, trans, nounit, alpha, a, b, class(errors), intent(inout), optional, target :: err end subroutine - !> @brief Solves the system of equations: op(A) * X = B, where A is a - !! triangular matrix. - !! - !! @param[in] upper Set to true if A is an upper triangular matrix; else, - !! set to false if A is a lower triangular matrix. - !! @param[in] trans Set to true if op(A) = A**T; else, set to false if - !! op(A) = A. - !! @param[in] nounit Set to true if A is not a unit-diagonal matrix (ones on - !! every diagonal element); else, set to false if A is a unit-diagonal - !! matrix. - !! @param[in] a The N-by-N triangular matrix. - !! @param[in,out] x On input, the N-element right-hand-side array. On - !! output, the N-element solution array. - !! @param[out] err An optional errors-based object that if provided can be - !! used to retrieve information relating to any errors encountered during - !! execution. If not provided, a default implementation of the errors - !! class is used internally to provide error handling. Possible errors and - !! warning messages that may be encountered are as follows. - !! - LA_ARRAY_SIZE_ERROR: Occurs if @p a is not square, or if the sizes of - !! @p a and @p b are not compatible. - !! - !! - !! @par Usage - !! To solve a triangular system of N equations of N unknowns A*X = B, where - !! A is an N-by-N upper triangular matrix, and B and X are N-element - !! arrays, the following code will suffice. - !! - !! @code{.f90} - !! ! Solve the system: A*X = B, where A is an upper triangular N-by-N - !! ! matrix, and B and X are N-elements in size. - !! - !! ! Variables - !! integer(int32) :: info - !! real(real64), dimension(n, n) :: a - !! real(real64), dimension(n) :: b - !! - !! ! Initialize A and B... - !! - !! ! Solve A*X = B for X - Note: X overwrites B. - !! call solve_triangular_system(.true., .false., a, b) - !! @endcode - !! - !! @par Notes - !! This routine is based upon the BLAS routine DTRSV. module subroutine solve_tri_vec(upper, trans, nounit, a, x, err) logical, intent(in) :: upper, trans, nounit real(real64), intent(in), dimension(:,:) :: a real(real64), intent(inout), dimension(:) :: x class(errors), intent(inout), optional, target :: err end subroutine - - !> @brief Solves the system of equations: op(A) * X = B, where A is a - !! triangular matrix. - !! - !! @param[in] upper Set to true if A is an upper triangular matrix; else, - !! set to false if A is a lower triangular matrix. - !! @param[in] trans Set to true if op(A) = A**H; else, set to false if - !! op(A) = A. - !! @param[in] nounit Set to true if A is not a unit-diagonal matrix (ones on - !! every diagonal element); else, set to false if A is a unit-diagonal - !! matrix. - !! @param[in] a The N-by-N triangular matrix. - !! @param[in,out] x On input, the N-element right-hand-side array. On - !! output, the N-element solution array. - !! @param[out] err An optional errors-based object that if provided can be - !! used to retrieve information relating to any errors encountered during - !! execution. If not provided, a default implementation of the errors - !! class is used internally to provide error handling. Possible errors and - !! warning messages that may be encountered are as follows. - !! - LA_ARRAY_SIZE_ERROR: Occurs if @p a is not square, or if the sizes of - !! @p a and @p b are not compatible. - !! - !! - !! @par Usage - !! To solve a triangular system of N equations of N unknowns A*X = B, where - !! A is an N-by-N upper triangular matrix, and B and X are N-element - !! arrays, the following code will suffice. - !! - !! @code{.f90} - !! ! Solve the system: A*X = B, where A is an upper triangular N-by-N - !! ! matrix, and B and X are N-elements in size. - !! - !! ! Variables - !! integer(int32) :: info - !! real(real64), dimension(n, n) :: a - !! real(real64), dimension(n) :: b - !! - !! ! Initialize A and B... - !! - !! ! Solve A*X = B for X - Note: X overwrites B. - !! call solve_triangular_system(.true., .false., a, b) - !! @endcode - !! - !! @par Notes - !! This routine is based upon the BLAS routine ZTRSV. + module subroutine solve_tri_vec_cmplx(upper, trans, nounit, a, x, err) logical, intent(in) :: upper, trans, nounit complex(real64), intent(in), dimension(:,:) :: a From 9654df251faf23b30b8cda1182ded2b8b0d9db74 Mon Sep 17 00:00:00 2001 From: jchristopherson Date: Thu, 15 Dec 2022 05:46:07 -0600 Subject: [PATCH 21/65] Update documentation --- doc/html/annotated.html | 6 +- ...rfacelinalg__core_1_1cholesky__factor.html | 4 +- doc/html/interfacelinalg__core_1_1eigen.html | 4 +- .../interfacelinalg__core_1_1form__lu.html | 2 +- .../interfacelinalg__core_1_1form__qr.html | 2 +- .../interfacelinalg__core_1_1lu__factor.html | 2 +- ...interfacelinalg__core_1_1mtx__inverse.html | 28 +- ...nterfacelinalg__core_1_1mtx__pinverse.html | 30 +- .../interfacelinalg__core_1_1mult__qr.html | 2 +- .../interfacelinalg__core_1_1qr__factor.html | 2 +- ...erfacelinalg__core_1_1solve__cholesky.html | 24 +- ...linalg__core_1_1solve__least__squares.html | 29 +- ...__core_1_1solve__least__squares__full.html | 31 +- ...g__core_1_1solve__least__squares__svd.html | 33 +- .../interfacelinalg__core_1_1solve__lu.html | 22 +- .../interfacelinalg__core_1_1solve__qr.html | 45 +- ...lg__core_1_1solve__triangular__system.html | 8 +- doc/html/interfacelinalg__core_1_1sort.html | 2 +- doc/html/linalg__c__api_8f90_source.html | 18 +- doc/html/linalg__core_8f90_source.html | 1962 ++++++++--------- doc/html/linalg__immutable_8f90_source.html | 10 +- doc/html/namespacelinalg__core.html | 6 +- doc/html/namespaces.html | 6 +- src/linalg_core.f90 | 1349 +++--------- 24 files changed, 1600 insertions(+), 2027 deletions(-) diff --git a/doc/html/annotated.html b/doc/html/annotated.html index 0e167c47..a1b7d91f 100644 --- a/doc/html/annotated.html +++ b/doc/html/annotated.html @@ -124,9 +124,9 @@  Crecip_mult_arrayMultiplies a vector by the reciprocal of a real scalar  Crz_factorFactors an upper trapezoidal matrix by means of orthogonal transformations such that \( A = R Z = (R 0) Z \). Z is an orthogonal matrix of dimension N-by-N, and R is an M-by-M upper triangular matrix  Csolve_choleskySolves a system of Cholesky factored equations - Csolve_least_squaresSolves the overdetermined or underdetermined system (A*X = B) of M equations of N unknowns - Csolve_least_squares_fullSolves the overdetermined or underdetermined system (A*X = B) of M equations of N unknowns, but uses a full orthogonal factorization of the system - Csolve_least_squares_svdSolves the overdetermined or underdetermined system (A*X = B) of M equations of N unknowns using a singular value decomposition of matrix A + Csolve_least_squaresSolves the overdetermined or underdetermined system \( A X = B \) of M equations of N unknowns. Notice, it is assumed that matrix A has full rank + Csolve_least_squares_fullSolves the overdetermined or underdetermined system \( A X = B \) of M equations of N unknowns, but uses a full orthogonal factorization of the system + Csolve_least_squares_svdSolves the overdetermined or underdetermined system \( A X = B \) of M equations of N unknowns using a singular value decomposition of matrix A  Csolve_luSolves a system of LU-factored equations  Csolve_qrSolves a system of M QR-factored equations of N unknowns  Csolve_triangular_systemSolves a triangular system of equations diff --git a/doc/html/interfacelinalg__core_1_1cholesky__factor.html b/doc/html/interfacelinalg__core_1_1cholesky__factor.html index 838babc6..92528e31 100644 --- a/doc/html/interfacelinalg__core_1_1cholesky__factor.html +++ b/doc/html/interfacelinalg__core_1_1cholesky__factor.html @@ -174,8 +174,8 @@
    print '(F8.4)', (bu(i), i = 1, size(bu))
    end program
    Computes the Cholesky factorization of a symmetric, positive definite matrix.
    -
    Solves a system of Cholesky factored equations.
    -
    Solves a triangular system of equations.
    +
    Solves a system of Cholesky factored equations.
    +
    Solves a triangular system of equations.
    Provides a set of common linear algebra routines.
    Definition: linalg_core.f90:15
    The above program produces the following output.
    Cholesky Solution: X =
    239.5833
    diff --git a/doc/html/interfacelinalg__core_1_1eigen.html b/doc/html/interfacelinalg__core_1_1eigen.html index 608b5fa6..542f099d 100644 --- a/doc/html/interfacelinalg__core_1_1eigen.html +++ b/doc/html/interfacelinalg__core_1_1eigen.html @@ -164,7 +164,7 @@
    print '(F10.3)', (real(modeshapes(j,i)), j = 1, size(natfreq))
    end do
    end program
    -
    Computes the eigenvalues, and optionally the eigenvectors, of a matrix.
    +
    Computes the eigenvalues, and optionally the eigenvectors, of a matrix.
    Provides a set of common linear algebra routines.
    Definition: linalg_core.f90:15
    The above program produces the following output.
    Modal Information:
    Mode 1: (232.9225 Hz)
    @@ -187,7 +187,7 @@ -

    Definition at line 2611 of file linalg_core.f90.

    +

    Definition at line 2938 of file linalg_core.f90.


    The documentation for this interface was generated from the following file: diff --git a/doc/html/interfacelinalg__core_1_1form__lu.html b/doc/html/interfacelinalg__core_1_1form__lu.html index a9881531..b0ba8112 100644 --- a/doc/html/interfacelinalg__core_1_1form__lu.html +++ b/doc/html/interfacelinalg__core_1_1form__lu.html @@ -199,7 +199,7 @@
    end program
    Extracts the L and U matrices from the condensed [L\U] storage format used by the lu_factor.
    Computes the LU factorization of an M-by-N matrix.
    -
    Solves a triangular system of equations.
    +
    Solves a triangular system of equations.
    Provides a set of common linear algebra routines.
    Definition: linalg_core.f90:15
    The above program produces the following output.
    LU Solution: X =
    0.3333
    diff --git a/doc/html/interfacelinalg__core_1_1form__qr.html b/doc/html/interfacelinalg__core_1_1form__qr.html index 53668f5d..3242b062 100644 --- a/doc/html/interfacelinalg__core_1_1form__qr.html +++ b/doc/html/interfacelinalg__core_1_1form__qr.html @@ -204,7 +204,7 @@
    end program
    Forms the full M-by-M orthogonal matrix Q from the elementary reflectors returned by the base QR fact...
    Computes the QR factorization of an M-by-N matrix.
    -
    Solves a triangular system of equations.
    +
    Solves a triangular system of equations.
    Provides a set of common linear algebra routines.
    Definition: linalg_core.f90:15
    The above program produces the following output.
    QR Solution: X =
    0.3333
    diff --git a/doc/html/interfacelinalg__core_1_1lu__factor.html b/doc/html/interfacelinalg__core_1_1lu__factor.html index 2858b577..8f6b2ef8 100644 --- a/doc/html/interfacelinalg__core_1_1lu__factor.html +++ b/doc/html/interfacelinalg__core_1_1lu__factor.html @@ -167,7 +167,7 @@
    print '(F8.4)', (b(i), i = 1, size(b))
    end program
    Computes the LU factorization of an M-by-N matrix.
    -
    Solves a system of LU-factored equations.
    +
    Solves a system of LU-factored equations.
    Provides a set of common linear algebra routines.
    Definition: linalg_core.f90:15
    The program generates the following output.
    LU Solution: X =
    0.3333
    diff --git a/doc/html/interfacelinalg__core_1_1mtx__inverse.html b/doc/html/interfacelinalg__core_1_1mtx__inverse.html index 5fbdeef5..b7092c52 100644 --- a/doc/html/interfacelinalg__core_1_1mtx__inverse.html +++ b/doc/html/interfacelinalg__core_1_1mtx__inverse.html @@ -107,6 +107,30 @@ More...

    Detailed Description

    Computes the inverse of a square matrix.

    +
    Syntax
    subroutine mtx_inverse(real(real64) a(:,:), optional integer(int32) iwork, optional real(real64) work(:), optional integer olwork, optional class(errors) err)
    +
    subroutine mtx_inverse(complex(real64) a(:,:), optional integer(int32) iwork, optional complex(real64) work(:), optional integer olwork, optional class(errors) err)
    +
    +
    Parameters
    + + + + + + +
    [in,out]aOn input, the N-by-N matrix to invert. On output, the inverted matrix.
    [out]iworkAn optional N-element integer workspace array.
    [out]workAn optional input, that if provided, prevents any local memory allocation. If not provided, the memory required is allocated within. If provided, the length of the array must be at least olwork.
    [out]olworkAn optional output used to determine workspace size. If supplied, the routine determines the optimal size for work, and returns without performing any actual calculations.
    [in,out]errAn optional errors-based object that if provided can be used to retrieve information relating to any errors encountered during execution. If not provided, a default implementation of the errors class is used internally to provide error handling. Possible errors and warning messages that may be encountered are as follows.
      +
    • LA_ARRAY_SIZE_ERROR: Occurs if a is not square. Will also occur if incorrectly sized workspace arrays are provided.
    • +
    • LA_OUT_OF_MEMORY_ERROR: Occurs if local memory must be allocated, and there is insufficient memory available.
    • +
    • LA_SINGULAR_MATRIX_ERROR: Occurs if the input matrix is singular.
    • +
    +
    +
    +
    +
    Notes
    This routine utilizes the LAPACK routines DGETRF to perform an LU factorization of the matrix, and DGETRI to invert the LU factored matrix (ZGETRF and ZGETRI in the complex case).
    +
    See Also
    +
    Usage
    The following example illustrates the inversion of a 3-by-3 matrix.
    program example
    use iso_fortran_env, only : real64, int32
    @@ -143,7 +167,7 @@
    print *, c(i,:)
    end do
    end program
    -
    Computes the inverse of a square matrix.
    +
    Computes the inverse of a square matrix.
    Provides a set of common linear algebra routines.
    Definition: linalg_core.f90:15
    The above program produces the following output.
    Inverse:
    -1.7777777777777777 0.88888888888888884 -0.11111111111111110
    @@ -155,7 +179,7 @@
    1.7763568394002505E-015 -8.8817841970012523E-016 1.0000000000000000
    -

    Definition at line 2456 of file linalg_core.f90.

    +

    Definition at line 2738 of file linalg_core.f90.


    The documentation for this interface was generated from the following file: diff --git a/doc/html/interfacelinalg__core_1_1mtx__pinverse.html b/doc/html/interfacelinalg__core_1_1mtx__pinverse.html index cb141ad2..b5862bac 100644 --- a/doc/html/interfacelinalg__core_1_1mtx__pinverse.html +++ b/doc/html/interfacelinalg__core_1_1mtx__pinverse.html @@ -107,6 +107,32 @@ More...

    Detailed Description

    Computes the Moore-Penrose pseudo-inverse of a M-by-N matrix using the singular value decomposition of the matrix.

    +
    Syntax
    subroutine mtx_pinverse(real(real64) a(:,:), real(real64) ainv(:,:), optional real(real64) tol, optional real(real64) work(:), optional integer(int32) olwork, optional class(errors) err)
    +
    subroutine mtx_pinverse(complex(real64) a(:,:), complex(real64) ainv(:,:), optional real(real64) tol, optional complex(real64) work(:), optional integer(int32) olwork, optional real(real64) rwork(:), optional class(errors) err)
    +
    +
    Parameters
    + + + + + + + + +
    [in,out]aOn input, the M-by-N matrix to invert. The matrix is overwritten on output.
    [out]ainvThe N-by-M matrix where the pseudo-inverse of a will be written.
    [in]tolAn optional input, that if supplied, overrides the default tolerance on singular values such that singular values less than this tolerance are forced to have a reciprocal of zero, as opposed to 1/S(I). The default tolerance is: MAX(M, N) * EPS * MAX(S). If the supplied value is less than a value that causes an overflow, the tolerance reverts back to its default value, and the operation continues; however, a warning message is issued.
    [out]workAn optional input, that if provided, prevents any local memory allocation. If not provided, the memory required is allocated within. If provided, the length of the array must be at least olwork.
    [out]olworkAn optional output used to determine workspace size. If supplied, the routine determines the optimal size for work, and returns without performing any actual calculations.
    [out]rworkAn optional input, that if provided, prevents any local memory allocation for real-valued workspaces. If not provided, the memory required is allocated within. If provided, the length of the array must be at least 6 * MIN(M, N).
    [in,out]errAn optional errors-based object that if provided can be used to retrieve information relating to any errors encountered during execution. If not provided, a default implementation of the errors class is used internally to provide error handling. Possible errors and warning messages that may be encountered are as follows.
      +
    • LA_ARRAY_SIZE_ERROR: Occurs if any of the input arrays are not sized appropriately.
    • +
    • LA_OUT_OF_MEMORY_ERROR: Occurs if local memory must be allocated, and there is insufficient memory available.
    • +
    • LA_CONVERGENCE_ERROR: Occurs as a warning if the QR iteration process could not converge to a zero value.
    • +
    +
    +
    +
    +
    See Also
    +
    Usage
    The following example illustrates how to compute the Moore-Penrose pseudo-inverse of a matrix.
    program example
    use iso_fortran_env, only : int32, real64
    @@ -145,7 +171,7 @@
    print *, c(i,:)
    end do
    end program
    -
    Computes the Moore-Penrose pseudo-inverse of a M-by-N matrix using the singular value decomposition o...
    +
    Computes the Moore-Penrose pseudo-inverse of a M-by-N matrix using the singular value decomposition o...
    Provides a set of common linear algebra routines.
    Definition: linalg_core.f90:15
    The above program produces the following output.
    Inverse:
    1.0000000000000000 0.0000000000000000 0.0000000000000000
    @@ -155,7 +181,7 @@
    0.0000000000000000 0.99999999999999967
    -

    Definition at line 2517 of file linalg_core.f90.

    +

    Definition at line 2844 of file linalg_core.f90.


    The documentation for this interface was generated from the following file: diff --git a/doc/html/interfacelinalg__core_1_1mult__qr.html b/doc/html/interfacelinalg__core_1_1mult__qr.html index c4d64057..1969c82f 100644 --- a/doc/html/interfacelinalg__core_1_1mult__qr.html +++ b/doc/html/interfacelinalg__core_1_1mult__qr.html @@ -203,7 +203,7 @@
    end program
    Multiplies a general matrix by the orthogonal matrix Q from a QR factorization.
    Computes the QR factorization of an M-by-N matrix.
    -
    Solves a triangular system of equations.
    +
    Solves a triangular system of equations.
    Provides a set of common linear algebra routines.
    Definition: linalg_core.f90:15
    The above program produces the following output.
    QR Solution: X =
    0.3333
    diff --git a/doc/html/interfacelinalg__core_1_1qr__factor.html b/doc/html/interfacelinalg__core_1_1qr__factor.html index a41570cd..14bc76a1 100644 --- a/doc/html/interfacelinalg__core_1_1qr__factor.html +++ b/doc/html/interfacelinalg__core_1_1qr__factor.html @@ -190,7 +190,7 @@
    ! tracking array).
    end program
    Computes the QR factorization of an M-by-N matrix.
    -
    Solves a system of M QR-factored equations of N unknowns.
    +
    Solves a system of M QR-factored equations of N unknowns.
    Provides a set of common linear algebra routines.
    Definition: linalg_core.f90:15
    The above program produces the following output.
    QR Solution: X =
    0.3333
    diff --git a/doc/html/interfacelinalg__core_1_1solve__cholesky.html b/doc/html/interfacelinalg__core_1_1solve__cholesky.html index 179d56cd..17354aa0 100644 --- a/doc/html/interfacelinalg__core_1_1solve__cholesky.html +++ b/doc/html/interfacelinalg__core_1_1solve__cholesky.html @@ -107,6 +107,24 @@ More...

    Detailed Description

    Solves a system of Cholesky factored equations.

    +
    Syntax
    subroutine solve_cholesky(logical upper, real(real64) a(:,:), real(real64) b(:,:), optional class(errors) err)
    +
    subroutine solve_cholesky(logical upper, complex(real64) a(:,:), complex(real64) b(:,:), optional class(errors) err)
    +
    subroutine solve_cholesky(logical upper, real(real64) a(:,:), real(real64) b(:), optional class(errors) err)
    +
    subroutine solve_cholesky(logical upper, complex(real64) a(:,:), complex(real64) b(:), optional class(errors) err)
    +
    +
    Parameters
    + + + + + +
    [in]upperSet to true if the original matrix \( A \) was factored such that \( A = U^T U \); else, set to false if the factorization of \( A \) was \( A = L L^T \).
    [in]aThe N-by-N Cholesky factored matrix as returned by cholesky_factor.
    [in,out]bOn input, the N-by-NRHS right-hand-side matrix B. On output, the solution matrix X.
    [in,out]errAn optional errors-based object that if provided can be used to retrieve information relating to any errors encountered during execution. If not provided, a default implementation of the errors class is used internally to provide error handling. Possible errors and warning messages that may be encountered are as follows.
      +
    • LA_ARRAY_SIZE_ERROR: Occurs if any of the input array sizes are incorrect.
    • +
    +
    +
    +
    +
    Notes
    This routine utilizes the LAPACK routine DPOTRS (ZPOTRS in the complex case).
    Usage
    The following example illustrates the solution of a positive-definite system of equations via Cholesky factorization.
    program example
    use iso_fortran_env, only : real64, int32
    @@ -158,8 +176,8 @@
    print '(F8.4)', (bu(i), i = 1, size(bu))
    end program
    Computes the Cholesky factorization of a symmetric, positive definite matrix.
    -
    Solves a system of Cholesky factored equations.
    -
    Solves a triangular system of equations.
    +
    Solves a system of Cholesky factored equations.
    +
    Solves a triangular system of equations.
    Provides a set of common linear algebra routines.
    Definition: linalg_core.f90:15
    The above program produces the following output.
    Cholesky Solution: X =
    239.5833
    @@ -171,7 +189,7 @@
    10.3333
    -

    Definition at line 2233 of file linalg_core.f90.

    +

    Definition at line 2350 of file linalg_core.f90.


    The documentation for this interface was generated from the following file: diff --git a/doc/html/interfacelinalg__core_1_1solve__least__squares.html b/doc/html/interfacelinalg__core_1_1solve__least__squares.html index 09f23324..8efaa4f4 100644 --- a/doc/html/interfacelinalg__core_1_1solve__least__squares.html +++ b/doc/html/interfacelinalg__core_1_1solve__least__squares.html @@ -103,10 +103,31 @@
    -

    Solves the overdetermined or underdetermined system (A*X = B) of M equations of N unknowns. +

    Solves the overdetermined or underdetermined system \( A X = B \) of M equations of N unknowns. Notice, it is assumed that matrix A has full rank. More...

    Detailed Description

    -

    Solves the overdetermined or underdetermined system (A*X = B) of M equations of N unknowns.

    +

    Solves the overdetermined or underdetermined system \( A X = B \) of M equations of N unknowns. Notice, it is assumed that matrix A has full rank.

    +
    Syntax
    subroutine solve_least_squares(real(real64) a(:,:), real(real64) b(:,:), optional real(real64) work(:), optional integer(int32) olwork, optional class(errors) err)
    +
    subroutine solve_least_squares(complex(real64) a(:,:), complex(real64) b(:,:), optional complex(real64) work(:), optional integer(int32) olwork, optional class(errors) err)
    +
    subroutine solve_least_squares(real(real64) a(:,:), real(real64) b(:), optional real(real64) work(:), optional integer(int32) olwork, optional class(errors) err)
    +
    subroutine solve_least_squares(complex(real64) a(:,:), complex(real64) b(:), optional complex(real64) work(:), optional integer(int32) olwork, optional class(errors) err)
    +
    +
    Parameters
    + + + + + + +
    [in,out]aOn input, the M-by-N matrix A. On output, if M >= N, the QR factorization of A in the form as output by qr_factor; else, if M < N, the LQ factorization of A.
    [in,out]bIf M >= N, the M-by-NRHS matrix B. On output, the first N rows contain the N-by-NRHS solution matrix X. If M < N, an N-by-NRHS matrix with the first M rows containing the matrix B. On output, the N-by-NRHS solution matrix X.
    [out]workAn optional input, that if provided, prevents any local memory allocation. If not provided, the memory required is allocated within. If provided, the length of the array must be at least olwork.
    [out]olworkAn optional output used to determine workspace size. If supplied, the routine determines the optimal size for work, and returns without performing any actual calculations.
    [in,out]errAn optional errors-based object that if provided can be used to retrieve information relating to any errors encountered during execution. If not provided, a default implementation of the errors class is used internally to provide error handling. Possible errors and warning messages that may be encountered are as follows.
      +
    • LA_ARRAY_SIZE_ERROR: Occurs if any of the input arrays are not sized appropriately.
    • +
    • LA_OUT_OF_MEMORY_ERROR: Occurs if local memory must be allocated, and there is insufficient memory available.
    • +
    • LA_INVALID_OPERATION_ERROR: Occurs if a is not of full rank.
    • +
    +
    +
    +
    +
    Notes
    This routine utilizes the LAPACK routine DGELS (ZGELS in the complex case).
    Usage
    The following example illustrates the least squares solution of an overdetermined system of linear equations.
    program example
    use iso_fortran_env, only : real64, int32
    @@ -139,14 +160,14 @@
    print '(A)', "Least Squares Solution: X = "
    print '(F9.5)', (b(i), i = 1, size(a, 2))
    end program
    -
    Solves the overdetermined or underdetermined system (A*X = B) of M equations of N unknowns.
    +
    Solves the overdetermined or underdetermined system of M equations of N unknowns....
    Provides a set of common linear algebra routines.
    Definition: linalg_core.f90:15
    The above program produces the following output.
    Least Squares Solution: X =
    0.13158
    -0.57895
    -

    Definition at line 2287 of file linalg_core.f90.

    +

    Definition at line 2440 of file linalg_core.f90.


    The documentation for this interface was generated from the following file: diff --git a/doc/html/interfacelinalg__core_1_1solve__least__squares__full.html b/doc/html/interfacelinalg__core_1_1solve__least__squares__full.html index bd32a35f..5be0d2aa 100644 --- a/doc/html/interfacelinalg__core_1_1solve__least__squares__full.html +++ b/doc/html/interfacelinalg__core_1_1solve__least__squares__full.html @@ -103,10 +103,33 @@
    -

    Solves the overdetermined or underdetermined system (A*X = B) of M equations of N unknowns, but uses a full orthogonal factorization of the system. +

    Solves the overdetermined or underdetermined system \( A X = B \) of M equations of N unknowns, but uses a full orthogonal factorization of the system. More...

    Detailed Description

    -

    Solves the overdetermined or underdetermined system (A*X = B) of M equations of N unknowns, but uses a full orthogonal factorization of the system.

    +

    Solves the overdetermined or underdetermined system \( A X = B \) of M equations of N unknowns, but uses a full orthogonal factorization of the system.

    +
    Syntax
    subroutine solve_least_squares_full(real(real64) a(:,:), real(real64) b(:,:), optional integer(int32) ipvt(:), optional integer(int32) arnk, optional real(real64) work(:), optional integer(int32) olwork, optional class(errors) err)
    +
    subroutine solve_least_squares_full(complex(real64) a(:,:), complex(real64) b(:,:), optional integer(int32) ipvt(:), optional integer(int32) arnk, optional complex(real64) work(:), optional integer(int32) olwork, optional real(real64) rwork(:), optional class(errors) err)
    +
    subroutine solve_least_squares_full(real(real64) a(:,:), real(real64) b(:), optional integer(int32) ipvt(:), optional integer(int32) arnk, optional real(real64) work(:), optional integer(int32) olwork, optional class(errors) err)
    +
    subroutine solve_least_squares_full(complex(real64) a(:,:), complex(real64) b(:), optional integer(int32) ipvt(:), optional integer(int32) arnk, optional complex(real64) work(:), optional integer(int32) olwork, optional real(real64) rwork(:), optional class(errors) err)
    +
    +
    Parameters
    + + + + + + + + + +
    [in,out]aOn input, the M-by-N matrix A. On output, the matrix is overwritten by the details of its complete orthogonal factorization.
    [in,out]bIf M >= N, the M-by-NRHS matrix B. On output, the first N rows contain the N-by-NRHS solution matrix X. If M < N, an N-by-NRHS matrix with the first M rows containing the matrix B. On output, the N-by-NRHS solution matrix X.
    [out]ipvtAn optional input that on input, an N-element array that if IPVT(I) .ne. 0, the I-th column of A is permuted to the front of A * P; if IPVT(I) = 0, the I-th column of A is a free column. On output, if IPVT(I) = K, then the I-th column of A * P was the K-th column of A. If not supplied, memory is allocated internally, and IPVT is set to all zeros such that all columns are treated as free.
    [out]arnkAn optional output, that if provided, will return the rank of a.
    [out]workAn optional input, that if provided, prevents any local memory allocation. If not provided, the memory required is allocated within. If provided, the length of the array must be at least olwork.
    [out]olworkAn optional output used to determine workspace size. If supplied, the routine determines the optimal size for work, and returns without performing any actual calculations.
    [out]rworkAn optional input, that if provided, prevents any local memory allocation for real-valued workspaces. If not provided, the memory required is allocated within. If provided, the length of the array must be at least 2 * N.
    [in,out]errAn optional errors-based object that if provided can be used to retrieve information relating to any errors encountered during execution. If not provided, a default implementation of the errors class is used internally to provide error handling. Possible errors and warning messages that may be encountered are as follows.
      +
    • LA_ARRAY_SIZE_ERROR: Occurs if any of the input arrays are not sized appropriately.
    • +
    • LA_OUT_OF_MEMORY_ERROR: Occurs if local memory must be allocated, and there is insufficient memory available.
    • +
    +
    +
    +
    +
    Notes
    This routine utilizes the LAPACK routine DGELSY (ZGELSY in the complex case).
    Usage
    The following example illustrates the least squares solution of an overdetermined system of linear equations.
    program example
    use iso_fortran_env, only : real64, int32
    @@ -139,14 +162,14 @@
    print '(A)', "Least Squares Solution: X = "
    print '(F9.5)', (b(i), i = 1, size(a, 2))
    end program
    -
    Solves the overdetermined or underdetermined system (A*X = B) of M equations of N unknowns,...
    +
    Solves the overdetermined or underdetermined system of M equations of N unknowns,...
    Provides a set of common linear algebra routines.
    Definition: linalg_core.f90:15
    The above program produces the following output.
    Least Squares Solution: X =
    0.13158
    -0.57895
    -

    Definition at line 2342 of file linalg_core.f90.

    +

    Definition at line 2541 of file linalg_core.f90.


    The documentation for this interface was generated from the following file: diff --git a/doc/html/interfacelinalg__core_1_1solve__least__squares__svd.html b/doc/html/interfacelinalg__core_1_1solve__least__squares__svd.html index e62645de..c99c0228 100644 --- a/doc/html/interfacelinalg__core_1_1solve__least__squares__svd.html +++ b/doc/html/interfacelinalg__core_1_1solve__least__squares__svd.html @@ -103,10 +103,35 @@
    -

    Solves the overdetermined or underdetermined system (A*X = B) of M equations of N unknowns using a singular value decomposition of matrix A. +

    Solves the overdetermined or underdetermined system \( A X = B \) of M equations of N unknowns using a singular value decomposition of matrix A. More...

    Detailed Description

    -

    Solves the overdetermined or underdetermined system (A*X = B) of M equations of N unknowns using a singular value decomposition of matrix A.

    +

    Solves the overdetermined or underdetermined system \( A X = B \) of M equations of N unknowns using a singular value decomposition of matrix A.

    +
    Syntax
    subroutine solve_least_squares_svd(real(real64) a(:,:), real(real64) b(:,:), optional real(real64) s(:), optional integer(int32) arnk, optional real(real64) work(:), optional integer(int32) olwork, optional class(errors) err)
    +
    subroutine solve_least_squares_svd(complex(real64) a(:,:), complex(real64) b(:,:), optional real(real64) s(:), optional integer(int32) arnk, optional complex(real64) work(:), optional integer(int32) olwork, optional real(real64) rwork(:), optional class(errors) err)
    +
    subroutine solve_least_squares_svd(real(real64) a(:,:), real(real64) b(:), optional real(real64) s(:), optional integer(int32) arnk, optional real(real64) work(:), optional integer(int32) olwork, optional class(errors) err)
    +
    subroutine solve_least_squares_svd(complex(real64) a(:,:), complex(real64) b(:), optional real(real64) s(:), optional integer(int32) arnk, optional complex(real64) work(:), optional integer(int32) olwork, optional real(real64) rwork(:), optional class(errors) err)
    +
    +
    Parameters
    + + + + + + + + + + +
    [in,out]aOn input, the M-by-N matrix A. On output, the matrix is overwritten by the details of its complete orthogonal factorization.
    [in,out]bIf M >= N, the M-by-NRHS matrix B. On output, the first N rows contain the N-by-NRHS solution matrix X. If M < N, an N-by-NRHS matrix with the first M rows containing the matrix B. On output, the N-by-NRHS solution matrix X.
    [out]arnkAn optional output, that if provided, will return the rank of a.
    [out]sAn optional MIN(M, N)-element array that on output contains the singular values of a in descending order. Notice, the condition number of a can be determined by S(1) / S(MIN(M, N)).
    [out]arnkAn optional output, that if provided, will return the rank of a.
    [out]workAn optional input, that if provided, prevents any local memory allocation for complex-valued workspaces. If not provided, the memory required is allocated within. If provided, the length of the array must be at least olwork.
    [out]olworkAn optional output used to determine workspace size. If supplied, the routine determines the optimal size for work, and returns without performing any actual calculations.
    [out]rworkAn optional input, that if provided, prevents any local memory allocation for real-valued workspaces. If not provided, the memory required is allocated within. If provided, the length of the array must be at least 5 * MIN(M, N).
    [in,out]errAn optional errors-based object that if provided can be used to retrieve information relating to any errors encountered during execution. If not provided, a default implementation of the errors class is used internally to provide error handling. Possible errors and warning messages that may be encountered are as follows.
      +
    • LA_ARRAY_SIZE_ERROR: Occurs if any of the input arrays are not sized appropriately.
    • +
    • LA_OUT_OF_MEMORY_ERROR: Occurs if local memory must be allocated, and there is insufficient memory available.
    • +
    • LA_CONVERGENCE_ERROR: Occurs as a warning if the QR iteration process could not converge to a zero value.
    • +
    +
    +
    +
    +
    Notes
    This routine utilizes the LAPACK routine DGELSS (ZGELSS in the complex case).
    Usage
    The following example illustrates the least squares solution of an overdetermined system of linear equations.
    program example
    use iso_fortran_env, only : real64, int32
    @@ -139,14 +164,14 @@
    print '(A)', "Least Squares Solution: X = "
    print '(F9.5)', (b(i), i = 1, size(a, 2))
    end program
    -
    Solves the overdetermined or underdetermined system (A*X = B) of M equations of N unknowns using a si...
    +
    Solves the overdetermined or underdetermined system of M equations of N unknowns using a singular va...
    Provides a set of common linear algebra routines.
    Definition: linalg_core.f90:15
    The above program produces the following output.
    Least Squares Solution: X =
    0.13158
    -0.57895
    -

    Definition at line 2397 of file linalg_core.f90.

    +

    Definition at line 2643 of file linalg_core.f90.


    The documentation for this interface was generated from the following file: diff --git a/doc/html/interfacelinalg__core_1_1solve__lu.html b/doc/html/interfacelinalg__core_1_1solve__lu.html index 8ef54568..37fc14a0 100644 --- a/doc/html/interfacelinalg__core_1_1solve__lu.html +++ b/doc/html/interfacelinalg__core_1_1solve__lu.html @@ -107,6 +107,24 @@ More...

    Detailed Description

    Solves a system of LU-factored equations.

    +
    Syntax
    subroutine solve_lu(real(real64) a(:,:), integer(int32) ipvt(:), real(real64) b(:,:), optional class(errors) err)
    +
    subroutine solve_lu(complex(real64) a(:,:), integer(int32) ipvt(:), complex(real64) b(:,:), optional class(errors) err)
    +
    subroutine solve_lu(real(real64) a(:,:), integer(int32) ipvt(:), real(real64) b(:), optional class(errors) err)
    +
    subroutine solve_lu(complex(real64) a(:,:), integer(int32) ipvt(:), complex(real64) b(:), optional class(errors) err)
    +
    +
    Parameters
    + + + + + +
    [in]aThe N-by-N LU factored matrix as output by lu_factor.
    [in]ipvtThe N-element pivot array as output by lu_factor.
    [in,out]bOn input, the N-by-NRHS right-hand-side matrix. On output, the N-by-NRHS solution matrix.
    [in,out]errAn optional errors-based object that if provided can be used to retrieve information relating to any errors encountered during execution. If not provided, a default implementation of the errors class is used internally to provide error handling. Possible errors and warning messages that may be encountered are as follows.
      +
    • LA_ARRAY_SIZE_ERROR: Occurs if any of the input array sizes are incorrect.
    • +
    +
    +
    +
    +
    Notes
    The routine is based upon the LAPACK routine DGETRS (ZGETRS in the complex case).
    Usage
    To solve a system of 3 equations of 3 unknowns using LU factorization, the following code will suffice.
    program example
    use iso_fortran_env
    @@ -146,7 +164,7 @@
    print '(F8.4)', (b(i), i = 1, size(b))
    end program
    Computes the LU factorization of an M-by-N matrix.
    -
    Solves a system of LU-factored equations.
    +
    Solves a system of LU-factored equations.
    Provides a set of common linear algebra routines.
    Definition: linalg_core.f90:15
    The program generates the following output.
    LU Solution: X =
    0.3333
    @@ -159,7 +177,7 @@
    -

    Definition at line 2084 of file linalg_core.f90.

    +

    Definition at line 2109 of file linalg_core.f90.


    The documentation for this interface was generated from the following file: diff --git a/doc/html/interfacelinalg__core_1_1solve__qr.html b/doc/html/interfacelinalg__core_1_1solve__qr.html index 84e38cd5..c1f1d12d 100644 --- a/doc/html/interfacelinalg__core_1_1solve__qr.html +++ b/doc/html/interfacelinalg__core_1_1solve__qr.html @@ -107,6 +107,47 @@ More...

    Detailed Description

    Solves a system of M QR-factored equations of N unknowns.

    +
    Syntax 1 (No Pivoting)
    subroutine solve_qr(real(real64) a(:,:), real(real64) tau(:), real(real64) b(:,:), optional real(real64) work(:), optional integer(int32) olwork, optional class(errors) err)
    +
    subroutine solve_qr(complex(real64) a(:,:), complex(real64) tau(:), complex(real64) b(:,:), optional complex(real64) work(:), optional integer(int32) olwork, optional class(errors) err)
    +
    subroutine solve_qr(real(real64) a(:,:), real(real64) tau(:), real(real64) b(:), optional real(real64) work(:), optional integer(int32) olwork, optional class(errors) err)
    +
    subroutine solve_qr(complex(real64) a(:,:), complex(real64) tau(:), complex(real64) b(:), optional complex(real64) work(:), optional integer(int32) olwork, optional class(errors) err)
    +
    +
    Parameters
    + + + + + + + +
    [in]aOn input, the M-by-N QR factored matrix as returned by qr_factor. On output, the contents of this matrix are restored. Notice, M must be greater than or equal to N.
    [in]tauA MIN(M, N)-element array containing the scalar factors of the elementary reflectors as returned by qr_factor.
    [in]bOn input, the M-by-NRHS right-hand-side matrix. On output, the first N rows are overwritten by the solution matrix X.
    [out]workAn optional input, that if provided, prevents any local memory allocation. If not provided, the memory required is allocated within. If provided, the length of the array must be at least olwork.
    [out]olworkAn optional output used to determine workspace size. If supplied, the routine determines the optimal size for work, and returns without performing any actual calculations.
    [in,out]errAn optional errors-based object that if provided can be used to retrieve information relating to any errors encountered during execution. If not provided, a default implementation of the errors class is used internally to provide error handling. Possible errors and warning messages that may be encountered are as follows.
      +
    • LA_ARRAY_SIZE_ERROR: Occurs if any of the input arrays are not sized appropriately.
    • +
    • LA_OUT_OF_MEMORY_ERROR: Occurs if local memory must be allocated, and there is insufficient memory available.
    • +
    +
    +
    +
    +
    Syntax 2 (With Pivoting)
    subroutine solve_qr(real(real64) a(:,:), real(real64) tau(:), integer(int32) jpvt(:), real(real64) b(:,:), optional real(real64) work(:), optional integer(int32) olwork, optional class(errors) err)
    +
    subroutine solve_qr(complex(real64) a(:,:), complex(real64) tau(:), integer(int32) jpvt(:), complex(real64) b(:,:), optional complex(real64) work(:), optional integer(int32) olwork, optional class(errors) err)
    +
    subroutine solve_qr(real(real64) a(:,:), real(real64) tau(:), integer(int32) jpvt(:), real(real64) b(:), optional real(real64) work(:), optional integer(int32) olwork, optional class(errors) err)
    +
    subroutine solve_qr(complex(real64) a(:,:), complex(real64) tau(:), integer(int32) jpvt(:), complex(real64) b(:), optional complex(real64) work(:), optional integer(int32) olwork, optional class(errors) err)
    +
    +
    Parameters
    + + + + + + + + +
    [in]aOn input, the M-by-N QR factored matrix as returned by qr_factor. On output, the contents of this matrix are altered.
    [in]tauA MIN(M, N)-element array containing the scalar factors of the elementary reflectors as returned by qr_factor.
    [in]jpvtAn N-element array, as output by qr_factor, used to track the column pivots.
    [in]bOn input, the MAX(M, N)-by-NRHS matrix where the first M rows contain the right-hand-side matrix B. On output, the first N rows are overwritten by the solution matrix X.
    [out]workAn optional input, that if provided, prevents any local memory allocation. If not provided, the memory required is allocated within. If provided, the length of the array must be at least olwork.
    [out]olworkAn optional output used to determine workspace size. If supplied, the routine determines the optimal size for work, and returns without performing any actual calculations.
    [in,out]errAn optional errors-based object that if provided can be used to retrieve information relating to any errors encountered during execution. If not provided, a default implementation of the errors class is used internally to provide error handling. Possible errors and warning messages that may be encountered are as follows.
      +
    • LA_ARRAY_SIZE_ERROR: Occurs if any of the input arrays are not sized appropriately.
    • +
    • LA_OUT_OF_MEMORY_ERROR: Occurs if local memory must be allocated, and there is insufficient memory available.
    • +
    +
    +
    +
    Usage
    The following example illustrates the solution of a system of equations using QR factorization.
    program example
    use iso_fortran_env, only : real64, int32
    @@ -151,7 +192,7 @@
    ! tracking array).
    end program
    Computes the QR factorization of an M-by-N matrix.
    -
    Solves a system of M QR-factored equations of N unknowns.
    +
    Solves a system of M QR-factored equations of N unknowns.
    Provides a set of common linear algebra routines.
    Definition: linalg_core.f90:15
    The above program produces the following output.
    QR Solution: X =
    0.3333
    @@ -164,7 +205,7 @@
    -

    Definition at line 2153 of file linalg_core.f90.

    +

    Definition at line 2244 of file linalg_core.f90.


    The documentation for this interface was generated from the following file: diff --git a/doc/html/interfacelinalg__core_1_1solve__triangular__system.html b/doc/html/interfacelinalg__core_1_1solve__triangular__system.html index 90e15921..39b35dc8 100644 --- a/doc/html/interfacelinalg__core_1_1solve__triangular__system.html +++ b/doc/html/interfacelinalg__core_1_1solve__triangular__system.html @@ -127,7 +127,9 @@
    Notes
    This routine is based upon the BLAS routine DTRSM (ZTRSM in the complex case).
    -
    Syntax 2
    Solves the system of equations: \( op(A) X = B \), where \( A \) is a triangular matrix.
    +
    Syntax 2
    Solves the system of equations: \( op(A) X = B \), where \( A \) is a triangular matrix.
    subroutine solve_triangular_system(logical upper, logical trans, logical nounit, real(real64) a(:,:), real(real64) x(:), optional class(errors) err)
    +
    subroutine solve_triangular_system(logical upper, logical trans, logical nounit, complex(real64) a(:,:), complex(real64) x(:), optional class(errors) err)
    +
    Parameters
    @@ -194,7 +196,7 @@
    end program
    Extracts the L and U matrices from the condensed [L\U] storage format used by the lu_factor.
    Computes the LU factorization of an M-by-N matrix.
    -
    Solves a triangular system of equations.
    +
    Solves a triangular system of equations.
    Provides a set of common linear algebra routines.
    Definition: linalg_core.f90:15
    The above program produces the following output.
    LU Solution: X =
    0.3333
    @@ -202,7 +204,7 @@
    0.0000
    -

    Definition at line 2020 of file linalg_core.f90.

    +

    Definition at line 2021 of file linalg_core.f90.


    The documentation for this interface was generated from the following file: diff --git a/doc/html/interfacelinalg__core_1_1sort.html b/doc/html/interfacelinalg__core_1_1sort.html index 38607ac8..637af865 100644 --- a/doc/html/interfacelinalg__core_1_1sort.html +++ b/doc/html/interfacelinalg__core_1_1sort.html @@ -108,7 +108,7 @@

    Detailed Description

    Sorts an array.

    -

    Definition at line 2620 of file linalg_core.f90.

    +

    Definition at line 2947 of file linalg_core.f90.


    The documentation for this interface was generated from the following file: diff --git a/doc/html/linalg__c__api_8f90_source.html b/doc/html/linalg__c__api_8f90_source.html index 28890125..a42b1df0 100644 --- a/doc/html/linalg__c__api_8f90_source.html +++ b/doc/html/linalg__c__api_8f90_source.html @@ -2027,23 +2027,23 @@
    Computes the rank 1 update to a Cholesky factored matrix (upper triangular).
    Computes the determinant of a square matrix.
    Multiplies a diagonal matrix with another matrix or array.
    -
    Computes the eigenvalues, and optionally the eigenvectors, of a matrix.
    +
    Computes the eigenvalues, and optionally the eigenvectors, of a matrix.
    Extracts the L and U matrices from the condensed [L\U] storage format used by the lu_factor.
    Forms the full M-by-M orthogonal matrix Q from the elementary reflectors returned by the base QR fact...
    Computes the LU factorization of an M-by-N matrix.
    -
    Computes the inverse of a square matrix.
    -
    Computes the Moore-Penrose pseudo-inverse of a M-by-N matrix using the singular value decomposition o...
    +
    Computes the inverse of a square matrix.
    +
    Computes the Moore-Penrose pseudo-inverse of a M-by-N matrix using the singular value decomposition o...
    Computes the rank of a matrix.
    Multiplies a general matrix by the orthogonal matrix Q from a QR factorization.
    Computes the QR factorization of an M-by-N matrix.
    Computes the rank 1 update to an M-by-N QR factored matrix A (M >= N) where , and such that .
    Performs the rank-1 update to matrix A such that: , where is an M-by-N matrix, is a scalar,...
    -
    Solves a system of Cholesky factored equations.
    -
    Solves the overdetermined or underdetermined system (A*X = B) of M equations of N unknowns.
    -
    Solves a system of LU-factored equations.
    -
    Solves a system of M QR-factored equations of N unknowns.
    -
    Solves a triangular system of equations.
    -
    Sorts an array.
    +
    Solves a system of Cholesky factored equations.
    +
    Solves the overdetermined or underdetermined system of M equations of N unknowns....
    +
    Solves a system of LU-factored equations.
    +
    Solves a system of M QR-factored equations of N unknowns.
    +
    Solves a triangular system of equations.
    +
    Sorts an array.
    Computes the singular value decomposition of a matrix A. The SVD is defined as: , where is an M-by-M...
    Computes the trace of a matrix (the sum of the main diagonal elements).
    Computes the triangular matrix operation: , or , where A is a triangular matrix.
    diff --git a/doc/html/linalg__core_8f90_source.html b/doc/html/linalg__core_8f90_source.html index 458e0c6a..c13b3618 100644 --- a/doc/html/linalg__core_8f90_source.html +++ b/doc/html/linalg__core_8f90_source.html @@ -290,995 +290,995 @@
    1890end interface
    1891
    1892! ------------------------------------------------------------------------------
    - -
    2021 module procedure :: solve_tri_mtx
    -
    2022 module procedure :: solve_tri_mtx_cmplx
    -
    2023 module procedure :: solve_tri_vec
    -
    2024 module procedure :: solve_tri_vec_cmplx
    -
    2025end interface
    -
    2026
    -
    2027! ------------------------------------------------------------------------------
    -
    2084interface solve_lu
    -
    2085 module procedure :: solve_lu_mtx
    -
    2086 module procedure :: solve_lu_mtx_cmplx
    -
    2087 module procedure :: solve_lu_vec
    -
    2088 module procedure :: solve_lu_vec_cmplx
    -
    2089end interface
    -
    2090
    -
    2091! ------------------------------------------------------------------------------
    -
    2153interface solve_qr
    -
    2154 module procedure :: solve_qr_no_pivot_mtx
    -
    2155 module procedure :: solve_qr_no_pivot_mtx_cmplx
    -
    2156 module procedure :: solve_qr_no_pivot_vec
    -
    2157 module procedure :: solve_qr_no_pivot_vec_cmplx
    -
    2158 module procedure :: solve_qr_pivot_mtx
    -
    2159 module procedure :: solve_qr_pivot_mtx_cmplx
    -
    2160 module procedure :: solve_qr_pivot_vec
    -
    2161 module procedure :: solve_qr_pivot_vec_cmplx
    -
    2162end interface
    -
    2163
    -
    2164! ------------------------------------------------------------------------------
    - -
    2234 module procedure :: solve_cholesky_mtx
    -
    2235 module procedure :: solve_cholesky_mtx_cmplx
    -
    2236 module procedure :: solve_cholesky_vec
    -
    2237 module procedure :: solve_cholesky_vec_cmplx
    -
    2238end interface
    -
    2239
    -
    2240! ------------------------------------------------------------------------------
    - -
    2288 module procedure :: solve_least_squares_mtx
    -
    2289 module procedure :: solve_least_squares_mtx_cmplx
    -
    2290 module procedure :: solve_least_squares_vec
    -
    2291 module procedure :: solve_least_squares_vec_cmplx
    -
    2292end interface
    -
    2293
    -
    2294! ------------------------------------------------------------------------------
    - -
    2343 module procedure :: solve_least_squares_mtx_pvt
    -
    2344 module procedure :: solve_least_squares_mtx_pvt_cmplx
    -
    2345 module procedure :: solve_least_squares_vec_pvt
    -
    2346 module procedure :: solve_least_squares_vec_pvt_cmplx
    -
    2347end interface
    -
    2348
    -
    2349! ------------------------------------------------------------------------------
    - -
    2398 module procedure :: solve_least_squares_mtx_svd
    -
    2399 module procedure :: solve_least_squares_vec_svd
    -
    2400end interface
    -
    2401
    -
    2402! ------------------------------------------------------------------------------
    - -
    2457 module procedure :: mtx_inverse_dbl
    -
    2458 module procedure :: mtx_inverse_cmplx
    -
    2459end interface
    -
    2460
    -
    2461! ------------------------------------------------------------------------------
    - -
    2518 module procedure :: mtx_pinverse_dbl
    -
    2519 module procedure :: mtx_pinverse_cmplx
    -
    2520end interface
    -
    2521
    -
    2522! ------------------------------------------------------------------------------
    -
    2611interface eigen
    -
    2612 module procedure :: eigen_symm
    -
    2613 module procedure :: eigen_asymm
    -
    2614 module procedure :: eigen_gen
    -
    2615 module procedure :: eigen_cmplx
    -
    2616end interface
    -
    2617
    -
    2618! ------------------------------------------------------------------------------
    -
    2620interface sort
    -
    2621 module procedure :: sort_dbl_array
    -
    2622 module procedure :: sort_dbl_array_ind
    -
    2623 module procedure :: sort_cmplx_array
    -
    2624 module procedure :: sort_cmplx_array_ind
    -
    2625 module procedure :: sort_eigen_cmplx
    -
    2626 module procedure :: sort_eigen_dbl
    -
    2627end interface
    -
    2628
    -
    2629
    -
    2630! ******************************************************************************
    -
    2631! LINALG_BASIC.F90
    -
    2632! ------------------------------------------------------------------------------
    -
    2633interface
    -
    2634 module subroutine mtx_mult_mtx(transa, transb, alpha, a, b, beta, c, err)
    -
    2635 logical, intent(in) :: transa, transb
    -
    2636 real(real64), intent(in) :: alpha, beta
    -
    2637 real(real64), intent(in), dimension(:,:) :: a, b
    -
    2638 real(real64), intent(inout), dimension(:,:) :: c
    -
    2639 class(errors), intent(inout), optional, target :: err
    -
    2640 end subroutine
    -
    2641
    -
    2642 module subroutine mtx_mult_vec(trans, alpha, a, b, beta, c, err)
    -
    2643 logical, intent(in) :: trans
    -
    2644 real(real64), intent(in) :: alpha, beta
    -
    2645 real(real64), intent(in), dimension(:,:) :: a
    -
    2646 real(real64), intent(in), dimension(:) :: b
    -
    2647 real(real64), intent(inout), dimension(:) :: c
    -
    2648 class(errors), intent(inout), optional, target :: err
    -
    2649 end subroutine
    -
    2650
    -
    2651 module subroutine cmtx_mult_mtx(opa, opb, alpha, a, b, beta, c, err)
    -
    2652 integer(int32), intent(in) :: opa, opb
    -
    2653 complex(real64), intent(in) :: alpha, beta
    -
    2654 complex(real64), intent(in), dimension(:,:) :: a, b
    -
    2655 complex(real64), intent(inout), dimension(:,:) :: c
    -
    2656 class(errors), intent(inout), optional, target :: err
    -
    2657 end subroutine
    -
    2658
    -
    2659 module subroutine cmtx_mult_vec(opa, alpha, a, b, beta, c, err)
    -
    2660 integer(int32), intent(in) :: opa
    -
    2661 complex(real64), intent(in) :: alpha, beta
    -
    2662 complex(real64), intent(in), dimension(:,:) :: a
    -
    2663 complex(real64), intent(in), dimension(:) :: b
    -
    2664 complex(real64), intent(inout), dimension(:) :: c
    -
    2665 class(errors), intent(inout), optional, target :: err
    -
    2666 end subroutine
    -
    2667
    -
    2668 module subroutine rank1_update_dbl(alpha, x, y, a, err)
    -
    2669 real(real64), intent(in) :: alpha
    -
    2670 real(real64), intent(in), dimension(:) :: x, y
    -
    2671 real(real64), intent(inout), dimension(:,:) :: a
    -
    2672 class(errors), intent(inout), optional, target :: err
    -
    2673 end subroutine
    -
    2674
    -
    2675 module subroutine rank1_update_cmplx(alpha, x, y, a, err)
    -
    2676 complex(real64), intent(in) :: alpha
    -
    2677 complex(real64), intent(in), dimension(:) :: x, y
    -
    2678 complex(real64), intent(inout), dimension(:,:) :: a
    -
    2679 class(errors), intent(inout), optional, target :: err
    -
    2680 end subroutine
    -
    2681
    -
    2682 module subroutine diag_mtx_mult_mtx(lside, trans, alpha, a, b, beta, c, err)
    -
    2683 logical, intent(in) :: lside, trans
    -
    2684 real(real64) :: alpha, beta
    -
    2685 real(real64), intent(in), dimension(:) :: a
    -
    2686 real(real64), intent(in), dimension(:,:) :: b
    -
    2687 real(real64), intent(inout), dimension(:,:) :: c
    -
    2688 class(errors), intent(inout), optional, target :: err
    -
    2689 end subroutine
    -
    2690
    -
    2691 module subroutine diag_mtx_mult_mtx2(lside, alpha, a, b, err)
    -
    2692 logical, intent(in) :: lside
    -
    2693 real(real64), intent(in) :: alpha
    -
    2694 real(real64), intent(in), dimension(:) :: a
    -
    2695 real(real64), intent(inout), dimension(:,:) :: b
    -
    2696 class(errors), intent(inout), optional, target :: err
    -
    2697 end subroutine
    -
    2698
    -
    2699 module subroutine diag_mtx_mult_mtx3(lside, trans, alpha, a, b, beta, c, err)
    -
    2700 logical, intent(in) :: lside, trans
    -
    2701 real(real64) :: alpha, beta
    -
    2702 complex(real64), intent(in), dimension(:) :: a
    -
    2703 real(real64), intent(in), dimension(:,:) :: b
    -
    2704 complex(real64), intent(inout), dimension(:,:) :: c
    -
    2705 class(errors), intent(inout), optional, target :: err
    -
    2706 end subroutine
    -
    2707
    -
    2708 module subroutine diag_mtx_mult_mtx4(lside, opb, alpha, a, b, beta, c, err)
    -
    2709 logical, intent(in) :: lside
    -
    2710 integer(int32), intent(in) :: opb
    -
    2711 real(real64) :: alpha, beta
    -
    2712 complex(real64), intent(in), dimension(:) :: a
    -
    2713 complex(real64), intent(in), dimension(:,:) :: b
    -
    2714 complex(real64), intent(inout), dimension(:,:) :: c
    -
    2715 class(errors), intent(inout), optional, target :: err
    -
    2716 end subroutine
    -
    2717
    -
    2718 module subroutine diag_mtx_mult_mtx_cmplx(lside, opb, alpha, a, b, beta, c, err)
    -
    2719 logical, intent(in) :: lside
    -
    2720 integer(int32), intent(in) :: opb
    -
    2721 complex(real64) :: alpha, beta
    -
    2722 complex(real64), intent(in), dimension(:) :: a
    -
    2723 complex(real64), intent(in), dimension(:,:) :: b
    -
    2724 complex(real64), intent(inout), dimension(:,:) :: c
    -
    2725 class(errors), intent(inout), optional, target :: err
    -
    2726 end subroutine
    -
    2727
    -
    2728 module subroutine diag_mtx_mult_mtx2_cmplx(lside, alpha, a, b, err)
    -
    2729 logical, intent(in) :: lside
    -
    2730 complex(real64), intent(in) :: alpha
    -
    2731 complex(real64), intent(in), dimension(:) :: a
    -
    2732 complex(real64), intent(inout), dimension(:,:) :: b
    -
    2733 class(errors), intent(inout), optional, target :: err
    -
    2734 end subroutine
    -
    2735
    -
    2736 module subroutine diag_mtx_mult_mtx_mix(lside, opb, alpha, a, b, beta, c, err)
    -
    2737 logical, intent(in) :: lside
    -
    2738 integer(int32), intent(in) :: opb
    -
    2739 complex(real64) :: alpha, beta
    -
    2740 real(real64), intent(in), dimension(:) :: a
    -
    2741 complex(real64), intent(in), dimension(:,:) :: b
    -
    2742 complex(real64), intent(inout), dimension(:,:) :: c
    -
    2743 class(errors), intent(inout), optional, target :: err
    -
    2744 end subroutine
    -
    2745
    -
    2746 module subroutine diag_mtx_mult_mtx2_mix(lside, alpha, a, b, err)
    -
    2747 logical, intent(in) :: lside
    -
    2748 complex(real64), intent(in) :: alpha
    -
    2749 real(real64), intent(in), dimension(:) :: a
    -
    2750 complex(real64), intent(inout), dimension(:,:) :: b
    -
    2751 class(errors), intent(inout), optional, target :: err
    -
    2752 end subroutine
    -
    2753
    -
    2754 pure module function trace_dbl(x) result(y)
    -
    2755 real(real64), intent(in), dimension(:,:) :: x
    -
    2756 real(real64) :: y
    -
    2757 end function
    -
    2758
    -
    2759 pure module function trace_cmplx(x) result(y)
    -
    2760 complex(real64), intent(in), dimension(:,:) :: x
    -
    2761 complex(real64) :: y
    -
    2762 end function
    -
    2763
    -
    2764 module function mtx_rank_dbl(a, tol, work, olwork, err) result(rnk)
    -
    2765 real(real64), intent(inout), dimension(:,:) :: a
    -
    2766 real(real64), intent(in), optional :: tol
    -
    2767 real(real64), intent(out), target, optional, dimension(:) :: work
    -
    2768 integer(int32), intent(out), optional :: olwork
    -
    2769 class(errors), intent(inout), optional, target :: err
    -
    2770 integer(int32) :: rnk
    -
    2771 end function
    -
    2772
    -
    2773 module function mtx_rank_cmplx(a, tol, work, olwork, rwork, err) result(rnk)
    -
    2774 complex(real64), intent(inout), dimension(:,:) :: a
    -
    2775 real(real64), intent(in), optional :: tol
    -
    2776 complex(real64), intent(out), target, optional, dimension(:) :: work
    -
    2777 integer(int32), intent(out), optional :: olwork
    -
    2778 real(real64), intent(out), target, optional, dimension(:) :: rwork
    -
    2779 class(errors), intent(inout), optional, target :: err
    -
    2780 integer(int32) :: rnk
    -
    2781 end function
    -
    2782
    -
    2783 module function det_dbl(a, iwork, err) result(x)
    -
    2784 real(real64), intent(inout), dimension(:,:) :: a
    -
    2785 integer(int32), intent(out), target, optional, dimension(:) :: iwork
    -
    2786 class(errors), intent(inout), optional, target :: err
    -
    2787 real(real64) :: x
    -
    2788 end function
    -
    2789
    -
    2790 module function det_cmplx(a, iwork, err) result(x)
    -
    2791 complex(real64), intent(inout), dimension(:,:) :: a
    -
    2792 integer(int32), intent(out), target, optional, dimension(:) :: iwork
    -
    2793 class(errors), intent(inout), optional, target :: err
    -
    2794 complex(real64) :: x
    -
    2795 end function
    -
    2796
    -
    2797 module subroutine swap_dbl(x, y, err)
    -
    2798 real(real64), intent(inout), dimension(:) :: x, y
    -
    2799 class(errors), intent(inout), optional, target :: err
    -
    2800 end subroutine
    -
    2801
    -
    2802 module subroutine swap_cmplx(x, y, err)
    -
    2803 complex(real64), intent(inout), dimension(:) :: x, y
    -
    2804 class(errors), intent(inout), optional, target :: err
    -
    2805 end subroutine
    -
    2806
    -
    2807 module subroutine recip_mult_array_dbl(a, x)
    -
    2808 real(real64), intent(in) :: a
    -
    2809 real(real64), intent(inout), dimension(:) :: x
    -
    2810 end subroutine
    -
    2811
    -
    2812 module subroutine tri_mtx_mult_dbl(upper, alpha, a, beta, b, err)
    -
    2813 logical, intent(in) :: upper
    -
    2814 real(real64), intent(in) :: alpha, beta
    -
    2815 real(real64), intent(in), dimension(:,:) :: a
    -
    2816 real(real64), intent(inout), dimension(:,:) :: b
    -
    2817 class(errors), intent(inout), optional, target :: err
    -
    2818 end subroutine
    -
    2819
    -
    2820 module subroutine tri_mtx_mult_cmplx(upper, alpha, a, beta, b, err)
    -
    2821 logical, intent(in) :: upper
    -
    2822 complex(real64), intent(in) :: alpha, beta
    -
    2823 complex(real64), intent(in), dimension(:,:) :: a
    -
    2824 complex(real64), intent(inout), dimension(:,:) :: b
    -
    2825 class(errors), intent(inout), optional, target :: err
    -
    2826 end subroutine
    -
    2827
    -
    2828end interface
    -
    2829
    -
    2830! ******************************************************************************
    -
    2831! LINALG_FACTOR.F90
    -
    2832! ------------------------------------------------------------------------------
    -
    2833interface
    -
    2834 module subroutine lu_factor_dbl(a, ipvt, err)
    -
    2835 real(real64), intent(inout), dimension(:,:) :: a
    -
    2836 integer(int32), intent(out), dimension(:) :: ipvt
    -
    2837 class(errors), intent(inout), optional, target :: err
    -
    2838 end subroutine
    -
    2839
    -
    2840 module subroutine lu_factor_cmplx(a, ipvt, err)
    -
    2841 complex(real64), intent(inout), dimension(:,:) :: a
    -
    2842 integer(int32), intent(out), dimension(:) :: ipvt
    -
    2843 class(errors), intent(inout), optional, target :: err
    -
    2844 end subroutine
    -
    2845
    -
    2846 module subroutine form_lu_all(lu, ipvt, u, p, err)
    -
    2847 real(real64), intent(inout), dimension(:,:) :: lu
    -
    2848 integer(int32), intent(in), dimension(:) :: ipvt
    -
    2849 real(real64), intent(out), dimension(:,:) :: u, p
    -
    2850 class(errors), intent(inout), optional, target :: err
    -
    2851 end subroutine
    -
    2852
    -
    2853 module subroutine form_lu_all_cmplx(lu, ipvt, u, p, err)
    -
    2854 complex(real64), intent(inout), dimension(:,:) :: lu
    -
    2855 integer(int32), intent(in), dimension(:) :: ipvt
    -
    2856 complex(real64), intent(out), dimension(:,:) :: u
    -
    2857 real(real64), intent(out), dimension(:,:) :: p
    -
    2858 class(errors), intent(inout), optional, target :: err
    -
    2859 end subroutine
    -
    2860
    -
    2861 module subroutine form_lu_only(lu, u, err)
    -
    2862 real(real64), intent(inout), dimension(:,:) :: lu
    -
    2863 real(real64), intent(out), dimension(:,:) :: u
    -
    2864 class(errors), intent(inout), optional, target :: err
    -
    2865 end subroutine
    -
    2866
    -
    2867 module subroutine form_lu_only_cmplx(lu, u, err)
    -
    2868 complex(real64), intent(inout), dimension(:,:) :: lu
    -
    2869 complex(real64), intent(out), dimension(:,:) :: u
    -
    2870 class(errors), intent(inout), optional, target :: err
    -
    2871 end subroutine
    -
    2872
    -
    2873 module subroutine qr_factor_no_pivot(a, tau, work, olwork, err)
    -
    2874 real(real64), intent(inout), dimension(:,:) :: a
    -
    2875 real(real64), intent(out), dimension(:) :: tau
    -
    2876 real(real64), intent(out), target, dimension(:), optional :: work
    -
    2877 integer(int32), intent(out), optional :: olwork
    -
    2878 class(errors), intent(inout), optional, target :: err
    -
    2879 end subroutine
    -
    2880
    -
    2881 module subroutine qr_factor_no_pivot_cmplx(a, tau, work, olwork, err)
    -
    2882 complex(real64), intent(inout), dimension(:,:) :: a
    -
    2883 complex(real64), intent(out), dimension(:) :: tau
    -
    2884 complex(real64), intent(out), target, dimension(:), optional :: work
    -
    2885 integer(int32), intent(out), optional :: olwork
    -
    2886 class(errors), intent(inout), optional, target :: err
    -
    2887 end subroutine
    -
    2888
    -
    2889 module subroutine qr_factor_pivot(a, tau, jpvt, work, olwork, err)
    -
    2890 real(real64), intent(inout), dimension(:,:) :: a
    -
    2891 real(real64), intent(out), dimension(:) :: tau
    -
    2892 integer(int32), intent(inout), dimension(:) :: jpvt
    -
    2893 real(real64), intent(out), target, dimension(:), optional :: work
    -
    2894 integer(int32), intent(out), optional :: olwork
    -
    2895 class(errors), intent(inout), optional, target :: err
    -
    2896 end subroutine
    -
    2897
    -
    2898 module subroutine qr_factor_pivot_cmplx(a, tau, jpvt, work, olwork, rwork, &
    -
    2899 err)
    -
    2900 complex(real64), intent(inout), dimension(:,:) :: a
    -
    2901 complex(real64), intent(out), dimension(:) :: tau
    -
    2902 integer(int32), intent(inout), dimension(:) :: jpvt
    -
    2903 complex(real64), intent(out), target, dimension(:), optional :: work
    -
    2904 integer(int32), intent(out), optional :: olwork
    -
    2905 real(real64), intent(out), target, dimension(:), optional :: rwork
    -
    2906 class(errors), intent(inout), optional, target :: err
    -
    2907 end subroutine
    -
    2908
    -
    2909 module subroutine form_qr_no_pivot(r, tau, q, work, olwork, err)
    -
    2910 real(real64), intent(inout), dimension(:,:) :: r
    -
    2911 real(real64), intent(in), dimension(:) :: tau
    -
    2912 real(real64), intent(out), dimension(:,:) :: q
    -
    2913 real(real64), intent(out), target, dimension(:), optional :: work
    -
    2914 integer(int32), intent(out), optional :: olwork
    -
    2915 class(errors), intent(inout), optional, target :: err
    -
    2916 end subroutine
    -
    2917
    -
    2918 module subroutine form_qr_no_pivot_cmplx(r, tau, q, work, olwork, err)
    -
    2919 complex(real64), intent(inout), dimension(:,:) :: r
    -
    2920 complex(real64), intent(in), dimension(:) :: tau
    -
    2921 complex(real64), intent(out), dimension(:,:) :: q
    -
    2922 complex(real64), intent(out), target, dimension(:), optional :: work
    -
    2923 integer(int32), intent(out), optional :: olwork
    -
    2924 class(errors), intent(inout), optional, target :: err
    -
    2925 end subroutine
    -
    2926
    -
    2927 module subroutine form_qr_pivot(r, tau, pvt, q, p, work, olwork, err)
    -
    2928 real(real64), intent(inout), dimension(:,:) :: r
    -
    2929 real(real64), intent(in), dimension(:) :: tau
    -
    2930 integer(int32), intent(in), dimension(:) :: pvt
    -
    2931 real(real64), intent(out), dimension(:,:) :: q, p
    -
    2932 real(real64), intent(out), target, dimension(:), optional :: work
    -
    2933 integer(int32), intent(out), optional :: olwork
    -
    2934 class(errors), intent(inout), optional, target :: err
    -
    2935 end subroutine
    -
    2936
    -
    2937 module subroutine form_qr_pivot_cmplx(r, tau, pvt, q, p, work, olwork, err)
    -
    2938 complex(real64), intent(inout), dimension(:,:) :: r
    -
    2939 complex(real64), intent(in), dimension(:) :: tau
    -
    2940 integer(int32), intent(in), dimension(:) :: pvt
    -
    2941 complex(real64), intent(out), dimension(:,:) :: q, p
    -
    2942 complex(real64), intent(out), target, dimension(:), optional :: work
    -
    2943 integer(int32), intent(out), optional :: olwork
    -
    2944 class(errors), intent(inout), optional, target :: err
    -
    2945 end subroutine
    -
    2946
    -
    2947 module subroutine mult_qr_mtx(lside, trans, a, tau, c, work, olwork, err)
    -
    2948 logical, intent(in) :: lside, trans
    -
    2949 real(real64), intent(in), dimension(:) :: tau
    -
    2950 real(real64), intent(inout), dimension(:,:) :: a, c
    -
    2951 real(real64), intent(out), target, dimension(:), optional :: work
    -
    2952 integer(int32), intent(out), optional :: olwork
    -
    2953 class(errors), intent(inout), optional, target :: err
    -
    2954 end subroutine
    -
    2955
    -
    2956 module subroutine mult_qr_mtx_cmplx(lside, trans, a, tau, c, work, olwork, err)
    -
    2957 logical, intent(in) :: lside, trans
    -
    2958 complex(real64), intent(in), dimension(:) :: tau
    -
    2959 complex(real64), intent(inout), dimension(:,:) :: a, c
    -
    2960 complex(real64), intent(out), target, dimension(:), optional :: work
    -
    2961 integer(int32), intent(out), optional :: olwork
    -
    2962 class(errors), intent(inout), optional, target :: err
    -
    2963 end subroutine
    -
    2964
    -
    2965 module subroutine mult_qr_vec(trans, a, tau, c, work, olwork, err)
    -
    2966 logical, intent(in) :: trans
    -
    2967 real(real64), intent(inout), dimension(:,:) :: a
    -
    2968 real(real64), intent(in), dimension(:) :: tau
    -
    2969 real(real64), intent(inout), dimension(:) :: c
    -
    2970 real(real64), intent(out), target, dimension(:), optional :: work
    -
    2971 integer(int32), intent(out), optional :: olwork
    -
    2972 class(errors), intent(inout), optional, target :: err
    -
    2973 end subroutine
    -
    2974
    -
    2975 module subroutine mult_qr_vec_cmplx(trans, a, tau, c, work, olwork, err)
    -
    2976 logical, intent(in) :: trans
    -
    2977 complex(real64), intent(inout), dimension(:,:) :: a
    -
    2978 complex(real64), intent(in), dimension(:) :: tau
    -
    2979 complex(real64), intent(inout), dimension(:) :: c
    -
    2980 complex(real64), intent(out), target, dimension(:), optional :: work
    -
    2981 integer(int32), intent(out), optional :: olwork
    -
    2982 class(errors), intent(inout), optional, target :: err
    -
    2983 end subroutine
    -
    2984
    -
    2985 module subroutine qr_rank1_update_dbl(q, r, u, v, work, err)
    -
    2986 real(real64), intent(inout), dimension(:,:) :: q, r
    -
    2987 real(real64), intent(inout), dimension(:) :: u, v
    -
    2988 real(real64), intent(out), target, optional, dimension(:) :: work
    -
    2989 class(errors), intent(inout), optional, target :: err
    -
    2990 end subroutine
    -
    2991
    -
    2992 module subroutine qr_rank1_update_cmplx(q, r, u, v, work, rwork, err)
    -
    2993 complex(real64), intent(inout), dimension(:,:) :: q, r
    -
    2994 complex(real64), intent(inout), dimension(:) :: u, v
    -
    2995 complex(real64), intent(out), target, optional, dimension(:) :: work
    -
    2996 real(real64), intent(out), target, optional, dimension(:) :: rwork
    -
    2997 class(errors), intent(inout), optional, target :: err
    -
    2998 end subroutine
    -
    2999
    -
    3000 module subroutine cholesky_factor_dbl(a, upper, err)
    -
    3001 real(real64), intent(inout), dimension(:,:) :: a
    -
    3002 logical, intent(in), optional :: upper
    -
    3003 class(errors), intent(inout), optional, target :: err
    -
    3004 end subroutine
    -
    3005
    -
    3006 module subroutine cholesky_factor_cmplx(a, upper, err)
    -
    3007 complex(real64), intent(inout), dimension(:,:) :: a
    -
    3008 logical, intent(in), optional :: upper
    -
    3009 class(errors), intent(inout), optional, target :: err
    -
    3010 end subroutine
    -
    3011
    -
    3012 module subroutine cholesky_rank1_update_dbl(r, u, work, err)
    -
    3013 real(real64), intent(inout), dimension(:,:) :: r
    -
    3014 real(real64), intent(inout), dimension(:) :: u
    -
    3015 real(real64), intent(out), target, optional, dimension(:) :: work
    -
    3016 class(errors), intent(inout), optional, target :: err
    -
    3017 end subroutine
    -
    3018
    -
    3019 module subroutine cholesky_rank1_update_cmplx(r, u, work, err)
    -
    3020 complex(real64), intent(inout), dimension(:,:) :: r
    -
    3021 complex(real64), intent(inout), dimension(:) :: u
    -
    3022 real(real64), intent(out), target, optional, dimension(:) :: work
    + +
    2022 module procedure :: solve_tri_mtx
    +
    2023 module procedure :: solve_tri_mtx_cmplx
    +
    2024 module procedure :: solve_tri_vec
    +
    2025 module procedure :: solve_tri_vec_cmplx
    +
    2026end interface
    +
    2027
    +
    2028! ------------------------------------------------------------------------------
    +
    2109interface solve_lu
    +
    2110 module procedure :: solve_lu_mtx
    +
    2111 module procedure :: solve_lu_mtx_cmplx
    +
    2112 module procedure :: solve_lu_vec
    +
    2113 module procedure :: solve_lu_vec_cmplx
    +
    2114end interface
    +
    2115
    +
    2116! ------------------------------------------------------------------------------
    +
    2244interface solve_qr
    +
    2245 module procedure :: solve_qr_no_pivot_mtx
    +
    2246 module procedure :: solve_qr_no_pivot_mtx_cmplx
    +
    2247 module procedure :: solve_qr_no_pivot_vec
    +
    2248 module procedure :: solve_qr_no_pivot_vec_cmplx
    +
    2249 module procedure :: solve_qr_pivot_mtx
    +
    2250 module procedure :: solve_qr_pivot_mtx_cmplx
    +
    2251 module procedure :: solve_qr_pivot_vec
    +
    2252 module procedure :: solve_qr_pivot_vec_cmplx
    +
    2253end interface
    +
    2254
    +
    2255! ------------------------------------------------------------------------------
    + +
    2351 module procedure :: solve_cholesky_mtx
    +
    2352 module procedure :: solve_cholesky_mtx_cmplx
    +
    2353 module procedure :: solve_cholesky_vec
    +
    2354 module procedure :: solve_cholesky_vec_cmplx
    +
    2355end interface
    +
    2356
    +
    2357! ------------------------------------------------------------------------------
    + +
    2441 module procedure :: solve_least_squares_mtx
    +
    2442 module procedure :: solve_least_squares_mtx_cmplx
    +
    2443 module procedure :: solve_least_squares_vec
    +
    2444 module procedure :: solve_least_squares_vec_cmplx
    +
    2445end interface
    +
    2446
    +
    2447! ------------------------------------------------------------------------------
    + +
    2542 module procedure :: solve_least_squares_mtx_pvt
    +
    2543 module procedure :: solve_least_squares_mtx_pvt_cmplx
    +
    2544 module procedure :: solve_least_squares_vec_pvt
    +
    2545 module procedure :: solve_least_squares_vec_pvt_cmplx
    +
    2546end interface
    +
    2547
    +
    2548! ------------------------------------------------------------------------------
    + +
    2644 module procedure :: solve_least_squares_mtx_svd
    +
    2645 module procedure :: solve_least_squares_vec_svd
    +
    2646end interface
    +
    2647
    +
    2648! ------------------------------------------------------------------------------
    + +
    2739 module procedure :: mtx_inverse_dbl
    +
    2740 module procedure :: mtx_inverse_cmplx
    +
    2741end interface
    +
    2742
    +
    2743! ------------------------------------------------------------------------------
    + +
    2845 module procedure :: mtx_pinverse_dbl
    +
    2846 module procedure :: mtx_pinverse_cmplx
    +
    2847end interface
    +
    2848
    +
    2849! ------------------------------------------------------------------------------
    +
    2938interface eigen
    +
    2939 module procedure :: eigen_symm
    +
    2940 module procedure :: eigen_asymm
    +
    2941 module procedure :: eigen_gen
    +
    2942 module procedure :: eigen_cmplx
    +
    2943end interface
    +
    2944
    +
    2945! ------------------------------------------------------------------------------
    +
    2947interface sort
    +
    2948 module procedure :: sort_dbl_array
    +
    2949 module procedure :: sort_dbl_array_ind
    +
    2950 module procedure :: sort_cmplx_array
    +
    2951 module procedure :: sort_cmplx_array_ind
    +
    2952 module procedure :: sort_eigen_cmplx
    +
    2953 module procedure :: sort_eigen_dbl
    +
    2954end interface
    +
    2955
    +
    2956
    +
    2957! ******************************************************************************
    +
    2958! LINALG_BASIC.F90
    +
    2959! ------------------------------------------------------------------------------
    +
    2960interface
    +
    2961 module subroutine mtx_mult_mtx(transa, transb, alpha, a, b, beta, c, err)
    +
    2962 logical, intent(in) :: transa, transb
    +
    2963 real(real64), intent(in) :: alpha, beta
    +
    2964 real(real64), intent(in), dimension(:,:) :: a, b
    +
    2965 real(real64), intent(inout), dimension(:,:) :: c
    +
    2966 class(errors), intent(inout), optional, target :: err
    +
    2967 end subroutine
    +
    2968
    +
    2969 module subroutine mtx_mult_vec(trans, alpha, a, b, beta, c, err)
    +
    2970 logical, intent(in) :: trans
    +
    2971 real(real64), intent(in) :: alpha, beta
    +
    2972 real(real64), intent(in), dimension(:,:) :: a
    +
    2973 real(real64), intent(in), dimension(:) :: b
    +
    2974 real(real64), intent(inout), dimension(:) :: c
    +
    2975 class(errors), intent(inout), optional, target :: err
    +
    2976 end subroutine
    +
    2977
    +
    2978 module subroutine cmtx_mult_mtx(opa, opb, alpha, a, b, beta, c, err)
    +
    2979 integer(int32), intent(in) :: opa, opb
    +
    2980 complex(real64), intent(in) :: alpha, beta
    +
    2981 complex(real64), intent(in), dimension(:,:) :: a, b
    +
    2982 complex(real64), intent(inout), dimension(:,:) :: c
    +
    2983 class(errors), intent(inout), optional, target :: err
    +
    2984 end subroutine
    +
    2985
    +
    2986 module subroutine cmtx_mult_vec(opa, alpha, a, b, beta, c, err)
    +
    2987 integer(int32), intent(in) :: opa
    +
    2988 complex(real64), intent(in) :: alpha, beta
    +
    2989 complex(real64), intent(in), dimension(:,:) :: a
    +
    2990 complex(real64), intent(in), dimension(:) :: b
    +
    2991 complex(real64), intent(inout), dimension(:) :: c
    +
    2992 class(errors), intent(inout), optional, target :: err
    +
    2993 end subroutine
    +
    2994
    +
    2995 module subroutine rank1_update_dbl(alpha, x, y, a, err)
    +
    2996 real(real64), intent(in) :: alpha
    +
    2997 real(real64), intent(in), dimension(:) :: x, y
    +
    2998 real(real64), intent(inout), dimension(:,:) :: a
    +
    2999 class(errors), intent(inout), optional, target :: err
    +
    3000 end subroutine
    +
    3001
    +
    3002 module subroutine rank1_update_cmplx(alpha, x, y, a, err)
    +
    3003 complex(real64), intent(in) :: alpha
    +
    3004 complex(real64), intent(in), dimension(:) :: x, y
    +
    3005 complex(real64), intent(inout), dimension(:,:) :: a
    +
    3006 class(errors), intent(inout), optional, target :: err
    +
    3007 end subroutine
    +
    3008
    +
    3009 module subroutine diag_mtx_mult_mtx(lside, trans, alpha, a, b, beta, c, err)
    +
    3010 logical, intent(in) :: lside, trans
    +
    3011 real(real64) :: alpha, beta
    +
    3012 real(real64), intent(in), dimension(:) :: a
    +
    3013 real(real64), intent(in), dimension(:,:) :: b
    +
    3014 real(real64), intent(inout), dimension(:,:) :: c
    +
    3015 class(errors), intent(inout), optional, target :: err
    +
    3016 end subroutine
    +
    3017
    +
    3018 module subroutine diag_mtx_mult_mtx2(lside, alpha, a, b, err)
    +
    3019 logical, intent(in) :: lside
    +
    3020 real(real64), intent(in) :: alpha
    +
    3021 real(real64), intent(in), dimension(:) :: a
    +
    3022 real(real64), intent(inout), dimension(:,:) :: b
    3023 class(errors), intent(inout), optional, target :: err
    3024 end subroutine
    3025
    -
    3026 module subroutine cholesky_rank1_downdate_dbl(r, u, work, err)
    -
    3027 real(real64), intent(inout), dimension(:,:) :: r
    -
    3028 real(real64), intent(inout), dimension(:) :: u
    -
    3029 real(real64), intent(out), target, optional, dimension(:) :: work
    -
    3030 class(errors), intent(inout), optional, target :: err
    -
    3031 end subroutine
    -
    3032
    -
    3033 module subroutine cholesky_rank1_downdate_cmplx(r, u, work, err)
    -
    3034 complex(real64), intent(inout), dimension(:,:) :: r
    -
    3035 complex(real64), intent(inout), dimension(:) :: u
    -
    3036 real(real64), intent(out), target, optional, dimension(:) :: work
    -
    3037 class(errors), intent(inout), optional, target :: err
    -
    3038 end subroutine
    -
    3039
    -
    3040 module subroutine rz_factor_dbl(a, tau, work, olwork, err)
    -
    3041 real(real64), intent(inout), dimension(:,:) :: a
    -
    3042 real(real64), intent(out), dimension(:) :: tau
    -
    3043 real(real64), intent(out), target, optional, dimension(:) :: work
    -
    3044 integer(int32), intent(out), optional :: olwork
    -
    3045 class(errors), intent(inout), optional, target :: err
    -
    3046 end subroutine
    -
    3047
    -
    3048 module subroutine rz_factor_cmplx(a, tau, work, olwork, err)
    -
    3049 complex(real64), intent(inout), dimension(:,:) :: a
    -
    3050 complex(real64), intent(out), dimension(:) :: tau
    -
    3051 complex(real64), intent(out), target, optional, dimension(:) :: work
    -
    3052 integer(int32), intent(out), optional :: olwork
    -
    3053 class(errors), intent(inout), optional, target :: err
    -
    3054 end subroutine
    -
    3055
    -
    3056 module subroutine mult_rz_mtx(lside, trans, l, a, tau, c, work, olwork, err)
    -
    3057 logical, intent(in) :: lside, trans
    -
    3058 integer(int32), intent(in) :: l
    -
    3059 real(real64), intent(inout), dimension(:,:) :: a, c
    -
    3060 real(real64), intent(in), dimension(:) :: tau
    -
    3061 real(real64), intent(out), target, optional, dimension(:) :: work
    -
    3062 integer(int32), intent(out), optional :: olwork
    -
    3063 class(errors), intent(inout), optional, target :: err
    -
    3064 end subroutine
    -
    3065
    -
    3066 module subroutine mult_rz_mtx_cmplx(lside, trans, l, a, tau, c, work, olwork, err)
    -
    3067 logical, intent(in) :: lside, trans
    -
    3068 integer(int32), intent(in) :: l
    -
    3069 complex(real64), intent(inout), dimension(:,:) :: a, c
    -
    3070 complex(real64), intent(in), dimension(:) :: tau
    -
    3071 complex(real64), intent(out), target, optional, dimension(:) :: work
    -
    3072 integer(int32), intent(out), optional :: olwork
    -
    3073 class(errors), intent(inout), optional, target :: err
    -
    3074 end subroutine
    -
    3075
    -
    3076 module subroutine mult_rz_vec(trans, l, a, tau, c, work, olwork, err)
    -
    3077 logical, intent(in) :: trans
    -
    3078 integer(int32), intent(in) :: l
    -
    3079 real(real64), intent(inout), dimension(:,:) :: a
    -
    3080 real(real64), intent(in), dimension(:) :: tau
    -
    3081 real(real64), intent(inout), dimension(:) :: c
    -
    3082 real(real64), intent(out), target, optional, dimension(:) :: work
    -
    3083 integer(int32), intent(out), optional :: olwork
    -
    3084 class(errors), intent(inout), optional, target :: err
    -
    3085 end subroutine
    -
    3086
    -
    3087 module subroutine mult_rz_vec_cmplx(trans, l, a, tau, c, work, olwork, err)
    -
    3088 logical, intent(in) :: trans
    -
    3089 integer(int32), intent(in) :: l
    -
    3090 complex(real64), intent(inout), dimension(:,:) :: a
    -
    3091 complex(real64), intent(in), dimension(:) :: tau
    -
    3092 complex(real64), intent(inout), dimension(:) :: c
    -
    3093 complex(real64), intent(out), target, optional, dimension(:) :: work
    -
    3094 integer(int32), intent(out), optional :: olwork
    -
    3095 class(errors), intent(inout), optional, target :: err
    -
    3096 end subroutine
    -
    3097
    -
    3098 module subroutine svd_dbl(a, s, u, vt, work, olwork, err)
    -
    3099 real(real64), intent(inout), dimension(:,:) :: a
    -
    3100 real(real64), intent(out), dimension(:) :: s
    -
    3101 real(real64), intent(out), optional, dimension(:,:) :: u, vt
    -
    3102 real(real64), intent(out), target, optional, dimension(:) :: work
    -
    3103 integer(int32), intent(out), optional :: olwork
    -
    3104 class(errors), intent(inout), optional, target :: err
    -
    3105 end subroutine
    -
    3106
    -
    3107 module subroutine svd_cmplx(a, s, u, vt, work, olwork, rwork, err)
    -
    3108 complex(real64), intent(inout), dimension(:,:) :: a
    -
    3109 real(real64), intent(out), dimension(:) :: s
    -
    3110 complex(real64), intent(out), optional, dimension(:,:) :: u, vt
    -
    3111 complex(real64), intent(out), target, optional, dimension(:) :: work
    -
    3112 integer(int32), intent(out), optional :: olwork
    -
    3113 real(real64), intent(out), target, optional, dimension(:) :: rwork
    -
    3114 class(errors), intent(inout), optional, target :: err
    -
    3115 end subroutine
    -
    3116end interface
    -
    3117
    -
    3118! ******************************************************************************
    -
    3119! LINALG_SOLVE.F90
    -
    3120! ------------------------------------------------------------------------------
    -
    3121interface
    -
    3122 module subroutine solve_tri_mtx(lside, upper, trans, nounit, alpha, a, b, err)
    -
    3123 logical, intent(in) :: lside, upper, trans, nounit
    -
    3124 real(real64), intent(in) :: alpha
    -
    3125 real(real64), intent(in), dimension(:,:) :: a
    -
    3126 real(real64), intent(inout), dimension(:,:) :: b
    -
    3127 class(errors), intent(inout), optional, target :: err
    -
    3128 end subroutine
    -
    3129
    -
    3130 module subroutine solve_tri_mtx_cmplx(lside, upper, trans, nounit, alpha, a, b, err)
    -
    3131 logical, intent(in) :: lside, upper, trans, nounit
    -
    3132 complex(real64), intent(in) :: alpha
    -
    3133 complex(real64), intent(in), dimension(:,:) :: a
    -
    3134 complex(real64), intent(inout), dimension(:,:) :: b
    -
    3135 class(errors), intent(inout), optional, target :: err
    -
    3136 end subroutine
    -
    3137
    -
    3138 module subroutine solve_tri_vec(upper, trans, nounit, a, x, err)
    -
    3139 logical, intent(in) :: upper, trans, nounit
    -
    3140 real(real64), intent(in), dimension(:,:) :: a
    -
    3141 real(real64), intent(inout), dimension(:) :: x
    -
    3142 class(errors), intent(inout), optional, target :: err
    -
    3143 end subroutine
    -
    3144
    -
    3145 module subroutine solve_tri_vec_cmplx(upper, trans, nounit, a, x, err)
    -
    3146 logical, intent(in) :: upper, trans, nounit
    -
    3147 complex(real64), intent(in), dimension(:,:) :: a
    -
    3148 complex(real64), intent(inout), dimension(:) :: x
    -
    3149 class(errors), intent(inout), optional, target :: err
    -
    3150 end subroutine
    -
    3151
    -
    3168 module subroutine solve_lu_mtx(a, ipvt, b, err)
    -
    3169 real(real64), intent(in), dimension(:,:) :: a
    -
    3170 integer(int32), intent(in), dimension(:) :: ipvt
    -
    3171 real(real64), intent(inout), dimension(:,:) :: b
    -
    3172 class(errors), intent(inout), optional, target :: err
    -
    3173 end subroutine
    -
    3174
    -
    3191 module subroutine solve_lu_mtx_cmplx(a, ipvt, b, err)
    -
    3192 complex(real64), intent(in), dimension(:,:) :: a
    -
    3193 integer(int32), intent(in), dimension(:) :: ipvt
    -
    3194 complex(real64), intent(inout), dimension(:,:) :: b
    -
    3195 class(errors), intent(inout), optional, target :: err
    -
    3196 end subroutine
    -
    3197
    -
    3214 module subroutine solve_lu_vec(a, ipvt, b, err)
    -
    3215 real(real64), intent(in), dimension(:,:) :: a
    -
    3216 integer(int32), intent(in), dimension(:) :: ipvt
    -
    3217 real(real64), intent(inout), dimension(:) :: b
    -
    3218 class(errors), intent(inout), optional, target :: err
    -
    3219 end subroutine
    -
    3220
    -
    3237 module subroutine solve_lu_vec_cmplx(a, ipvt, b, err)
    -
    3238 complex(real64), intent(in), dimension(:,:) :: a
    -
    3239 integer(int32), intent(in), dimension(:) :: ipvt
    -
    3240 complex(real64), intent(inout), dimension(:) :: b
    -
    3241 class(errors), intent(inout), optional, target :: err
    -
    3242 end subroutine
    -
    3243
    -
    3273 module subroutine solve_qr_no_pivot_mtx(a, tau, b, work, olwork, err)
    -
    3274 real(real64), intent(inout), dimension(:,:) :: a, b
    -
    3275 real(real64), intent(in), dimension(:) :: tau
    -
    3276 real(real64), intent(out), target, optional, dimension(:) :: work
    -
    3277 integer(int32), intent(out), optional :: olwork
    -
    3278 class(errors), intent(inout), optional, target :: err
    -
    3279 end subroutine
    -
    3280
    -
    3310 module subroutine solve_qr_no_pivot_mtx_cmplx(a, tau, b, work, olwork, err)
    -
    3311 complex(real64), intent(inout), dimension(:,:) :: a, b
    -
    3312 complex(real64), intent(in), dimension(:) :: tau
    -
    3313 complex(real64), intent(out), target, optional, dimension(:) :: work
    -
    3314 integer(int32), intent(out), optional :: olwork
    -
    3315 class(errors), intent(inout), optional, target :: err
    -
    3316 end subroutine
    -
    3317
    -
    3347 module subroutine solve_qr_no_pivot_vec(a, tau, b, work, olwork, err)
    -
    3348 real(real64), intent(inout), dimension(:,:) :: a
    -
    3349 real(real64), intent(in), dimension(:) :: tau
    -
    3350 real(real64), intent(inout), dimension(:) :: b
    -
    3351 real(real64), intent(out), target, optional, dimension(:) :: work
    -
    3352 integer(int32), intent(out), optional :: olwork
    -
    3353 class(errors), intent(inout), optional, target :: err
    -
    3354 end subroutine
    -
    3355
    -
    3385 module subroutine solve_qr_no_pivot_vec_cmplx(a, tau, b, work, olwork, err)
    -
    3386 complex(real64), intent(inout), dimension(:,:) :: a
    -
    3387 complex(real64), intent(in), dimension(:) :: tau
    -
    3388 complex(real64), intent(inout), dimension(:) :: b
    -
    3389 complex(real64), intent(out), target, optional, dimension(:) :: work
    -
    3390 integer(int32), intent(out), optional :: olwork
    -
    3391 class(errors), intent(inout), optional, target :: err
    -
    3392 end subroutine
    -
    3393
    -
    3425 module subroutine solve_qr_pivot_mtx(a, tau, jpvt, b, work, olwork, err)
    +
    3026 module subroutine diag_mtx_mult_mtx3(lside, trans, alpha, a, b, beta, c, err)
    +
    3027 logical, intent(in) :: lside, trans
    +
    3028 real(real64) :: alpha, beta
    +
    3029 complex(real64), intent(in), dimension(:) :: a
    +
    3030 real(real64), intent(in), dimension(:,:) :: b
    +
    3031 complex(real64), intent(inout), dimension(:,:) :: c
    +
    3032 class(errors), intent(inout), optional, target :: err
    +
    3033 end subroutine
    +
    3034
    +
    3035 module subroutine diag_mtx_mult_mtx4(lside, opb, alpha, a, b, beta, c, err)
    +
    3036 logical, intent(in) :: lside
    +
    3037 integer(int32), intent(in) :: opb
    +
    3038 real(real64) :: alpha, beta
    +
    3039 complex(real64), intent(in), dimension(:) :: a
    +
    3040 complex(real64), intent(in), dimension(:,:) :: b
    +
    3041 complex(real64), intent(inout), dimension(:,:) :: c
    +
    3042 class(errors), intent(inout), optional, target :: err
    +
    3043 end subroutine
    +
    3044
    +
    3045 module subroutine diag_mtx_mult_mtx_cmplx(lside, opb, alpha, a, b, beta, c, err)
    +
    3046 logical, intent(in) :: lside
    +
    3047 integer(int32), intent(in) :: opb
    +
    3048 complex(real64) :: alpha, beta
    +
    3049 complex(real64), intent(in), dimension(:) :: a
    +
    3050 complex(real64), intent(in), dimension(:,:) :: b
    +
    3051 complex(real64), intent(inout), dimension(:,:) :: c
    +
    3052 class(errors), intent(inout), optional, target :: err
    +
    3053 end subroutine
    +
    3054
    +
    3055 module subroutine diag_mtx_mult_mtx2_cmplx(lside, alpha, a, b, err)
    +
    3056 logical, intent(in) :: lside
    +
    3057 complex(real64), intent(in) :: alpha
    +
    3058 complex(real64), intent(in), dimension(:) :: a
    +
    3059 complex(real64), intent(inout), dimension(:,:) :: b
    +
    3060 class(errors), intent(inout), optional, target :: err
    +
    3061 end subroutine
    +
    3062
    +
    3063 module subroutine diag_mtx_mult_mtx_mix(lside, opb, alpha, a, b, beta, c, err)
    +
    3064 logical, intent(in) :: lside
    +
    3065 integer(int32), intent(in) :: opb
    +
    3066 complex(real64) :: alpha, beta
    +
    3067 real(real64), intent(in), dimension(:) :: a
    +
    3068 complex(real64), intent(in), dimension(:,:) :: b
    +
    3069 complex(real64), intent(inout), dimension(:,:) :: c
    +
    3070 class(errors), intent(inout), optional, target :: err
    +
    3071 end subroutine
    +
    3072
    +
    3073 module subroutine diag_mtx_mult_mtx2_mix(lside, alpha, a, b, err)
    +
    3074 logical, intent(in) :: lside
    +
    3075 complex(real64), intent(in) :: alpha
    +
    3076 real(real64), intent(in), dimension(:) :: a
    +
    3077 complex(real64), intent(inout), dimension(:,:) :: b
    +
    3078 class(errors), intent(inout), optional, target :: err
    +
    3079 end subroutine
    +
    3080
    +
    3081 pure module function trace_dbl(x) result(y)
    +
    3082 real(real64), intent(in), dimension(:,:) :: x
    +
    3083 real(real64) :: y
    +
    3084 end function
    +
    3085
    +
    3086 pure module function trace_cmplx(x) result(y)
    +
    3087 complex(real64), intent(in), dimension(:,:) :: x
    +
    3088 complex(real64) :: y
    +
    3089 end function
    +
    3090
    +
    3091 module function mtx_rank_dbl(a, tol, work, olwork, err) result(rnk)
    +
    3092 real(real64), intent(inout), dimension(:,:) :: a
    +
    3093 real(real64), intent(in), optional :: tol
    +
    3094 real(real64), intent(out), target, optional, dimension(:) :: work
    +
    3095 integer(int32), intent(out), optional :: olwork
    +
    3096 class(errors), intent(inout), optional, target :: err
    +
    3097 integer(int32) :: rnk
    +
    3098 end function
    +
    3099
    +
    3100 module function mtx_rank_cmplx(a, tol, work, olwork, rwork, err) result(rnk)
    +
    3101 complex(real64), intent(inout), dimension(:,:) :: a
    +
    3102 real(real64), intent(in), optional :: tol
    +
    3103 complex(real64), intent(out), target, optional, dimension(:) :: work
    +
    3104 integer(int32), intent(out), optional :: olwork
    +
    3105 real(real64), intent(out), target, optional, dimension(:) :: rwork
    +
    3106 class(errors), intent(inout), optional, target :: err
    +
    3107 integer(int32) :: rnk
    +
    3108 end function
    +
    3109
    +
    3110 module function det_dbl(a, iwork, err) result(x)
    +
    3111 real(real64), intent(inout), dimension(:,:) :: a
    +
    3112 integer(int32), intent(out), target, optional, dimension(:) :: iwork
    +
    3113 class(errors), intent(inout), optional, target :: err
    +
    3114 real(real64) :: x
    +
    3115 end function
    +
    3116
    +
    3117 module function det_cmplx(a, iwork, err) result(x)
    +
    3118 complex(real64), intent(inout), dimension(:,:) :: a
    +
    3119 integer(int32), intent(out), target, optional, dimension(:) :: iwork
    +
    3120 class(errors), intent(inout), optional, target :: err
    +
    3121 complex(real64) :: x
    +
    3122 end function
    +
    3123
    +
    3124 module subroutine swap_dbl(x, y, err)
    +
    3125 real(real64), intent(inout), dimension(:) :: x, y
    +
    3126 class(errors), intent(inout), optional, target :: err
    +
    3127 end subroutine
    +
    3128
    +
    3129 module subroutine swap_cmplx(x, y, err)
    +
    3130 complex(real64), intent(inout), dimension(:) :: x, y
    +
    3131 class(errors), intent(inout), optional, target :: err
    +
    3132 end subroutine
    +
    3133
    +
    3134 module subroutine recip_mult_array_dbl(a, x)
    +
    3135 real(real64), intent(in) :: a
    +
    3136 real(real64), intent(inout), dimension(:) :: x
    +
    3137 end subroutine
    +
    3138
    +
    3139 module subroutine tri_mtx_mult_dbl(upper, alpha, a, beta, b, err)
    +
    3140 logical, intent(in) :: upper
    +
    3141 real(real64), intent(in) :: alpha, beta
    +
    3142 real(real64), intent(in), dimension(:,:) :: a
    +
    3143 real(real64), intent(inout), dimension(:,:) :: b
    +
    3144 class(errors), intent(inout), optional, target :: err
    +
    3145 end subroutine
    +
    3146
    +
    3147 module subroutine tri_mtx_mult_cmplx(upper, alpha, a, beta, b, err)
    +
    3148 logical, intent(in) :: upper
    +
    3149 complex(real64), intent(in) :: alpha, beta
    +
    3150 complex(real64), intent(in), dimension(:,:) :: a
    +
    3151 complex(real64), intent(inout), dimension(:,:) :: b
    +
    3152 class(errors), intent(inout), optional, target :: err
    +
    3153 end subroutine
    +
    3154
    +
    3155end interface
    +
    3156
    +
    3157! ******************************************************************************
    +
    3158! LINALG_FACTOR.F90
    +
    3159! ------------------------------------------------------------------------------
    +
    3160interface
    +
    3161 module subroutine lu_factor_dbl(a, ipvt, err)
    +
    3162 real(real64), intent(inout), dimension(:,:) :: a
    +
    3163 integer(int32), intent(out), dimension(:) :: ipvt
    +
    3164 class(errors), intent(inout), optional, target :: err
    +
    3165 end subroutine
    +
    3166
    +
    3167 module subroutine lu_factor_cmplx(a, ipvt, err)
    +
    3168 complex(real64), intent(inout), dimension(:,:) :: a
    +
    3169 integer(int32), intent(out), dimension(:) :: ipvt
    +
    3170 class(errors), intent(inout), optional, target :: err
    +
    3171 end subroutine
    +
    3172
    +
    3173 module subroutine form_lu_all(lu, ipvt, u, p, err)
    +
    3174 real(real64), intent(inout), dimension(:,:) :: lu
    +
    3175 integer(int32), intent(in), dimension(:) :: ipvt
    +
    3176 real(real64), intent(out), dimension(:,:) :: u, p
    +
    3177 class(errors), intent(inout), optional, target :: err
    +
    3178 end subroutine
    +
    3179
    +
    3180 module subroutine form_lu_all_cmplx(lu, ipvt, u, p, err)
    +
    3181 complex(real64), intent(inout), dimension(:,:) :: lu
    +
    3182 integer(int32), intent(in), dimension(:) :: ipvt
    +
    3183 complex(real64), intent(out), dimension(:,:) :: u
    +
    3184 real(real64), intent(out), dimension(:,:) :: p
    +
    3185 class(errors), intent(inout), optional, target :: err
    +
    3186 end subroutine
    +
    3187
    +
    3188 module subroutine form_lu_only(lu, u, err)
    +
    3189 real(real64), intent(inout), dimension(:,:) :: lu
    +
    3190 real(real64), intent(out), dimension(:,:) :: u
    +
    3191 class(errors), intent(inout), optional, target :: err
    +
    3192 end subroutine
    +
    3193
    +
    3194 module subroutine form_lu_only_cmplx(lu, u, err)
    +
    3195 complex(real64), intent(inout), dimension(:,:) :: lu
    +
    3196 complex(real64), intent(out), dimension(:,:) :: u
    +
    3197 class(errors), intent(inout), optional, target :: err
    +
    3198 end subroutine
    +
    3199
    +
    3200 module subroutine qr_factor_no_pivot(a, tau, work, olwork, err)
    +
    3201 real(real64), intent(inout), dimension(:,:) :: a
    +
    3202 real(real64), intent(out), dimension(:) :: tau
    +
    3203 real(real64), intent(out), target, dimension(:), optional :: work
    +
    3204 integer(int32), intent(out), optional :: olwork
    +
    3205 class(errors), intent(inout), optional, target :: err
    +
    3206 end subroutine
    +
    3207
    +
    3208 module subroutine qr_factor_no_pivot_cmplx(a, tau, work, olwork, err)
    +
    3209 complex(real64), intent(inout), dimension(:,:) :: a
    +
    3210 complex(real64), intent(out), dimension(:) :: tau
    +
    3211 complex(real64), intent(out), target, dimension(:), optional :: work
    +
    3212 integer(int32), intent(out), optional :: olwork
    +
    3213 class(errors), intent(inout), optional, target :: err
    +
    3214 end subroutine
    +
    3215
    +
    3216 module subroutine qr_factor_pivot(a, tau, jpvt, work, olwork, err)
    +
    3217 real(real64), intent(inout), dimension(:,:) :: a
    +
    3218 real(real64), intent(out), dimension(:) :: tau
    +
    3219 integer(int32), intent(inout), dimension(:) :: jpvt
    +
    3220 real(real64), intent(out), target, dimension(:), optional :: work
    +
    3221 integer(int32), intent(out), optional :: olwork
    +
    3222 class(errors), intent(inout), optional, target :: err
    +
    3223 end subroutine
    +
    3224
    +
    3225 module subroutine qr_factor_pivot_cmplx(a, tau, jpvt, work, olwork, rwork, &
    +
    3226 err)
    +
    3227 complex(real64), intent(inout), dimension(:,:) :: a
    +
    3228 complex(real64), intent(out), dimension(:) :: tau
    +
    3229 integer(int32), intent(inout), dimension(:) :: jpvt
    +
    3230 complex(real64), intent(out), target, dimension(:), optional :: work
    +
    3231 integer(int32), intent(out), optional :: olwork
    +
    3232 real(real64), intent(out), target, dimension(:), optional :: rwork
    +
    3233 class(errors), intent(inout), optional, target :: err
    +
    3234 end subroutine
    +
    3235
    +
    3236 module subroutine form_qr_no_pivot(r, tau, q, work, olwork, err)
    +
    3237 real(real64), intent(inout), dimension(:,:) :: r
    +
    3238 real(real64), intent(in), dimension(:) :: tau
    +
    3239 real(real64), intent(out), dimension(:,:) :: q
    +
    3240 real(real64), intent(out), target, dimension(:), optional :: work
    +
    3241 integer(int32), intent(out), optional :: olwork
    +
    3242 class(errors), intent(inout), optional, target :: err
    +
    3243 end subroutine
    +
    3244
    +
    3245 module subroutine form_qr_no_pivot_cmplx(r, tau, q, work, olwork, err)
    +
    3246 complex(real64), intent(inout), dimension(:,:) :: r
    +
    3247 complex(real64), intent(in), dimension(:) :: tau
    +
    3248 complex(real64), intent(out), dimension(:,:) :: q
    +
    3249 complex(real64), intent(out), target, dimension(:), optional :: work
    +
    3250 integer(int32), intent(out), optional :: olwork
    +
    3251 class(errors), intent(inout), optional, target :: err
    +
    3252 end subroutine
    +
    3253
    +
    3254 module subroutine form_qr_pivot(r, tau, pvt, q, p, work, olwork, err)
    +
    3255 real(real64), intent(inout), dimension(:,:) :: r
    +
    3256 real(real64), intent(in), dimension(:) :: tau
    +
    3257 integer(int32), intent(in), dimension(:) :: pvt
    +
    3258 real(real64), intent(out), dimension(:,:) :: q, p
    +
    3259 real(real64), intent(out), target, dimension(:), optional :: work
    +
    3260 integer(int32), intent(out), optional :: olwork
    +
    3261 class(errors), intent(inout), optional, target :: err
    +
    3262 end subroutine
    +
    3263
    +
    3264 module subroutine form_qr_pivot_cmplx(r, tau, pvt, q, p, work, olwork, err)
    +
    3265 complex(real64), intent(inout), dimension(:,:) :: r
    +
    3266 complex(real64), intent(in), dimension(:) :: tau
    +
    3267 integer(int32), intent(in), dimension(:) :: pvt
    +
    3268 complex(real64), intent(out), dimension(:,:) :: q, p
    +
    3269 complex(real64), intent(out), target, dimension(:), optional :: work
    +
    3270 integer(int32), intent(out), optional :: olwork
    +
    3271 class(errors), intent(inout), optional, target :: err
    +
    3272 end subroutine
    +
    3273
    +
    3274 module subroutine mult_qr_mtx(lside, trans, a, tau, c, work, olwork, err)
    +
    3275 logical, intent(in) :: lside, trans
    +
    3276 real(real64), intent(in), dimension(:) :: tau
    +
    3277 real(real64), intent(inout), dimension(:,:) :: a, c
    +
    3278 real(real64), intent(out), target, dimension(:), optional :: work
    +
    3279 integer(int32), intent(out), optional :: olwork
    +
    3280 class(errors), intent(inout), optional, target :: err
    +
    3281 end subroutine
    +
    3282
    +
    3283 module subroutine mult_qr_mtx_cmplx(lside, trans, a, tau, c, work, olwork, err)
    +
    3284 logical, intent(in) :: lside, trans
    +
    3285 complex(real64), intent(in), dimension(:) :: tau
    +
    3286 complex(real64), intent(inout), dimension(:,:) :: a, c
    +
    3287 complex(real64), intent(out), target, dimension(:), optional :: work
    +
    3288 integer(int32), intent(out), optional :: olwork
    +
    3289 class(errors), intent(inout), optional, target :: err
    +
    3290 end subroutine
    +
    3291
    +
    3292 module subroutine mult_qr_vec(trans, a, tau, c, work, olwork, err)
    +
    3293 logical, intent(in) :: trans
    +
    3294 real(real64), intent(inout), dimension(:,:) :: a
    +
    3295 real(real64), intent(in), dimension(:) :: tau
    +
    3296 real(real64), intent(inout), dimension(:) :: c
    +
    3297 real(real64), intent(out), target, dimension(:), optional :: work
    +
    3298 integer(int32), intent(out), optional :: olwork
    +
    3299 class(errors), intent(inout), optional, target :: err
    +
    3300 end subroutine
    +
    3301
    +
    3302 module subroutine mult_qr_vec_cmplx(trans, a, tau, c, work, olwork, err)
    +
    3303 logical, intent(in) :: trans
    +
    3304 complex(real64), intent(inout), dimension(:,:) :: a
    +
    3305 complex(real64), intent(in), dimension(:) :: tau
    +
    3306 complex(real64), intent(inout), dimension(:) :: c
    +
    3307 complex(real64), intent(out), target, dimension(:), optional :: work
    +
    3308 integer(int32), intent(out), optional :: olwork
    +
    3309 class(errors), intent(inout), optional, target :: err
    +
    3310 end subroutine
    +
    3311
    +
    3312 module subroutine qr_rank1_update_dbl(q, r, u, v, work, err)
    +
    3313 real(real64), intent(inout), dimension(:,:) :: q, r
    +
    3314 real(real64), intent(inout), dimension(:) :: u, v
    +
    3315 real(real64), intent(out), target, optional, dimension(:) :: work
    +
    3316 class(errors), intent(inout), optional, target :: err
    +
    3317 end subroutine
    +
    3318
    +
    3319 module subroutine qr_rank1_update_cmplx(q, r, u, v, work, rwork, err)
    +
    3320 complex(real64), intent(inout), dimension(:,:) :: q, r
    +
    3321 complex(real64), intent(inout), dimension(:) :: u, v
    +
    3322 complex(real64), intent(out), target, optional, dimension(:) :: work
    +
    3323 real(real64), intent(out), target, optional, dimension(:) :: rwork
    +
    3324 class(errors), intent(inout), optional, target :: err
    +
    3325 end subroutine
    +
    3326
    +
    3327 module subroutine cholesky_factor_dbl(a, upper, err)
    +
    3328 real(real64), intent(inout), dimension(:,:) :: a
    +
    3329 logical, intent(in), optional :: upper
    +
    3330 class(errors), intent(inout), optional, target :: err
    +
    3331 end subroutine
    +
    3332
    +
    3333 module subroutine cholesky_factor_cmplx(a, upper, err)
    +
    3334 complex(real64), intent(inout), dimension(:,:) :: a
    +
    3335 logical, intent(in), optional :: upper
    +
    3336 class(errors), intent(inout), optional, target :: err
    +
    3337 end subroutine
    +
    3338
    +
    3339 module subroutine cholesky_rank1_update_dbl(r, u, work, err)
    +
    3340 real(real64), intent(inout), dimension(:,:) :: r
    +
    3341 real(real64), intent(inout), dimension(:) :: u
    +
    3342 real(real64), intent(out), target, optional, dimension(:) :: work
    +
    3343 class(errors), intent(inout), optional, target :: err
    +
    3344 end subroutine
    +
    3345
    +
    3346 module subroutine cholesky_rank1_update_cmplx(r, u, work, err)
    +
    3347 complex(real64), intent(inout), dimension(:,:) :: r
    +
    3348 complex(real64), intent(inout), dimension(:) :: u
    +
    3349 real(real64), intent(out), target, optional, dimension(:) :: work
    +
    3350 class(errors), intent(inout), optional, target :: err
    +
    3351 end subroutine
    +
    3352
    +
    3353 module subroutine cholesky_rank1_downdate_dbl(r, u, work, err)
    +
    3354 real(real64), intent(inout), dimension(:,:) :: r
    +
    3355 real(real64), intent(inout), dimension(:) :: u
    +
    3356 real(real64), intent(out), target, optional, dimension(:) :: work
    +
    3357 class(errors), intent(inout), optional, target :: err
    +
    3358 end subroutine
    +
    3359
    +
    3360 module subroutine cholesky_rank1_downdate_cmplx(r, u, work, err)
    +
    3361 complex(real64), intent(inout), dimension(:,:) :: r
    +
    3362 complex(real64), intent(inout), dimension(:) :: u
    +
    3363 real(real64), intent(out), target, optional, dimension(:) :: work
    +
    3364 class(errors), intent(inout), optional, target :: err
    +
    3365 end subroutine
    +
    3366
    +
    3367 module subroutine rz_factor_dbl(a, tau, work, olwork, err)
    +
    3368 real(real64), intent(inout), dimension(:,:) :: a
    +
    3369 real(real64), intent(out), dimension(:) :: tau
    +
    3370 real(real64), intent(out), target, optional, dimension(:) :: work
    +
    3371 integer(int32), intent(out), optional :: olwork
    +
    3372 class(errors), intent(inout), optional, target :: err
    +
    3373 end subroutine
    +
    3374
    +
    3375 module subroutine rz_factor_cmplx(a, tau, work, olwork, err)
    +
    3376 complex(real64), intent(inout), dimension(:,:) :: a
    +
    3377 complex(real64), intent(out), dimension(:) :: tau
    +
    3378 complex(real64), intent(out), target, optional, dimension(:) :: work
    +
    3379 integer(int32), intent(out), optional :: olwork
    +
    3380 class(errors), intent(inout), optional, target :: err
    +
    3381 end subroutine
    +
    3382
    +
    3383 module subroutine mult_rz_mtx(lside, trans, l, a, tau, c, work, olwork, err)
    +
    3384 logical, intent(in) :: lside, trans
    +
    3385 integer(int32), intent(in) :: l
    +
    3386 real(real64), intent(inout), dimension(:,:) :: a, c
    +
    3387 real(real64), intent(in), dimension(:) :: tau
    +
    3388 real(real64), intent(out), target, optional, dimension(:) :: work
    +
    3389 integer(int32), intent(out), optional :: olwork
    +
    3390 class(errors), intent(inout), optional, target :: err
    +
    3391 end subroutine
    +
    3392
    +
    3393 module subroutine mult_rz_mtx_cmplx(lside, trans, l, a, tau, c, work, olwork, err)
    +
    3394 logical, intent(in) :: lside, trans
    +
    3395 integer(int32), intent(in) :: l
    +
    3396 complex(real64), intent(inout), dimension(:,:) :: a, c
    +
    3397 complex(real64), intent(in), dimension(:) :: tau
    +
    3398 complex(real64), intent(out), target, optional, dimension(:) :: work
    +
    3399 integer(int32), intent(out), optional :: olwork
    +
    3400 class(errors), intent(inout), optional, target :: err
    +
    3401 end subroutine
    +
    3402
    +
    3403 module subroutine mult_rz_vec(trans, l, a, tau, c, work, olwork, err)
    +
    3404 logical, intent(in) :: trans
    +
    3405 integer(int32), intent(in) :: l
    +
    3406 real(real64), intent(inout), dimension(:,:) :: a
    +
    3407 real(real64), intent(in), dimension(:) :: tau
    +
    3408 real(real64), intent(inout), dimension(:) :: c
    +
    3409 real(real64), intent(out), target, optional, dimension(:) :: work
    +
    3410 integer(int32), intent(out), optional :: olwork
    +
    3411 class(errors), intent(inout), optional, target :: err
    +
    3412 end subroutine
    +
    3413
    +
    3414 module subroutine mult_rz_vec_cmplx(trans, l, a, tau, c, work, olwork, err)
    +
    3415 logical, intent(in) :: trans
    +
    3416 integer(int32), intent(in) :: l
    +
    3417 complex(real64), intent(inout), dimension(:,:) :: a
    +
    3418 complex(real64), intent(in), dimension(:) :: tau
    +
    3419 complex(real64), intent(inout), dimension(:) :: c
    +
    3420 complex(real64), intent(out), target, optional, dimension(:) :: work
    +
    3421 integer(int32), intent(out), optional :: olwork
    +
    3422 class(errors), intent(inout), optional, target :: err
    +
    3423 end subroutine
    +
    3424
    +
    3425 module subroutine svd_dbl(a, s, u, vt, work, olwork, err)
    3426 real(real64), intent(inout), dimension(:,:) :: a
    -
    3427 real(real64), intent(in), dimension(:) :: tau
    -
    3428 integer(int32), intent(in), dimension(:) :: jpvt
    -
    3429 real(real64), intent(inout), dimension(:,:) :: b
    -
    3430 real(real64), intent(out), target, optional, dimension(:) :: work
    -
    3431 integer(int32), intent(out), optional :: olwork
    -
    3432 class(errors), intent(inout), optional, target :: err
    -
    3433 end subroutine
    -
    3434
    -
    3466 module subroutine solve_qr_pivot_mtx_cmplx(a, tau, jpvt, b, work, olwork, err)
    -
    3467 complex(real64), intent(inout), dimension(:,:) :: a
    -
    3468 complex(real64), intent(in), dimension(:) :: tau
    -
    3469 integer(int32), intent(in), dimension(:) :: jpvt
    -
    3470 complex(real64), intent(inout), dimension(:,:) :: b
    -
    3471 complex(real64), intent(out), target, optional, dimension(:) :: work
    -
    3472 integer(int32), intent(out), optional :: olwork
    -
    3473 class(errors), intent(inout), optional, target :: err
    -
    3474 end subroutine
    -
    3475
    -
    3507 module subroutine solve_qr_pivot_vec(a, tau, jpvt, b, work, olwork, err)
    -
    3508 real(real64), intent(inout), dimension(:,:) :: a
    +
    3427 real(real64), intent(out), dimension(:) :: s
    +
    3428 real(real64), intent(out), optional, dimension(:,:) :: u, vt
    +
    3429 real(real64), intent(out), target, optional, dimension(:) :: work
    +
    3430 integer(int32), intent(out), optional :: olwork
    +
    3431 class(errors), intent(inout), optional, target :: err
    +
    3432 end subroutine
    +
    3433
    +
    3434 module subroutine svd_cmplx(a, s, u, vt, work, olwork, rwork, err)
    +
    3435 complex(real64), intent(inout), dimension(:,:) :: a
    +
    3436 real(real64), intent(out), dimension(:) :: s
    +
    3437 complex(real64), intent(out), optional, dimension(:,:) :: u, vt
    +
    3438 complex(real64), intent(out), target, optional, dimension(:) :: work
    +
    3439 integer(int32), intent(out), optional :: olwork
    +
    3440 real(real64), intent(out), target, optional, dimension(:) :: rwork
    +
    3441 class(errors), intent(inout), optional, target :: err
    +
    3442 end subroutine
    +
    3443end interface
    +
    3444
    +
    3445! ******************************************************************************
    +
    3446! LINALG_SOLVE.F90
    +
    3447! ------------------------------------------------------------------------------
    +
    3448interface
    +
    3449 module subroutine solve_tri_mtx(lside, upper, trans, nounit, alpha, a, b, err)
    +
    3450 logical, intent(in) :: lside, upper, trans, nounit
    +
    3451 real(real64), intent(in) :: alpha
    +
    3452 real(real64), intent(in), dimension(:,:) :: a
    +
    3453 real(real64), intent(inout), dimension(:,:) :: b
    +
    3454 class(errors), intent(inout), optional, target :: err
    +
    3455 end subroutine
    +
    3456
    +
    3457 module subroutine solve_tri_mtx_cmplx(lside, upper, trans, nounit, alpha, a, b, err)
    +
    3458 logical, intent(in) :: lside, upper, trans, nounit
    +
    3459 complex(real64), intent(in) :: alpha
    +
    3460 complex(real64), intent(in), dimension(:,:) :: a
    +
    3461 complex(real64), intent(inout), dimension(:,:) :: b
    +
    3462 class(errors), intent(inout), optional, target :: err
    +
    3463 end subroutine
    +
    3464
    +
    3465 module subroutine solve_tri_vec(upper, trans, nounit, a, x, err)
    +
    3466 logical, intent(in) :: upper, trans, nounit
    +
    3467 real(real64), intent(in), dimension(:,:) :: a
    +
    3468 real(real64), intent(inout), dimension(:) :: x
    +
    3469 class(errors), intent(inout), optional, target :: err
    +
    3470 end subroutine
    +
    3471
    +
    3472 module subroutine solve_tri_vec_cmplx(upper, trans, nounit, a, x, err)
    +
    3473 logical, intent(in) :: upper, trans, nounit
    +
    3474 complex(real64), intent(in), dimension(:,:) :: a
    +
    3475 complex(real64), intent(inout), dimension(:) :: x
    +
    3476 class(errors), intent(inout), optional, target :: err
    +
    3477 end subroutine
    +
    3478
    +
    3479 module subroutine solve_lu_mtx(a, ipvt, b, err)
    +
    3480 real(real64), intent(in), dimension(:,:) :: a
    +
    3481 integer(int32), intent(in), dimension(:) :: ipvt
    +
    3482 real(real64), intent(inout), dimension(:,:) :: b
    +
    3483 class(errors), intent(inout), optional, target :: err
    +
    3484 end subroutine
    +
    3485
    +
    3486 module subroutine solve_lu_mtx_cmplx(a, ipvt, b, err)
    +
    3487 complex(real64), intent(in), dimension(:,:) :: a
    +
    3488 integer(int32), intent(in), dimension(:) :: ipvt
    +
    3489 complex(real64), intent(inout), dimension(:,:) :: b
    +
    3490 class(errors), intent(inout), optional, target :: err
    +
    3491 end subroutine
    +
    3492
    +
    3493 module subroutine solve_lu_vec(a, ipvt, b, err)
    +
    3494 real(real64), intent(in), dimension(:,:) :: a
    +
    3495 integer(int32), intent(in), dimension(:) :: ipvt
    +
    3496 real(real64), intent(inout), dimension(:) :: b
    +
    3497 class(errors), intent(inout), optional, target :: err
    +
    3498 end subroutine
    +
    3499
    +
    3500 module subroutine solve_lu_vec_cmplx(a, ipvt, b, err)
    +
    3501 complex(real64), intent(in), dimension(:,:) :: a
    +
    3502 integer(int32), intent(in), dimension(:) :: ipvt
    +
    3503 complex(real64), intent(inout), dimension(:) :: b
    +
    3504 class(errors), intent(inout), optional, target :: err
    +
    3505 end subroutine
    +
    3506
    +
    3507 module subroutine solve_qr_no_pivot_mtx(a, tau, b, work, olwork, err)
    +
    3508 real(real64), intent(inout), dimension(:,:) :: a, b
    3509 real(real64), intent(in), dimension(:) :: tau
    -
    3510 integer(int32), intent(in), dimension(:) :: jpvt
    -
    3511 real(real64), intent(inout), dimension(:) :: b
    -
    3512 real(real64), intent(out), target, optional, dimension(:) :: work
    -
    3513 integer(int32), intent(out), optional :: olwork
    -
    3514 class(errors), intent(inout), optional, target :: err
    -
    3515 end subroutine
    -
    3516
    -
    3548 module subroutine solve_qr_pivot_vec_cmplx(a, tau, jpvt, b, work, olwork, err)
    -
    3549 complex(real64), intent(inout), dimension(:,:) :: a
    -
    3550 complex(real64), intent(in), dimension(:) :: tau
    -
    3551 integer(int32), intent(in), dimension(:) :: jpvt
    -
    3552 complex(real64), intent(inout), dimension(:) :: b
    -
    3553 complex(real64), intent(out), target, optional, dimension(:) :: work
    -
    3554 integer(int32), intent(out), optional :: olwork
    -
    3555 class(errors), intent(inout), optional, target :: err
    -
    3556 end subroutine
    -
    3557
    -
    3576 module subroutine solve_cholesky_mtx(upper, a, b, err)
    -
    3577 logical, intent(in) :: upper
    -
    3578 real(real64), intent(in), dimension(:,:) :: a
    -
    3579 real(real64), intent(inout), dimension(:,:) :: b
    -
    3580 class(errors), intent(inout), optional, target :: err
    -
    3581 end subroutine
    -
    3582
    -
    3601 module subroutine solve_cholesky_mtx_cmplx(upper, a, b, err)
    -
    3602 logical, intent(in) :: upper
    -
    3603 complex(real64), intent(in), dimension(:,:) :: a
    -
    3604 complex(real64), intent(inout), dimension(:,:) :: b
    -
    3605 class(errors), intent(inout), optional, target :: err
    -
    3606 end subroutine
    -
    3607
    -
    3626 module subroutine solve_cholesky_vec(upper, a, b, err)
    -
    3627 logical, intent(in) :: upper
    -
    3628 real(real64), intent(in), dimension(:,:) :: a
    -
    3629 real(real64), intent(inout), dimension(:) :: b
    -
    3630 class(errors), intent(inout), optional, target :: err
    -
    3631 end subroutine
    -
    3632
    -
    3651 module subroutine solve_cholesky_vec_cmplx(upper, a, b, err)
    -
    3652 logical, intent(in) :: upper
    -
    3653 complex(real64), intent(in), dimension(:,:) :: a
    -
    3654 complex(real64), intent(inout), dimension(:) :: b
    -
    3655 class(errors), intent(inout), optional, target :: err
    -
    3656 end subroutine
    -
    3657
    -
    3689 module subroutine solve_least_squares_mtx(a, b, work, olwork, err)
    -
    3690 real(real64), intent(inout), dimension(:,:) :: a, b
    -
    3691 real(real64), intent(out), target, optional, dimension(:) :: work
    -
    3692 integer(int32), intent(out), optional :: olwork
    -
    3693 class(errors), intent(inout), optional, target :: err
    -
    3694 end subroutine
    -
    3695
    -
    3727 module subroutine solve_least_squares_mtx_cmplx(a, b, work, olwork, err)
    -
    3728 complex(real64), intent(inout), dimension(:,:) :: a, b
    -
    3729 complex(real64), intent(out), target, optional, dimension(:) :: work
    -
    3730 integer(int32), intent(out), optional :: olwork
    -
    3731 class(errors), intent(inout), optional, target :: err
    -
    3732 end subroutine
    -
    3733
    -
    3765 module subroutine solve_least_squares_vec(a, b, work, olwork, err)
    -
    3766 real(real64), intent(inout), dimension(:,:) :: a
    -
    3767 real(real64), intent(inout), dimension(:) :: b
    -
    3768 real(real64), intent(out), target, optional, dimension(:) :: work
    -
    3769 integer(int32), intent(out), optional :: olwork
    -
    3770 class(errors), intent(inout), optional, target :: err
    -
    3771 end subroutine
    -
    3772
    -
    3804 module subroutine solve_least_squares_vec_cmplx(a, b, work, olwork, err)
    -
    3805 complex(real64), intent(inout), dimension(:,:) :: a
    -
    3806 complex(real64), intent(inout), dimension(:) :: b
    -
    3807 complex(real64), intent(out), target, optional, dimension(:) :: work
    -
    3808 integer(int32), intent(out), optional :: olwork
    -
    3809 class(errors), intent(inout), optional, target :: err
    -
    3810 end subroutine
    -
    3811
    -
    3849 module subroutine solve_least_squares_mtx_pvt(a, b, ipvt, arnk, work, olwork, err)
    -
    3850 real(real64), intent(inout), dimension(:,:) :: a, b
    -
    3851 integer(int32), intent(inout), target, optional, dimension(:) :: ipvt
    -
    3852 integer(int32), intent(out), optional :: arnk
    -
    3853 real(real64), intent(out), target, optional, dimension(:) :: work
    -
    3854 integer(int32), intent(out), optional :: olwork
    -
    3855 class(errors), intent(inout), optional, target :: err
    -
    3856 end subroutine
    -
    3857
    -
    3899 module subroutine solve_least_squares_mtx_pvt_cmplx(a, b, ipvt, arnk, &
    -
    3900 work, olwork, rwork, err)
    -
    3901 complex(real64), intent(inout), dimension(:,:) :: a, b
    -
    3902 integer(int32), intent(inout), target, optional, dimension(:) :: ipvt
    -
    3903 integer(int32), intent(out), optional :: arnk
    -
    3904 complex(real64), intent(out), target, optional, dimension(:) :: work
    -
    3905 integer(int32), intent(out), optional :: olwork
    -
    3906 real(real64), intent(out), target, optional, dimension(:) :: rwork
    -
    3907 class(errors), intent(inout), optional, target :: err
    -
    3908 end subroutine
    -
    3909
    -
    3947 module subroutine solve_least_squares_vec_pvt(a, b, ipvt, arnk, work, olwork, err)
    -
    3948 real(real64), intent(inout), dimension(:,:) :: a
    -
    3949 real(real64), intent(inout), dimension(:) :: b
    -
    3950 integer(int32), intent(inout), target, optional, dimension(:) :: ipvt
    -
    3951 integer(int32), intent(out), optional :: arnk
    -
    3952 real(real64), intent(out), target, optional, dimension(:) :: work
    -
    3953 integer(int32), intent(out), optional :: olwork
    -
    3954 class(errors), intent(inout), optional, target :: err
    +
    3510 real(real64), intent(out), target, optional, dimension(:) :: work
    +
    3511 integer(int32), intent(out), optional :: olwork
    +
    3512 class(errors), intent(inout), optional, target :: err
    +
    3513 end subroutine
    +
    3514
    +
    3515 module subroutine solve_qr_no_pivot_mtx_cmplx(a, tau, b, work, olwork, err)
    +
    3516 complex(real64), intent(inout), dimension(:,:) :: a, b
    +
    3517 complex(real64), intent(in), dimension(:) :: tau
    +
    3518 complex(real64), intent(out), target, optional, dimension(:) :: work
    +
    3519 integer(int32), intent(out), optional :: olwork
    +
    3520 class(errors), intent(inout), optional, target :: err
    +
    3521 end subroutine
    +
    3522
    +
    3523 module subroutine solve_qr_no_pivot_vec(a, tau, b, work, olwork, err)
    +
    3524 real(real64), intent(inout), dimension(:,:) :: a
    +
    3525 real(real64), intent(in), dimension(:) :: tau
    +
    3526 real(real64), intent(inout), dimension(:) :: b
    +
    3527 real(real64), intent(out), target, optional, dimension(:) :: work
    +
    3528 integer(int32), intent(out), optional :: olwork
    +
    3529 class(errors), intent(inout), optional, target :: err
    +
    3530 end subroutine
    +
    3531
    +
    3532 module subroutine solve_qr_no_pivot_vec_cmplx(a, tau, b, work, olwork, err)
    +
    3533 complex(real64), intent(inout), dimension(:,:) :: a
    +
    3534 complex(real64), intent(in), dimension(:) :: tau
    +
    3535 complex(real64), intent(inout), dimension(:) :: b
    +
    3536 complex(real64), intent(out), target, optional, dimension(:) :: work
    +
    3537 integer(int32), intent(out), optional :: olwork
    +
    3538 class(errors), intent(inout), optional, target :: err
    +
    3539 end subroutine
    +
    3540
    +
    3541 module subroutine solve_qr_pivot_mtx(a, tau, jpvt, b, work, olwork, err)
    +
    3542 real(real64), intent(inout), dimension(:,:) :: a
    +
    3543 real(real64), intent(in), dimension(:) :: tau
    +
    3544 integer(int32), intent(in), dimension(:) :: jpvt
    +
    3545 real(real64), intent(inout), dimension(:,:) :: b
    +
    3546 real(real64), intent(out), target, optional, dimension(:) :: work
    +
    3547 integer(int32), intent(out), optional :: olwork
    +
    3548 class(errors), intent(inout), optional, target :: err
    +
    3549 end subroutine
    +
    3550
    +
    3551 module subroutine solve_qr_pivot_mtx_cmplx(a, tau, jpvt, b, work, olwork, err)
    +
    3552 complex(real64), intent(inout), dimension(:,:) :: a
    +
    3553 complex(real64), intent(in), dimension(:) :: tau
    +
    3554 integer(int32), intent(in), dimension(:) :: jpvt
    +
    3555 complex(real64), intent(inout), dimension(:,:) :: b
    +
    3556 complex(real64), intent(out), target, optional, dimension(:) :: work
    +
    3557 integer(int32), intent(out), optional :: olwork
    +
    3558 class(errors), intent(inout), optional, target :: err
    +
    3559 end subroutine
    +
    3560
    +
    3561 module subroutine solve_qr_pivot_vec(a, tau, jpvt, b, work, olwork, err)
    +
    3562 real(real64), intent(inout), dimension(:,:) :: a
    +
    3563 real(real64), intent(in), dimension(:) :: tau
    +
    3564 integer(int32), intent(in), dimension(:) :: jpvt
    +
    3565 real(real64), intent(inout), dimension(:) :: b
    +
    3566 real(real64), intent(out), target, optional, dimension(:) :: work
    +
    3567 integer(int32), intent(out), optional :: olwork
    +
    3568 class(errors), intent(inout), optional, target :: err
    +
    3569 end subroutine
    +
    3570
    +
    3571 module subroutine solve_qr_pivot_vec_cmplx(a, tau, jpvt, b, work, olwork, err)
    +
    3572 complex(real64), intent(inout), dimension(:,:) :: a
    +
    3573 complex(real64), intent(in), dimension(:) :: tau
    +
    3574 integer(int32), intent(in), dimension(:) :: jpvt
    +
    3575 complex(real64), intent(inout), dimension(:) :: b
    +
    3576 complex(real64), intent(out), target, optional, dimension(:) :: work
    +
    3577 integer(int32), intent(out), optional :: olwork
    +
    3578 class(errors), intent(inout), optional, target :: err
    +
    3579 end subroutine
    +
    3580
    +
    3581 module subroutine solve_cholesky_mtx(upper, a, b, err)
    +
    3582 logical, intent(in) :: upper
    +
    3583 real(real64), intent(in), dimension(:,:) :: a
    +
    3584 real(real64), intent(inout), dimension(:,:) :: b
    +
    3585 class(errors), intent(inout), optional, target :: err
    +
    3586 end subroutine
    +
    3587
    +
    3588 module subroutine solve_cholesky_mtx_cmplx(upper, a, b, err)
    +
    3589 logical, intent(in) :: upper
    +
    3590 complex(real64), intent(in), dimension(:,:) :: a
    +
    3591 complex(real64), intent(inout), dimension(:,:) :: b
    +
    3592 class(errors), intent(inout), optional, target :: err
    +
    3593 end subroutine
    +
    3594
    +
    3595 module subroutine solve_cholesky_vec(upper, a, b, err)
    +
    3596 logical, intent(in) :: upper
    +
    3597 real(real64), intent(in), dimension(:,:) :: a
    +
    3598 real(real64), intent(inout), dimension(:) :: b
    +
    3599 class(errors), intent(inout), optional, target :: err
    +
    3600 end subroutine
    +
    3601
    +
    3602 module subroutine solve_cholesky_vec_cmplx(upper, a, b, err)
    +
    3603 logical, intent(in) :: upper
    +
    3604 complex(real64), intent(in), dimension(:,:) :: a
    +
    3605 complex(real64), intent(inout), dimension(:) :: b
    +
    3606 class(errors), intent(inout), optional, target :: err
    +
    3607 end subroutine
    +
    3608
    +
    3609 module subroutine solve_least_squares_mtx(a, b, work, olwork, err)
    +
    3610 real(real64), intent(inout), dimension(:,:) :: a, b
    +
    3611 real(real64), intent(out), target, optional, dimension(:) :: work
    +
    3612 integer(int32), intent(out), optional :: olwork
    +
    3613 class(errors), intent(inout), optional, target :: err
    +
    3614 end subroutine
    +
    3615
    +
    3616 module subroutine solve_least_squares_mtx_cmplx(a, b, work, olwork, err)
    +
    3617 complex(real64), intent(inout), dimension(:,:) :: a, b
    +
    3618 complex(real64), intent(out), target, optional, dimension(:) :: work
    +
    3619 integer(int32), intent(out), optional :: olwork
    +
    3620 class(errors), intent(inout), optional, target :: err
    +
    3621 end subroutine
    +
    3622
    +
    3623 module subroutine solve_least_squares_vec(a, b, work, olwork, err)
    +
    3624 real(real64), intent(inout), dimension(:,:) :: a
    +
    3625 real(real64), intent(inout), dimension(:) :: b
    +
    3626 real(real64), intent(out), target, optional, dimension(:) :: work
    +
    3627 integer(int32), intent(out), optional :: olwork
    +
    3628 class(errors), intent(inout), optional, target :: err
    +
    3629 end subroutine
    +
    3630
    +
    3631 module subroutine solve_least_squares_vec_cmplx(a, b, work, olwork, err)
    +
    3632 complex(real64), intent(inout), dimension(:,:) :: a
    +
    3633 complex(real64), intent(inout), dimension(:) :: b
    +
    3634 complex(real64), intent(out), target, optional, dimension(:) :: work
    +
    3635 integer(int32), intent(out), optional :: olwork
    +
    3636 class(errors), intent(inout), optional, target :: err
    +
    3637 end subroutine
    +
    3638
    +
    3639 module subroutine solve_least_squares_mtx_pvt(a, b, ipvt, arnk, work, olwork, err)
    +
    3640 real(real64), intent(inout), dimension(:,:) :: a, b
    +
    3641 integer(int32), intent(inout), target, optional, dimension(:) :: ipvt
    +
    3642 integer(int32), intent(out), optional :: arnk
    +
    3643 real(real64), intent(out), target, optional, dimension(:) :: work
    +
    3644 integer(int32), intent(out), optional :: olwork
    +
    3645 class(errors), intent(inout), optional, target :: err
    +
    3646 end subroutine
    +
    3647
    +
    3648 module subroutine solve_least_squares_mtx_pvt_cmplx(a, b, ipvt, arnk, &
    +
    3649 work, olwork, rwork, err)
    +
    3650 complex(real64), intent(inout), dimension(:,:) :: a, b
    +
    3651 integer(int32), intent(inout), target, optional, dimension(:) :: ipvt
    +
    3652 integer(int32), intent(out), optional :: arnk
    +
    3653 complex(real64), intent(out), target, optional, dimension(:) :: work
    +
    3654 integer(int32), intent(out), optional :: olwork
    +
    3655 real(real64), intent(out), target, optional, dimension(:) :: rwork
    +
    3656 class(errors), intent(inout), optional, target :: err
    +
    3657 end subroutine
    +
    3658
    +
    3659 module subroutine solve_least_squares_vec_pvt(a, b, ipvt, arnk, work, olwork, err)
    +
    3660 real(real64), intent(inout), dimension(:,:) :: a
    +
    3661 real(real64), intent(inout), dimension(:) :: b
    +
    3662 integer(int32), intent(inout), target, optional, dimension(:) :: ipvt
    +
    3663 integer(int32), intent(out), optional :: arnk
    +
    3664 real(real64), intent(out), target, optional, dimension(:) :: work
    +
    3665 integer(int32), intent(out), optional :: olwork
    +
    3666 class(errors), intent(inout), optional, target :: err
    +
    3667 end subroutine
    +
    3668
    +
    3669 module subroutine solve_least_squares_vec_pvt_cmplx(a, b, ipvt, arnk, &
    +
    3670 work, olwork, rwork, err)
    +
    3671 complex(real64), intent(inout), dimension(:,:) :: a
    +
    3672 complex(real64), intent(inout), dimension(:) :: b
    +
    3673 integer(int32), intent(inout), target, optional, dimension(:) :: ipvt
    +
    3674 integer(int32), intent(out), optional :: arnk
    +
    3675 complex(real64), intent(out), target, optional, dimension(:) :: work
    +
    3676 integer(int32), intent(out), optional :: olwork
    +
    3677 real(real64), intent(out), target, optional, dimension(:) :: rwork
    +
    3678 class(errors), intent(inout), optional, target :: err
    +
    3679 end subroutine
    +
    3680
    +
    3681 module subroutine solve_least_squares_mtx_svd(a, b, s, arnk, work, olwork, err)
    +
    3682 real(real64), intent(inout), dimension(:,:) :: a, b
    +
    3683 integer(int32), intent(out), optional :: arnk
    +
    3684 real(real64), intent(out), target, optional, dimension(:) :: work, s
    +
    3685 integer(int32), intent(out), optional :: olwork
    +
    3686 class(errors), intent(inout), optional, target :: err
    +
    3687 end subroutine
    +
    3688
    +
    3689 module subroutine solve_least_squares_mtx_svd_cmplx(a, b, s, arnk, work, &
    +
    3690 olwork, rwork, err)
    +
    3691 complex(real64), intent(inout), dimension(:,:) :: a, b
    +
    3692 integer(int32), intent(out), optional :: arnk
    +
    3693 complex(real64), intent(out), target, optional, dimension(:) :: work
    +
    3694 real(real64), intent(out), target, optional, dimension(:) :: rwork, s
    +
    3695 integer(int32), intent(out), optional :: olwork
    +
    3696 class(errors), intent(inout), optional, target :: err
    +
    3697 end subroutine
    +
    3698
    +
    3699 module subroutine solve_least_squares_vec_svd(a, b, s, arnk, work, olwork, err)
    +
    3700 real(real64), intent(inout), dimension(:,:) :: a
    +
    3701 real(real64), intent(inout), dimension(:) :: b
    +
    3702 integer(int32), intent(out), optional :: arnk
    +
    3703 real(real64), intent(out), target, optional, dimension(:) :: work, s
    +
    3704 integer(int32), intent(out), optional :: olwork
    +
    3705 class(errors), intent(inout), optional, target :: err
    +
    3706 end subroutine
    +
    3707
    +
    3708 module subroutine solve_least_squares_vec_svd_cmplx(a, b, s, arnk, work, &
    +
    3709 olwork, rwork, err)
    +
    3710 complex(real64), intent(inout), dimension(:,:) :: a
    +
    3711 complex(real64), intent(inout), dimension(:) :: b
    +
    3712 integer(int32), intent(out), optional :: arnk
    +
    3713 complex(real64), intent(out), target, optional, dimension(:) :: work
    +
    3714 real(real64), intent(out), target, optional, dimension(:) :: rwork, s
    +
    3715 integer(int32), intent(out), optional :: olwork
    +
    3716 class(errors), intent(inout), optional, target :: err
    +
    3717 end subroutine
    +
    3718
    +
    3719 module subroutine mtx_inverse_dbl(a, iwork, work, olwork, err)
    +
    3720 real(real64), intent(inout), dimension(:,:) :: a
    +
    3721 integer(int32), intent(out), target, optional, dimension(:) :: iwork
    +
    3722 real(real64), intent(out), target, optional, dimension(:) :: work
    +
    3723 integer(int32), intent(out), optional :: olwork
    +
    3724 class(errors), intent(inout), optional, target :: err
    +
    3725 end subroutine
    +
    3726
    +
    3727 module subroutine mtx_inverse_cmplx(a, iwork, work, olwork, err)
    +
    3728 complex(real64), intent(inout), dimension(:,:) :: a
    +
    3729 integer(int32), intent(out), target, optional, dimension(:) :: iwork
    +
    3730 complex(real64), intent(out), target, optional, dimension(:) :: work
    +
    3731 integer(int32), intent(out), optional :: olwork
    +
    3732 class(errors), intent(inout), optional, target :: err
    +
    3733 end subroutine
    +
    3734
    +
    3735 module subroutine mtx_pinverse_dbl(a, ainv, tol, work, olwork, err)
    +
    3736 real(real64), intent(inout), dimension(:,:) :: a
    +
    3737 real(real64), intent(out), dimension(:,:) :: ainv
    +
    3738 real(real64), intent(in), optional :: tol
    +
    3739 real(real64), intent(out), target, dimension(:), optional :: work
    +
    3740 integer(int32), intent(out), optional :: olwork
    +
    3741 class(errors), intent(inout), optional, target :: err
    +
    3742 end subroutine
    +
    3743
    +
    3744 module subroutine mtx_pinverse_cmplx(a, ainv, tol, work, olwork, rwork, err)
    +
    3745 complex(real64), intent(inout), dimension(:,:) :: a
    +
    3746 complex(real64), intent(out), dimension(:,:) :: ainv
    +
    3747 real(real64), intent(in), optional :: tol
    +
    3748 complex(real64), intent(out), target, dimension(:), optional :: work
    +
    3749 integer(int32), intent(out), optional :: olwork
    +
    3750 real(real64), intent(out), target, dimension(:), optional :: rwork
    +
    3751 class(errors), intent(inout), optional, target :: err
    +
    3752 end subroutine
    +
    3753
    +
    3754end interface
    +
    3755
    +
    3756! ******************************************************************************
    +
    3757! LINALG_EIGEN.F90
    +
    3758! ------------------------------------------------------------------------------
    +
    3759interface
    +
    3760
    +
    3792 module subroutine eigen_symm(vecs, a, vals, work, olwork, err)
    +
    3793 logical, intent(in) :: vecs
    +
    3794 real(real64), intent(inout), dimension(:,:) :: a
    +
    3795 real(real64), intent(out), dimension(:) :: vals
    +
    3796 real(real64), intent(out), pointer, optional, dimension(:) :: work
    +
    3797 integer(int32), intent(out), optional :: olwork
    +
    3798 class(errors), intent(inout), optional, target :: err
    +
    3799 end subroutine
    +
    3800
    +
    3831 module subroutine eigen_asymm(a, vals, vecs, work, olwork, err)
    +
    3832 real(real64), intent(inout), dimension(:,:) :: a
    +
    3833 complex(real64), intent(out), dimension(:) :: vals
    +
    3834 complex(real64), intent(out), optional, dimension(:,:) :: vecs
    +
    3835 real(real64), intent(out), pointer, optional, dimension(:) :: work
    +
    3836 integer(int32), intent(out), optional :: olwork
    +
    3837 class(errors), intent(inout), optional, target :: err
    +
    3838 end subroutine
    +
    3839
    +
    3882 module subroutine eigen_gen(a, b, alpha, beta, vecs, work, olwork, err)
    +
    3883 real(real64), intent(inout), dimension(:,:) :: a, b
    +
    3884 complex(real64), intent(out), dimension(:) :: alpha
    +
    3885 real(real64), intent(out), optional, dimension(:) :: beta
    +
    3886 complex(real64), intent(out), optional, dimension(:,:) :: vecs
    +
    3887 real(real64), intent(out), optional, pointer, dimension(:) :: work
    +
    3888 integer(int32), intent(out), optional :: olwork
    +
    3889 class(errors), intent(inout), optional, target :: err
    +
    3890 end subroutine
    +
    3891
    +
    3922 module subroutine eigen_cmplx(a, vals, vecs, work, olwork, rwork, err)
    +
    3923 complex(real64), intent(inout), dimension(:,:) :: a
    +
    3924 complex(real64), intent(out), dimension(:) :: vals
    +
    3925 complex(real64), intent(out), optional, dimension(:,:) :: vecs
    +
    3926 complex(real64), intent(out), target, optional, dimension(:) :: work
    +
    3927 real(real64), intent(out), target, optional, dimension(:) :: rwork
    +
    3928 integer(int32), intent(out), optional :: olwork
    +
    3929 class(errors), intent(inout), optional, target :: err
    +
    3930 end subroutine
    +
    3931end interface
    +
    3932
    +
    3933! ******************************************************************************
    +
    3934! LINALG_SORTING.F90
    +
    3935! ------------------------------------------------------------------------------
    +
    3936interface
    +
    3937
    +
    3952 module subroutine sort_dbl_array(x, ascend)
    +
    3953 real(real64), intent(inout), dimension(:) :: x
    +
    3954 logical, intent(in), optional :: ascend
    3955 end subroutine
    3956
    -
    3998 module subroutine solve_least_squares_vec_pvt_cmplx(a, b, ipvt, arnk, &
    -
    3999 work, olwork, rwork, err)
    -
    4000 complex(real64), intent(inout), dimension(:,:) :: a
    -
    4001 complex(real64), intent(inout), dimension(:) :: b
    -
    4002 integer(int32), intent(inout), target, optional, dimension(:) :: ipvt
    -
    4003 integer(int32), intent(out), optional :: arnk
    -
    4004 complex(real64), intent(out), target, optional, dimension(:) :: work
    -
    4005 integer(int32), intent(out), optional :: olwork
    -
    4006 real(real64), intent(out), target, optional, dimension(:) :: rwork
    -
    4007 class(errors), intent(inout), optional, target :: err
    -
    4008 end subroutine
    -
    4009
    -
    4048 module subroutine solve_least_squares_mtx_svd(a, b, s, arnk, work, olwork, err)
    -
    4049 real(real64), intent(inout), dimension(:,:) :: a, b
    -
    4050 integer(int32), intent(out), optional :: arnk
    -
    4051 real(real64), intent(out), target, optional, dimension(:) :: work, s
    -
    4052 integer(int32), intent(out), optional :: olwork
    -
    4053 class(errors), intent(inout), optional, target :: err
    -
    4054 end subroutine
    -
    4055
    -
    4098 module subroutine solve_least_squares_mtx_svd_cmplx(a, b, s, arnk, work, &
    -
    4099 olwork, rwork, err)
    -
    4100 complex(real64), intent(inout), dimension(:,:) :: a, b
    -
    4101 integer(int32), intent(out), optional :: arnk
    -
    4102 complex(real64), intent(out), target, optional, dimension(:) :: work
    -
    4103 real(real64), intent(out), target, optional, dimension(:) :: rwork, s
    -
    4104 integer(int32), intent(out), optional :: olwork
    -
    4105 class(errors), intent(inout), optional, target :: err
    -
    4106 end subroutine
    -
    4107
    -
    4144 module subroutine solve_least_squares_vec_svd(a, b, s, arnk, work, olwork, err)
    -
    4145 real(real64), intent(inout), dimension(:,:) :: a
    -
    4146 real(real64), intent(inout), dimension(:) :: b
    -
    4147 integer(int32), intent(out), optional :: arnk
    -
    4148 real(real64), intent(out), target, optional, dimension(:) :: work, s
    -
    4149 integer(int32), intent(out), optional :: olwork
    -
    4150 class(errors), intent(inout), optional, target :: err
    -
    4151 end subroutine
    -
    4152
    -
    4193 module subroutine solve_least_squares_vec_svd_cmplx(a, b, s, arnk, work, &
    -
    4194 olwork, rwork, err)
    -
    4195 complex(real64), intent(inout), dimension(:,:) :: a
    -
    4196 complex(real64), intent(inout), dimension(:) :: b
    -
    4197 integer(int32), intent(out), optional :: arnk
    -
    4198 complex(real64), intent(out), target, optional, dimension(:) :: work
    -
    4199 real(real64), intent(out), target, optional, dimension(:) :: rwork, s
    -
    4200 integer(int32), intent(out), optional :: olwork
    -
    4201 class(errors), intent(inout), optional, target :: err
    -
    4202 end subroutine
    -
    4203
    -
    4235 module subroutine mtx_inverse_dbl(a, iwork, work, olwork, err)
    -
    4236 real(real64), intent(inout), dimension(:,:) :: a
    -
    4237 integer(int32), intent(out), target, optional, dimension(:) :: iwork
    -
    4238 real(real64), intent(out), target, optional, dimension(:) :: work
    -
    4239 integer(int32), intent(out), optional :: olwork
    -
    4240 class(errors), intent(inout), optional, target :: err
    -
    4241 end subroutine
    -
    4242
    -
    4274 module subroutine mtx_inverse_cmplx(a, iwork, work, olwork, err)
    -
    4275 complex(real64), intent(inout), dimension(:,:) :: a
    -
    4276 integer(int32), intent(out), target, optional, dimension(:) :: iwork
    -
    4277 complex(real64), intent(out), target, optional, dimension(:) :: work
    -
    4278 integer(int32), intent(out), optional :: olwork
    -
    4279 class(errors), intent(inout), optional, target :: err
    -
    4280 end subroutine
    -
    4281
    -
    4319 module subroutine mtx_pinverse_dbl(a, ainv, tol, work, olwork, err)
    -
    4320 real(real64), intent(inout), dimension(:,:) :: a
    -
    4321 real(real64), intent(out), dimension(:,:) :: ainv
    -
    4322 real(real64), intent(in), optional :: tol
    -
    4323 real(real64), intent(out), target, dimension(:), optional :: work
    -
    4324 integer(int32), intent(out), optional :: olwork
    -
    4325 class(errors), intent(inout), optional, target :: err
    -
    4326 end subroutine
    -
    4327
    -
    4369 module subroutine mtx_pinverse_cmplx(a, ainv, tol, work, olwork, rwork, err)
    -
    4370 complex(real64), intent(inout), dimension(:,:) :: a
    -
    4371 complex(real64), intent(out), dimension(:,:) :: ainv
    -
    4372 real(real64), intent(in), optional :: tol
    -
    4373 complex(real64), intent(out), target, dimension(:), optional :: work
    -
    4374 integer(int32), intent(out), optional :: olwork
    -
    4375 real(real64), intent(out), target, dimension(:), optional :: rwork
    -
    4376 class(errors), intent(inout), optional, target :: err
    -
    4377 end subroutine
    -
    4378
    -
    4379end interface
    -
    4380
    -
    4381! ******************************************************************************
    -
    4382! LINALG_EIGEN.F90
    -
    4383! ------------------------------------------------------------------------------
    -
    4384interface
    -
    4385
    -
    4417 module subroutine eigen_symm(vecs, a, vals, work, olwork, err)
    -
    4418 logical, intent(in) :: vecs
    -
    4419 real(real64), intent(inout), dimension(:,:) :: a
    -
    4420 real(real64), intent(out), dimension(:) :: vals
    -
    4421 real(real64), intent(out), pointer, optional, dimension(:) :: work
    -
    4422 integer(int32), intent(out), optional :: olwork
    -
    4423 class(errors), intent(inout), optional, target :: err
    -
    4424 end subroutine
    -
    4425
    -
    4456 module subroutine eigen_asymm(a, vals, vecs, work, olwork, err)
    -
    4457 real(real64), intent(inout), dimension(:,:) :: a
    -
    4458 complex(real64), intent(out), dimension(:) :: vals
    -
    4459 complex(real64), intent(out), optional, dimension(:,:) :: vecs
    -
    4460 real(real64), intent(out), pointer, optional, dimension(:) :: work
    -
    4461 integer(int32), intent(out), optional :: olwork
    -
    4462 class(errors), intent(inout), optional, target :: err
    -
    4463 end subroutine
    -
    4464
    -
    4507 module subroutine eigen_gen(a, b, alpha, beta, vecs, work, olwork, err)
    -
    4508 real(real64), intent(inout), dimension(:,:) :: a, b
    -
    4509 complex(real64), intent(out), dimension(:) :: alpha
    -
    4510 real(real64), intent(out), optional, dimension(:) :: beta
    -
    4511 complex(real64), intent(out), optional, dimension(:,:) :: vecs
    -
    4512 real(real64), intent(out), optional, pointer, dimension(:) :: work
    -
    4513 integer(int32), intent(out), optional :: olwork
    -
    4514 class(errors), intent(inout), optional, target :: err
    -
    4515 end subroutine
    -
    4516
    -
    4547 module subroutine eigen_cmplx(a, vals, vecs, work, olwork, rwork, err)
    -
    4548 complex(real64), intent(inout), dimension(:,:) :: a
    -
    4549 complex(real64), intent(out), dimension(:) :: vals
    -
    4550 complex(real64), intent(out), optional, dimension(:,:) :: vecs
    -
    4551 complex(real64), intent(out), target, optional, dimension(:) :: work
    -
    4552 real(real64), intent(out), target, optional, dimension(:) :: rwork
    -
    4553 integer(int32), intent(out), optional :: olwork
    -
    4554 class(errors), intent(inout), optional, target :: err
    -
    4555 end subroutine
    -
    4556end interface
    -
    4557
    -
    4558! ******************************************************************************
    -
    4559! LINALG_SORTING.F90
    -
    4560! ------------------------------------------------------------------------------
    -
    4561interface
    -
    4562
    -
    4577 module subroutine sort_dbl_array(x, ascend)
    -
    4578 real(real64), intent(inout), dimension(:) :: x
    -
    4579 logical, intent(in), optional :: ascend
    -
    4580 end subroutine
    -
    4581
    -
    4606 module subroutine sort_dbl_array_ind(x, ind, ascend, err)
    -
    4607 real(real64), intent(inout), dimension(:) :: x
    -
    4608 integer(int32), intent(inout), dimension(:) :: ind
    -
    4609 logical, intent(in), optional :: ascend
    -
    4610 class(errors), intent(inout), optional, target :: err
    -
    4611 end subroutine
    -
    4612
    -
    4629 module subroutine sort_cmplx_array(x, ascend)
    -
    4630 complex(real64), intent(inout), dimension(:) :: x
    -
    4631 logical, intent(in), optional :: ascend
    -
    4632 end subroutine
    -
    4633
    -
    4663 module subroutine sort_cmplx_array_ind(x, ind, ascend, err)
    -
    4664 complex(real64), intent(inout), dimension(:) :: x
    -
    4665 integer(int32), intent(inout), dimension(:) :: ind
    -
    4666 logical, intent(in), optional :: ascend
    -
    4667 class(errors), intent(inout), optional, target :: err
    -
    4668 end subroutine
    -
    4669
    -
    4689 module subroutine sort_eigen_cmplx(vals, vecs, ascend, err)
    -
    4690 complex(real64), intent(inout), dimension(:) :: vals
    -
    4691 complex(real64), intent(inout), dimension(:,:) :: vecs
    -
    4692 logical, intent(in), optional :: ascend
    -
    4693 class(errors), intent(inout), optional, target :: err
    -
    4694 end subroutine
    -
    4695
    -
    4715 module subroutine sort_eigen_dbl(vals, vecs, ascend, err)
    -
    4716 real(real64), intent(inout), dimension(:) :: vals
    -
    4717 real(real64), intent(inout), dimension(:,:) :: vecs
    -
    4718 logical, intent(in), optional :: ascend
    -
    4719 class(errors), intent(inout), optional, target :: err
    -
    4720 end subroutine
    -
    4721
    -
    4722end interface
    -
    4723
    -
    4724end module
    +
    3981 module subroutine sort_dbl_array_ind(x, ind, ascend, err)
    +
    3982 real(real64), intent(inout), dimension(:) :: x
    +
    3983 integer(int32), intent(inout), dimension(:) :: ind
    +
    3984 logical, intent(in), optional :: ascend
    +
    3985 class(errors), intent(inout), optional, target :: err
    +
    3986 end subroutine
    +
    3987
    +
    4004 module subroutine sort_cmplx_array(x, ascend)
    +
    4005 complex(real64), intent(inout), dimension(:) :: x
    +
    4006 logical, intent(in), optional :: ascend
    +
    4007 end subroutine
    +
    4008
    +
    4038 module subroutine sort_cmplx_array_ind(x, ind, ascend, err)
    +
    4039 complex(real64), intent(inout), dimension(:) :: x
    +
    4040 integer(int32), intent(inout), dimension(:) :: ind
    +
    4041 logical, intent(in), optional :: ascend
    +
    4042 class(errors), intent(inout), optional, target :: err
    +
    4043 end subroutine
    +
    4044
    +
    4064 module subroutine sort_eigen_cmplx(vals, vecs, ascend, err)
    +
    4065 complex(real64), intent(inout), dimension(:) :: vals
    +
    4066 complex(real64), intent(inout), dimension(:,:) :: vecs
    +
    4067 logical, intent(in), optional :: ascend
    +
    4068 class(errors), intent(inout), optional, target :: err
    +
    4069 end subroutine
    +
    4070
    +
    4090 module subroutine sort_eigen_dbl(vals, vecs, ascend, err)
    +
    4091 real(real64), intent(inout), dimension(:) :: vals
    +
    4092 real(real64), intent(inout), dimension(:,:) :: vecs
    +
    4093 logical, intent(in), optional :: ascend
    +
    4094 class(errors), intent(inout), optional, target :: err
    +
    4095 end subroutine
    +
    4096
    +
    4097end interface
    +
    4098
    +
    4099end module
    Computes the Cholesky factorization of a symmetric, positive definite matrix.
    Computes the rank 1 downdate to a Cholesky factored matrix (upper triangular).
    Computes the rank 1 update to a Cholesky factored matrix (upper triangular).
    Computes the determinant of a square matrix.
    Multiplies a diagonal matrix with another matrix or array.
    -
    Computes the eigenvalues, and optionally the eigenvectors, of a matrix.
    +
    Computes the eigenvalues, and optionally the eigenvectors, of a matrix.
    Extracts the L and U matrices from the condensed [L\U] storage format used by the lu_factor.
    Forms the full M-by-M orthogonal matrix Q from the elementary reflectors returned by the base QR fact...
    Computes the LU factorization of an M-by-N matrix.
    -
    Computes the inverse of a square matrix.
    +
    Computes the inverse of a square matrix.
    Performs the matrix operation: .
    -
    Computes the Moore-Penrose pseudo-inverse of a M-by-N matrix using the singular value decomposition o...
    +
    Computes the Moore-Penrose pseudo-inverse of a M-by-N matrix using the singular value decomposition o...
    Computes the rank of a matrix.
    Multiplies a general matrix by the orthogonal matrix Q from a QR factorization.
    Multiplies a general matrix by the orthogonal matrix Z from an RZ factorization.
    @@ -1287,14 +1287,14 @@
    Performs the rank-1 update to matrix A such that: , where is an M-by-N matrix, is a scalar,...
    Multiplies a vector by the reciprocal of a real scalar.
    Factors an upper trapezoidal matrix by means of orthogonal transformations such that ....
    -
    Solves a system of Cholesky factored equations.
    -
    Solves the overdetermined or underdetermined system (A*X = B) of M equations of N unknowns,...
    -
    Solves the overdetermined or underdetermined system (A*X = B) of M equations of N unknowns using a si...
    -
    Solves the overdetermined or underdetermined system (A*X = B) of M equations of N unknowns.
    -
    Solves a system of LU-factored equations.
    -
    Solves a system of M QR-factored equations of N unknowns.
    -
    Solves a triangular system of equations.
    -
    Sorts an array.
    +
    Solves a system of Cholesky factored equations.
    +
    Solves the overdetermined or underdetermined system of M equations of N unknowns,...
    +
    Solves the overdetermined or underdetermined system of M equations of N unknowns using a singular va...
    +
    Solves the overdetermined or underdetermined system of M equations of N unknowns....
    +
    Solves a system of LU-factored equations.
    +
    Solves a system of M QR-factored equations of N unknowns.
    +
    Solves a triangular system of equations.
    +
    Sorts an array.
    Computes the singular value decomposition of a matrix A. The SVD is defined as: , where is an M-by-M...
    Swaps the contents of two arrays.
    Computes the trace of a matrix (the sum of the main diagonal elements).
    diff --git a/doc/html/linalg__immutable_8f90_source.html b/doc/html/linalg__immutable_8f90_source.html index fea99c3e..92c10010 100644 --- a/doc/html/linalg__immutable_8f90_source.html +++ b/doc/html/linalg__immutable_8f90_source.html @@ -850,17 +850,17 @@
    Computes the rank 1 update to a Cholesky factored matrix (upper triangular).
    Computes the determinant of a square matrix.
    Multiplies a diagonal matrix with another matrix or array.
    -
    Computes the eigenvalues, and optionally the eigenvectors, of a matrix.
    +
    Computes the eigenvalues, and optionally the eigenvectors, of a matrix.
    Extracts the L and U matrices from the condensed [L\U] storage format used by the lu_factor.
    Forms the full M-by-M orthogonal matrix Q from the elementary reflectors returned by the base QR fact...
    Computes the LU factorization of an M-by-N matrix.
    -
    Computes the inverse of a square matrix.
    -
    Computes the Moore-Penrose pseudo-inverse of a M-by-N matrix using the singular value decomposition o...
    +
    Computes the inverse of a square matrix.
    +
    Computes the Moore-Penrose pseudo-inverse of a M-by-N matrix using the singular value decomposition o...
    Computes the QR factorization of an M-by-N matrix.
    Computes the rank 1 update to an M-by-N QR factored matrix A (M >= N) where , and such that .
    Performs the rank-1 update to matrix A such that: , where is an M-by-N matrix, is a scalar,...
    -
    Solves a triangular system of equations.
    -
    Sorts an array.
    +
    Solves a triangular system of equations.
    +
    Sorts an array.
    Computes the singular value decomposition of a matrix A. The SVD is defined as: , where is an M-by-M...
    Computes the eigenvalues and eigenvectors (right) of a general N-by-N matrix.
    Computes the LU factorization of a square matrix. Notice, partial row pivoting is utilized.
    diff --git a/doc/html/namespacelinalg__core.html b/doc/html/namespacelinalg__core.html index c7387077..9d2ce157 100644 --- a/doc/html/namespacelinalg__core.html +++ b/doc/html/namespacelinalg__core.html @@ -172,13 +172,13 @@ - + - + - + diff --git a/doc/html/namespaces.html b/doc/html/namespaces.html index 7a5c9bd8..879e025a 100644 --- a/doc/html/namespaces.html +++ b/doc/html/namespaces.html @@ -126,9 +126,9 @@ - - - + + + diff --git a/src/linalg_core.f90 b/src/linalg_core.f90 index 39e01a90..b307693b 100644 --- a/src/linalg_core.f90 +++ b/src/linalg_core.f90 @@ -1931,7 +1931,8 @@ module linalg_core !! Solves the system of equations: \f$ op(A) X = B \f$, where \f$ A \f$ is a !! triangular matrix. !! @code{.f90} -!! +!! subroutine solve_triangular_system(logical upper, logical trans, logical nounit, real(real64) a(:,:), real(real64) x(:), optional class(errors) err) +!! subroutine solve_triangular_system(logical upper, logical trans, logical nounit, complex(real64) a(:,:), complex(real64) x(:), optional class(errors) err) !! @endcode !! !! @param[in] upper Set to true if A is an upper triangular matrix; else, @@ -2027,6 +2028,30 @@ module linalg_core ! ------------------------------------------------------------------------------ !> @brief Solves a system of LU-factored equations. !! +!! @par Syntax +!! @code{.f90} +!! subroutine solve_lu(real(real64) a(:,:), integer(int32) ipvt(:), real(real64) b(:,:), optional class(errors) err) +!! subroutine solve_lu(complex(real64) a(:,:), integer(int32) ipvt(:), complex(real64) b(:,:), optional class(errors) err) +!! subroutine solve_lu(real(real64) a(:,:), integer(int32) ipvt(:), real(real64) b(:), optional class(errors) err) +!! subroutine solve_lu(complex(real64) a(:,:), integer(int32) ipvt(:), complex(real64) b(:), optional class(errors) err) +!! @endcode +!! +!! @param[in] a The N-by-N LU factored matrix as output by @ref lu_factor. +!! @param[in] ipvt The N-element pivot array as output by @ref lu_factor. +!! @param[in,out] b On input, the N-by-NRHS right-hand-side matrix. On +!! output, the N-by-NRHS solution matrix. +!! @param[in,out] err An optional errors-based object that if provided can be +!! used to retrieve information relating to any errors encountered during +!! execution. If not provided, a default implementation of the errors +!! class is used internally to provide error handling. Possible errors and +!! warning messages that may be encountered are as follows. +!! - LA_ARRAY_SIZE_ERROR: Occurs if any of the input array sizes are +!! incorrect. +!! +!! @par Notes +!! The routine is based upon the LAPACK routine DGETRS (ZGETRS in the complex +!! case). +!! !! @par Usage !! To solve a system of 3 equations of 3 unknowns using LU factorization, !! the following code will suffice. @@ -2091,6 +2116,72 @@ module linalg_core ! ------------------------------------------------------------------------------ !> @brief Solves a system of M QR-factored equations of N unknowns. !! +!! @par Syntax 1 (No Pivoting) +!! @code{.f90} +!! subroutine solve_qr(real(real64) a(:,:), real(real64) tau(:), real(real64) b(:,:), optional real(real64) work(:), optional integer(int32) olwork, optional class(errors) err) +!! subroutine solve_qr(complex(real64) a(:,:), complex(real64) tau(:), complex(real64) b(:,:), optional complex(real64) work(:), optional integer(int32) olwork, optional class(errors) err) +!! subroutine solve_qr(real(real64) a(:,:), real(real64) tau(:), real(real64) b(:), optional real(real64) work(:), optional integer(int32) olwork, optional class(errors) err) +!! subroutine solve_qr(complex(real64) a(:,:), complex(real64) tau(:), complex(real64) b(:), optional complex(real64) work(:), optional integer(int32) olwork, optional class(errors) err) +!! @endcode +!! +!! @param[in] a On input, the M-by-N QR factored matrix as returned by +!! @ref qr_factor. On output, the contents of this matrix are restored. +!! Notice, M must be greater than or equal to N. +!! @param[in] tau A MIN(M, N)-element array containing the scalar factors of +!! the elementary reflectors as returned by @ref qr_factor. +!! @param[in] b On input, the M-by-NRHS right-hand-side matrix. On output, +!! the first N rows are overwritten by the solution matrix X. +!! @param[out] work An optional input, that if provided, prevents any local +!! memory allocation. If not provided, the memory required is allocated +!! within. If provided, the length of the array must be at least +!! @p olwork. +!! @param[out] olwork An optional output used to determine workspace size. +!! If supplied, the routine determines the optimal size for @p work, and +!! returns without performing any actual calculations. +!! @param[in,out] err An optional errors-based object that if provided can be +!! used to retrieve information relating to any errors encountered during +!! execution. If not provided, a default implementation of the errors +!! class is used internally to provide error handling. Possible errors and +!! warning messages that may be encountered are as follows. +!! - LA_ARRAY_SIZE_ERROR: Occurs if any of the input arrays are not sized +!! appropriately. +!! - LA_OUT_OF_MEMORY_ERROR: Occurs if local memory must be allocated, and +!! there is insufficient memory available. +!! +!! @par Syntax 2 (With Pivoting) +!! @code{.f90} +!! subroutine solve_qr(real(real64) a(:,:), real(real64) tau(:), integer(int32) jpvt(:), real(real64) b(:,:), optional real(real64) work(:), optional integer(int32) olwork, optional class(errors) err) +!! subroutine solve_qr(complex(real64) a(:,:), complex(real64) tau(:), integer(int32) jpvt(:), complex(real64) b(:,:), optional complex(real64) work(:), optional integer(int32) olwork, optional class(errors) err) +!! subroutine solve_qr(real(real64) a(:,:), real(real64) tau(:), integer(int32) jpvt(:), real(real64) b(:), optional real(real64) work(:), optional integer(int32) olwork, optional class(errors) err) +!! subroutine solve_qr(complex(real64) a(:,:), complex(real64) tau(:), integer(int32) jpvt(:), complex(real64) b(:), optional complex(real64) work(:), optional integer(int32) olwork, optional class(errors) err) +!! @endcode +!! +!! @param[in] a On input, the M-by-N QR factored matrix as returned by +!! @ref qr_factor. On output, the contents of this matrix are altered. +!! @param[in] tau A MIN(M, N)-element array containing the scalar factors of +!! the elementary reflectors as returned by @ref qr_factor. +!! @param[in] jpvt An N-element array, as output by @ref qr_factor, used to +!! track the column pivots. +!! @param[in] b On input, the MAX(M, N)-by-NRHS matrix where the first M +!! rows contain the right-hand-side matrix B. On output, the first N rows +!! are overwritten by the solution matrix X. +!! @param[out] work An optional input, that if provided, prevents any local +!! memory allocation. If not provided, the memory required is allocated +!! within. If provided, the length of the array must be at least +!! @p olwork. +!! @param[out] olwork An optional output used to determine workspace size. +!! If supplied, the routine determines the optimal size for @p work, and +!! returns without performing any actual calculations. +!! @param[in,out] err An optional errors-based object that if provided can be +!! used to retrieve information relating to any errors encountered during +!! execution. If not provided, a default implementation of the errors +!! class is used internally to provide error handling. Possible errors and +!! warning messages that may be encountered are as follows. +!! - LA_ARRAY_SIZE_ERROR: Occurs if any of the input arrays are not sized +!! appropriately. +!! - LA_OUT_OF_MEMORY_ERROR: Occurs if local memory must be allocated, and +!! there is insufficient memory available. +!! !! @par Usage !! The following example illustrates the solution of a system of equations !! using QR factorization. @@ -2164,6 +2255,32 @@ module linalg_core ! ------------------------------------------------------------------------------ !> @brief Solves a system of Cholesky factored equations. !! +!! @par Syntax +!! @code{.f90} +!! subroutine solve_cholesky(logical upper, real(real64) a(:,:), real(real64) b(:,:), optional class(errors) err) +!! subroutine solve_cholesky(logical upper, complex(real64) a(:,:), complex(real64) b(:,:), optional class(errors) err) +!! subroutine solve_cholesky(logical upper, real(real64) a(:,:), real(real64) b(:), optional class(errors) err) +!! subroutine solve_cholesky(logical upper, complex(real64) a(:,:), complex(real64) b(:), optional class(errors) err) +!! @endcode +!! +!! @param[in] upper Set to true if the original matrix \f$ A \f$ was factored +!! such that \f$ A = U^T U \f$; else, set to false if the factorization of +!! \f$ A \f$ was \f$ A = L L^T \f$. +!! @param[in] a The N-by-N Cholesky factored matrix as returned by +!! @ref cholesky_factor. +!! @param[in,out] b On input, the N-by-NRHS right-hand-side matrix B. On +!! output, the solution matrix X. +!! @param[in,out] err An optional errors-based object that if provided can be +!! used to retrieve information relating to any errors encountered during +!! execution. If not provided, a default implementation of the errors +!! class is used internally to provide error handling. Possible errors and +!! warning messages that may be encountered are as follows. +!! - LA_ARRAY_SIZE_ERROR: Occurs if any of the input array sizes are +!! incorrect. +!! +!! @par Notes +!! This routine utilizes the LAPACK routine DPOTRS (ZPOTRS in the complex case). +!! !! @par Usage !! The following example illustrates the solution of a positive-definite !! system of equations via Cholesky factorization. @@ -2238,8 +2355,44 @@ module linalg_core end interface ! ------------------------------------------------------------------------------ -!> @brief Solves the overdetermined or underdetermined system (A*X = B) of -!! M equations of N unknowns. +!> @brief Solves the overdetermined or underdetermined system \f$ A X = B \f$ of +!! M equations of N unknowns. Notice, it is assumed that matrix A has full rank. +!! +!! @par Syntax +!! @code{.f90} +!! subroutine solve_least_squares(real(real64) a(:,:), real(real64) b(:,:), optional real(real64) work(:), optional integer(int32) olwork, optional class(errors) err) +!! subroutine solve_least_squares(complex(real64) a(:,:), complex(real64) b(:,:), optional complex(real64) work(:), optional integer(int32) olwork, optional class(errors) err) +!! subroutine solve_least_squares(real(real64) a(:,:), real(real64) b(:), optional real(real64) work(:), optional integer(int32) olwork, optional class(errors) err) +!! subroutine solve_least_squares(complex(real64) a(:,:), complex(real64) b(:), optional complex(real64) work(:), optional integer(int32) olwork, optional class(errors) err) +!! @endcode +!! +!! @param[in,out] a On input, the M-by-N matrix A. On output, if M >= N, +!! the QR factorization of A in the form as output by @ref qr_factor; else, +!! if M < N, the LQ factorization of A. +!! @param[in,out] b If M >= N, the M-by-NRHS matrix B. On output, the first +!! N rows contain the N-by-NRHS solution matrix X. If M < N, an +!! N-by-NRHS matrix with the first M rows containing the matrix B. On +!! output, the N-by-NRHS solution matrix X. +!! @param[out] work An optional input, that if provided, prevents any local +!! memory allocation. If not provided, the memory required is allocated +!! within. If provided, the length of the array must be at least +!! @p olwork. +!! @param[out] olwork An optional output used to determine workspace size. +!! If supplied, the routine determines the optimal size for @p work, and +!! returns without performing any actual calculations. +!! @param[in,out] err An optional errors-based object that if provided can be +!! used to retrieve information relating to any errors encountered during +!! execution. If not provided, a default implementation of the errors +!! class is used internally to provide error handling. Possible errors and +!! warning messages that may be encountered are as follows. +!! - LA_ARRAY_SIZE_ERROR: Occurs if any of the input arrays are not sized +!! appropriately. +!! - LA_OUT_OF_MEMORY_ERROR: Occurs if local memory must be allocated, and +!! there is insufficient memory available. +!! - LA_INVALID_OPERATION_ERROR: Occurs if @p a is not of full rank. +!! +!! @par Notes +!! This routine utilizes the LAPACK routine DGELS (ZGELS in the complex case). !! !! @par Usage !! The following example illustrates the least squares solution of an @@ -2292,10 +2445,56 @@ module linalg_core end interface ! ------------------------------------------------------------------------------ -!> @brief Solves the overdetermined or underdetermined system (A*X = B) of +!> @brief Solves the overdetermined or underdetermined system \f$ A X = B \f$ of !! M equations of N unknowns, but uses a full orthogonal factorization of !! the system. !! +!! @par Syntax +!! @code{.f90} +!! subroutine solve_least_squares_full(real(real64) a(:,:), real(real64) b(:,:), optional integer(int32) ipvt(:), optional integer(int32) arnk, optional real(real64) work(:), optional integer(int32) olwork, optional class(errors) err) +!! subroutine solve_least_squares_full(complex(real64) a(:,:), complex(real64) b(:,:), optional integer(int32) ipvt(:), optional integer(int32) arnk, optional complex(real64) work(:), optional integer(int32) olwork, optional real(real64) rwork(:), optional class(errors) err) +!! subroutine solve_least_squares_full(real(real64) a(:,:), real(real64) b(:), optional integer(int32) ipvt(:), optional integer(int32) arnk, optional real(real64) work(:), optional integer(int32) olwork, optional class(errors) err) +!! subroutine solve_least_squares_full(complex(real64) a(:,:), complex(real64) b(:), optional integer(int32) ipvt(:), optional integer(int32) arnk, optional complex(real64) work(:), optional integer(int32) olwork, optional real(real64) rwork(:), optional class(errors) err) +!! @endcode +!! +!! @param[in,out] a On input, the M-by-N matrix A. On output, the matrix +!! is overwritten by the details of its complete orthogonal factorization. +!! @param[in,out] b If M >= N, the M-by-NRHS matrix B. On output, the first +!! N rows contain the N-by-NRHS solution matrix X. If M < N, an +!! N-by-NRHS matrix with the first M rows containing the matrix B. On +!! output, the N-by-NRHS solution matrix X. +!! @param[out] ipvt An optional input that on input, an N-element array +!! that if IPVT(I) .ne. 0, the I-th column of A is permuted to the front +!! of A * P; if IPVT(I) = 0, the I-th column of A is a free column. On +!! output, if IPVT(I) = K, then the I-th column of A * P was the K-th +!! column of A. If not supplied, memory is allocated internally, and IPVT +!! is set to all zeros such that all columns are treated as free. +!! @param[out] arnk An optional output, that if provided, will return the +!! rank of @p a. +!! @param[out] work An optional input, that if provided, prevents any local +!! memory allocation. If not provided, the memory required is allocated +!! within. If provided, the length of the array must be at least +!! @p olwork. +!! @param[out] olwork An optional output used to determine workspace size. +!! If supplied, the routine determines the optimal size for @p work, and +!! returns without performing any actual calculations. +!! @param[out] rwork An optional input, that if provided, prevents any local +!! memory allocation for real-valued workspaces. If not provided, the +!! memory required is allocated within. If provided, the length of the +!! array must be at least 2 * N. +!! @param[in,out] err An optional errors-based object that if provided can be +!! used to retrieve information relating to any errors encountered during +!! execution. If not provided, a default implementation of the errors +!! class is used internally to provide error handling. Possible errors and +!! warning messages that may be encountered are as follows. +!! - LA_ARRAY_SIZE_ERROR: Occurs if any of the input arrays are not sized +!! appropriately. +!! - LA_OUT_OF_MEMORY_ERROR: Occurs if local memory must be allocated, and +!! there is insufficient memory available. +!! +!! @par Notes +!! This routine utilizes the LAPACK routine DGELSY (ZGELSY in the complex case). +!! !! @par Usage !! The following example illustrates the least squares solution of an !! overdetermined system of linear equations. @@ -2347,10 +2546,57 @@ module linalg_core end interface ! ------------------------------------------------------------------------------ -!> @brief Solves the overdetermined or underdetermined system (A*X = B) of +!> @brief Solves the overdetermined or underdetermined system \f$ A X = B \f$ of !! M equations of N unknowns using a singular value decomposition of !! matrix A. !! +!! @par Syntax +!! @code{.f90} +!! subroutine solve_least_squares_svd(real(real64) a(:,:), real(real64) b(:,:), optional real(real64) s(:), optional integer(int32) arnk, optional real(real64) work(:), optional integer(int32) olwork, optional class(errors) err) +!! subroutine solve_least_squares_svd(complex(real64) a(:,:), complex(real64) b(:,:), optional real(real64) s(:), optional integer(int32) arnk, optional complex(real64) work(:), optional integer(int32) olwork, optional real(real64) rwork(:), optional class(errors) err) +!! subroutine solve_least_squares_svd(real(real64) a(:,:), real(real64) b(:), optional real(real64) s(:), optional integer(int32) arnk, optional real(real64) work(:), optional integer(int32) olwork, optional class(errors) err) +!! subroutine solve_least_squares_svd(complex(real64) a(:,:), complex(real64) b(:), optional real(real64) s(:), optional integer(int32) arnk, optional complex(real64) work(:), optional integer(int32) olwork, optional real(real64) rwork(:), optional class(errors) err) +!! @endcode +!! +!! @param[in,out] a On input, the M-by-N matrix A. On output, the matrix +!! is overwritten by the details of its complete orthogonal factorization. +!! @param[in,out] b If M >= N, the M-by-NRHS matrix B. On output, the first +!! N rows contain the N-by-NRHS solution matrix X. If M < N, an +!! N-by-NRHS matrix with the first M rows containing the matrix B. On +!! output, the N-by-NRHS solution matrix X. +!! @param[out] arnk An optional output, that if provided, will return the +!! rank of @p a. +!! @param[out] s An optional MIN(M, N)-element array that on output contains +!! the singular values of @p a in descending order. Notice, the condition +!! number of @p a can be determined by S(1) / S(MIN(M, N)). +!! @param[out] arnk An optional output, that if provided, will return the +!! rank of @p a. +!! @param[out] work An optional input, that if provided, prevents any local +!! memory allocation for complex-valued workspaces. If not provided, the +!! memory required is allocated within. If provided, the length of the +!! array must be at least @p olwork. +!! @param[out] olwork An optional output used to determine workspace size. +!! If supplied, the routine determines the optimal size for @p work, and +!! returns without performing any actual calculations. +!! @param[out] rwork An optional input, that if provided, prevents any local +!! memory allocation for real-valued workspaces. If not provided, the +!! memory required is allocated within. If provided, the length of the +!! array must be at least 5 * MIN(M, N). +!! @param[in,out] err An optional errors-based object that if provided can be +!! used to retrieve information relating to any errors encountered during +!! execution. If not provided, a default implementation of the errors +!! class is used internally to provide error handling. Possible errors and +!! warning messages that may be encountered are as follows. +!! - LA_ARRAY_SIZE_ERROR: Occurs if any of the input arrays are not sized +!! appropriately. +!! - LA_OUT_OF_MEMORY_ERROR: Occurs if local memory must be allocated, and +!! there is insufficient memory available. +!! - LA_CONVERGENCE_ERROR: Occurs as a warning if the QR iteration process +!! could not converge to a zero value. +!! +!! @par Notes +!! This routine utilizes the LAPACK routine DGELSS (ZGELSS in the complex case). +!! !! @par Usage !! The following example illustrates the least squares solution of an !! overdetermined system of linear equations. @@ -2402,6 +2648,42 @@ module linalg_core ! ------------------------------------------------------------------------------ !> @brief Computes the inverse of a square matrix. !! +!! @par Syntax +!! @code{.f90} +!! subroutine mtx_inverse(real(real64) a(:,:), optional integer(int32) iwork, optional real(real64) work(:), optional integer olwork, optional class(errors) err) +!! subroutine mtx_inverse(complex(real64) a(:,:), optional integer(int32) iwork, optional complex(real64) work(:), optional integer olwork, optional class(errors) err) +!! @endcode +!! +!! @param[in,out] a On input, the N-by-N matrix to invert. On output, the +!! inverted matrix. +!! @param[out] iwork An optional N-element integer workspace array. +!! @param[out] work An optional input, that if provided, prevents any local +!! memory allocation. If not provided, the memory required is allocated +!! within. If provided, the length of the array must be at least +!! @p olwork. +!! @param[out] olwork An optional output used to determine workspace size. +!! If supplied, the routine determines the optimal size for @p work, and +!! returns without performing any actual calculations. +!! @param[in,out] err An optional errors-based object that if provided can be +!! used to retrieve information relating to any errors encountered during +!! execution. If not provided, a default implementation of the errors +!! class is used internally to provide error handling. Possible errors and +!! warning messages that may be encountered are as follows. +!! - LA_ARRAY_SIZE_ERROR: Occurs if @p a is not square. Will also occur if +!! incorrectly sized workspace arrays are provided. +!! - LA_OUT_OF_MEMORY_ERROR: Occurs if local memory must be allocated, and +!! there is insufficient memory available. +!! - LA_SINGULAR_MATRIX_ERROR: Occurs if the input matrix is singular. +!! +!! @par Notes +!! This routine utilizes the LAPACK routines DGETRF to perform an LU +!! factorization of the matrix, and DGETRI to invert the LU factored +!! matrix (ZGETRF and ZGETRI in the complex case). +!! +!! @par See Also +!! - [Wikipedia](https://en.wikipedia.org/wiki/Invertible_matrix) +!! - [Wolfram MathWorld](http://mathworld.wolfram.com/MatrixInverse.html) +!! !! @par Usage !! The following example illustrates the inversion of a 3-by-3 matrix. !! @code{.f90} @@ -2462,6 +2744,51 @@ module linalg_core !> @brief Computes the Moore-Penrose pseudo-inverse of a M-by-N matrix !! using the singular value decomposition of the matrix. !! +!! @par Syntax +!! @code{.f90} +!! subroutine mtx_pinverse(real(real64) a(:,:), real(real64) ainv(:,:), optional real(real64) tol, optional real(real64) work(:), optional integer(int32) olwork, optional class(errors) err) +!! subroutine mtx_pinverse(complex(real64) a(:,:), complex(real64) ainv(:,:), optional real(real64) tol, optional complex(real64) work(:), optional integer(int32) olwork, optional real(real64) rwork(:), optional class(errors) err) +!! @endcode +!! +!! @param[in,out] a On input, the M-by-N matrix to invert. The matrix is +!! overwritten on output. +!! @param[out] ainv The N-by-M matrix where the pseudo-inverse of @p a +!! will be written. +!! @param[in] tol An optional input, that if supplied, overrides the default +!! tolerance on singular values such that singular values less than this +!! tolerance are forced to have a reciprocal of zero, as opposed to 1/S(I). +!! The default tolerance is: MAX(M, N) * EPS * MAX(S). If the supplied +!! value is less than a value that causes an overflow, the tolerance +!! reverts back to its default value, and the operation continues; +!! however, a warning message is issued. +!! @param[out] work An optional input, that if provided, prevents any local +!! memory allocation. If not provided, the memory required is allocated +!! within. If provided, the length of the array must be at least +!! @p olwork. +!! @param[out] olwork An optional output used to determine workspace size. +!! If supplied, the routine determines the optimal size for @p work, and +!! returns without performing any actual calculations. +!! @param[out] rwork An optional input, that if provided, prevents any local +!! memory allocation for real-valued workspaces. If not provided, the +!! memory required is allocated within. If provided, the length of the +!! array must be at least 6 * MIN(M, N). +!! @param[in,out] err An optional errors-based object that if provided can be +!! used to retrieve information relating to any errors encountered during +!! execution. If not provided, a default implementation of the errors +!! class is used internally to provide error handling. Possible errors and +!! warning messages that may be encountered are as follows. +!! - LA_ARRAY_SIZE_ERROR: Occurs if any of the input arrays are not sized +!! appropriately. +!! - LA_OUT_OF_MEMORY_ERROR: Occurs if local memory must be allocated, and +!! there is insufficient memory available. +!! - LA_CONVERGENCE_ERROR: Occurs as a warning if the QR iteration process +!! could not converge to a zero value. +!! +!! @par See Also +!! - [Wikipedia](https://en.wikipedia.org/wiki/Moore%E2%80%93Penrose_pseudoinverse) +!! - [Wolfram MathWorld](http://mathworld.wolfram.com/Moore-PenroseMatrixInverse.html) +!! - [MathWorks](http://www.mathworks.com/help/matlab/ref/pinv.html?s_tid=srchtitle) +!! !! @par Usage !! The following example illustrates how to compute the Moore-Penrose !! pseudo-inverse of a matrix. @@ -3148,23 +3475,7 @@ module subroutine solve_tri_vec_cmplx(upper, trans, nounit, a, x, err) complex(real64), intent(inout), dimension(:) :: x class(errors), intent(inout), optional, target :: err end subroutine - - !> @brief Solves a system of LU-factored equations. - !! - !! @param[in] a The N-by-N LU factored matrix as output by lu_factor. - !! @param[in] ipvt The N-element pivot array as output by lu_factor. - !! @param[in,out] b On input, the N-by-NRHS right-hand-side matrix. On - !! output, the N-by-NRHS solution matrix. - !! @param[out] err An optional errors-based object that if provided can be - !! used to retrieve information relating to any errors encountered during - !! execution. If not provided, a default implementation of the errors - !! class is used internally to provide error handling. Possible errors and - !! warning messages that may be encountered are as follows. - !! - LA_ARRAY_SIZE_ERROR: Occurs if any of the input array sizes are - !! incorrect. - !! - !! @par Notes - !! The routine is based upon the LAPACK routine DGETRS. + module subroutine solve_lu_mtx(a, ipvt, b, err) real(real64), intent(in), dimension(:,:) :: a integer(int32), intent(in), dimension(:) :: ipvt @@ -3172,104 +3483,27 @@ module subroutine solve_lu_mtx(a, ipvt, b, err) class(errors), intent(inout), optional, target :: err end subroutine - !> @brief Solves a system of complex-valued LU-factored equations. - !! - !! @param[in] a The N-by-N LU factored matrix as output by lu_factor. - !! @param[in] ipvt The N-element pivot array as output by lu_factor. - !! @param[in,out] b On input, the N-by-NRHS right-hand-side matrix. On - !! output, the N-by-NRHS solution matrix. - !! @param[out] err An optional errors-based object that if provided can be - !! used to retrieve information relating to any errors encountered during - !! execution. If not provided, a default implementation of the errors - !! class is used internally to provide error handling. Possible errors and - !! warning messages that may be encountered are as follows. - !! - LA_ARRAY_SIZE_ERROR: Occurs if any of the input array sizes are - !! incorrect. - !! - !! @par Notes - !! The routine is based upon the LAPACK routine DGETRS. module subroutine solve_lu_mtx_cmplx(a, ipvt, b, err) complex(real64), intent(in), dimension(:,:) :: a integer(int32), intent(in), dimension(:) :: ipvt complex(real64), intent(inout), dimension(:,:) :: b class(errors), intent(inout), optional, target :: err end subroutine - - !> @brief Solves a system of LU-factored equations. - !! - !! @param[in] a The N-by-N LU factored matrix as output by lu_factor. - !! @param[in] ipvt The N-element pivot array as output by lu_factor. - !! @param[in,out] b On input, the N-element right-hand-side array. On - !! output, the N-element solution array. - !! @param[out] err An optional errors-based object that if provided can be - !! used to retrieve information relating to any errors encountered during - !! execution. If not provided, a default implementation of the errors - !! class is used internally to provide error handling. Possible errors and - !! warning messages that may be encountered are as follows. - !! - LA_ARRAY_SIZE_ERROR: Occurs if any of the input array sizes are - !! incorrect. - !! - !! @par Notes - !! The routine is based upon the LAPACK routine DGETRS. + module subroutine solve_lu_vec(a, ipvt, b, err) real(real64), intent(in), dimension(:,:) :: a integer(int32), intent(in), dimension(:) :: ipvt real(real64), intent(inout), dimension(:) :: b class(errors), intent(inout), optional, target :: err end subroutine - - !> @brief Solves a system of LU-factored equations. - !! - !! @param[in] a The N-by-N LU factored matrix as output by lu_factor. - !! @param[in] ipvt The N-element pivot array as output by lu_factor. - !! @param[in,out] b On input, the N-element right-hand-side array. On - !! output, the N-element solution array. - !! @param[out] err An optional errors-based object that if provided can be - !! used to retrieve information relating to any errors encountered during - !! execution. If not provided, a default implementation of the errors - !! class is used internally to provide error handling. Possible errors and - !! warning messages that may be encountered are as follows. - !! - LA_ARRAY_SIZE_ERROR: Occurs if any of the input array sizes are - !! incorrect. - !! - !! @par Notes - !! The routine is based upon the LAPACK routine DGETRS. + module subroutine solve_lu_vec_cmplx(a, ipvt, b, err) complex(real64), intent(in), dimension(:,:) :: a integer(int32), intent(in), dimension(:) :: ipvt complex(real64), intent(inout), dimension(:) :: b class(errors), intent(inout), optional, target :: err end subroutine - - !> @brief Solves a system of M QR-factored equations of N unknowns where - !! M >= N. - !! - !! @param[in] a On input, the M-by-N QR factored matrix as returned by - !! qr_factor. On output, the contents of this matrix are restored. - !! Notice, M must be greater than or equal to N. - !! @param[in] tau A MIN(M, N)-element array containing the scalar factors of - !! the elementary reflectors as returned by qr_factor. - !! @param[in] b On input, the M-by-NRHS right-hand-side matrix. On output, - !! the first N rows are overwritten by the solution matrix X. - !! @param[out] work An optional input, that if provided, prevents any local - !! memory allocation. If not provided, the memory required is allocated - !! within. If provided, the length of the array must be at least - !! @p olwork. - !! @param[out] olwork An optional output used to determine workspace size. - !! If supplied, the routine determines the optimal size for @p work, and - !! returns without performing any actual calculations. - !! @param[out] err An optional errors-based object that if provided can be - !! used to retrieve information relating to any errors encountered during - !! execution. If not provided, a default implementation of the errors - !! class is used internally to provide error handling. Possible errors and - !! warning messages that may be encountered are as follows. - !! - LA_ARRAY_SIZE_ERROR: Occurs if any of the input arrays are not sized - !! appropriately. - !! - LA_OUT_OF_MEMORY_ERROR: Occurs if local memory must be allocated, and - !! there is insufficient memory available. - !! - !! @par Notes - !! This routine is based upon a subset of the LAPACK routine DGELS. + module subroutine solve_qr_no_pivot_mtx(a, tau, b, work, olwork, err) real(real64), intent(inout), dimension(:,:) :: a, b real(real64), intent(in), dimension(:) :: tau @@ -3277,36 +3511,7 @@ module subroutine solve_qr_no_pivot_mtx(a, tau, b, work, olwork, err) integer(int32), intent(out), optional :: olwork class(errors), intent(inout), optional, target :: err end subroutine - - !> @brief Solves a system of M QR-factored equations of N unknowns where - !! M >= N. - !! - !! @param[in] a On input, the M-by-N QR factored matrix as returned by - !! qr_factor. On output, the contents of this matrix are restored. - !! Notice, M must be greater than or equal to N. - !! @param[in] tau A MIN(M, N)-element array containing the scalar factors of - !! the elementary reflectors as returned by qr_factor. - !! @param[in] b On input, the M-by-NRHS right-hand-side matrix. On output, - !! the first N rows are overwritten by the solution matrix X. - !! @param[out] work An optional input, that if provided, prevents any local - !! memory allocation. If not provided, the memory required is allocated - !! within. If provided, the length of the array must be at least - !! @p olwork. - !! @param[out] olwork An optional output used to determine workspace size. - !! If supplied, the routine determines the optimal size for @p work, and - !! returns without performing any actual calculations. - !! @param[out] err An optional errors-based object that if provided can be - !! used to retrieve information relating to any errors encountered during - !! execution. If not provided, a default implementation of the errors - !! class is used internally to provide error handling. Possible errors and - !! warning messages that may be encountered are as follows. - !! - LA_ARRAY_SIZE_ERROR: Occurs if any of the input arrays are not sized - !! appropriately. - !! - LA_OUT_OF_MEMORY_ERROR: Occurs if local memory must be allocated, and - !! there is insufficient memory available. - !! - !! @par Notes - !! This routine is based upon a subset of the LAPACK routine ZGELS. + module subroutine solve_qr_no_pivot_mtx_cmplx(a, tau, b, work, olwork, err) complex(real64), intent(inout), dimension(:,:) :: a, b complex(real64), intent(in), dimension(:) :: tau @@ -3314,36 +3519,7 @@ module subroutine solve_qr_no_pivot_mtx_cmplx(a, tau, b, work, olwork, err) integer(int32), intent(out), optional :: olwork class(errors), intent(inout), optional, target :: err end subroutine - - !> @brief Solves a system of M QR-factored equations of N unknowns where - !! M >= N. - !! - !! @param[in] a On input, the M-by-N QR factored matrix as returned by - !! qr_factor. On output, the contents of this matrix are restored. - !! Notice, M must be greater than or equal to N. - !! @param[in] tau A MIN(M, N)-element array containing the scalar factors of - !! the elementary reflectors as returned by qr_factor. - !! @param[in] b On input, the M-element right-hand-side vector. On output, - !! the first N elements are overwritten by the solution vector X. - !! @param[out] work An optional input, that if provided, prevents any local - !! memory allocation. If not provided, the memory required is allocated - !! within. If provided, the length of the array must be at least - !! @p olwork. - !! @param[out] olwork An optional output used to determine workspace size. - !! If supplied, the routine determines the optimal size for @p work, and - !! returns without performing any actual calculations. - !! @param[out] err An optional errors-based object that if provided can be - !! used to retrieve information relating to any errors encountered during - !! execution. If not provided, a default implementation of the errors - !! class is used internally to provide error handling. Possible errors and - !! warning messages that may be encountered are as follows. - !! - LA_ARRAY_SIZE_ERROR: Occurs if any of the input arrays are not sized - !! appropriately. - !! - LA_OUT_OF_MEMORY_ERROR: Occurs if local memory must be allocated, and - !! there is insufficient memory available. - !! - !! @par Notes - !! This routine is based upon a subset of the LAPACK routine DGELS. + module subroutine solve_qr_no_pivot_vec(a, tau, b, work, olwork, err) real(real64), intent(inout), dimension(:,:) :: a real(real64), intent(in), dimension(:) :: tau @@ -3352,36 +3528,7 @@ module subroutine solve_qr_no_pivot_vec(a, tau, b, work, olwork, err) integer(int32), intent(out), optional :: olwork class(errors), intent(inout), optional, target :: err end subroutine - - !> @brief Solves a system of M QR-factored equations of N unknowns where - !! M >= N. - !! - !! @param[in] a On input, the M-by-N QR factored matrix as returned by - !! qr_factor. On output, the contents of this matrix are restored. - !! Notice, M must be greater than or equal to N. - !! @param[in] tau A MIN(M, N)-element array containing the scalar factors of - !! the elementary reflectors as returned by qr_factor. - !! @param[in] b On input, the M-element right-hand-side vector. On output, - !! the first N elements are overwritten by the solution vector X. - !! @param[out] work An optional input, that if provided, prevents any local - !! memory allocation. If not provided, the memory required is allocated - !! within. If provided, the length of the array must be at least - !! @p olwork. - !! @param[out] olwork An optional output used to determine workspace size. - !! If supplied, the routine determines the optimal size for @p work, and - !! returns without performing any actual calculations. - !! @param[out] err An optional errors-based object that if provided can be - !! used to retrieve information relating to any errors encountered during - !! execution. If not provided, a default implementation of the errors - !! class is used internally to provide error handling. Possible errors and - !! warning messages that may be encountered are as follows. - !! - LA_ARRAY_SIZE_ERROR: Occurs if any of the input arrays are not sized - !! appropriately. - !! - LA_OUT_OF_MEMORY_ERROR: Occurs if local memory must be allocated, and - !! there is insufficient memory available. - !! - !! @par Notes - !! This routine is based upon a subset of the LAPACK routine ZGELS. + module subroutine solve_qr_no_pivot_vec_cmplx(a, tau, b, work, olwork, err) complex(real64), intent(inout), dimension(:,:) :: a complex(real64), intent(in), dimension(:) :: tau @@ -3390,38 +3537,7 @@ module subroutine solve_qr_no_pivot_vec_cmplx(a, tau, b, work, olwork, err) integer(int32), intent(out), optional :: olwork class(errors), intent(inout), optional, target :: err end subroutine - - !> @brief Solves a system of M QR-factored equations of N unknowns where the - !! QR factorization made use of column pivoting. - !! - !! @param[in] a On input, the M-by-N QR factored matrix as returned by - !! qr_factor. On output, the contents of this matrix are altered. - !! @param[in] tau A MIN(M, N)-element array containing the scalar factors of - !! the elementary reflectors as returned by qr_factor. - !! @param[in] jpvt An N-element array, as output by qr_factor, used to - !! track the column pivots. - !! @param[in] b On input, the MAX(M, N)-by-NRHS matrix where the first M - !! rows contain the right-hand-side matrix B. On output, the first N rows - !! are overwritten by the solution matrix X. - !! @param[out] work An optional input, that if provided, prevents any local - !! memory allocation. If not provided, the memory required is allocated - !! within. If provided, the length of the array must be at least - !! @p olwork. - !! @param[out] olwork An optional output used to determine workspace size. - !! If supplied, the routine determines the optimal size for @p work, and - !! returns without performing any actual calculations. - !! @param[out] err An optional errors-based object that if provided can be - !! used to retrieve information relating to any errors encountered during - !! execution. If not provided, a default implementation of the errors - !! class is used internally to provide error handling. Possible errors and - !! warning messages that may be encountered are as follows. - !! - LA_ARRAY_SIZE_ERROR: Occurs if any of the input arrays are not sized - !! appropriately. - !! - LA_OUT_OF_MEMORY_ERROR: Occurs if local memory must be allocated, and - !! there is insufficient memory available. - !! - !! @par Notes - !! This routine is based upon a subset of the LAPACK routine DGELSY. + module subroutine solve_qr_pivot_mtx(a, tau, jpvt, b, work, olwork, err) real(real64), intent(inout), dimension(:,:) :: a real(real64), intent(in), dimension(:) :: tau @@ -3431,38 +3547,7 @@ module subroutine solve_qr_pivot_mtx(a, tau, jpvt, b, work, olwork, err) integer(int32), intent(out), optional :: olwork class(errors), intent(inout), optional, target :: err end subroutine - - !> @brief Solves a system of M QR-factored equations of N unknowns where the - !! QR factorization made use of column pivoting. - !! - !! @param[in] a On input, the M-by-N QR factored matrix as returned by - !! qr_factor. On output, the contents of this matrix are altered. - !! @param[in] tau A MIN(M, N)-element array containing the scalar factors of - !! the elementary reflectors as returned by qr_factor. - !! @param[in] jpvt An N-element array, as output by qr_factor, used to - !! track the column pivots. - !! @param[in] b On input, the MAX(M, N)-by-NRHS matrix where the first M - !! rows contain the right-hand-side matrix B. On output, the first N rows - !! are overwritten by the solution matrix X. - !! @param[out] work An optional input, that if provided, prevents any local - !! memory allocation. If not provided, the memory required is allocated - !! within. If provided, the length of the array must be at least - !! @p olwork. - !! @param[out] olwork An optional output used to determine workspace size. - !! If supplied, the routine determines the optimal size for @p work, and - !! returns without performing any actual calculations. - !! @param[out] err An optional errors-based object that if provided can be - !! used to retrieve information relating to any errors encountered during - !! execution. If not provided, a default implementation of the errors - !! class is used internally to provide error handling. Possible errors and - !! warning messages that may be encountered are as follows. - !! - LA_ARRAY_SIZE_ERROR: Occurs if any of the input arrays are not sized - !! appropriately. - !! - LA_OUT_OF_MEMORY_ERROR: Occurs if local memory must be allocated, and - !! there is insufficient memory available. - !! - !! @par Notes - !! This routine is based upon a subset of the LAPACK routine ZGELSY. + module subroutine solve_qr_pivot_mtx_cmplx(a, tau, jpvt, b, work, olwork, err) complex(real64), intent(inout), dimension(:,:) :: a complex(real64), intent(in), dimension(:) :: tau @@ -3472,38 +3557,7 @@ module subroutine solve_qr_pivot_mtx_cmplx(a, tau, jpvt, b, work, olwork, err) integer(int32), intent(out), optional :: olwork class(errors), intent(inout), optional, target :: err end subroutine - - !> @brief Solves a system of M QR-factored equations of N unknowns where the - !! QR factorization made use of column pivoting. - !! - !! @param[in] a On input, the M-by-N QR factored matrix as returned by - !! qr_factor. On output, the contents of this matrix are altered. - !! @param[in] tau A MIN(M, N)-element array containing the scalar factors of - !! the elementary reflectors as returned by qr_factor. - !! @param[in] jpvt An N-element array, as output by qr_factor, used to - !! track the column pivots. - !! @param[in] b On input, the MAX(M, N)-element array where the first M - !! elements contain the right-hand-side vector B. On output, the first N - !! elements are overwritten by the solution vector X. - !! @param[out] work An optional input, that if provided, prevents any local - !! memory allocation. If not provided, the memory required is allocated - !! within. If provided, the length of the array must be at least - !! @p olwork. - !! @param[out] olwork An optional output used to determine workspace size. - !! If supplied, the routine determines the optimal size for @p work, and - !! returns without performing any actual calculations. - !! @param[out] err An optional errors-based object that if provided can be - !! used to retrieve information relating to any errors encountered during - !! execution. If not provided, a default implementation of the errors - !! class is used internally to provide error handling. Possible errors and - !! warning messages that may be encountered are as follows. - !! - LA_ARRAY_SIZE_ERROR: Occurs if any of the input arrays are not sized - !! appropriately. - !! - LA_OUT_OF_MEMORY_ERROR: Occurs if local memory must be allocated, and - !! there is insufficient memory available. - !! - !! @par Notes - !! This routine is based upon a subset of the LAPACK routine DGELSY. + module subroutine solve_qr_pivot_vec(a, tau, jpvt, b, work, olwork, err) real(real64), intent(inout), dimension(:,:) :: a real(real64), intent(in), dimension(:) :: tau @@ -3513,38 +3567,7 @@ module subroutine solve_qr_pivot_vec(a, tau, jpvt, b, work, olwork, err) integer(int32), intent(out), optional :: olwork class(errors), intent(inout), optional, target :: err end subroutine - - !> @brief Solves a system of M QR-factored equations of N unknowns where the - !! QR factorization made use of column pivoting. - !! - !! @param[in] a On input, the M-by-N QR factored matrix as returned by - !! qr_factor. On output, the contents of this matrix are altered. - !! @param[in] tau A MIN(M, N)-element array containing the scalar factors of - !! the elementary reflectors as returned by qr_factor. - !! @param[in] jpvt An N-element array, as output by qr_factor, used to - !! track the column pivots. - !! @param[in] b On input, the MAX(M, N)-element array where the first M - !! elements contain the right-hand-side vector B. On output, the first N - !! elements are overwritten by the solution vector X. - !! @param[out] work An optional input, that if provided, prevents any local - !! memory allocation. If not provided, the memory required is allocated - !! within. If provided, the length of the array must be at least - !! @p olwork. - !! @param[out] olwork An optional output used to determine workspace size. - !! If supplied, the routine determines the optimal size for @p work, and - !! returns without performing any actual calculations. - !! @param[out] err An optional errors-based object that if provided can be - !! used to retrieve information relating to any errors encountered during - !! execution. If not provided, a default implementation of the errors - !! class is used internally to provide error handling. Possible errors and - !! warning messages that may be encountered are as follows. - !! - LA_ARRAY_SIZE_ERROR: Occurs if any of the input arrays are not sized - !! appropriately. - !! - LA_OUT_OF_MEMORY_ERROR: Occurs if local memory must be allocated, and - !! there is insufficient memory available. - !! - !! @par Notes - !! This routine is based upon a subset of the LAPACK routine ZGELSY. + module subroutine solve_qr_pivot_vec_cmplx(a, tau, jpvt, b, work, olwork, err) complex(real64), intent(inout), dimension(:,:) :: a complex(real64), intent(in), dimension(:) :: tau @@ -3554,214 +3577,49 @@ module subroutine solve_qr_pivot_vec_cmplx(a, tau, jpvt, b, work, olwork, err) integer(int32), intent(out), optional :: olwork class(errors), intent(inout), optional, target :: err end subroutine - - !> @brief Solves a system of Cholesky factored equations. - !! - !! @param[in] upper Set to true if the original matrix A was factored such - !! that A = U**T * U; else, set to false if the factorization of A was - !! A = L**T * L. - !! @param[in] a The N-by-N Cholesky factored matrix. - !! @param[in,out] b On input, the N-by-NRHS right-hand-side matrix B. On - !! output, the solution matrix X. - !! @param[out] err An optional errors-based object that if provided can be - !! used to retrieve information relating to any errors encountered during - !! execution. If not provided, a default implementation of the errors - !! class is used internally to provide error handling. Possible errors and - !! warning messages that may be encountered are as follows. - !! - LA_ARRAY_SIZE_ERROR: Occurs if any of the input array sizes are - !! incorrect. - !! - !! @par Notes - !! This routine utilizes the LAPACK routine DPOTRS. + module subroutine solve_cholesky_mtx(upper, a, b, err) logical, intent(in) :: upper real(real64), intent(in), dimension(:,:) :: a real(real64), intent(inout), dimension(:,:) :: b class(errors), intent(inout), optional, target :: err end subroutine - - !> @brief Solves a system of Cholesky factored equations. - !! - !! @param[in] upper Set to true if the original matrix A was factored such - !! that A = U**H * U; else, set to false if the factorization of A was - !! A = L**H * L. - !! @param[in] a The N-by-N Cholesky factored matrix. - !! @param[in,out] b On input, the N-by-NRHS right-hand-side matrix B. On - !! output, the solution matrix X. - !! @param[out] err An optional errors-based object that if provided can be - !! used to retrieve information relating to any errors encountered during - !! execution. If not provided, a default implementation of the errors - !! class is used internally to provide error handling. Possible errors and - !! warning messages that may be encountered are as follows. - !! - LA_ARRAY_SIZE_ERROR: Occurs if any of the input array sizes are - !! incorrect. - !! - !! @par Notes - !! This routine utilizes the LAPACK routine ZPOTRS. + module subroutine solve_cholesky_mtx_cmplx(upper, a, b, err) logical, intent(in) :: upper complex(real64), intent(in), dimension(:,:) :: a complex(real64), intent(inout), dimension(:,:) :: b class(errors), intent(inout), optional, target :: err end subroutine - - !> @brief Solves a system of Cholesky factored equations. - !! - !! @param[in] upper Set to true if the original matrix A was factored such - !! that A = U**T * U; else, set to false if the factorization of A was - !! A = L**T * L. - !! @param[in] a The N-by-N Cholesky factored matrix. - !! @param[in,out] b On input, the N-element right-hand-side vector B. On - !! output, the solution vector X. - !! @param[out] err An optional errors-based object that if provided can be - !! used to retrieve information relating to any errors encountered during - !! execution. If not provided, a default implementation of the errors - !! class is used internally to provide error handling. Possible errors and - !! warning messages that may be encountered are as follows. - !! - LA_ARRAY_SIZE_ERROR: Occurs if any of the input array sizes are - !! incorrect. - !! - !! @par Notes - !! This routine utilizes the LAPACK routine DPOTRS. + module subroutine solve_cholesky_vec(upper, a, b, err) logical, intent(in) :: upper real(real64), intent(in), dimension(:,:) :: a real(real64), intent(inout), dimension(:) :: b class(errors), intent(inout), optional, target :: err end subroutine - - !> @brief Solves a system of Cholesky factored equations. - !! - !! @param[in] upper Set to true if the original matrix A was factored such - !! that A = U**T * U; else, set to false if the factorization of A was - !! A = L**T * L. - !! @param[in] a The N-by-N Cholesky factored matrix. - !! @param[in,out] b On input, the N-element right-hand-side vector B. On - !! output, the solution vector X. - !! @param[out] err An optional errors-based object that if provided can be - !! used to retrieve information relating to any errors encountered during - !! execution. If not provided, a default implementation of the errors - !! class is used internally to provide error handling. Possible errors and - !! warning messages that may be encountered are as follows. - !! - LA_ARRAY_SIZE_ERROR: Occurs if any of the input array sizes are - !! incorrect. - !! - !! @par Notes - !! This routine utilizes the LAPACK routine ZPOTRS. + module subroutine solve_cholesky_vec_cmplx(upper, a, b, err) logical, intent(in) :: upper complex(real64), intent(in), dimension(:,:) :: a complex(real64), intent(inout), dimension(:) :: b class(errors), intent(inout), optional, target :: err end subroutine - - !> @brief Solves the overdetermined or underdetermined system (A*X = B) of - !! M equations of N unknowns using a QR or LQ factorization of the matrix A. - !! Notice, it is assumed that matrix A has full rank. - !! - !! @param[in,out] a On input, the M-by-N matrix A. On output, if M >= N, - !! the QR factorization of A in the form as output by qr_factor; else, - !! if M < N, the LQ factorization of A. - !! @param[in,out] b If M >= N, the M-by-NRHS matrix B. On output, the first - !! N rows contain the N-by-NRHS solution matrix X. If M < N, an - !! N-by-NRHS matrix with the first M rows containing the matrix B. On - !! output, the N-by-NRHS solution matrix X. - !! @param[out] work An optional input, that if provided, prevents any local - !! memory allocation. If not provided, the memory required is allocated - !! within. If provided, the length of the array must be at least - !! @p olwork. - !! @param[out] olwork An optional output used to determine workspace size. - !! If supplied, the routine determines the optimal size for @p work, and - !! returns without performing any actual calculations. - !! @param[out] err An optional errors-based object that if provided can be - !! used to retrieve information relating to any errors encountered during - !! execution. If not provided, a default implementation of the errors - !! class is used internally to provide error handling. Possible errors and - !! warning messages that may be encountered are as follows. - !! - LA_ARRAY_SIZE_ERROR: Occurs if any of the input arrays are not sized - !! appropriately. - !! - LA_OUT_OF_MEMORY_ERROR: Occurs if local memory must be allocated, and - !! there is insufficient memory available. - !! - LA_INVALID_OPERATION_ERROR: Occurs if @p a is not of full rank. - !! - !! @par Notes - !! This routine utilizes the LAPACK routine DGELS. + module subroutine solve_least_squares_mtx(a, b, work, olwork, err) real(real64), intent(inout), dimension(:,:) :: a, b real(real64), intent(out), target, optional, dimension(:) :: work integer(int32), intent(out), optional :: olwork class(errors), intent(inout), optional, target :: err end subroutine - - !> @brief Solves the overdetermined or underdetermined system (A*X = B) of - !! M equations of N unknowns using a QR or LQ factorization of the matrix A. - !! Notice, it is assumed that matrix A has full rank. - !! - !! @param[in,out] a On input, the M-by-N matrix A. On output, if M >= N, - !! the QR factorization of A in the form as output by qr_factor; else, - !! if M < N, the LQ factorization of A. - !! @param[in,out] b If M >= N, the M-by-NRHS matrix B. On output, the first - !! N rows contain the N-by-NRHS solution matrix X. If M < N, an - !! N-by-NRHS matrix with the first M rows containing the matrix B. On - !! output, the N-by-NRHS solution matrix X. - !! @param[out] work An optional input, that if provided, prevents any local - !! memory allocation. If not provided, the memory required is allocated - !! within. If provided, the length of the array must be at least - !! @p olwork. - !! @param[out] olwork An optional output used to determine workspace size. - !! If supplied, the routine determines the optimal size for @p work, and - !! returns without performing any actual calculations. - !! @param[out] err An optional errors-based object that if provided can be - !! used to retrieve information relating to any errors encountered during - !! execution. If not provided, a default implementation of the errors - !! class is used internally to provide error handling. Possible errors and - !! warning messages that may be encountered are as follows. - !! - LA_ARRAY_SIZE_ERROR: Occurs if any of the input arrays are not sized - !! appropriately. - !! - LA_OUT_OF_MEMORY_ERROR: Occurs if local memory must be allocated, and - !! there is insufficient memory available. - !! - LA_INVALID_OPERATION_ERROR: Occurs if @p a is not of full rank. - !! - !! @par Notes - !! This routine utilizes the LAPACK routine ZGELS. + module subroutine solve_least_squares_mtx_cmplx(a, b, work, olwork, err) complex(real64), intent(inout), dimension(:,:) :: a, b complex(real64), intent(out), target, optional, dimension(:) :: work integer(int32), intent(out), optional :: olwork class(errors), intent(inout), optional, target :: err end subroutine - - !> @brief Solves the overdetermined or underdetermined system (A*X = B) of - !! M equations of N unknowns using a QR or LQ factorization of the matrix A. - !! Notice, it is assumed that matrix A has full rank. - !! - !! @param[in,out] a On input, the M-by-N matrix A. On output, if M >= N, - !! the QR factorization of A in the form as output by qr_factor; else, - !! if M < N, the LQ factorization of A. - !! @param[in,out] b If M >= N, the M-element array B. On output, the first - !! N elements contain the N-element solution array X. If M < N, an - !! N-element array with the first M elements containing the array B. On - !! output, the N-element solution array X. - !! @param[out] work An optional input, that if provided, prevents any local - !! memory allocation. If not provided, the memory required is allocated - !! within. If provided, the length of the array must be at least - !! @p olwork. - !! @param[out] olwork An optional output used to determine workspace size. - !! If supplied, the routine determines the optimal size for @p work, and - !! returns without performing any actual calculations. - !! @param[out] err An optional errors-based object that if provided can be - !! used to retrieve information relating to any errors encountered during - !! execution. If not provided, a default implementation of the errors - !! class is used internally to provide error handling. Possible errors and - !! warning messages that may be encountered are as follows. - !! - LA_ARRAY_SIZE_ERROR: Occurs if any of the input arrays are not sized - !! appropriately. - !! - LA_OUT_OF_MEMORY_ERROR: Occurs if local memory must be allocated, and - !! there is insufficient memory available. - !! - LA_INVALID_OPERATION_ERROR: Occurs if @p a is not of full rank. - !! - !! @par Notes - !! This routine utilizes the LAPACK routine DGELS. + module subroutine solve_least_squares_vec(a, b, work, olwork, err) real(real64), intent(inout), dimension(:,:) :: a real(real64), intent(inout), dimension(:) :: b @@ -3769,38 +3627,7 @@ module subroutine solve_least_squares_vec(a, b, work, olwork, err) integer(int32), intent(out), optional :: olwork class(errors), intent(inout), optional, target :: err end subroutine - - !> @brief Solves the overdetermined or underdetermined system (A*X = B) of - !! M equations of N unknowns using a QR or LQ factorization of the matrix A. - !! Notice, it is assumed that matrix A has full rank. - !! - !! @param[in,out] a On input, the M-by-N matrix A. On output, if M >= N, - !! the QR factorization of A in the form as output by qr_factor; else, - !! if M < N, the LQ factorization of A. - !! @param[in,out] b If M >= N, the M-element array B. On output, the first - !! N elements contain the N-element solution array X. If M < N, an - !! N-element array with the first M elements containing the array B. On - !! output, the N-element solution array X. - !! @param[out] work An optional input, that if provided, prevents any local - !! memory allocation. If not provided, the memory required is allocated - !! within. If provided, the length of the array must be at least - !! @p olwork. - !! @param[out] olwork An optional output used to determine workspace size. - !! If supplied, the routine determines the optimal size for @p work, and - !! returns without performing any actual calculations. - !! @param[out] err An optional errors-based object that if provided can be - !! used to retrieve information relating to any errors encountered during - !! execution. If not provided, a default implementation of the errors - !! class is used internally to provide error handling. Possible errors and - !! warning messages that may be encountered are as follows. - !! - LA_ARRAY_SIZE_ERROR: Occurs if any of the input arrays are not sized - !! appropriately. - !! - LA_OUT_OF_MEMORY_ERROR: Occurs if local memory must be allocated, and - !! there is insufficient memory available. - !! - LA_INVALID_OPERATION_ERROR: Occurs if @p a is not of full rank. - !! - !! @par Notes - !! This routine utilizes the LAPACK routine ZGELS. + module subroutine solve_least_squares_vec_cmplx(a, b, work, olwork, err) complex(real64), intent(inout), dimension(:,:) :: a complex(real64), intent(inout), dimension(:) :: b @@ -3808,44 +3635,7 @@ module subroutine solve_least_squares_vec_cmplx(a, b, work, olwork, err) integer(int32), intent(out), optional :: olwork class(errors), intent(inout), optional, target :: err end subroutine - - !> @brief Solves the overdetermined or underdetermined system (A*X = B) of - !! M equations of N unknowns using a complete orthogonal factorization of - !! matrix A. - !! - !! @param[in,out] a On input, the M-by-N matrix A. On output, the matrix - !! is overwritten by the details of its complete orthogonal factorization. - !! @param[in,out] b If M >= N, the M-by-NRHS matrix B. On output, the first - !! N rows contain the N-by-NRHS solution matrix X. If M < N, an - !! N-by-NRHS matrix with the first M rows containing the matrix B. On - !! output, the N-by-NRHS solution matrix X. - !! @param[out] ipvt An optional input that on input, an N-element array - !! that if IPVT(I) .ne. 0, the I-th column of A is permuted to the front - !! of A * P; if IPVT(I) = 0, the I-th column of A is a free column. On - !! output, if IPVT(I) = K, then the I-th column of A * P was the K-th - !! column of A. If not supplied, memory is allocated internally, and IPVT - !! is set to all zeros such that all columns are treated as free. - !! @param[out] arnk An optional output, that if provided, will return the - !! rank of @p a. - !! @param[out] work An optional input, that if provided, prevents any local - !! memory allocation. If not provided, the memory required is allocated - !! within. If provided, the length of the array must be at least - !! @p olwork. - !! @param[out] olwork An optional output used to determine workspace size. - !! If supplied, the routine determines the optimal size for @p work, and - !! returns without performing any actual calculations. - !! @param[out] err An optional errors-based object that if provided can be - !! used to retrieve information relating to any errors encountered during - !! execution. If not provided, a default implementation of the errors - !! class is used internally to provide error handling. Possible errors and - !! warning messages that may be encountered are as follows. - !! - LA_ARRAY_SIZE_ERROR: Occurs if any of the input arrays are not sized - !! appropriately. - !! - LA_OUT_OF_MEMORY_ERROR: Occurs if local memory must be allocated, and - !! there is insufficient memory available. - !! - !! @par Notes - !! This routine utilizes the LAPACK routine DGELSY. + module subroutine solve_least_squares_mtx_pvt(a, b, ipvt, arnk, work, olwork, err) real(real64), intent(inout), dimension(:,:) :: a, b integer(int32), intent(inout), target, optional, dimension(:) :: ipvt @@ -3854,48 +3644,7 @@ module subroutine solve_least_squares_mtx_pvt(a, b, ipvt, arnk, work, olwork, er integer(int32), intent(out), optional :: olwork class(errors), intent(inout), optional, target :: err end subroutine - - !> @brief Solves the overdetermined or underdetermined system (A*X = B) of - !! M equations of N unknowns using a complete orthogonal factorization of - !! matrix A. - !! - !! @param[in,out] a On input, the M-by-N matrix A. On output, the matrix - !! is overwritten by the details of its complete orthogonal factorization. - !! @param[in,out] b If M >= N, the M-by-NRHS matrix B. On output, the first - !! N rows contain the N-by-NRHS solution matrix X. If M < N, an - !! N-by-NRHS matrix with the first M rows containing the matrix B. On - !! output, the N-by-NRHS solution matrix X. - !! @param[out] ipvt An optional input that on input, an N-element array - !! that if IPVT(I) .ne. 0, the I-th column of A is permuted to the front - !! of A * P; if IPVT(I) = 0, the I-th column of A is a free column. On - !! output, if IPVT(I) = K, then the I-th column of A * P was the K-th - !! column of A. If not supplied, memory is allocated internally, and IPVT - !! is set to all zeros such that all columns are treated as free. - !! @param[out] arnk An optional output, that if provided, will return the - !! rank of @p a. - !! @param[out] work An optional input, that if provided, prevents any local - !! memory allocation for complex-valued workspaces. If not provided, the - !! memory required is allocated within. If provided, the length of the - !! array must be at least @p olwork. - !! @param[out] olwork An optional output used to determine workspace size. - !! If supplied, the routine determines the optimal size for @p work, and - !! returns without performing any actual calculations. - !! @param[out] rwork An optional input, that if provided, prevents any local - !! memory allocation for real-valued workspaces. If not provided, the - !! memory required is allocated within. If provided, the length of the - !! array must be at least 2 * N. - !! @param[out] err An optional errors-based object that if provided can be - !! used to retrieve information relating to any errors encountered during - !! execution. If not provided, a default implementation of the errors - !! class is used internally to provide error handling. Possible errors and - !! warning messages that may be encountered are as follows. - !! - LA_ARRAY_SIZE_ERROR: Occurs if any of the input arrays are not sized - !! appropriately. - !! - LA_OUT_OF_MEMORY_ERROR: Occurs if local memory must be allocated, and - !! there is insufficient memory available. - !! - !! @par Notes - !! This routine utilizes the LAPACK routine ZGELSY. + module subroutine solve_least_squares_mtx_pvt_cmplx(a, b, ipvt, arnk, & work, olwork, rwork, err) complex(real64), intent(inout), dimension(:,:) :: a, b @@ -3906,44 +3655,7 @@ module subroutine solve_least_squares_mtx_pvt_cmplx(a, b, ipvt, arnk, & real(real64), intent(out), target, optional, dimension(:) :: rwork class(errors), intent(inout), optional, target :: err end subroutine - - !> @brief Solves the overdetermined or underdetermined system (A*X = B) of - !! M equations of N unknowns using a complete orthogonal factorization of - !! matrix A. - !! - !! @param[in,out] a On input, the M-by-N matrix A. On output, the matrix - !! is overwritten by the details of its complete orthogonal factorization. - !! @param[in,out] b If M >= N, the M-element array B. On output, the first - !! N elements contain the N-element solution array X. If M < N, an - !! N-element array with the first M elements containing the array B. On - !! output, the N-element solution array X. - !! @param[out] ipvt An optional input that on input, an N-element array - !! that if IPVT(I) .ne. 0, the I-th column of A is permuted to the front - !! of A * P; if IPVT(I) = 0, the I-th column of A is a free column. On - !! output, if IPVT(I) = K, then the I-th column of A * P was the K-th - !! column of A. If not supplied, memory is allocated internally, and IPVT - !! is set to all zeros such that all columns are treated as free. - !! @param[out] arnk An optional output, that if provided, will return the - !! rank of @p a. - !! @param[out] work An optional input, that if provided, prevents any local - !! memory allocation. If not provided, the memory required is allocated - !! within. If provided, the length of the array must be at least - !! @p olwork. - !! @param[out] olwork An optional output used to determine workspace size. - !! If supplied, the routine determines the optimal size for @p work, and - !! returns without performing any actual calculations. - !! @param[out] err An optional errors-based object that if provided can be - !! used to retrieve information relating to any errors encountered during - !! execution. If not provided, a default implementation of the errors - !! class is used internally to provide error handling. Possible errors and - !! warning messages that may be encountered are as follows. - !! - LA_ARRAY_SIZE_ERROR: Occurs if any of the input arrays are not sized - !! appropriately. - !! - LA_OUT_OF_MEMORY_ERROR: Occurs if local memory must be allocated, and - !! there is insufficient memory available. - !! - !! @par Notes - !! This routine utilizes the LAPACK routine DGELSY. + module subroutine solve_least_squares_vec_pvt(a, b, ipvt, arnk, work, olwork, err) real(real64), intent(inout), dimension(:,:) :: a real(real64), intent(inout), dimension(:) :: b @@ -3953,48 +3665,7 @@ module subroutine solve_least_squares_vec_pvt(a, b, ipvt, arnk, work, olwork, er integer(int32), intent(out), optional :: olwork class(errors), intent(inout), optional, target :: err end subroutine - - !> @brief Solves the overdetermined or underdetermined system (A*X = B) of - !! M equations of N unknowns using a complete orthogonal factorization of - !! matrix A. - !! - !! @param[in,out] a On input, the M-by-N matrix A. On output, the matrix - !! is overwritten by the details of its complete orthogonal factorization. - !! @param[in,out] b If M >= N, the M-element array B. On output, the first - !! N elements contain the N-element solution array X. If M < N, an - !! N-element array with the first M elements containing the array B. On - !! output, the N-element solution array X. - !! @param[out] ipvt An optional input that on input, an N-element array - !! that if IPVT(I) .ne. 0, the I-th column of A is permuted to the front - !! of A * P; if IPVT(I) = 0, the I-th column of A is a free column. On - !! output, if IPVT(I) = K, then the I-th column of A * P was the K-th - !! column of A. If not supplied, memory is allocated internally, and IPVT - !! is set to all zeros such that all columns are treated as free. - !! @param[out] arnk An optional output, that if provided, will return the - !! rank of @p a. - !! @param[out] work An optional input, that if provided, prevents any local - !! memory allocation for complex-valued workspaces. If not provided, the - !! memory required is allocated within. If provided, the length of the - !! array must be at least @p olwork. - !! @param[out] olwork An optional output used to determine workspace size. - !! If supplied, the routine determines the optimal size for @p work, and - !! returns without performing any actual calculations. - !! @param[out] rwork An optional input, that if provided, prevents any local - !! memory allocation for real-valued workspaces. If not provided, the - !! memory required is allocated within. If provided, the length of the - !! array must be at least 2 * N. - !! @param[out] err An optional errors-based object that if provided can be - !! used to retrieve information relating to any errors encountered during - !! execution. If not provided, a default implementation of the errors - !! class is used internally to provide error handling. Possible errors and - !! warning messages that may be encountered are as follows. - !! - LA_ARRAY_SIZE_ERROR: Occurs if any of the input arrays are not sized - !! appropriately. - !! - LA_OUT_OF_MEMORY_ERROR: Occurs if local memory must be allocated, and - !! there is insufficient memory available. - !! - !! @par Notes - !! This routine utilizes the LAPACK routine ZGELSY. + module subroutine solve_least_squares_vec_pvt_cmplx(a, b, ipvt, arnk, & work, olwork, rwork, err) complex(real64), intent(inout), dimension(:,:) :: a @@ -4006,45 +3677,7 @@ module subroutine solve_least_squares_vec_pvt_cmplx(a, b, ipvt, arnk, & real(real64), intent(out), target, optional, dimension(:) :: rwork class(errors), intent(inout), optional, target :: err end subroutine - - !> @brief Solves the overdetermined or underdetermined system (A*X = B) of - !! M equations of N unknowns using a singular value decomposition of - !! matrix A. - !! - !! @param[in,out] a On input, the M-by-N matrix A. On output, the matrix - !! is overwritten by the details of its complete orthogonal factorization. - !! @param[in,out] b If M >= N, the M-by-NRHS matrix B. On output, the first - !! N rows contain the N-by-NRHS solution matrix X. If M < N, an - !! N-by-NRHS matrix with the first M rows containing the matrix B. On - !! output, the N-by-NRHS solution matrix X. - !! @param[out] arnk An optional output, that if provided, will return the - !! rank of @p a. - !! @param[out] s An optional MIN(M, N)-element array that on output contains - !! the singular values of @p a in descending order. Notice, the condition - !! number of @p a can be determined by S(1) / S(MIN(M, N)). - !! @param[out] arnk An optional output, that if provided, will return the - !! rank of @p a. - !! @param[out] work An optional input, that if provided, prevents any local - !! memory allocation. If not provided, the memory required is allocated - !! within. If provided, the length of the array must be at least - !! @p olwork. - !! @param[out] olwork An optional output used to determine workspace size. - !! If supplied, the routine determines the optimal size for @p work, and - !! returns without performing any actual calculations. - !! @param[out] err An optional errors-based object that if provided can be - !! used to retrieve information relating to any errors encountered during - !! execution. If not provided, a default implementation of the errors - !! class is used internally to provide error handling. Possible errors and - !! warning messages that may be encountered are as follows. - !! - LA_ARRAY_SIZE_ERROR: Occurs if any of the input arrays are not sized - !! appropriately. - !! - LA_OUT_OF_MEMORY_ERROR: Occurs if local memory must be allocated, and - !! there is insufficient memory available. - !! - LA_CONVERGENCE_ERROR: Occurs as a warning if the QR iteration process - !! could not converge to a zero value. - !! - !! @par Notes - !! This routine utilizes the LAPACK routine DGELSS. + module subroutine solve_least_squares_mtx_svd(a, b, s, arnk, work, olwork, err) real(real64), intent(inout), dimension(:,:) :: a, b integer(int32), intent(out), optional :: arnk @@ -4052,49 +3685,7 @@ module subroutine solve_least_squares_mtx_svd(a, b, s, arnk, work, olwork, err) integer(int32), intent(out), optional :: olwork class(errors), intent(inout), optional, target :: err end subroutine - - !> @brief Solves the overdetermined or underdetermined system (A*X = B) of - !! M equations of N unknowns using a singular value decomposition of - !! matrix A. - !! - !! @param[in,out] a On input, the M-by-N matrix A. On output, the matrix - !! is overwritten by the details of its complete orthogonal factorization. - !! @param[in,out] b If M >= N, the M-by-NRHS matrix B. On output, the first - !! N rows contain the N-by-NRHS solution matrix X. If M < N, an - !! N-by-NRHS matrix with the first M rows containing the matrix B. On - !! output, the N-by-NRHS solution matrix X. - !! @param[out] arnk An optional output, that if provided, will return the - !! rank of @p a. - !! @param[out] s An optional MIN(M, N)-element array that on output contains - !! the singular values of @p a in descending order. Notice, the condition - !! number of @p a can be determined by S(1) / S(MIN(M, N)). - !! @param[out] arnk An optional output, that if provided, will return the - !! rank of @p a. - !! @param[out] work An optional input, that if provided, prevents any local - !! memory allocation for complex-valued workspaces. If not provided, the - !! memory required is allocated within. If provided, the length of the - !! array must be at least @p olwork. - !! @param[out] olwork An optional output used to determine workspace size. - !! If supplied, the routine determines the optimal size for @p work, and - !! returns without performing any actual calculations. - !! @param[out] rwork An optional input, that if provided, prevents any local - !! memory allocation for real-valued workspaces. If not provided, the - !! memory required is allocated within. If provided, the length of the - !! array must be at least 5 * MIN(M, N). - !! @param[out] err An optional errors-based object that if provided can be - !! used to retrieve information relating to any errors encountered during - !! execution. If not provided, a default implementation of the errors - !! class is used internally to provide error handling. Possible errors and - !! warning messages that may be encountered are as follows. - !! - LA_ARRAY_SIZE_ERROR: Occurs if any of the input arrays are not sized - !! appropriately. - !! - LA_OUT_OF_MEMORY_ERROR: Occurs if local memory must be allocated, and - !! there is insufficient memory available. - !! - LA_CONVERGENCE_ERROR: Occurs as a warning if the QR iteration process - !! could not converge to a zero value. - !! - !! @par Notes - !! This routine utilizes the LAPACK routine ZGELSS. + module subroutine solve_least_squares_mtx_svd_cmplx(a, b, s, arnk, work, & olwork, rwork, err) complex(real64), intent(inout), dimension(:,:) :: a, b @@ -4104,43 +3695,7 @@ module subroutine solve_least_squares_mtx_svd_cmplx(a, b, s, arnk, work, & integer(int32), intent(out), optional :: olwork class(errors), intent(inout), optional, target :: err end subroutine - - !> @brief Solves the overdetermined or underdetermined system (A*X = B) of - !! M equations of N unknowns using a singular value decomposition of - !! matrix A. - !! - !! @param[in,out] a On input, the M-by-N matrix A. On output, the matrix - !! is overwritten by the details of its complete orthogonal factorization. - !! @param[in,out] b If M >= N, the M-by-NRHS matrix B. On output, the first - !! N rows contain the N-by-NRHS solution matrix X. If M < N, an - !! N-by-NRHS matrix with the first M rows containing the matrix B. On - !! output, the N-by-NRHS solution matrix X. - !! @param[out] s An optional MIN(M, N)-element array that on output contains - !! the singular values of @p a in descending order. Notice, the condition - !! number of @p a can be determined by S(1) / S(MIN(M, N)). - !! @param[out] arnk An optional output, that if provided, will return the - !! rank of @p a. - !! @param[out] work An optional input, that if provided, prevents any local - !! memory allocation. If not provided, the memory required is allocated - !! within. If provided, the length of the array must be at least - !! @p olwork. - !! @param[out] olwork An optional output used to determine workspace size. - !! If supplied, the routine determines the optimal size for @p work, and - !! returns without performing any actual calculations. - !! @param[out] err An optional errors-based object that if provided can be - !! used to retrieve information relating to any errors encountered during - !! execution. If not provided, a default implementation of the errors - !! class is used internally to provide error handling. Possible errors and - !! warning messages that may be encountered are as follows. - !! - LA_ARRAY_SIZE_ERROR: Occurs if any of the input arrays are not sized - !! appropriately. - !! - LA_OUT_OF_MEMORY_ERROR: Occurs if local memory must be allocated, and - !! there is insufficient memory available. - !! - LA_CONVERGENCE_ERROR: Occurs as a warning if the QR iteration process - !! could not converge to a zero value. - !! - !! @par Notes - !! This routine utilizes the LAPACK routine DGELSS. + module subroutine solve_least_squares_vec_svd(a, b, s, arnk, work, olwork, err) real(real64), intent(inout), dimension(:,:) :: a real(real64), intent(inout), dimension(:) :: b @@ -4149,47 +3704,7 @@ module subroutine solve_least_squares_vec_svd(a, b, s, arnk, work, olwork, err) integer(int32), intent(out), optional :: olwork class(errors), intent(inout), optional, target :: err end subroutine - - !> @brief Solves the overdetermined or underdetermined system (A*X = B) of - !! M equations of N unknowns using a singular value decomposition of - !! matrix A. - !! - !! @param[in,out] a On input, the M-by-N matrix A. On output, the matrix - !! is overwritten by the details of its complete orthogonal factorization. - !! @param[in,out] b If M >= N, the M-by-NRHS matrix B. On output, the first - !! N rows contain the N-by-NRHS solution matrix X. If M < N, an - !! N-by-NRHS matrix with the first M rows containing the matrix B. On - !! output, the N-by-NRHS solution matrix X. - !! @param[out] s An optional MIN(M, N)-element array that on output contains - !! the singular values of @p a in descending order. Notice, the condition - !! number of @p a can be determined by S(1) / S(MIN(M, N)). - !! @param[out] arnk An optional output, that if provided, will return the - !! rank of @p a. - !! @param[out] work An optional input, that if provided, prevents any local - !! memory allocation for complex-valued workspaces. If not provided, the - !! memory required is allocated within. If provided, the length of the - !! array must be at least @p olwork. - !! @param[out] olwork An optional output used to determine workspace size. - !! If supplied, the routine determines the optimal size for @p work, and - !! returns without performing any actual calculations. - !! @param[out] rwork An optional input, that if provided, prevents any local - !! memory allocation for real-valued workspaces. If not provided, the - !! memory required is allocated within. If provided, the length of the - !! array must be at least 5 * MIN(M, N). - !! @param[out] err An optional errors-based object that if provided can be - !! used to retrieve information relating to any errors encountered during - !! execution. If not provided, a default implementation of the errors - !! class is used internally to provide error handling. Possible errors and - !! warning messages that may be encountered are as follows. - !! - LA_ARRAY_SIZE_ERROR: Occurs if any of the input arrays are not sized - !! appropriately. - !! - LA_OUT_OF_MEMORY_ERROR: Occurs if local memory must be allocated, and - !! there is insufficient memory available. - !! - LA_CONVERGENCE_ERROR: Occurs as a warning if the QR iteration process - !! could not converge to a zero value. - !! - !! @par Notes - !! This routine utilizes the LAPACK routine ZGELSS. + module subroutine solve_least_squares_vec_svd_cmplx(a, b, s, arnk, work, & olwork, rwork, err) complex(real64), intent(inout), dimension(:,:) :: a @@ -4200,38 +3715,7 @@ module subroutine solve_least_squares_vec_svd_cmplx(a, b, s, arnk, work, & integer(int32), intent(out), optional :: olwork class(errors), intent(inout), optional, target :: err end subroutine - - !> @brief Computes the inverse of a square matrix. - !! - !! @param[in,out] a On input, the N-by-N matrix to invert. On output, the - !! inverted matrix. - !! @param[out] iwork An optional N-element integer workspace array. - !! @param[out] work An optional input, that if provided, prevents any local - !! memory allocation. If not provided, the memory required is allocated - !! within. If provided, the length of the array must be at least - !! @p olwork. - !! @param[out] olwork An optional output used to determine workspace size. - !! If supplied, the routine determines the optimal size for @p work, and - !! returns without performing any actual calculations. - !! @param[out] err An optional errors-based object that if provided can be - !! used to retrieve information relating to any errors encountered during - !! execution. If not provided, a default implementation of the errors - !! class is used internally to provide error handling. Possible errors and - !! warning messages that may be encountered are as follows. - !! - LA_ARRAY_SIZE_ERROR: Occurs if @p a is not square. Will also occur if - !! incorrectly sized workspace arrays are provided. - !! - LA_OUT_OF_MEMORY_ERROR: Occurs if local memory must be allocated, and - !! there is insufficient memory available. - !! - LA_SINGULAR_MATRIX_ERROR: Occurs if the input matrix is singular. - !! - !! @par Notes - !! This routine utilizes the LAPACK routines DGETRF to perform an LU - !! factorization of the matrix, and DGETRI to invert the LU factored - !! matrix. - !! - !! @par See Also - !! - [Wikipedia](https://en.wikipedia.org/wiki/Invertible_matrix) - !! - [Wolfram MathWorld](http://mathworld.wolfram.com/MatrixInverse.html) + module subroutine mtx_inverse_dbl(a, iwork, work, olwork, err) real(real64), intent(inout), dimension(:,:) :: a integer(int32), intent(out), target, optional, dimension(:) :: iwork @@ -4240,37 +3724,6 @@ module subroutine mtx_inverse_dbl(a, iwork, work, olwork, err) class(errors), intent(inout), optional, target :: err end subroutine - !> @brief Computes the inverse of a square matrix. - !! - !! @param[in,out] a On input, the N-by-N matrix to invert. On output, the - !! inverted matrix. - !! @param[out] iwork An optional N-element integer workspace array. - !! @param[out] work An optional input, that if provided, prevents any local - !! memory allocation. If not provided, the memory required is allocated - !! within. If provided, the length of the array must be at least - !! @p olwork. - !! @param[out] olwork An optional output used to determine workspace size. - !! If supplied, the routine determines the optimal size for @p work, and - !! returns without performing any actual calculations. - !! @param[out] err An optional errors-based object that if provided can be - !! used to retrieve information relating to any errors encountered during - !! execution. If not provided, a default implementation of the errors - !! class is used internally to provide error handling. Possible errors and - !! warning messages that may be encountered are as follows. - !! - LA_ARRAY_SIZE_ERROR: Occurs if @p a is not square. Will also occur if - !! incorrectly sized workspace arrays are provided. - !! - LA_OUT_OF_MEMORY_ERROR: Occurs if local memory must be allocated, and - !! there is insufficient memory available. - !! - LA_SINGULAR_MATRIX_ERROR: Occurs if the input matrix is singular. - !! - !! @par Notes - !! This routine utilizes the LAPACK routines ZGETRF to perform an LU - !! factorization of the matrix, and ZGETRI to invert the LU factored - !! matrix. - !! - !! @par See Also - !! - [Wikipedia](https://en.wikipedia.org/wiki/Invertible_matrix) - !! - [Wolfram MathWorld](http://mathworld.wolfram.com/MatrixInverse.html) module subroutine mtx_inverse_cmplx(a, iwork, work, olwork, err) complex(real64), intent(inout), dimension(:,:) :: a integer(int32), intent(out), target, optional, dimension(:) :: iwork @@ -4278,44 +3731,7 @@ module subroutine mtx_inverse_cmplx(a, iwork, work, olwork, err) integer(int32), intent(out), optional :: olwork class(errors), intent(inout), optional, target :: err end subroutine - - !> @brief Computes the Moore-Penrose pseudo-inverse of a M-by-N matrix - !! using the singular value decomposition of the matrix. - !! - !! @param[in,out] a On input, the M-by-N matrix to invert. The matrix is - !! overwritten on output. - !! @param[out] ainv The N-by-M matrix where the pseudo-inverse of @p a - !! will be written. - !! @param[in] tol An optional input, that if supplied, overrides the default - !! tolerance on singular values such that singular values less than this - !! tolerance are forced to have a reciprocal of zero, as opposed to 1/S(I). - !! The default tolerance is: MAX(M, N) * EPS * MAX(S). If the supplied - !! value is less than a value that causes an overflow, the tolerance - !! reverts back to its default value, and the operation continues; - !! however, a warning message is issued. - !! @param[out] work An optional input, that if provided, prevents any local - !! memory allocation. If not provided, the memory required is allocated - !! within. If provided, the length of the array must be at least - !! @p olwork. - !! @param[out] olwork An optional output used to determine workspace size. - !! If supplied, the routine determines the optimal size for @p work, and - !! returns without performing any actual calculations. - !! @param[out] err An optional errors-based object that if provided can be - !! used to retrieve information relating to any errors encountered during - !! execution. If not provided, a default implementation of the errors - !! class is used internally to provide error handling. Possible errors and - !! warning messages that may be encountered are as follows. - !! - LA_ARRAY_SIZE_ERROR: Occurs if any of the input arrays are not sized - !! appropriately. - !! - LA_OUT_OF_MEMORY_ERROR: Occurs if local memory must be allocated, and - !! there is insufficient memory available. - !! - LA_CONVERGENCE_ERROR: Occurs as a warning if the QR iteration process - !! could not converge to a zero value. - !! - !! @par See Also - !! - [Wikipedia](https://en.wikipedia.org/wiki/Moore%E2%80%93Penrose_pseudoinverse) - !! - [Wolfram MathWorld](http://mathworld.wolfram.com/Moore-PenroseMatrixInverse.html) - !! - [MathWorks](http://www.mathworks.com/help/matlab/ref/pinv.html?s_tid=srchtitle) + module subroutine mtx_pinverse_dbl(a, ainv, tol, work, olwork, err) real(real64), intent(inout), dimension(:,:) :: a real(real64), intent(out), dimension(:,:) :: ainv @@ -4324,48 +3740,7 @@ module subroutine mtx_pinverse_dbl(a, ainv, tol, work, olwork, err) integer(int32), intent(out), optional :: olwork class(errors), intent(inout), optional, target :: err end subroutine - - !> @brief Computes the Moore-Penrose pseudo-inverse of a M-by-N matrix - !! using the singular value decomposition of the matrix. - !! - !! @param[in,out] a On input, the M-by-N matrix to invert. The matrix is - !! overwritten on output. - !! @param[out] ainv The N-by-M matrix where the pseudo-inverse of @p a - !! will be written. - !! @param[in] tol An optional input, that if supplied, overrides the default - !! tolerance on singular values such that singular values less than this - !! tolerance are forced to have a reciprocal of zero, as opposed to 1/S(I). - !! The default tolerance is: MAX(M, N) * EPS * MAX(S). If the supplied - !! value is less than a value that causes an overflow, the tolerance - !! reverts back to its default value, and the operation continues; - !! however, a warning message is issued. - !! @param[out] work An optional input, that if provided, prevents any local - !! memory allocation for complex-valued workspaces. If not provided, the - !! memory required is allocated within. If provided, the length of the - !! array must be at least @p olwork. - !! @param[out] olwork An optional output used to determine workspace size. - !! If supplied, the routine determines the optimal size for @p work, and - !! returns without performing any actual calculations. - !! @param[out] rwork An optional input, that if provided, prevents any local - !! memory allocation for real-valued workspaces. If not provided, the - !! memory required is allocated within. If provided, the length of the - !! array must be at least 6 * MIN(M, N). - !! @param[out] err An optional errors-based object that if provided can be - !! used to retrieve information relating to any errors encountered during - !! execution. If not provided, a default implementation of the errors - !! class is used internally to provide error handling. Possible errors and - !! warning messages that may be encountered are as follows. - !! - LA_ARRAY_SIZE_ERROR: Occurs if any of the input arrays are not sized - !! appropriately. - !! - LA_OUT_OF_MEMORY_ERROR: Occurs if local memory must be allocated, and - !! there is insufficient memory available. - !! - LA_CONVERGENCE_ERROR: Occurs as a warning if the QR iteration process - !! could not converge to a zero value. - !! - !! @par See Also - !! - [Wikipedia](https://en.wikipedia.org/wiki/Moore%E2%80%93Penrose_pseudoinverse) - !! - [Wolfram MathWorld](http://mathworld.wolfram.com/Moore-PenroseMatrixInverse.html) - !! - [MathWorks](http://www.mathworks.com/help/matlab/ref/pinv.html?s_tid=srchtitle) + module subroutine mtx_pinverse_cmplx(a, ainv, tol, work, olwork, rwork, err) complex(real64), intent(inout), dimension(:,:) :: a complex(real64), intent(out), dimension(:,:) :: ainv From 3e7edfd8ef1fc6a1586060501d05d95cc06c9d9d Mon Sep 17 00:00:00 2001 From: jchristopherson Date: Thu, 15 Dec 2022 17:03:16 -0600 Subject: [PATCH 22/65] Update documentation --- doc/html/interfacelinalg__core_1_1eigen.html | 65 +- doc/html/interfacelinalg__core_1_1sort.html | 46 +- doc/html/linalg__c__api_8f90_source.html | 4 +- doc/html/linalg__core_8f90_source.html | 1770 +++++++++--------- doc/html/linalg__immutable_8f90_source.html | 4 +- 5 files changed, 996 insertions(+), 893 deletions(-) diff --git a/doc/html/interfacelinalg__core_1_1eigen.html b/doc/html/interfacelinalg__core_1_1eigen.html index 542f099d..04948ca3 100644 --- a/doc/html/interfacelinalg__core_1_1eigen.html +++ b/doc/html/interfacelinalg__core_1_1eigen.html @@ -107,6 +107,67 @@ More...

    Detailed Description

    Computes the eigenvalues, and optionally the eigenvectors, of a matrix.

    +
    Syntax 1 (Symmetric Matrices)
    subroutine eigen(logical vecs, real(real64) a(:,:), real(real64) vals(:), optional real(real64) work(:), optional integer(int32) olwork, optional class(errors) err)
    +
    +
    Parameters
    +
    [in]upperSet to true if A is an upper triangular matrix; else, set to false if A is a lower triangular matrix.
     Solves a system of Cholesky factored equations. More...
     
    interface  solve_least_squares
     Solves the overdetermined or underdetermined system (A*X = B) of M equations of N unknowns. More...
     Solves the overdetermined or underdetermined system \( A X = B \) of M equations of N unknowns. Notice, it is assumed that matrix A has full rank. More...
     
    interface  solve_least_squares_full
     Solves the overdetermined or underdetermined system (A*X = B) of M equations of N unknowns, but uses a full orthogonal factorization of the system. More...
     Solves the overdetermined or underdetermined system \( A X = B \) of M equations of N unknowns, but uses a full orthogonal factorization of the system. More...
     
    interface  solve_least_squares_svd
     Solves the overdetermined or underdetermined system (A*X = B) of M equations of N unknowns using a singular value decomposition of matrix A. More...
     Solves the overdetermined or underdetermined system \( A X = B \) of M equations of N unknowns using a singular value decomposition of matrix A. More...
     
    interface  solve_lu
     Solves a system of LU-factored equations. More...
     Crecip_mult_arrayMultiplies a vector by the reciprocal of a real scalar
     Crz_factorFactors an upper trapezoidal matrix by means of orthogonal transformations such that \( A = R Z = (R 0) Z \). Z is an orthogonal matrix of dimension N-by-N, and R is an M-by-M upper triangular matrix
     Csolve_choleskySolves a system of Cholesky factored equations
     Csolve_least_squaresSolves the overdetermined or underdetermined system (A*X = B) of M equations of N unknowns
     Csolve_least_squares_fullSolves the overdetermined or underdetermined system (A*X = B) of M equations of N unknowns, but uses a full orthogonal factorization of the system
     Csolve_least_squares_svdSolves the overdetermined or underdetermined system (A*X = B) of M equations of N unknowns using a singular value decomposition of matrix A
     Csolve_least_squaresSolves the overdetermined or underdetermined system \( A X = B \) of M equations of N unknowns. Notice, it is assumed that matrix A has full rank
     Csolve_least_squares_fullSolves the overdetermined or underdetermined system \( A X = B \) of M equations of N unknowns, but uses a full orthogonal factorization of the system
     Csolve_least_squares_svdSolves the overdetermined or underdetermined system \( A X = B \) of M equations of N unknowns using a singular value decomposition of matrix A
     Csolve_luSolves a system of LU-factored equations
     Csolve_qrSolves a system of M QR-factored equations of N unknowns
     Csolve_triangular_systemSolves a triangular system of equations
    + + + + + + +
    [in]vecsSet to true to compute the eigenvectors as well as the eigenvalues; else, set to false to just compute the eigenvalues.
    [in,out]aOn input, the N-by-N symmetric matrix on which to operate. On output, and if vecs is set to true, the matrix will contain the eigenvectors (one per column) corresponding to each eigenvalue in vals. If vecs is set to false, the lower triangular portion of the matrix is overwritten.
    [out]valsAn N-element array that will contain the eigenvalues sorted into ascending order.
    [out]workAn optional input, that if provided, prevents any local memory allocation. If not provided, the memory required is allocated within. If provided, the length of the array must be at least olwork.
    [out]olworkAn optional output used to determine workspace size. If supplied, the routine determines the optimal size for work, and returns without performing any actual calculations.
    [in,out]errAn optional errors-based object that if provided can be used to retrieve information relating to any errors encountered during execution. If not provided, a default implementation of the errors class is used internally to provide error handling. Possible errors and warning messages that may be encountered are as follows.
      +
    • LA_ARRAY_SIZE_ERROR: Occurs if any of the input arrays are not sized appropriately.
    • +
    • LA_OUT_OF_MEMORY_ERROR: Occurs if local memory must be allocated, and there is insufficient memory available.
    • +
    • LA_CONVERGENCE_ERROR: Occurs if the algorithm failed to converge.
    • +
    +
    +
    +
    +
    Notes
    This routine utilizes the LAPACK routine DSYEV.
    +
    Syntax 2 (Asymmetric Matrices)
    subroutine eigen(real(real64) a(:,:), complex(real64) vals(:), optional complex(real64) vecs(:,:), optional real(real64) work(:), optional integer(int32) olwork, optional class(errors) err)
    +
    subroutine eigen(complex(real64) a(:,:), complex(real64) vals(:), optional complex(real64) vecs(:,:), optional complex(real64) work(:), optional integer(int32) olwork, real(real64) rwork(:), optional class(errors) err)
    +
    +
    Parameters
    + + + + + + + + +
    [in,out]aOn input, the N-by-N matrix on which to operate. On output, the contents of this matrix are overwritten.
    [out]valsAn N-element array containing the eigenvalues of the matrix. The eigenvalues are not sorted.
    [out]vecsAn optional N-by-N matrix, that if supplied, signals to compute the right eigenvectors (one per column). If not provided, only the eigenvalues will be computed.
    [out]workAn optional input, that if provided, prevents any local memory allocation. If not provided, the memory required is allocated within. If provided, the length of the array must be at least olwork.
    [out]olworkAn optional output used to determine workspace size. If supplied, the routine determines the optimal size for work, and returns without performing any actual calculations.
    [out]rworkAn optional input, that if provided, prevents any local memory allocation for real-valued workspaces. If not provided, the memory required is allocated within. If provided, the length of the array must be at least 2 * N.
    [in,out]errAn optional errors-based object that if provided can be used to retrieve information relating to any errors encountered during execution. If not provided, a default implementation of the errors class is used internally to provide error handling. Possible errors and warning messages that may be encountered are as follows.
      +
    • LA_ARRAY_SIZE_ERROR: Occurs if any of the input arrays are not sized appropriately.
    • +
    • LA_OUT_OF_MEMORY_ERROR: Occurs if local memory must be allocated, and there is insufficient memory available.
    • +
    • LA_CONVERGENCE_ERROR: Occurs if the algorithm failed to converge.
    • +
    +
    +
    +
    +
    Notes
    This routine utilizes the LAPACK routine DGEEV (ZGEEV in the complex case).
    +
    Syntax 3 (General Eigen Problem)
    Computes the eigenvalues, and optionally the right eigenvectors of a square matrix assuming the structure of the eigenvalue problem is \( A X = \lambda B X \).
    subroutine eigen(real(real64) a(:,:), real(real64) b(:,:), complex(real64) alpha(:), optional real(real64) beta(:), optional complex(real64) vecs(:,:), optional real(real64) work(:), optional integer(int32) olwork, optional class(errors) err)
    +
    +
    Parameters
    + + + + + + + + + +
    [in,out]aOn input, the N-by-N matrix A. On output, the contents of this matrix are overwritten.
    [in,out]bOn input, the N-by-N matrix B. On output, the contents of this matrix are overwritten.
    [out]alphaAn N-element array that, if beta is not supplied, contains the eigenvalues. If beta is supplied however, the eigenvalues must be computed as ALPHA / BETA. This however, is not as trivial as it seems as it is entirely possible, and likely, that ALPHA / BETA can overflow or underflow. With that said, the values in ALPHA will always be less than and usually comparable with the NORM(A).
    [out]betaAn optional N-element array that if provided forces alpha to return the numerator, and this array contains the denominator used to determine the eigenvalues as ALPHA / BETA. If used, the values in this array will always be less than and usually comparable with the NORM(B).
    [out]vecsAn optional N-by-N matrix, that if supplied, signals to compute the right eigenvectors (one per column). If not provided, only the eigenvalues will be computed.
    [out]workAn optional input, that if provided, prevents any local memory allocation. If not provided, the memory required is allocated within. If provided, the length of the array must be at least olwork.
    [out]olworkAn optional output used to determine workspace size. If supplied, the routine determines the optimal size for work, and returns without performing any actual calculations.
    [in,out]errAn optional errors-based object that if provided can be used to retrieve information relating to any errors encountered during execution. If not provided, a default implementation of the errors class is used internally to provide error handling. Possible errors and warning messages that may be encountered are as follows.
      +
    • LA_ARRAY_SIZE_ERROR: Occurs if any of the input arrays are not sized appropriately.
    • +
    • LA_OUT_OF_MEMORY_ERROR: Occurs if local memory must be allocated, and there is insufficient memory available.
    • +
    • LA_CONVERGENCE_ERROR: Occurs if the algorithm failed to converge.
    • +
    +
    +
    +
    +
    Notes
    This routine utilizes the LAPACK routine DGGEV.
    Usage
    As an example, consider the eigenvalue problem arising from a mechanical system of masses and springs such that the masses are described by a mass matrix M, and the arrangement of springs are described by a stiffness matrix K.
    ! This is an example illustrating the use of the eigenvalue and eigenvector
    ! routines to solve a free vibration problem of 3 masses connected by springs.
    !
    @@ -164,7 +225,7 @@
    print '(F10.3)', (real(modeshapes(j,i)), j = 1, size(natfreq))
    end do
    end program
    -
    Computes the eigenvalues, and optionally the eigenvectors, of a matrix.
    +
    Computes the eigenvalues, and optionally the eigenvectors, of a matrix.
    Provides a set of common linear algebra routines.
    Definition: linalg_core.f90:15
    The above program produces the following output.
    Modal Information:
    Mode 1: (232.9225 Hz)
    @@ -187,7 +248,7 @@
    -

    Definition at line 2938 of file linalg_core.f90.

    +

    Definition at line 3058 of file linalg_core.f90.


    The documentation for this interface was generated from the following file: diff --git a/doc/html/interfacelinalg__core_1_1sort.html b/doc/html/interfacelinalg__core_1_1sort.html index 637af865..0c751430 100644 --- a/doc/html/interfacelinalg__core_1_1sort.html +++ b/doc/html/interfacelinalg__core_1_1sort.html @@ -107,8 +107,52 @@ More...

    Detailed Description

    Sorts an array.

    +
    Syntax 1
    subroutine sort(real(real64) x(:), optional logical ascend)
    +
    subroutine sort(complex(real64) x(:), optional logical ascend)
    +
    +
    Parameters
    + + + +
    [in,out]xOn input, the array to sort. On output, the sorted array.
    [in]ascendAn optional input that, if specified, controls if the the array is sorted in an ascending order (default), or a descending order.
    +
    +
    +
    Remarks
    The routine utilizes a quick sort algorithm unless the size of the array is less than or equal to 20. For such small arrays an insertion sort algorithm is utilized.
    +
    Notes
    This routine utilizes the LAPACK routine DLASRT.
    +
    Syntax 2
    subroutine sort(real(real64) x(:), integer(int32) ind(:), optional logical ascend, optional class(errors) err)
    +
    subroutine sort(complex(real64) x(:), integer(int32) ind(:), optional logical ascend, optional class(errors) err)
    +
    +
    Parameters
    + + + + + +
    [in,out]xOn input, the array to sort. On output, the sorted array.
    [in,out]indOn input, an integer array. On output, the contents of this array are shifted in the same order as that of x as a means of tracking the sorting operation. It is often useful to set this array to an ascending group of values (1, 2, ... n) such that this array tracks the original positions of the sorted array. Such an array can then be used to align other arrays. This array must be the same size as x.
    [in]ascendAn optional input that, if specified, controls if the the array is sorted in an ascending order (default), or a descending order.
    [in,out]errAn optional errors-based object that if provided can be used to retrieve information relating to any errors encountered during execution. If not provided, a default implementation of the errors class is used internally to provide error handling. Possible errors and warning messages that may be encountered are as follows.
      +
    • LA_ARRAY_SIZE_ERROR: Occurs if ind is not sized to match x.
    • +
    +
    +
    +
    +
    Remarks
    This routine utilizes a quick sort algorithm explained at http://www.fortran.com/qsort_c.f95.
    +
    Syntax 3 (Eigen soring)
    A sorting routine specifically tailored for sorting of eigenvalues and their associated eigenvectors using a quick-sort approach.
    subroutine sort(real(real64) vals(:), real(real64) vecs(:,:), optional logical ascend, optional class(errors) err)
    +
    subroutine sort(complex(real64) vals(:), complex(real64) vecs(:,:), optional logical ascend, optional class(errors) err)
    +
    +
    Parameters
    + + + + + +
    [in,out]valsOn input, an N-element array containing the eigenvalues. On output, the sorted eigenvalues.
    [in,out]vecsOn input, an N-by-N matrix containing the eigenvectors associated with vals (one vector per column). On output, the sorted eigenvector matrix.
    [in]ascendAn optional input that, if specified, controls if the the array is sorted in an ascending order (default), or a descending order.
    [in,out]errAn optional errors-based object that if provided can be used to retrieve information relating to any errors encountered during execution. If not provided, a default implementation of the errors class is used internally to provide error handling. Possible errors and warning messages that may be encountered are as follows.
      +
    • LA_ARRAY_SIZE_ERROR: Occurs if vecs is not sized to match vals.
    • +
    • LA_OUT_OF_MEMORY_ERROR: Occurs if there is insufficient memory available to comoplete this operation.
    • +
    +
    +
    +
    -

    Definition at line 2947 of file linalg_core.f90.

    +

    Definition at line 3141 of file linalg_core.f90.


    The documentation for this interface was generated from the following file: diff --git a/doc/html/linalg__c__api_8f90_source.html b/doc/html/linalg__c__api_8f90_source.html index a42b1df0..44e6604f 100644 --- a/doc/html/linalg__c__api_8f90_source.html +++ b/doc/html/linalg__c__api_8f90_source.html @@ -2027,7 +2027,7 @@
    Computes the rank 1 update to a Cholesky factored matrix (upper triangular).
    Computes the determinant of a square matrix.
    Multiplies a diagonal matrix with another matrix or array.
    -
    Computes the eigenvalues, and optionally the eigenvectors, of a matrix.
    +
    Computes the eigenvalues, and optionally the eigenvectors, of a matrix.
    Extracts the L and U matrices from the condensed [L\U] storage format used by the lu_factor.
    Forms the full M-by-M orthogonal matrix Q from the elementary reflectors returned by the base QR fact...
    Computes the LU factorization of an M-by-N matrix.
    @@ -2043,7 +2043,7 @@
    Solves a system of LU-factored equations.
    Solves a system of M QR-factored equations of N unknowns.
    Solves a triangular system of equations.
    -
    Sorts an array.
    +
    Sorts an array.
    Computes the singular value decomposition of a matrix A. The SVD is defined as: , where is an M-by-M...
    Computes the trace of a matrix (the sum of the main diagonal elements).
    Computes the triangular matrix operation: , or , where A is a triangular matrix.
    diff --git a/doc/html/linalg__core_8f90_source.html b/doc/html/linalg__core_8f90_source.html index c13b3618..80ceb16d 100644 --- a/doc/html/linalg__core_8f90_source.html +++ b/doc/html/linalg__core_8f90_source.html @@ -360,919 +360,917 @@
    2847end interface
    2848
    2849! ------------------------------------------------------------------------------
    -
    2938interface eigen
    -
    2939 module procedure :: eigen_symm
    -
    2940 module procedure :: eigen_asymm
    -
    2941 module procedure :: eigen_gen
    -
    2942 module procedure :: eigen_cmplx
    -
    2943end interface
    -
    2944
    -
    2945! ------------------------------------------------------------------------------
    -
    2947interface sort
    -
    2948 module procedure :: sort_dbl_array
    -
    2949 module procedure :: sort_dbl_array_ind
    -
    2950 module procedure :: sort_cmplx_array
    -
    2951 module procedure :: sort_cmplx_array_ind
    -
    2952 module procedure :: sort_eigen_cmplx
    -
    2953 module procedure :: sort_eigen_dbl
    -
    2954end interface
    -
    2955
    -
    2956
    -
    2957! ******************************************************************************
    -
    2958! LINALG_BASIC.F90
    -
    2959! ------------------------------------------------------------------------------
    -
    2960interface
    -
    2961 module subroutine mtx_mult_mtx(transa, transb, alpha, a, b, beta, c, err)
    -
    2962 logical, intent(in) :: transa, transb
    -
    2963 real(real64), intent(in) :: alpha, beta
    -
    2964 real(real64), intent(in), dimension(:,:) :: a, b
    -
    2965 real(real64), intent(inout), dimension(:,:) :: c
    -
    2966 class(errors), intent(inout), optional, target :: err
    -
    2967 end subroutine
    -
    2968
    -
    2969 module subroutine mtx_mult_vec(trans, alpha, a, b, beta, c, err)
    -
    2970 logical, intent(in) :: trans
    -
    2971 real(real64), intent(in) :: alpha, beta
    -
    2972 real(real64), intent(in), dimension(:,:) :: a
    -
    2973 real(real64), intent(in), dimension(:) :: b
    -
    2974 real(real64), intent(inout), dimension(:) :: c
    -
    2975 class(errors), intent(inout), optional, target :: err
    -
    2976 end subroutine
    -
    2977
    -
    2978 module subroutine cmtx_mult_mtx(opa, opb, alpha, a, b, beta, c, err)
    -
    2979 integer(int32), intent(in) :: opa, opb
    -
    2980 complex(real64), intent(in) :: alpha, beta
    -
    2981 complex(real64), intent(in), dimension(:,:) :: a, b
    -
    2982 complex(real64), intent(inout), dimension(:,:) :: c
    -
    2983 class(errors), intent(inout), optional, target :: err
    -
    2984 end subroutine
    -
    2985
    -
    2986 module subroutine cmtx_mult_vec(opa, alpha, a, b, beta, c, err)
    -
    2987 integer(int32), intent(in) :: opa
    -
    2988 complex(real64), intent(in) :: alpha, beta
    -
    2989 complex(real64), intent(in), dimension(:,:) :: a
    -
    2990 complex(real64), intent(in), dimension(:) :: b
    -
    2991 complex(real64), intent(inout), dimension(:) :: c
    -
    2992 class(errors), intent(inout), optional, target :: err
    -
    2993 end subroutine
    -
    2994
    -
    2995 module subroutine rank1_update_dbl(alpha, x, y, a, err)
    -
    2996 real(real64), intent(in) :: alpha
    -
    2997 real(real64), intent(in), dimension(:) :: x, y
    -
    2998 real(real64), intent(inout), dimension(:,:) :: a
    -
    2999 class(errors), intent(inout), optional, target :: err
    -
    3000 end subroutine
    -
    3001
    -
    3002 module subroutine rank1_update_cmplx(alpha, x, y, a, err)
    -
    3003 complex(real64), intent(in) :: alpha
    -
    3004 complex(real64), intent(in), dimension(:) :: x, y
    -
    3005 complex(real64), intent(inout), dimension(:,:) :: a
    -
    3006 class(errors), intent(inout), optional, target :: err
    -
    3007 end subroutine
    -
    3008
    -
    3009 module subroutine diag_mtx_mult_mtx(lside, trans, alpha, a, b, beta, c, err)
    -
    3010 logical, intent(in) :: lside, trans
    -
    3011 real(real64) :: alpha, beta
    -
    3012 real(real64), intent(in), dimension(:) :: a
    -
    3013 real(real64), intent(in), dimension(:,:) :: b
    -
    3014 real(real64), intent(inout), dimension(:,:) :: c
    -
    3015 class(errors), intent(inout), optional, target :: err
    -
    3016 end subroutine
    -
    3017
    -
    3018 module subroutine diag_mtx_mult_mtx2(lside, alpha, a, b, err)
    -
    3019 logical, intent(in) :: lside
    -
    3020 real(real64), intent(in) :: alpha
    -
    3021 real(real64), intent(in), dimension(:) :: a
    -
    3022 real(real64), intent(inout), dimension(:,:) :: b
    -
    3023 class(errors), intent(inout), optional, target :: err
    -
    3024 end subroutine
    -
    3025
    -
    3026 module subroutine diag_mtx_mult_mtx3(lside, trans, alpha, a, b, beta, c, err)
    -
    3027 logical, intent(in) :: lside, trans
    -
    3028 real(real64) :: alpha, beta
    -
    3029 complex(real64), intent(in), dimension(:) :: a
    -
    3030 real(real64), intent(in), dimension(:,:) :: b
    -
    3031 complex(real64), intent(inout), dimension(:,:) :: c
    -
    3032 class(errors), intent(inout), optional, target :: err
    -
    3033 end subroutine
    -
    3034
    -
    3035 module subroutine diag_mtx_mult_mtx4(lside, opb, alpha, a, b, beta, c, err)
    -
    3036 logical, intent(in) :: lside
    -
    3037 integer(int32), intent(in) :: opb
    -
    3038 real(real64) :: alpha, beta
    -
    3039 complex(real64), intent(in), dimension(:) :: a
    -
    3040 complex(real64), intent(in), dimension(:,:) :: b
    -
    3041 complex(real64), intent(inout), dimension(:,:) :: c
    -
    3042 class(errors), intent(inout), optional, target :: err
    -
    3043 end subroutine
    -
    3044
    -
    3045 module subroutine diag_mtx_mult_mtx_cmplx(lside, opb, alpha, a, b, beta, c, err)
    -
    3046 logical, intent(in) :: lside
    -
    3047 integer(int32), intent(in) :: opb
    -
    3048 complex(real64) :: alpha, beta
    -
    3049 complex(real64), intent(in), dimension(:) :: a
    -
    3050 complex(real64), intent(in), dimension(:,:) :: b
    -
    3051 complex(real64), intent(inout), dimension(:,:) :: c
    -
    3052 class(errors), intent(inout), optional, target :: err
    -
    3053 end subroutine
    -
    3054
    -
    3055 module subroutine diag_mtx_mult_mtx2_cmplx(lside, alpha, a, b, err)
    -
    3056 logical, intent(in) :: lside
    -
    3057 complex(real64), intent(in) :: alpha
    -
    3058 complex(real64), intent(in), dimension(:) :: a
    -
    3059 complex(real64), intent(inout), dimension(:,:) :: b
    -
    3060 class(errors), intent(inout), optional, target :: err
    -
    3061 end subroutine
    -
    3062
    -
    3063 module subroutine diag_mtx_mult_mtx_mix(lside, opb, alpha, a, b, beta, c, err)
    -
    3064 logical, intent(in) :: lside
    -
    3065 integer(int32), intent(in) :: opb
    -
    3066 complex(real64) :: alpha, beta
    -
    3067 real(real64), intent(in), dimension(:) :: a
    -
    3068 complex(real64), intent(in), dimension(:,:) :: b
    -
    3069 complex(real64), intent(inout), dimension(:,:) :: c
    -
    3070 class(errors), intent(inout), optional, target :: err
    -
    3071 end subroutine
    -
    3072
    -
    3073 module subroutine diag_mtx_mult_mtx2_mix(lside, alpha, a, b, err)
    -
    3074 logical, intent(in) :: lside
    -
    3075 complex(real64), intent(in) :: alpha
    -
    3076 real(real64), intent(in), dimension(:) :: a
    -
    3077 complex(real64), intent(inout), dimension(:,:) :: b
    -
    3078 class(errors), intent(inout), optional, target :: err
    -
    3079 end subroutine
    -
    3080
    -
    3081 pure module function trace_dbl(x) result(y)
    -
    3082 real(real64), intent(in), dimension(:,:) :: x
    -
    3083 real(real64) :: y
    -
    3084 end function
    -
    3085
    -
    3086 pure module function trace_cmplx(x) result(y)
    -
    3087 complex(real64), intent(in), dimension(:,:) :: x
    -
    3088 complex(real64) :: y
    -
    3089 end function
    -
    3090
    -
    3091 module function mtx_rank_dbl(a, tol, work, olwork, err) result(rnk)
    -
    3092 real(real64), intent(inout), dimension(:,:) :: a
    -
    3093 real(real64), intent(in), optional :: tol
    -
    3094 real(real64), intent(out), target, optional, dimension(:) :: work
    -
    3095 integer(int32), intent(out), optional :: olwork
    -
    3096 class(errors), intent(inout), optional, target :: err
    -
    3097 integer(int32) :: rnk
    -
    3098 end function
    -
    3099
    -
    3100 module function mtx_rank_cmplx(a, tol, work, olwork, rwork, err) result(rnk)
    -
    3101 complex(real64), intent(inout), dimension(:,:) :: a
    -
    3102 real(real64), intent(in), optional :: tol
    -
    3103 complex(real64), intent(out), target, optional, dimension(:) :: work
    -
    3104 integer(int32), intent(out), optional :: olwork
    -
    3105 real(real64), intent(out), target, optional, dimension(:) :: rwork
    -
    3106 class(errors), intent(inout), optional, target :: err
    -
    3107 integer(int32) :: rnk
    -
    3108 end function
    -
    3109
    -
    3110 module function det_dbl(a, iwork, err) result(x)
    -
    3111 real(real64), intent(inout), dimension(:,:) :: a
    -
    3112 integer(int32), intent(out), target, optional, dimension(:) :: iwork
    -
    3113 class(errors), intent(inout), optional, target :: err
    -
    3114 real(real64) :: x
    -
    3115 end function
    -
    3116
    -
    3117 module function det_cmplx(a, iwork, err) result(x)
    -
    3118 complex(real64), intent(inout), dimension(:,:) :: a
    -
    3119 integer(int32), intent(out), target, optional, dimension(:) :: iwork
    -
    3120 class(errors), intent(inout), optional, target :: err
    -
    3121 complex(real64) :: x
    -
    3122 end function
    -
    3123
    -
    3124 module subroutine swap_dbl(x, y, err)
    -
    3125 real(real64), intent(inout), dimension(:) :: x, y
    -
    3126 class(errors), intent(inout), optional, target :: err
    -
    3127 end subroutine
    -
    3128
    -
    3129 module subroutine swap_cmplx(x, y, err)
    -
    3130 complex(real64), intent(inout), dimension(:) :: x, y
    -
    3131 class(errors), intent(inout), optional, target :: err
    -
    3132 end subroutine
    -
    3133
    -
    3134 module subroutine recip_mult_array_dbl(a, x)
    -
    3135 real(real64), intent(in) :: a
    -
    3136 real(real64), intent(inout), dimension(:) :: x
    -
    3137 end subroutine
    -
    3138
    -
    3139 module subroutine tri_mtx_mult_dbl(upper, alpha, a, beta, b, err)
    -
    3140 logical, intent(in) :: upper
    -
    3141 real(real64), intent(in) :: alpha, beta
    -
    3142 real(real64), intent(in), dimension(:,:) :: a
    -
    3143 real(real64), intent(inout), dimension(:,:) :: b
    -
    3144 class(errors), intent(inout), optional, target :: err
    -
    3145 end subroutine
    -
    3146
    -
    3147 module subroutine tri_mtx_mult_cmplx(upper, alpha, a, beta, b, err)
    -
    3148 logical, intent(in) :: upper
    -
    3149 complex(real64), intent(in) :: alpha, beta
    -
    3150 complex(real64), intent(in), dimension(:,:) :: a
    -
    3151 complex(real64), intent(inout), dimension(:,:) :: b
    -
    3152 class(errors), intent(inout), optional, target :: err
    -
    3153 end subroutine
    -
    3154
    -
    3155end interface
    -
    3156
    -
    3157! ******************************************************************************
    -
    3158! LINALG_FACTOR.F90
    -
    3159! ------------------------------------------------------------------------------
    -
    3160interface
    -
    3161 module subroutine lu_factor_dbl(a, ipvt, err)
    -
    3162 real(real64), intent(inout), dimension(:,:) :: a
    -
    3163 integer(int32), intent(out), dimension(:) :: ipvt
    -
    3164 class(errors), intent(inout), optional, target :: err
    -
    3165 end subroutine
    -
    3166
    -
    3167 module subroutine lu_factor_cmplx(a, ipvt, err)
    -
    3168 complex(real64), intent(inout), dimension(:,:) :: a
    -
    3169 integer(int32), intent(out), dimension(:) :: ipvt
    -
    3170 class(errors), intent(inout), optional, target :: err
    -
    3171 end subroutine
    -
    3172
    -
    3173 module subroutine form_lu_all(lu, ipvt, u, p, err)
    -
    3174 real(real64), intent(inout), dimension(:,:) :: lu
    -
    3175 integer(int32), intent(in), dimension(:) :: ipvt
    -
    3176 real(real64), intent(out), dimension(:,:) :: u, p
    +
    3058interface eigen
    +
    3059 module procedure :: eigen_symm
    +
    3060 module procedure :: eigen_asymm
    +
    3061 module procedure :: eigen_gen
    +
    3062 module procedure :: eigen_cmplx
    +
    3063end interface
    +
    3064
    +
    3065! ------------------------------------------------------------------------------
    +
    3141interface sort
    +
    3142 module procedure :: sort_dbl_array
    +
    3143 module procedure :: sort_dbl_array_ind
    +
    3144 module procedure :: sort_cmplx_array
    +
    3145 module procedure :: sort_cmplx_array_ind
    +
    3146 module procedure :: sort_eigen_cmplx
    +
    3147 module procedure :: sort_eigen_dbl
    +
    3148end interface
    +
    3149
    +
    3150
    +
    3151! ******************************************************************************
    +
    3152! LINALG_BASIC.F90
    +
    3153! ------------------------------------------------------------------------------
    +
    3154interface
    +
    3155 module subroutine mtx_mult_mtx(transa, transb, alpha, a, b, beta, c, err)
    +
    3156 logical, intent(in) :: transa, transb
    +
    3157 real(real64), intent(in) :: alpha, beta
    +
    3158 real(real64), intent(in), dimension(:,:) :: a, b
    +
    3159 real(real64), intent(inout), dimension(:,:) :: c
    +
    3160 class(errors), intent(inout), optional, target :: err
    +
    3161 end subroutine
    +
    3162
    +
    3163 module subroutine mtx_mult_vec(trans, alpha, a, b, beta, c, err)
    +
    3164 logical, intent(in) :: trans
    +
    3165 real(real64), intent(in) :: alpha, beta
    +
    3166 real(real64), intent(in), dimension(:,:) :: a
    +
    3167 real(real64), intent(in), dimension(:) :: b
    +
    3168 real(real64), intent(inout), dimension(:) :: c
    +
    3169 class(errors), intent(inout), optional, target :: err
    +
    3170 end subroutine
    +
    3171
    +
    3172 module subroutine cmtx_mult_mtx(opa, opb, alpha, a, b, beta, c, err)
    +
    3173 integer(int32), intent(in) :: opa, opb
    +
    3174 complex(real64), intent(in) :: alpha, beta
    +
    3175 complex(real64), intent(in), dimension(:,:) :: a, b
    +
    3176 complex(real64), intent(inout), dimension(:,:) :: c
    3177 class(errors), intent(inout), optional, target :: err
    3178 end subroutine
    -
    3179
    -
    3180 module subroutine form_lu_all_cmplx(lu, ipvt, u, p, err)
    -
    3181 complex(real64), intent(inout), dimension(:,:) :: lu
    -
    3182 integer(int32), intent(in), dimension(:) :: ipvt
    -
    3183 complex(real64), intent(out), dimension(:,:) :: u
    -
    3184 real(real64), intent(out), dimension(:,:) :: p
    -
    3185 class(errors), intent(inout), optional, target :: err
    -
    3186 end subroutine
    -
    3187
    -
    3188 module subroutine form_lu_only(lu, u, err)
    -
    3189 real(real64), intent(inout), dimension(:,:) :: lu
    -
    3190 real(real64), intent(out), dimension(:,:) :: u
    -
    3191 class(errors), intent(inout), optional, target :: err
    -
    3192 end subroutine
    -
    3193
    -
    3194 module subroutine form_lu_only_cmplx(lu, u, err)
    -
    3195 complex(real64), intent(inout), dimension(:,:) :: lu
    -
    3196 complex(real64), intent(out), dimension(:,:) :: u
    -
    3197 class(errors), intent(inout), optional, target :: err
    -
    3198 end subroutine
    -
    3199
    -
    3200 module subroutine qr_factor_no_pivot(a, tau, work, olwork, err)
    -
    3201 real(real64), intent(inout), dimension(:,:) :: a
    -
    3202 real(real64), intent(out), dimension(:) :: tau
    -
    3203 real(real64), intent(out), target, dimension(:), optional :: work
    -
    3204 integer(int32), intent(out), optional :: olwork
    -
    3205 class(errors), intent(inout), optional, target :: err
    -
    3206 end subroutine
    -
    3207
    -
    3208 module subroutine qr_factor_no_pivot_cmplx(a, tau, work, olwork, err)
    -
    3209 complex(real64), intent(inout), dimension(:,:) :: a
    -
    3210 complex(real64), intent(out), dimension(:) :: tau
    -
    3211 complex(real64), intent(out), target, dimension(:), optional :: work
    -
    3212 integer(int32), intent(out), optional :: olwork
    -
    3213 class(errors), intent(inout), optional, target :: err
    -
    3214 end subroutine
    -
    3215
    -
    3216 module subroutine qr_factor_pivot(a, tau, jpvt, work, olwork, err)
    -
    3217 real(real64), intent(inout), dimension(:,:) :: a
    -
    3218 real(real64), intent(out), dimension(:) :: tau
    -
    3219 integer(int32), intent(inout), dimension(:) :: jpvt
    -
    3220 real(real64), intent(out), target, dimension(:), optional :: work
    -
    3221 integer(int32), intent(out), optional :: olwork
    -
    3222 class(errors), intent(inout), optional, target :: err
    -
    3223 end subroutine
    -
    3224
    -
    3225 module subroutine qr_factor_pivot_cmplx(a, tau, jpvt, work, olwork, rwork, &
    -
    3226 err)
    -
    3227 complex(real64), intent(inout), dimension(:,:) :: a
    -
    3228 complex(real64), intent(out), dimension(:) :: tau
    -
    3229 integer(int32), intent(inout), dimension(:) :: jpvt
    -
    3230 complex(real64), intent(out), target, dimension(:), optional :: work
    -
    3231 integer(int32), intent(out), optional :: olwork
    -
    3232 real(real64), intent(out), target, dimension(:), optional :: rwork
    -
    3233 class(errors), intent(inout), optional, target :: err
    -
    3234 end subroutine
    -
    3235
    -
    3236 module subroutine form_qr_no_pivot(r, tau, q, work, olwork, err)
    -
    3237 real(real64), intent(inout), dimension(:,:) :: r
    -
    3238 real(real64), intent(in), dimension(:) :: tau
    -
    3239 real(real64), intent(out), dimension(:,:) :: q
    -
    3240 real(real64), intent(out), target, dimension(:), optional :: work
    -
    3241 integer(int32), intent(out), optional :: olwork
    -
    3242 class(errors), intent(inout), optional, target :: err
    -
    3243 end subroutine
    -
    3244
    -
    3245 module subroutine form_qr_no_pivot_cmplx(r, tau, q, work, olwork, err)
    -
    3246 complex(real64), intent(inout), dimension(:,:) :: r
    -
    3247 complex(real64), intent(in), dimension(:) :: tau
    -
    3248 complex(real64), intent(out), dimension(:,:) :: q
    -
    3249 complex(real64), intent(out), target, dimension(:), optional :: work
    -
    3250 integer(int32), intent(out), optional :: olwork
    -
    3251 class(errors), intent(inout), optional, target :: err
    -
    3252 end subroutine
    -
    3253
    -
    3254 module subroutine form_qr_pivot(r, tau, pvt, q, p, work, olwork, err)
    -
    3255 real(real64), intent(inout), dimension(:,:) :: r
    -
    3256 real(real64), intent(in), dimension(:) :: tau
    -
    3257 integer(int32), intent(in), dimension(:) :: pvt
    -
    3258 real(real64), intent(out), dimension(:,:) :: q, p
    -
    3259 real(real64), intent(out), target, dimension(:), optional :: work
    -
    3260 integer(int32), intent(out), optional :: olwork
    -
    3261 class(errors), intent(inout), optional, target :: err
    -
    3262 end subroutine
    -
    3263
    -
    3264 module subroutine form_qr_pivot_cmplx(r, tau, pvt, q, p, work, olwork, err)
    -
    3265 complex(real64), intent(inout), dimension(:,:) :: r
    -
    3266 complex(real64), intent(in), dimension(:) :: tau
    -
    3267 integer(int32), intent(in), dimension(:) :: pvt
    -
    3268 complex(real64), intent(out), dimension(:,:) :: q, p
    -
    3269 complex(real64), intent(out), target, dimension(:), optional :: work
    -
    3270 integer(int32), intent(out), optional :: olwork
    -
    3271 class(errors), intent(inout), optional, target :: err
    -
    3272 end subroutine
    -
    3273
    -
    3274 module subroutine mult_qr_mtx(lside, trans, a, tau, c, work, olwork, err)
    -
    3275 logical, intent(in) :: lside, trans
    -
    3276 real(real64), intent(in), dimension(:) :: tau
    -
    3277 real(real64), intent(inout), dimension(:,:) :: a, c
    -
    3278 real(real64), intent(out), target, dimension(:), optional :: work
    -
    3279 integer(int32), intent(out), optional :: olwork
    -
    3280 class(errors), intent(inout), optional, target :: err
    -
    3281 end subroutine
    -
    3282
    -
    3283 module subroutine mult_qr_mtx_cmplx(lside, trans, a, tau, c, work, olwork, err)
    -
    3284 logical, intent(in) :: lside, trans
    -
    3285 complex(real64), intent(in), dimension(:) :: tau
    -
    3286 complex(real64), intent(inout), dimension(:,:) :: a, c
    -
    3287 complex(real64), intent(out), target, dimension(:), optional :: work
    -
    3288 integer(int32), intent(out), optional :: olwork
    -
    3289 class(errors), intent(inout), optional, target :: err
    -
    3290 end subroutine
    -
    3291
    -
    3292 module subroutine mult_qr_vec(trans, a, tau, c, work, olwork, err)
    -
    3293 logical, intent(in) :: trans
    -
    3294 real(real64), intent(inout), dimension(:,:) :: a
    -
    3295 real(real64), intent(in), dimension(:) :: tau
    -
    3296 real(real64), intent(inout), dimension(:) :: c
    -
    3297 real(real64), intent(out), target, dimension(:), optional :: work
    +
    3179
    +
    3180 module subroutine cmtx_mult_vec(opa, alpha, a, b, beta, c, err)
    +
    3181 integer(int32), intent(in) :: opa
    +
    3182 complex(real64), intent(in) :: alpha, beta
    +
    3183 complex(real64), intent(in), dimension(:,:) :: a
    +
    3184 complex(real64), intent(in), dimension(:) :: b
    +
    3185 complex(real64), intent(inout), dimension(:) :: c
    +
    3186 class(errors), intent(inout), optional, target :: err
    +
    3187 end subroutine
    +
    3188
    +
    3189 module subroutine rank1_update_dbl(alpha, x, y, a, err)
    +
    3190 real(real64), intent(in) :: alpha
    +
    3191 real(real64), intent(in), dimension(:) :: x, y
    +
    3192 real(real64), intent(inout), dimension(:,:) :: a
    +
    3193 class(errors), intent(inout), optional, target :: err
    +
    3194 end subroutine
    +
    3195
    +
    3196 module subroutine rank1_update_cmplx(alpha, x, y, a, err)
    +
    3197 complex(real64), intent(in) :: alpha
    +
    3198 complex(real64), intent(in), dimension(:) :: x, y
    +
    3199 complex(real64), intent(inout), dimension(:,:) :: a
    +
    3200 class(errors), intent(inout), optional, target :: err
    +
    3201 end subroutine
    +
    3202
    +
    3203 module subroutine diag_mtx_mult_mtx(lside, trans, alpha, a, b, beta, c, err)
    +
    3204 logical, intent(in) :: lside, trans
    +
    3205 real(real64) :: alpha, beta
    +
    3206 real(real64), intent(in), dimension(:) :: a
    +
    3207 real(real64), intent(in), dimension(:,:) :: b
    +
    3208 real(real64), intent(inout), dimension(:,:) :: c
    +
    3209 class(errors), intent(inout), optional, target :: err
    +
    3210 end subroutine
    +
    3211
    +
    3212 module subroutine diag_mtx_mult_mtx2(lside, alpha, a, b, err)
    +
    3213 logical, intent(in) :: lside
    +
    3214 real(real64), intent(in) :: alpha
    +
    3215 real(real64), intent(in), dimension(:) :: a
    +
    3216 real(real64), intent(inout), dimension(:,:) :: b
    +
    3217 class(errors), intent(inout), optional, target :: err
    +
    3218 end subroutine
    +
    3219
    +
    3220 module subroutine diag_mtx_mult_mtx3(lside, trans, alpha, a, b, beta, c, err)
    +
    3221 logical, intent(in) :: lside, trans
    +
    3222 real(real64) :: alpha, beta
    +
    3223 complex(real64), intent(in), dimension(:) :: a
    +
    3224 real(real64), intent(in), dimension(:,:) :: b
    +
    3225 complex(real64), intent(inout), dimension(:,:) :: c
    +
    3226 class(errors), intent(inout), optional, target :: err
    +
    3227 end subroutine
    +
    3228
    +
    3229 module subroutine diag_mtx_mult_mtx4(lside, opb, alpha, a, b, beta, c, err)
    +
    3230 logical, intent(in) :: lside
    +
    3231 integer(int32), intent(in) :: opb
    +
    3232 real(real64) :: alpha, beta
    +
    3233 complex(real64), intent(in), dimension(:) :: a
    +
    3234 complex(real64), intent(in), dimension(:,:) :: b
    +
    3235 complex(real64), intent(inout), dimension(:,:) :: c
    +
    3236 class(errors), intent(inout), optional, target :: err
    +
    3237 end subroutine
    +
    3238
    +
    3239 module subroutine diag_mtx_mult_mtx_cmplx(lside, opb, alpha, a, b, beta, c, err)
    +
    3240 logical, intent(in) :: lside
    +
    3241 integer(int32), intent(in) :: opb
    +
    3242 complex(real64) :: alpha, beta
    +
    3243 complex(real64), intent(in), dimension(:) :: a
    +
    3244 complex(real64), intent(in), dimension(:,:) :: b
    +
    3245 complex(real64), intent(inout), dimension(:,:) :: c
    +
    3246 class(errors), intent(inout), optional, target :: err
    +
    3247 end subroutine
    +
    3248
    +
    3249 module subroutine diag_mtx_mult_mtx2_cmplx(lside, alpha, a, b, err)
    +
    3250 logical, intent(in) :: lside
    +
    3251 complex(real64), intent(in) :: alpha
    +
    3252 complex(real64), intent(in), dimension(:) :: a
    +
    3253 complex(real64), intent(inout), dimension(:,:) :: b
    +
    3254 class(errors), intent(inout), optional, target :: err
    +
    3255 end subroutine
    +
    3256
    +
    3257 module subroutine diag_mtx_mult_mtx_mix(lside, opb, alpha, a, b, beta, c, err)
    +
    3258 logical, intent(in) :: lside
    +
    3259 integer(int32), intent(in) :: opb
    +
    3260 complex(real64) :: alpha, beta
    +
    3261 real(real64), intent(in), dimension(:) :: a
    +
    3262 complex(real64), intent(in), dimension(:,:) :: b
    +
    3263 complex(real64), intent(inout), dimension(:,:) :: c
    +
    3264 class(errors), intent(inout), optional, target :: err
    +
    3265 end subroutine
    +
    3266
    +
    3267 module subroutine diag_mtx_mult_mtx2_mix(lside, alpha, a, b, err)
    +
    3268 logical, intent(in) :: lside
    +
    3269 complex(real64), intent(in) :: alpha
    +
    3270 real(real64), intent(in), dimension(:) :: a
    +
    3271 complex(real64), intent(inout), dimension(:,:) :: b
    +
    3272 class(errors), intent(inout), optional, target :: err
    +
    3273 end subroutine
    +
    3274
    +
    3275 pure module function trace_dbl(x) result(y)
    +
    3276 real(real64), intent(in), dimension(:,:) :: x
    +
    3277 real(real64) :: y
    +
    3278 end function
    +
    3279
    +
    3280 pure module function trace_cmplx(x) result(y)
    +
    3281 complex(real64), intent(in), dimension(:,:) :: x
    +
    3282 complex(real64) :: y
    +
    3283 end function
    +
    3284
    +
    3285 module function mtx_rank_dbl(a, tol, work, olwork, err) result(rnk)
    +
    3286 real(real64), intent(inout), dimension(:,:) :: a
    +
    3287 real(real64), intent(in), optional :: tol
    +
    3288 real(real64), intent(out), target, optional, dimension(:) :: work
    +
    3289 integer(int32), intent(out), optional :: olwork
    +
    3290 class(errors), intent(inout), optional, target :: err
    +
    3291 integer(int32) :: rnk
    +
    3292 end function
    +
    3293
    +
    3294 module function mtx_rank_cmplx(a, tol, work, olwork, rwork, err) result(rnk)
    +
    3295 complex(real64), intent(inout), dimension(:,:) :: a
    +
    3296 real(real64), intent(in), optional :: tol
    +
    3297 complex(real64), intent(out), target, optional, dimension(:) :: work
    3298 integer(int32), intent(out), optional :: olwork
    -
    3299 class(errors), intent(inout), optional, target :: err
    -
    3300 end subroutine
    -
    3301
    -
    3302 module subroutine mult_qr_vec_cmplx(trans, a, tau, c, work, olwork, err)
    -
    3303 logical, intent(in) :: trans
    -
    3304 complex(real64), intent(inout), dimension(:,:) :: a
    -
    3305 complex(real64), intent(in), dimension(:) :: tau
    -
    3306 complex(real64), intent(inout), dimension(:) :: c
    -
    3307 complex(real64), intent(out), target, dimension(:), optional :: work
    -
    3308 integer(int32), intent(out), optional :: olwork
    -
    3309 class(errors), intent(inout), optional, target :: err
    -
    3310 end subroutine
    -
    3311
    -
    3312 module subroutine qr_rank1_update_dbl(q, r, u, v, work, err)
    -
    3313 real(real64), intent(inout), dimension(:,:) :: q, r
    -
    3314 real(real64), intent(inout), dimension(:) :: u, v
    -
    3315 real(real64), intent(out), target, optional, dimension(:) :: work
    -
    3316 class(errors), intent(inout), optional, target :: err
    -
    3317 end subroutine
    -
    3318
    -
    3319 module subroutine qr_rank1_update_cmplx(q, r, u, v, work, rwork, err)
    -
    3320 complex(real64), intent(inout), dimension(:,:) :: q, r
    -
    3321 complex(real64), intent(inout), dimension(:) :: u, v
    -
    3322 complex(real64), intent(out), target, optional, dimension(:) :: work
    -
    3323 real(real64), intent(out), target, optional, dimension(:) :: rwork
    -
    3324 class(errors), intent(inout), optional, target :: err
    -
    3325 end subroutine
    -
    3326
    -
    3327 module subroutine cholesky_factor_dbl(a, upper, err)
    -
    3328 real(real64), intent(inout), dimension(:,:) :: a
    -
    3329 logical, intent(in), optional :: upper
    -
    3330 class(errors), intent(inout), optional, target :: err
    +
    3299 real(real64), intent(out), target, optional, dimension(:) :: rwork
    +
    3300 class(errors), intent(inout), optional, target :: err
    +
    3301 integer(int32) :: rnk
    +
    3302 end function
    +
    3303
    +
    3304 module function det_dbl(a, iwork, err) result(x)
    +
    3305 real(real64), intent(inout), dimension(:,:) :: a
    +
    3306 integer(int32), intent(out), target, optional, dimension(:) :: iwork
    +
    3307 class(errors), intent(inout), optional, target :: err
    +
    3308 real(real64) :: x
    +
    3309 end function
    +
    3310
    +
    3311 module function det_cmplx(a, iwork, err) result(x)
    +
    3312 complex(real64), intent(inout), dimension(:,:) :: a
    +
    3313 integer(int32), intent(out), target, optional, dimension(:) :: iwork
    +
    3314 class(errors), intent(inout), optional, target :: err
    +
    3315 complex(real64) :: x
    +
    3316 end function
    +
    3317
    +
    3318 module subroutine swap_dbl(x, y, err)
    +
    3319 real(real64), intent(inout), dimension(:) :: x, y
    +
    3320 class(errors), intent(inout), optional, target :: err
    +
    3321 end subroutine
    +
    3322
    +
    3323 module subroutine swap_cmplx(x, y, err)
    +
    3324 complex(real64), intent(inout), dimension(:) :: x, y
    +
    3325 class(errors), intent(inout), optional, target :: err
    +
    3326 end subroutine
    +
    3327
    +
    3328 module subroutine recip_mult_array_dbl(a, x)
    +
    3329 real(real64), intent(in) :: a
    +
    3330 real(real64), intent(inout), dimension(:) :: x
    3331 end subroutine
    3332
    -
    3333 module subroutine cholesky_factor_cmplx(a, upper, err)
    -
    3334 complex(real64), intent(inout), dimension(:,:) :: a
    -
    3335 logical, intent(in), optional :: upper
    -
    3336 class(errors), intent(inout), optional, target :: err
    -
    3337 end subroutine
    -
    3338
    -
    3339 module subroutine cholesky_rank1_update_dbl(r, u, work, err)
    -
    3340 real(real64), intent(inout), dimension(:,:) :: r
    -
    3341 real(real64), intent(inout), dimension(:) :: u
    -
    3342 real(real64), intent(out), target, optional, dimension(:) :: work
    -
    3343 class(errors), intent(inout), optional, target :: err
    -
    3344 end subroutine
    -
    3345
    -
    3346 module subroutine cholesky_rank1_update_cmplx(r, u, work, err)
    -
    3347 complex(real64), intent(inout), dimension(:,:) :: r
    -
    3348 complex(real64), intent(inout), dimension(:) :: u
    -
    3349 real(real64), intent(out), target, optional, dimension(:) :: work
    -
    3350 class(errors), intent(inout), optional, target :: err
    -
    3351 end subroutine
    -
    3352
    -
    3353 module subroutine cholesky_rank1_downdate_dbl(r, u, work, err)
    -
    3354 real(real64), intent(inout), dimension(:,:) :: r
    -
    3355 real(real64), intent(inout), dimension(:) :: u
    -
    3356 real(real64), intent(out), target, optional, dimension(:) :: work
    -
    3357 class(errors), intent(inout), optional, target :: err
    -
    3358 end subroutine
    -
    3359
    -
    3360 module subroutine cholesky_rank1_downdate_cmplx(r, u, work, err)
    -
    3361 complex(real64), intent(inout), dimension(:,:) :: r
    -
    3362 complex(real64), intent(inout), dimension(:) :: u
    -
    3363 real(real64), intent(out), target, optional, dimension(:) :: work
    +
    3333 module subroutine tri_mtx_mult_dbl(upper, alpha, a, beta, b, err)
    +
    3334 logical, intent(in) :: upper
    +
    3335 real(real64), intent(in) :: alpha, beta
    +
    3336 real(real64), intent(in), dimension(:,:) :: a
    +
    3337 real(real64), intent(inout), dimension(:,:) :: b
    +
    3338 class(errors), intent(inout), optional, target :: err
    +
    3339 end subroutine
    +
    3340
    +
    3341 module subroutine tri_mtx_mult_cmplx(upper, alpha, a, beta, b, err)
    +
    3342 logical, intent(in) :: upper
    +
    3343 complex(real64), intent(in) :: alpha, beta
    +
    3344 complex(real64), intent(in), dimension(:,:) :: a
    +
    3345 complex(real64), intent(inout), dimension(:,:) :: b
    +
    3346 class(errors), intent(inout), optional, target :: err
    +
    3347 end subroutine
    +
    3348
    +
    3349end interface
    +
    3350
    +
    3351! ******************************************************************************
    +
    3352! LINALG_FACTOR.F90
    +
    3353! ------------------------------------------------------------------------------
    +
    3354interface
    +
    3355 module subroutine lu_factor_dbl(a, ipvt, err)
    +
    3356 real(real64), intent(inout), dimension(:,:) :: a
    +
    3357 integer(int32), intent(out), dimension(:) :: ipvt
    +
    3358 class(errors), intent(inout), optional, target :: err
    +
    3359 end subroutine
    +
    3360
    +
    3361 module subroutine lu_factor_cmplx(a, ipvt, err)
    +
    3362 complex(real64), intent(inout), dimension(:,:) :: a
    +
    3363 integer(int32), intent(out), dimension(:) :: ipvt
    3364 class(errors), intent(inout), optional, target :: err
    3365 end subroutine
    -
    3366
    -
    3367 module subroutine rz_factor_dbl(a, tau, work, olwork, err)
    -
    3368 real(real64), intent(inout), dimension(:,:) :: a
    -
    3369 real(real64), intent(out), dimension(:) :: tau
    -
    3370 real(real64), intent(out), target, optional, dimension(:) :: work
    -
    3371 integer(int32), intent(out), optional :: olwork
    -
    3372 class(errors), intent(inout), optional, target :: err
    -
    3373 end subroutine
    -
    3374
    -
    3375 module subroutine rz_factor_cmplx(a, tau, work, olwork, err)
    -
    3376 complex(real64), intent(inout), dimension(:,:) :: a
    -
    3377 complex(real64), intent(out), dimension(:) :: tau
    -
    3378 complex(real64), intent(out), target, optional, dimension(:) :: work
    -
    3379 integer(int32), intent(out), optional :: olwork
    -
    3380 class(errors), intent(inout), optional, target :: err
    -
    3381 end subroutine
    -
    3382
    -
    3383 module subroutine mult_rz_mtx(lside, trans, l, a, tau, c, work, olwork, err)
    -
    3384 logical, intent(in) :: lside, trans
    -
    3385 integer(int32), intent(in) :: l
    -
    3386 real(real64), intent(inout), dimension(:,:) :: a, c
    -
    3387 real(real64), intent(in), dimension(:) :: tau
    -
    3388 real(real64), intent(out), target, optional, dimension(:) :: work
    -
    3389 integer(int32), intent(out), optional :: olwork
    -
    3390 class(errors), intent(inout), optional, target :: err
    -
    3391 end subroutine
    -
    3392
    -
    3393 module subroutine mult_rz_mtx_cmplx(lside, trans, l, a, tau, c, work, olwork, err)
    -
    3394 logical, intent(in) :: lside, trans
    -
    3395 integer(int32), intent(in) :: l
    -
    3396 complex(real64), intent(inout), dimension(:,:) :: a, c
    -
    3397 complex(real64), intent(in), dimension(:) :: tau
    -
    3398 complex(real64), intent(out), target, optional, dimension(:) :: work
    -
    3399 integer(int32), intent(out), optional :: olwork
    -
    3400 class(errors), intent(inout), optional, target :: err
    -
    3401 end subroutine
    -
    3402
    -
    3403 module subroutine mult_rz_vec(trans, l, a, tau, c, work, olwork, err)
    -
    3404 logical, intent(in) :: trans
    -
    3405 integer(int32), intent(in) :: l
    -
    3406 real(real64), intent(inout), dimension(:,:) :: a
    -
    3407 real(real64), intent(in), dimension(:) :: tau
    -
    3408 real(real64), intent(inout), dimension(:) :: c
    -
    3409 real(real64), intent(out), target, optional, dimension(:) :: work
    -
    3410 integer(int32), intent(out), optional :: olwork
    -
    3411 class(errors), intent(inout), optional, target :: err
    -
    3412 end subroutine
    -
    3413
    -
    3414 module subroutine mult_rz_vec_cmplx(trans, l, a, tau, c, work, olwork, err)
    -
    3415 logical, intent(in) :: trans
    -
    3416 integer(int32), intent(in) :: l
    -
    3417 complex(real64), intent(inout), dimension(:,:) :: a
    -
    3418 complex(real64), intent(in), dimension(:) :: tau
    -
    3419 complex(real64), intent(inout), dimension(:) :: c
    -
    3420 complex(real64), intent(out), target, optional, dimension(:) :: work
    -
    3421 integer(int32), intent(out), optional :: olwork
    -
    3422 class(errors), intent(inout), optional, target :: err
    -
    3423 end subroutine
    -
    3424
    -
    3425 module subroutine svd_dbl(a, s, u, vt, work, olwork, err)
    -
    3426 real(real64), intent(inout), dimension(:,:) :: a
    -
    3427 real(real64), intent(out), dimension(:) :: s
    -
    3428 real(real64), intent(out), optional, dimension(:,:) :: u, vt
    -
    3429 real(real64), intent(out), target, optional, dimension(:) :: work
    -
    3430 integer(int32), intent(out), optional :: olwork
    -
    3431 class(errors), intent(inout), optional, target :: err
    -
    3432 end subroutine
    -
    3433
    -
    3434 module subroutine svd_cmplx(a, s, u, vt, work, olwork, rwork, err)
    -
    3435 complex(real64), intent(inout), dimension(:,:) :: a
    -
    3436 real(real64), intent(out), dimension(:) :: s
    -
    3437 complex(real64), intent(out), optional, dimension(:,:) :: u, vt
    -
    3438 complex(real64), intent(out), target, optional, dimension(:) :: work
    -
    3439 integer(int32), intent(out), optional :: olwork
    -
    3440 real(real64), intent(out), target, optional, dimension(:) :: rwork
    -
    3441 class(errors), intent(inout), optional, target :: err
    -
    3442 end subroutine
    -
    3443end interface
    -
    3444
    -
    3445! ******************************************************************************
    -
    3446! LINALG_SOLVE.F90
    -
    3447! ------------------------------------------------------------------------------
    -
    3448interface
    -
    3449 module subroutine solve_tri_mtx(lside, upper, trans, nounit, alpha, a, b, err)
    -
    3450 logical, intent(in) :: lside, upper, trans, nounit
    -
    3451 real(real64), intent(in) :: alpha
    -
    3452 real(real64), intent(in), dimension(:,:) :: a
    -
    3453 real(real64), intent(inout), dimension(:,:) :: b
    -
    3454 class(errors), intent(inout), optional, target :: err
    -
    3455 end subroutine
    -
    3456
    -
    3457 module subroutine solve_tri_mtx_cmplx(lside, upper, trans, nounit, alpha, a, b, err)
    -
    3458 logical, intent(in) :: lside, upper, trans, nounit
    -
    3459 complex(real64), intent(in) :: alpha
    -
    3460 complex(real64), intent(in), dimension(:,:) :: a
    -
    3461 complex(real64), intent(inout), dimension(:,:) :: b
    -
    3462 class(errors), intent(inout), optional, target :: err
    -
    3463 end subroutine
    -
    3464
    -
    3465 module subroutine solve_tri_vec(upper, trans, nounit, a, x, err)
    -
    3466 logical, intent(in) :: upper, trans, nounit
    -
    3467 real(real64), intent(in), dimension(:,:) :: a
    -
    3468 real(real64), intent(inout), dimension(:) :: x
    -
    3469 class(errors), intent(inout), optional, target :: err
    -
    3470 end subroutine
    -
    3471
    -
    3472 module subroutine solve_tri_vec_cmplx(upper, trans, nounit, a, x, err)
    -
    3473 logical, intent(in) :: upper, trans, nounit
    -
    3474 complex(real64), intent(in), dimension(:,:) :: a
    -
    3475 complex(real64), intent(inout), dimension(:) :: x
    -
    3476 class(errors), intent(inout), optional, target :: err
    -
    3477 end subroutine
    -
    3478
    -
    3479 module subroutine solve_lu_mtx(a, ipvt, b, err)
    -
    3480 real(real64), intent(in), dimension(:,:) :: a
    -
    3481 integer(int32), intent(in), dimension(:) :: ipvt
    -
    3482 real(real64), intent(inout), dimension(:,:) :: b
    +
    3366
    +
    3367 module subroutine form_lu_all(lu, ipvt, u, p, err)
    +
    3368 real(real64), intent(inout), dimension(:,:) :: lu
    +
    3369 integer(int32), intent(in), dimension(:) :: ipvt
    +
    3370 real(real64), intent(out), dimension(:,:) :: u, p
    +
    3371 class(errors), intent(inout), optional, target :: err
    +
    3372 end subroutine
    +
    3373
    +
    3374 module subroutine form_lu_all_cmplx(lu, ipvt, u, p, err)
    +
    3375 complex(real64), intent(inout), dimension(:,:) :: lu
    +
    3376 integer(int32), intent(in), dimension(:) :: ipvt
    +
    3377 complex(real64), intent(out), dimension(:,:) :: u
    +
    3378 real(real64), intent(out), dimension(:,:) :: p
    +
    3379 class(errors), intent(inout), optional, target :: err
    +
    3380 end subroutine
    +
    3381
    +
    3382 module subroutine form_lu_only(lu, u, err)
    +
    3383 real(real64), intent(inout), dimension(:,:) :: lu
    +
    3384 real(real64), intent(out), dimension(:,:) :: u
    +
    3385 class(errors), intent(inout), optional, target :: err
    +
    3386 end subroutine
    +
    3387
    +
    3388 module subroutine form_lu_only_cmplx(lu, u, err)
    +
    3389 complex(real64), intent(inout), dimension(:,:) :: lu
    +
    3390 complex(real64), intent(out), dimension(:,:) :: u
    +
    3391 class(errors), intent(inout), optional, target :: err
    +
    3392 end subroutine
    +
    3393
    +
    3394 module subroutine qr_factor_no_pivot(a, tau, work, olwork, err)
    +
    3395 real(real64), intent(inout), dimension(:,:) :: a
    +
    3396 real(real64), intent(out), dimension(:) :: tau
    +
    3397 real(real64), intent(out), target, dimension(:), optional :: work
    +
    3398 integer(int32), intent(out), optional :: olwork
    +
    3399 class(errors), intent(inout), optional, target :: err
    +
    3400 end subroutine
    +
    3401
    +
    3402 module subroutine qr_factor_no_pivot_cmplx(a, tau, work, olwork, err)
    +
    3403 complex(real64), intent(inout), dimension(:,:) :: a
    +
    3404 complex(real64), intent(out), dimension(:) :: tau
    +
    3405 complex(real64), intent(out), target, dimension(:), optional :: work
    +
    3406 integer(int32), intent(out), optional :: olwork
    +
    3407 class(errors), intent(inout), optional, target :: err
    +
    3408 end subroutine
    +
    3409
    +
    3410 module subroutine qr_factor_pivot(a, tau, jpvt, work, olwork, err)
    +
    3411 real(real64), intent(inout), dimension(:,:) :: a
    +
    3412 real(real64), intent(out), dimension(:) :: tau
    +
    3413 integer(int32), intent(inout), dimension(:) :: jpvt
    +
    3414 real(real64), intent(out), target, dimension(:), optional :: work
    +
    3415 integer(int32), intent(out), optional :: olwork
    +
    3416 class(errors), intent(inout), optional, target :: err
    +
    3417 end subroutine
    +
    3418
    +
    3419 module subroutine qr_factor_pivot_cmplx(a, tau, jpvt, work, olwork, rwork, &
    +
    3420 err)
    +
    3421 complex(real64), intent(inout), dimension(:,:) :: a
    +
    3422 complex(real64), intent(out), dimension(:) :: tau
    +
    3423 integer(int32), intent(inout), dimension(:) :: jpvt
    +
    3424 complex(real64), intent(out), target, dimension(:), optional :: work
    +
    3425 integer(int32), intent(out), optional :: olwork
    +
    3426 real(real64), intent(out), target, dimension(:), optional :: rwork
    +
    3427 class(errors), intent(inout), optional, target :: err
    +
    3428 end subroutine
    +
    3429
    +
    3430 module subroutine form_qr_no_pivot(r, tau, q, work, olwork, err)
    +
    3431 real(real64), intent(inout), dimension(:,:) :: r
    +
    3432 real(real64), intent(in), dimension(:) :: tau
    +
    3433 real(real64), intent(out), dimension(:,:) :: q
    +
    3434 real(real64), intent(out), target, dimension(:), optional :: work
    +
    3435 integer(int32), intent(out), optional :: olwork
    +
    3436 class(errors), intent(inout), optional, target :: err
    +
    3437 end subroutine
    +
    3438
    +
    3439 module subroutine form_qr_no_pivot_cmplx(r, tau, q, work, olwork, err)
    +
    3440 complex(real64), intent(inout), dimension(:,:) :: r
    +
    3441 complex(real64), intent(in), dimension(:) :: tau
    +
    3442 complex(real64), intent(out), dimension(:,:) :: q
    +
    3443 complex(real64), intent(out), target, dimension(:), optional :: work
    +
    3444 integer(int32), intent(out), optional :: olwork
    +
    3445 class(errors), intent(inout), optional, target :: err
    +
    3446 end subroutine
    +
    3447
    +
    3448 module subroutine form_qr_pivot(r, tau, pvt, q, p, work, olwork, err)
    +
    3449 real(real64), intent(inout), dimension(:,:) :: r
    +
    3450 real(real64), intent(in), dimension(:) :: tau
    +
    3451 integer(int32), intent(in), dimension(:) :: pvt
    +
    3452 real(real64), intent(out), dimension(:,:) :: q, p
    +
    3453 real(real64), intent(out), target, dimension(:), optional :: work
    +
    3454 integer(int32), intent(out), optional :: olwork
    +
    3455 class(errors), intent(inout), optional, target :: err
    +
    3456 end subroutine
    +
    3457
    +
    3458 module subroutine form_qr_pivot_cmplx(r, tau, pvt, q, p, work, olwork, err)
    +
    3459 complex(real64), intent(inout), dimension(:,:) :: r
    +
    3460 complex(real64), intent(in), dimension(:) :: tau
    +
    3461 integer(int32), intent(in), dimension(:) :: pvt
    +
    3462 complex(real64), intent(out), dimension(:,:) :: q, p
    +
    3463 complex(real64), intent(out), target, dimension(:), optional :: work
    +
    3464 integer(int32), intent(out), optional :: olwork
    +
    3465 class(errors), intent(inout), optional, target :: err
    +
    3466 end subroutine
    +
    3467
    +
    3468 module subroutine mult_qr_mtx(lside, trans, a, tau, c, work, olwork, err)
    +
    3469 logical, intent(in) :: lside, trans
    +
    3470 real(real64), intent(in), dimension(:) :: tau
    +
    3471 real(real64), intent(inout), dimension(:,:) :: a, c
    +
    3472 real(real64), intent(out), target, dimension(:), optional :: work
    +
    3473 integer(int32), intent(out), optional :: olwork
    +
    3474 class(errors), intent(inout), optional, target :: err
    +
    3475 end subroutine
    +
    3476
    +
    3477 module subroutine mult_qr_mtx_cmplx(lside, trans, a, tau, c, work, olwork, err)
    +
    3478 logical, intent(in) :: lside, trans
    +
    3479 complex(real64), intent(in), dimension(:) :: tau
    +
    3480 complex(real64), intent(inout), dimension(:,:) :: a, c
    +
    3481 complex(real64), intent(out), target, dimension(:), optional :: work
    +
    3482 integer(int32), intent(out), optional :: olwork
    3483 class(errors), intent(inout), optional, target :: err
    3484 end subroutine
    -
    3485
    -
    3486 module subroutine solve_lu_mtx_cmplx(a, ipvt, b, err)
    -
    3487 complex(real64), intent(in), dimension(:,:) :: a
    -
    3488 integer(int32), intent(in), dimension(:) :: ipvt
    -
    3489 complex(real64), intent(inout), dimension(:,:) :: b
    -
    3490 class(errors), intent(inout), optional, target :: err
    -
    3491 end subroutine
    -
    3492
    -
    3493 module subroutine solve_lu_vec(a, ipvt, b, err)
    -
    3494 real(real64), intent(in), dimension(:,:) :: a
    -
    3495 integer(int32), intent(in), dimension(:) :: ipvt
    -
    3496 real(real64), intent(inout), dimension(:) :: b
    -
    3497 class(errors), intent(inout), optional, target :: err
    -
    3498 end subroutine
    -
    3499
    -
    3500 module subroutine solve_lu_vec_cmplx(a, ipvt, b, err)
    -
    3501 complex(real64), intent(in), dimension(:,:) :: a
    -
    3502 integer(int32), intent(in), dimension(:) :: ipvt
    -
    3503 complex(real64), intent(inout), dimension(:) :: b
    -
    3504 class(errors), intent(inout), optional, target :: err
    -
    3505 end subroutine
    -
    3506
    -
    3507 module subroutine solve_qr_no_pivot_mtx(a, tau, b, work, olwork, err)
    -
    3508 real(real64), intent(inout), dimension(:,:) :: a, b
    -
    3509 real(real64), intent(in), dimension(:) :: tau
    -
    3510 real(real64), intent(out), target, optional, dimension(:) :: work
    -
    3511 integer(int32), intent(out), optional :: olwork
    -
    3512 class(errors), intent(inout), optional, target :: err
    -
    3513 end subroutine
    -
    3514
    -
    3515 module subroutine solve_qr_no_pivot_mtx_cmplx(a, tau, b, work, olwork, err)
    -
    3516 complex(real64), intent(inout), dimension(:,:) :: a, b
    -
    3517 complex(real64), intent(in), dimension(:) :: tau
    -
    3518 complex(real64), intent(out), target, optional, dimension(:) :: work
    -
    3519 integer(int32), intent(out), optional :: olwork
    -
    3520 class(errors), intent(inout), optional, target :: err
    -
    3521 end subroutine
    -
    3522
    -
    3523 module subroutine solve_qr_no_pivot_vec(a, tau, b, work, olwork, err)
    -
    3524 real(real64), intent(inout), dimension(:,:) :: a
    -
    3525 real(real64), intent(in), dimension(:) :: tau
    -
    3526 real(real64), intent(inout), dimension(:) :: b
    -
    3527 real(real64), intent(out), target, optional, dimension(:) :: work
    -
    3528 integer(int32), intent(out), optional :: olwork
    -
    3529 class(errors), intent(inout), optional, target :: err
    -
    3530 end subroutine
    -
    3531
    -
    3532 module subroutine solve_qr_no_pivot_vec_cmplx(a, tau, b, work, olwork, err)
    -
    3533 complex(real64), intent(inout), dimension(:,:) :: a
    -
    3534 complex(real64), intent(in), dimension(:) :: tau
    -
    3535 complex(real64), intent(inout), dimension(:) :: b
    -
    3536 complex(real64), intent(out), target, optional, dimension(:) :: work
    -
    3537 integer(int32), intent(out), optional :: olwork
    -
    3538 class(errors), intent(inout), optional, target :: err
    -
    3539 end subroutine
    -
    3540
    -
    3541 module subroutine solve_qr_pivot_mtx(a, tau, jpvt, b, work, olwork, err)
    -
    3542 real(real64), intent(inout), dimension(:,:) :: a
    -
    3543 real(real64), intent(in), dimension(:) :: tau
    -
    3544 integer(int32), intent(in), dimension(:) :: jpvt
    -
    3545 real(real64), intent(inout), dimension(:,:) :: b
    -
    3546 real(real64), intent(out), target, optional, dimension(:) :: work
    -
    3547 integer(int32), intent(out), optional :: olwork
    -
    3548 class(errors), intent(inout), optional, target :: err
    -
    3549 end subroutine
    -
    3550
    -
    3551 module subroutine solve_qr_pivot_mtx_cmplx(a, tau, jpvt, b, work, olwork, err)
    -
    3552 complex(real64), intent(inout), dimension(:,:) :: a
    -
    3553 complex(real64), intent(in), dimension(:) :: tau
    -
    3554 integer(int32), intent(in), dimension(:) :: jpvt
    -
    3555 complex(real64), intent(inout), dimension(:,:) :: b
    -
    3556 complex(real64), intent(out), target, optional, dimension(:) :: work
    -
    3557 integer(int32), intent(out), optional :: olwork
    +
    3485
    +
    3486 module subroutine mult_qr_vec(trans, a, tau, c, work, olwork, err)
    +
    3487 logical, intent(in) :: trans
    +
    3488 real(real64), intent(inout), dimension(:,:) :: a
    +
    3489 real(real64), intent(in), dimension(:) :: tau
    +
    3490 real(real64), intent(inout), dimension(:) :: c
    +
    3491 real(real64), intent(out), target, dimension(:), optional :: work
    +
    3492 integer(int32), intent(out), optional :: olwork
    +
    3493 class(errors), intent(inout), optional, target :: err
    +
    3494 end subroutine
    +
    3495
    +
    3496 module subroutine mult_qr_vec_cmplx(trans, a, tau, c, work, olwork, err)
    +
    3497 logical, intent(in) :: trans
    +
    3498 complex(real64), intent(inout), dimension(:,:) :: a
    +
    3499 complex(real64), intent(in), dimension(:) :: tau
    +
    3500 complex(real64), intent(inout), dimension(:) :: c
    +
    3501 complex(real64), intent(out), target, dimension(:), optional :: work
    +
    3502 integer(int32), intent(out), optional :: olwork
    +
    3503 class(errors), intent(inout), optional, target :: err
    +
    3504 end subroutine
    +
    3505
    +
    3506 module subroutine qr_rank1_update_dbl(q, r, u, v, work, err)
    +
    3507 real(real64), intent(inout), dimension(:,:) :: q, r
    +
    3508 real(real64), intent(inout), dimension(:) :: u, v
    +
    3509 real(real64), intent(out), target, optional, dimension(:) :: work
    +
    3510 class(errors), intent(inout), optional, target :: err
    +
    3511 end subroutine
    +
    3512
    +
    3513 module subroutine qr_rank1_update_cmplx(q, r, u, v, work, rwork, err)
    +
    3514 complex(real64), intent(inout), dimension(:,:) :: q, r
    +
    3515 complex(real64), intent(inout), dimension(:) :: u, v
    +
    3516 complex(real64), intent(out), target, optional, dimension(:) :: work
    +
    3517 real(real64), intent(out), target, optional, dimension(:) :: rwork
    +
    3518 class(errors), intent(inout), optional, target :: err
    +
    3519 end subroutine
    +
    3520
    +
    3521 module subroutine cholesky_factor_dbl(a, upper, err)
    +
    3522 real(real64), intent(inout), dimension(:,:) :: a
    +
    3523 logical, intent(in), optional :: upper
    +
    3524 class(errors), intent(inout), optional, target :: err
    +
    3525 end subroutine
    +
    3526
    +
    3527 module subroutine cholesky_factor_cmplx(a, upper, err)
    +
    3528 complex(real64), intent(inout), dimension(:,:) :: a
    +
    3529 logical, intent(in), optional :: upper
    +
    3530 class(errors), intent(inout), optional, target :: err
    +
    3531 end subroutine
    +
    3532
    +
    3533 module subroutine cholesky_rank1_update_dbl(r, u, work, err)
    +
    3534 real(real64), intent(inout), dimension(:,:) :: r
    +
    3535 real(real64), intent(inout), dimension(:) :: u
    +
    3536 real(real64), intent(out), target, optional, dimension(:) :: work
    +
    3537 class(errors), intent(inout), optional, target :: err
    +
    3538 end subroutine
    +
    3539
    +
    3540 module subroutine cholesky_rank1_update_cmplx(r, u, work, err)
    +
    3541 complex(real64), intent(inout), dimension(:,:) :: r
    +
    3542 complex(real64), intent(inout), dimension(:) :: u
    +
    3543 real(real64), intent(out), target, optional, dimension(:) :: work
    +
    3544 class(errors), intent(inout), optional, target :: err
    +
    3545 end subroutine
    +
    3546
    +
    3547 module subroutine cholesky_rank1_downdate_dbl(r, u, work, err)
    +
    3548 real(real64), intent(inout), dimension(:,:) :: r
    +
    3549 real(real64), intent(inout), dimension(:) :: u
    +
    3550 real(real64), intent(out), target, optional, dimension(:) :: work
    +
    3551 class(errors), intent(inout), optional, target :: err
    +
    3552 end subroutine
    +
    3553
    +
    3554 module subroutine cholesky_rank1_downdate_cmplx(r, u, work, err)
    +
    3555 complex(real64), intent(inout), dimension(:,:) :: r
    +
    3556 complex(real64), intent(inout), dimension(:) :: u
    +
    3557 real(real64), intent(out), target, optional, dimension(:) :: work
    3558 class(errors), intent(inout), optional, target :: err
    3559 end subroutine
    3560
    -
    3561 module subroutine solve_qr_pivot_vec(a, tau, jpvt, b, work, olwork, err)
    +
    3561 module subroutine rz_factor_dbl(a, tau, work, olwork, err)
    3562 real(real64), intent(inout), dimension(:,:) :: a
    -
    3563 real(real64), intent(in), dimension(:) :: tau
    -
    3564 integer(int32), intent(in), dimension(:) :: jpvt
    -
    3565 real(real64), intent(inout), dimension(:) :: b
    -
    3566 real(real64), intent(out), target, optional, dimension(:) :: work
    -
    3567 integer(int32), intent(out), optional :: olwork
    -
    3568 class(errors), intent(inout), optional, target :: err
    -
    3569 end subroutine
    -
    3570
    -
    3571 module subroutine solve_qr_pivot_vec_cmplx(a, tau, jpvt, b, work, olwork, err)
    -
    3572 complex(real64), intent(inout), dimension(:,:) :: a
    -
    3573 complex(real64), intent(in), dimension(:) :: tau
    -
    3574 integer(int32), intent(in), dimension(:) :: jpvt
    -
    3575 complex(real64), intent(inout), dimension(:) :: b
    -
    3576 complex(real64), intent(out), target, optional, dimension(:) :: work
    -
    3577 integer(int32), intent(out), optional :: olwork
    -
    3578 class(errors), intent(inout), optional, target :: err
    -
    3579 end subroutine
    -
    3580
    -
    3581 module subroutine solve_cholesky_mtx(upper, a, b, err)
    -
    3582 logical, intent(in) :: upper
    -
    3583 real(real64), intent(in), dimension(:,:) :: a
    -
    3584 real(real64), intent(inout), dimension(:,:) :: b
    -
    3585 class(errors), intent(inout), optional, target :: err
    -
    3586 end subroutine
    -
    3587
    -
    3588 module subroutine solve_cholesky_mtx_cmplx(upper, a, b, err)
    -
    3589 logical, intent(in) :: upper
    -
    3590 complex(real64), intent(in), dimension(:,:) :: a
    -
    3591 complex(real64), intent(inout), dimension(:,:) :: b
    -
    3592 class(errors), intent(inout), optional, target :: err
    -
    3593 end subroutine
    -
    3594
    -
    3595 module subroutine solve_cholesky_vec(upper, a, b, err)
    -
    3596 logical, intent(in) :: upper
    -
    3597 real(real64), intent(in), dimension(:,:) :: a
    -
    3598 real(real64), intent(inout), dimension(:) :: b
    -
    3599 class(errors), intent(inout), optional, target :: err
    -
    3600 end subroutine
    -
    3601
    -
    3602 module subroutine solve_cholesky_vec_cmplx(upper, a, b, err)
    -
    3603 logical, intent(in) :: upper
    -
    3604 complex(real64), intent(in), dimension(:,:) :: a
    -
    3605 complex(real64), intent(inout), dimension(:) :: b
    -
    3606 class(errors), intent(inout), optional, target :: err
    -
    3607 end subroutine
    -
    3608
    -
    3609 module subroutine solve_least_squares_mtx(a, b, work, olwork, err)
    -
    3610 real(real64), intent(inout), dimension(:,:) :: a, b
    -
    3611 real(real64), intent(out), target, optional, dimension(:) :: work
    -
    3612 integer(int32), intent(out), optional :: olwork
    -
    3613 class(errors), intent(inout), optional, target :: err
    -
    3614 end subroutine
    -
    3615
    -
    3616 module subroutine solve_least_squares_mtx_cmplx(a, b, work, olwork, err)
    -
    3617 complex(real64), intent(inout), dimension(:,:) :: a, b
    -
    3618 complex(real64), intent(out), target, optional, dimension(:) :: work
    -
    3619 integer(int32), intent(out), optional :: olwork
    -
    3620 class(errors), intent(inout), optional, target :: err
    -
    3621 end subroutine
    -
    3622
    -
    3623 module subroutine solve_least_squares_vec(a, b, work, olwork, err)
    -
    3624 real(real64), intent(inout), dimension(:,:) :: a
    -
    3625 real(real64), intent(inout), dimension(:) :: b
    -
    3626 real(real64), intent(out), target, optional, dimension(:) :: work
    -
    3627 integer(int32), intent(out), optional :: olwork
    -
    3628 class(errors), intent(inout), optional, target :: err
    -
    3629 end subroutine
    -
    3630
    -
    3631 module subroutine solve_least_squares_vec_cmplx(a, b, work, olwork, err)
    -
    3632 complex(real64), intent(inout), dimension(:,:) :: a
    -
    3633 complex(real64), intent(inout), dimension(:) :: b
    -
    3634 complex(real64), intent(out), target, optional, dimension(:) :: work
    -
    3635 integer(int32), intent(out), optional :: olwork
    -
    3636 class(errors), intent(inout), optional, target :: err
    -
    3637 end subroutine
    -
    3638
    -
    3639 module subroutine solve_least_squares_mtx_pvt(a, b, ipvt, arnk, work, olwork, err)
    -
    3640 real(real64), intent(inout), dimension(:,:) :: a, b
    -
    3641 integer(int32), intent(inout), target, optional, dimension(:) :: ipvt
    -
    3642 integer(int32), intent(out), optional :: arnk
    -
    3643 real(real64), intent(out), target, optional, dimension(:) :: work
    -
    3644 integer(int32), intent(out), optional :: olwork
    -
    3645 class(errors), intent(inout), optional, target :: err
    -
    3646 end subroutine
    -
    3647
    -
    3648 module subroutine solve_least_squares_mtx_pvt_cmplx(a, b, ipvt, arnk, &
    -
    3649 work, olwork, rwork, err)
    -
    3650 complex(real64), intent(inout), dimension(:,:) :: a, b
    -
    3651 integer(int32), intent(inout), target, optional, dimension(:) :: ipvt
    -
    3652 integer(int32), intent(out), optional :: arnk
    -
    3653 complex(real64), intent(out), target, optional, dimension(:) :: work
    -
    3654 integer(int32), intent(out), optional :: olwork
    -
    3655 real(real64), intent(out), target, optional, dimension(:) :: rwork
    +
    3563 real(real64), intent(out), dimension(:) :: tau
    +
    3564 real(real64), intent(out), target, optional, dimension(:) :: work
    +
    3565 integer(int32), intent(out), optional :: olwork
    +
    3566 class(errors), intent(inout), optional, target :: err
    +
    3567 end subroutine
    +
    3568
    +
    3569 module subroutine rz_factor_cmplx(a, tau, work, olwork, err)
    +
    3570 complex(real64), intent(inout), dimension(:,:) :: a
    +
    3571 complex(real64), intent(out), dimension(:) :: tau
    +
    3572 complex(real64), intent(out), target, optional, dimension(:) :: work
    +
    3573 integer(int32), intent(out), optional :: olwork
    +
    3574 class(errors), intent(inout), optional, target :: err
    +
    3575 end subroutine
    +
    3576
    +
    3577 module subroutine mult_rz_mtx(lside, trans, l, a, tau, c, work, olwork, err)
    +
    3578 logical, intent(in) :: lside, trans
    +
    3579 integer(int32), intent(in) :: l
    +
    3580 real(real64), intent(inout), dimension(:,:) :: a, c
    +
    3581 real(real64), intent(in), dimension(:) :: tau
    +
    3582 real(real64), intent(out), target, optional, dimension(:) :: work
    +
    3583 integer(int32), intent(out), optional :: olwork
    +
    3584 class(errors), intent(inout), optional, target :: err
    +
    3585 end subroutine
    +
    3586
    +
    3587 module subroutine mult_rz_mtx_cmplx(lside, trans, l, a, tau, c, work, olwork, err)
    +
    3588 logical, intent(in) :: lside, trans
    +
    3589 integer(int32), intent(in) :: l
    +
    3590 complex(real64), intent(inout), dimension(:,:) :: a, c
    +
    3591 complex(real64), intent(in), dimension(:) :: tau
    +
    3592 complex(real64), intent(out), target, optional, dimension(:) :: work
    +
    3593 integer(int32), intent(out), optional :: olwork
    +
    3594 class(errors), intent(inout), optional, target :: err
    +
    3595 end subroutine
    +
    3596
    +
    3597 module subroutine mult_rz_vec(trans, l, a, tau, c, work, olwork, err)
    +
    3598 logical, intent(in) :: trans
    +
    3599 integer(int32), intent(in) :: l
    +
    3600 real(real64), intent(inout), dimension(:,:) :: a
    +
    3601 real(real64), intent(in), dimension(:) :: tau
    +
    3602 real(real64), intent(inout), dimension(:) :: c
    +
    3603 real(real64), intent(out), target, optional, dimension(:) :: work
    +
    3604 integer(int32), intent(out), optional :: olwork
    +
    3605 class(errors), intent(inout), optional, target :: err
    +
    3606 end subroutine
    +
    3607
    +
    3608 module subroutine mult_rz_vec_cmplx(trans, l, a, tau, c, work, olwork, err)
    +
    3609 logical, intent(in) :: trans
    +
    3610 integer(int32), intent(in) :: l
    +
    3611 complex(real64), intent(inout), dimension(:,:) :: a
    +
    3612 complex(real64), intent(in), dimension(:) :: tau
    +
    3613 complex(real64), intent(inout), dimension(:) :: c
    +
    3614 complex(real64), intent(out), target, optional, dimension(:) :: work
    +
    3615 integer(int32), intent(out), optional :: olwork
    +
    3616 class(errors), intent(inout), optional, target :: err
    +
    3617 end subroutine
    +
    3618
    +
    3619 module subroutine svd_dbl(a, s, u, vt, work, olwork, err)
    +
    3620 real(real64), intent(inout), dimension(:,:) :: a
    +
    3621 real(real64), intent(out), dimension(:) :: s
    +
    3622 real(real64), intent(out), optional, dimension(:,:) :: u, vt
    +
    3623 real(real64), intent(out), target, optional, dimension(:) :: work
    +
    3624 integer(int32), intent(out), optional :: olwork
    +
    3625 class(errors), intent(inout), optional, target :: err
    +
    3626 end subroutine
    +
    3627
    +
    3628 module subroutine svd_cmplx(a, s, u, vt, work, olwork, rwork, err)
    +
    3629 complex(real64), intent(inout), dimension(:,:) :: a
    +
    3630 real(real64), intent(out), dimension(:) :: s
    +
    3631 complex(real64), intent(out), optional, dimension(:,:) :: u, vt
    +
    3632 complex(real64), intent(out), target, optional, dimension(:) :: work
    +
    3633 integer(int32), intent(out), optional :: olwork
    +
    3634 real(real64), intent(out), target, optional, dimension(:) :: rwork
    +
    3635 class(errors), intent(inout), optional, target :: err
    +
    3636 end subroutine
    +
    3637end interface
    +
    3638
    +
    3639! ******************************************************************************
    +
    3640! LINALG_SOLVE.F90
    +
    3641! ------------------------------------------------------------------------------
    +
    3642interface
    +
    3643 module subroutine solve_tri_mtx(lside, upper, trans, nounit, alpha, a, b, err)
    +
    3644 logical, intent(in) :: lside, upper, trans, nounit
    +
    3645 real(real64), intent(in) :: alpha
    +
    3646 real(real64), intent(in), dimension(:,:) :: a
    +
    3647 real(real64), intent(inout), dimension(:,:) :: b
    +
    3648 class(errors), intent(inout), optional, target :: err
    +
    3649 end subroutine
    +
    3650
    +
    3651 module subroutine solve_tri_mtx_cmplx(lside, upper, trans, nounit, alpha, a, b, err)
    +
    3652 logical, intent(in) :: lside, upper, trans, nounit
    +
    3653 complex(real64), intent(in) :: alpha
    +
    3654 complex(real64), intent(in), dimension(:,:) :: a
    +
    3655 complex(real64), intent(inout), dimension(:,:) :: b
    3656 class(errors), intent(inout), optional, target :: err
    3657 end subroutine
    -
    3658
    -
    3659 module subroutine solve_least_squares_vec_pvt(a, b, ipvt, arnk, work, olwork, err)
    -
    3660 real(real64), intent(inout), dimension(:,:) :: a
    -
    3661 real(real64), intent(inout), dimension(:) :: b
    -
    3662 integer(int32), intent(inout), target, optional, dimension(:) :: ipvt
    -
    3663 integer(int32), intent(out), optional :: arnk
    -
    3664 real(real64), intent(out), target, optional, dimension(:) :: work
    -
    3665 integer(int32), intent(out), optional :: olwork
    -
    3666 class(errors), intent(inout), optional, target :: err
    -
    3667 end subroutine
    -
    3668
    -
    3669 module subroutine solve_least_squares_vec_pvt_cmplx(a, b, ipvt, arnk, &
    -
    3670 work, olwork, rwork, err)
    -
    3671 complex(real64), intent(inout), dimension(:,:) :: a
    -
    3672 complex(real64), intent(inout), dimension(:) :: b
    -
    3673 integer(int32), intent(inout), target, optional, dimension(:) :: ipvt
    -
    3674 integer(int32), intent(out), optional :: arnk
    -
    3675 complex(real64), intent(out), target, optional, dimension(:) :: work
    -
    3676 integer(int32), intent(out), optional :: olwork
    -
    3677 real(real64), intent(out), target, optional, dimension(:) :: rwork
    -
    3678 class(errors), intent(inout), optional, target :: err
    -
    3679 end subroutine
    -
    3680
    -
    3681 module subroutine solve_least_squares_mtx_svd(a, b, s, arnk, work, olwork, err)
    -
    3682 real(real64), intent(inout), dimension(:,:) :: a, b
    -
    3683 integer(int32), intent(out), optional :: arnk
    -
    3684 real(real64), intent(out), target, optional, dimension(:) :: work, s
    -
    3685 integer(int32), intent(out), optional :: olwork
    -
    3686 class(errors), intent(inout), optional, target :: err
    -
    3687 end subroutine
    -
    3688
    -
    3689 module subroutine solve_least_squares_mtx_svd_cmplx(a, b, s, arnk, work, &
    -
    3690 olwork, rwork, err)
    -
    3691 complex(real64), intent(inout), dimension(:,:) :: a, b
    -
    3692 integer(int32), intent(out), optional :: arnk
    -
    3693 complex(real64), intent(out), target, optional, dimension(:) :: work
    -
    3694 real(real64), intent(out), target, optional, dimension(:) :: rwork, s
    -
    3695 integer(int32), intent(out), optional :: olwork
    -
    3696 class(errors), intent(inout), optional, target :: err
    -
    3697 end subroutine
    -
    3698
    -
    3699 module subroutine solve_least_squares_vec_svd(a, b, s, arnk, work, olwork, err)
    -
    3700 real(real64), intent(inout), dimension(:,:) :: a
    -
    3701 real(real64), intent(inout), dimension(:) :: b
    -
    3702 integer(int32), intent(out), optional :: arnk
    -
    3703 real(real64), intent(out), target, optional, dimension(:) :: work, s
    -
    3704 integer(int32), intent(out), optional :: olwork
    -
    3705 class(errors), intent(inout), optional, target :: err
    -
    3706 end subroutine
    -
    3707
    -
    3708 module subroutine solve_least_squares_vec_svd_cmplx(a, b, s, arnk, work, &
    -
    3709 olwork, rwork, err)
    -
    3710 complex(real64), intent(inout), dimension(:,:) :: a
    -
    3711 complex(real64), intent(inout), dimension(:) :: b
    -
    3712 integer(int32), intent(out), optional :: arnk
    -
    3713 complex(real64), intent(out), target, optional, dimension(:) :: work
    -
    3714 real(real64), intent(out), target, optional, dimension(:) :: rwork, s
    -
    3715 integer(int32), intent(out), optional :: olwork
    -
    3716 class(errors), intent(inout), optional, target :: err
    -
    3717 end subroutine
    -
    3718
    -
    3719 module subroutine mtx_inverse_dbl(a, iwork, work, olwork, err)
    -
    3720 real(real64), intent(inout), dimension(:,:) :: a
    -
    3721 integer(int32), intent(out), target, optional, dimension(:) :: iwork
    -
    3722 real(real64), intent(out), target, optional, dimension(:) :: work
    -
    3723 integer(int32), intent(out), optional :: olwork
    -
    3724 class(errors), intent(inout), optional, target :: err
    -
    3725 end subroutine
    -
    3726
    -
    3727 module subroutine mtx_inverse_cmplx(a, iwork, work, olwork, err)
    -
    3728 complex(real64), intent(inout), dimension(:,:) :: a
    -
    3729 integer(int32), intent(out), target, optional, dimension(:) :: iwork
    +
    3658
    +
    3659 module subroutine solve_tri_vec(upper, trans, nounit, a, x, err)
    +
    3660 logical, intent(in) :: upper, trans, nounit
    +
    3661 real(real64), intent(in), dimension(:,:) :: a
    +
    3662 real(real64), intent(inout), dimension(:) :: x
    +
    3663 class(errors), intent(inout), optional, target :: err
    +
    3664 end subroutine
    +
    3665
    +
    3666 module subroutine solve_tri_vec_cmplx(upper, trans, nounit, a, x, err)
    +
    3667 logical, intent(in) :: upper, trans, nounit
    +
    3668 complex(real64), intent(in), dimension(:,:) :: a
    +
    3669 complex(real64), intent(inout), dimension(:) :: x
    +
    3670 class(errors), intent(inout), optional, target :: err
    +
    3671 end subroutine
    +
    3672
    +
    3673 module subroutine solve_lu_mtx(a, ipvt, b, err)
    +
    3674 real(real64), intent(in), dimension(:,:) :: a
    +
    3675 integer(int32), intent(in), dimension(:) :: ipvt
    +
    3676 real(real64), intent(inout), dimension(:,:) :: b
    +
    3677 class(errors), intent(inout), optional, target :: err
    +
    3678 end subroutine
    +
    3679
    +
    3680 module subroutine solve_lu_mtx_cmplx(a, ipvt, b, err)
    +
    3681 complex(real64), intent(in), dimension(:,:) :: a
    +
    3682 integer(int32), intent(in), dimension(:) :: ipvt
    +
    3683 complex(real64), intent(inout), dimension(:,:) :: b
    +
    3684 class(errors), intent(inout), optional, target :: err
    +
    3685 end subroutine
    +
    3686
    +
    3687 module subroutine solve_lu_vec(a, ipvt, b, err)
    +
    3688 real(real64), intent(in), dimension(:,:) :: a
    +
    3689 integer(int32), intent(in), dimension(:) :: ipvt
    +
    3690 real(real64), intent(inout), dimension(:) :: b
    +
    3691 class(errors), intent(inout), optional, target :: err
    +
    3692 end subroutine
    +
    3693
    +
    3694 module subroutine solve_lu_vec_cmplx(a, ipvt, b, err)
    +
    3695 complex(real64), intent(in), dimension(:,:) :: a
    +
    3696 integer(int32), intent(in), dimension(:) :: ipvt
    +
    3697 complex(real64), intent(inout), dimension(:) :: b
    +
    3698 class(errors), intent(inout), optional, target :: err
    +
    3699 end subroutine
    +
    3700
    +
    3701 module subroutine solve_qr_no_pivot_mtx(a, tau, b, work, olwork, err)
    +
    3702 real(real64), intent(inout), dimension(:,:) :: a, b
    +
    3703 real(real64), intent(in), dimension(:) :: tau
    +
    3704 real(real64), intent(out), target, optional, dimension(:) :: work
    +
    3705 integer(int32), intent(out), optional :: olwork
    +
    3706 class(errors), intent(inout), optional, target :: err
    +
    3707 end subroutine
    +
    3708
    +
    3709 module subroutine solve_qr_no_pivot_mtx_cmplx(a, tau, b, work, olwork, err)
    +
    3710 complex(real64), intent(inout), dimension(:,:) :: a, b
    +
    3711 complex(real64), intent(in), dimension(:) :: tau
    +
    3712 complex(real64), intent(out), target, optional, dimension(:) :: work
    +
    3713 integer(int32), intent(out), optional :: olwork
    +
    3714 class(errors), intent(inout), optional, target :: err
    +
    3715 end subroutine
    +
    3716
    +
    3717 module subroutine solve_qr_no_pivot_vec(a, tau, b, work, olwork, err)
    +
    3718 real(real64), intent(inout), dimension(:,:) :: a
    +
    3719 real(real64), intent(in), dimension(:) :: tau
    +
    3720 real(real64), intent(inout), dimension(:) :: b
    +
    3721 real(real64), intent(out), target, optional, dimension(:) :: work
    +
    3722 integer(int32), intent(out), optional :: olwork
    +
    3723 class(errors), intent(inout), optional, target :: err
    +
    3724 end subroutine
    +
    3725
    +
    3726 module subroutine solve_qr_no_pivot_vec_cmplx(a, tau, b, work, olwork, err)
    +
    3727 complex(real64), intent(inout), dimension(:,:) :: a
    +
    3728 complex(real64), intent(in), dimension(:) :: tau
    +
    3729 complex(real64), intent(inout), dimension(:) :: b
    3730 complex(real64), intent(out), target, optional, dimension(:) :: work
    3731 integer(int32), intent(out), optional :: olwork
    3732 class(errors), intent(inout), optional, target :: err
    3733 end subroutine
    3734
    -
    3735 module subroutine mtx_pinverse_dbl(a, ainv, tol, work, olwork, err)
    +
    3735 module subroutine solve_qr_pivot_mtx(a, tau, jpvt, b, work, olwork, err)
    3736 real(real64), intent(inout), dimension(:,:) :: a
    -
    3737 real(real64), intent(out), dimension(:,:) :: ainv
    -
    3738 real(real64), intent(in), optional :: tol
    -
    3739 real(real64), intent(out), target, dimension(:), optional :: work
    -
    3740 integer(int32), intent(out), optional :: olwork
    -
    3741 class(errors), intent(inout), optional, target :: err
    -
    3742 end subroutine
    -
    3743
    -
    3744 module subroutine mtx_pinverse_cmplx(a, ainv, tol, work, olwork, rwork, err)
    -
    3745 complex(real64), intent(inout), dimension(:,:) :: a
    -
    3746 complex(real64), intent(out), dimension(:,:) :: ainv
    -
    3747 real(real64), intent(in), optional :: tol
    -
    3748 complex(real64), intent(out), target, dimension(:), optional :: work
    -
    3749 integer(int32), intent(out), optional :: olwork
    -
    3750 real(real64), intent(out), target, dimension(:), optional :: rwork
    -
    3751 class(errors), intent(inout), optional, target :: err
    -
    3752 end subroutine
    -
    3753
    -
    3754end interface
    -
    3755
    -
    3756! ******************************************************************************
    -
    3757! LINALG_EIGEN.F90
    -
    3758! ------------------------------------------------------------------------------
    -
    3759interface
    -
    3760
    -
    3792 module subroutine eigen_symm(vecs, a, vals, work, olwork, err)
    -
    3793 logical, intent(in) :: vecs
    -
    3794 real(real64), intent(inout), dimension(:,:) :: a
    -
    3795 real(real64), intent(out), dimension(:) :: vals
    -
    3796 real(real64), intent(out), pointer, optional, dimension(:) :: work
    -
    3797 integer(int32), intent(out), optional :: olwork
    -
    3798 class(errors), intent(inout), optional, target :: err
    -
    3799 end subroutine
    -
    3800
    -
    3831 module subroutine eigen_asymm(a, vals, vecs, work, olwork, err)
    -
    3832 real(real64), intent(inout), dimension(:,:) :: a
    -
    3833 complex(real64), intent(out), dimension(:) :: vals
    -
    3834 complex(real64), intent(out), optional, dimension(:,:) :: vecs
    -
    3835 real(real64), intent(out), pointer, optional, dimension(:) :: work
    -
    3836 integer(int32), intent(out), optional :: olwork
    -
    3837 class(errors), intent(inout), optional, target :: err
    -
    3838 end subroutine
    -
    3839
    -
    3882 module subroutine eigen_gen(a, b, alpha, beta, vecs, work, olwork, err)
    -
    3883 real(real64), intent(inout), dimension(:,:) :: a, b
    -
    3884 complex(real64), intent(out), dimension(:) :: alpha
    -
    3885 real(real64), intent(out), optional, dimension(:) :: beta
    -
    3886 complex(real64), intent(out), optional, dimension(:,:) :: vecs
    -
    3887 real(real64), intent(out), optional, pointer, dimension(:) :: work
    -
    3888 integer(int32), intent(out), optional :: olwork
    -
    3889 class(errors), intent(inout), optional, target :: err
    -
    3890 end subroutine
    -
    3891
    -
    3922 module subroutine eigen_cmplx(a, vals, vecs, work, olwork, rwork, err)
    -
    3923 complex(real64), intent(inout), dimension(:,:) :: a
    -
    3924 complex(real64), intent(out), dimension(:) :: vals
    -
    3925 complex(real64), intent(out), optional, dimension(:,:) :: vecs
    -
    3926 complex(real64), intent(out), target, optional, dimension(:) :: work
    -
    3927 real(real64), intent(out), target, optional, dimension(:) :: rwork
    -
    3928 integer(int32), intent(out), optional :: olwork
    -
    3929 class(errors), intent(inout), optional, target :: err
    -
    3930 end subroutine
    -
    3931end interface
    -
    3932
    -
    3933! ******************************************************************************
    -
    3934! LINALG_SORTING.F90
    -
    3935! ------------------------------------------------------------------------------
    -
    3936interface
    -
    3937
    -
    3952 module subroutine sort_dbl_array(x, ascend)
    -
    3953 real(real64), intent(inout), dimension(:) :: x
    -
    3954 logical, intent(in), optional :: ascend
    -
    3955 end subroutine
    -
    3956
    -
    3981 module subroutine sort_dbl_array_ind(x, ind, ascend, err)
    -
    3982 real(real64), intent(inout), dimension(:) :: x
    -
    3983 integer(int32), intent(inout), dimension(:) :: ind
    -
    3984 logical, intent(in), optional :: ascend
    -
    3985 class(errors), intent(inout), optional, target :: err
    -
    3986 end subroutine
    -
    3987
    -
    4004 module subroutine sort_cmplx_array(x, ascend)
    -
    4005 complex(real64), intent(inout), dimension(:) :: x
    -
    4006 logical, intent(in), optional :: ascend
    +
    3737 real(real64), intent(in), dimension(:) :: tau
    +
    3738 integer(int32), intent(in), dimension(:) :: jpvt
    +
    3739 real(real64), intent(inout), dimension(:,:) :: b
    +
    3740 real(real64), intent(out), target, optional, dimension(:) :: work
    +
    3741 integer(int32), intent(out), optional :: olwork
    +
    3742 class(errors), intent(inout), optional, target :: err
    +
    3743 end subroutine
    +
    3744
    +
    3745 module subroutine solve_qr_pivot_mtx_cmplx(a, tau, jpvt, b, work, olwork, err)
    +
    3746 complex(real64), intent(inout), dimension(:,:) :: a
    +
    3747 complex(real64), intent(in), dimension(:) :: tau
    +
    3748 integer(int32), intent(in), dimension(:) :: jpvt
    +
    3749 complex(real64), intent(inout), dimension(:,:) :: b
    +
    3750 complex(real64), intent(out), target, optional, dimension(:) :: work
    +
    3751 integer(int32), intent(out), optional :: olwork
    +
    3752 class(errors), intent(inout), optional, target :: err
    +
    3753 end subroutine
    +
    3754
    +
    3755 module subroutine solve_qr_pivot_vec(a, tau, jpvt, b, work, olwork, err)
    +
    3756 real(real64), intent(inout), dimension(:,:) :: a
    +
    3757 real(real64), intent(in), dimension(:) :: tau
    +
    3758 integer(int32), intent(in), dimension(:) :: jpvt
    +
    3759 real(real64), intent(inout), dimension(:) :: b
    +
    3760 real(real64), intent(out), target, optional, dimension(:) :: work
    +
    3761 integer(int32), intent(out), optional :: olwork
    +
    3762 class(errors), intent(inout), optional, target :: err
    +
    3763 end subroutine
    +
    3764
    +
    3765 module subroutine solve_qr_pivot_vec_cmplx(a, tau, jpvt, b, work, olwork, err)
    +
    3766 complex(real64), intent(inout), dimension(:,:) :: a
    +
    3767 complex(real64), intent(in), dimension(:) :: tau
    +
    3768 integer(int32), intent(in), dimension(:) :: jpvt
    +
    3769 complex(real64), intent(inout), dimension(:) :: b
    +
    3770 complex(real64), intent(out), target, optional, dimension(:) :: work
    +
    3771 integer(int32), intent(out), optional :: olwork
    +
    3772 class(errors), intent(inout), optional, target :: err
    +
    3773 end subroutine
    +
    3774
    +
    3775 module subroutine solve_cholesky_mtx(upper, a, b, err)
    +
    3776 logical, intent(in) :: upper
    +
    3777 real(real64), intent(in), dimension(:,:) :: a
    +
    3778 real(real64), intent(inout), dimension(:,:) :: b
    +
    3779 class(errors), intent(inout), optional, target :: err
    +
    3780 end subroutine
    +
    3781
    +
    3782 module subroutine solve_cholesky_mtx_cmplx(upper, a, b, err)
    +
    3783 logical, intent(in) :: upper
    +
    3784 complex(real64), intent(in), dimension(:,:) :: a
    +
    3785 complex(real64), intent(inout), dimension(:,:) :: b
    +
    3786 class(errors), intent(inout), optional, target :: err
    +
    3787 end subroutine
    +
    3788
    +
    3789 module subroutine solve_cholesky_vec(upper, a, b, err)
    +
    3790 logical, intent(in) :: upper
    +
    3791 real(real64), intent(in), dimension(:,:) :: a
    +
    3792 real(real64), intent(inout), dimension(:) :: b
    +
    3793 class(errors), intent(inout), optional, target :: err
    +
    3794 end subroutine
    +
    3795
    +
    3796 module subroutine solve_cholesky_vec_cmplx(upper, a, b, err)
    +
    3797 logical, intent(in) :: upper
    +
    3798 complex(real64), intent(in), dimension(:,:) :: a
    +
    3799 complex(real64), intent(inout), dimension(:) :: b
    +
    3800 class(errors), intent(inout), optional, target :: err
    +
    3801 end subroutine
    +
    3802
    +
    3803 module subroutine solve_least_squares_mtx(a, b, work, olwork, err)
    +
    3804 real(real64), intent(inout), dimension(:,:) :: a, b
    +
    3805 real(real64), intent(out), target, optional, dimension(:) :: work
    +
    3806 integer(int32), intent(out), optional :: olwork
    +
    3807 class(errors), intent(inout), optional, target :: err
    +
    3808 end subroutine
    +
    3809
    +
    3810 module subroutine solve_least_squares_mtx_cmplx(a, b, work, olwork, err)
    +
    3811 complex(real64), intent(inout), dimension(:,:) :: a, b
    +
    3812 complex(real64), intent(out), target, optional, dimension(:) :: work
    +
    3813 integer(int32), intent(out), optional :: olwork
    +
    3814 class(errors), intent(inout), optional, target :: err
    +
    3815 end subroutine
    +
    3816
    +
    3817 module subroutine solve_least_squares_vec(a, b, work, olwork, err)
    +
    3818 real(real64), intent(inout), dimension(:,:) :: a
    +
    3819 real(real64), intent(inout), dimension(:) :: b
    +
    3820 real(real64), intent(out), target, optional, dimension(:) :: work
    +
    3821 integer(int32), intent(out), optional :: olwork
    +
    3822 class(errors), intent(inout), optional, target :: err
    +
    3823 end subroutine
    +
    3824
    +
    3825 module subroutine solve_least_squares_vec_cmplx(a, b, work, olwork, err)
    +
    3826 complex(real64), intent(inout), dimension(:,:) :: a
    +
    3827 complex(real64), intent(inout), dimension(:) :: b
    +
    3828 complex(real64), intent(out), target, optional, dimension(:) :: work
    +
    3829 integer(int32), intent(out), optional :: olwork
    +
    3830 class(errors), intent(inout), optional, target :: err
    +
    3831 end subroutine
    +
    3832
    +
    3833 module subroutine solve_least_squares_mtx_pvt(a, b, ipvt, arnk, work, olwork, err)
    +
    3834 real(real64), intent(inout), dimension(:,:) :: a, b
    +
    3835 integer(int32), intent(inout), target, optional, dimension(:) :: ipvt
    +
    3836 integer(int32), intent(out), optional :: arnk
    +
    3837 real(real64), intent(out), target, optional, dimension(:) :: work
    +
    3838 integer(int32), intent(out), optional :: olwork
    +
    3839 class(errors), intent(inout), optional, target :: err
    +
    3840 end subroutine
    +
    3841
    +
    3842 module subroutine solve_least_squares_mtx_pvt_cmplx(a, b, ipvt, arnk, &
    +
    3843 work, olwork, rwork, err)
    +
    3844 complex(real64), intent(inout), dimension(:,:) :: a, b
    +
    3845 integer(int32), intent(inout), target, optional, dimension(:) :: ipvt
    +
    3846 integer(int32), intent(out), optional :: arnk
    +
    3847 complex(real64), intent(out), target, optional, dimension(:) :: work
    +
    3848 integer(int32), intent(out), optional :: olwork
    +
    3849 real(real64), intent(out), target, optional, dimension(:) :: rwork
    +
    3850 class(errors), intent(inout), optional, target :: err
    +
    3851 end subroutine
    +
    3852
    +
    3853 module subroutine solve_least_squares_vec_pvt(a, b, ipvt, arnk, work, olwork, err)
    +
    3854 real(real64), intent(inout), dimension(:,:) :: a
    +
    3855 real(real64), intent(inout), dimension(:) :: b
    +
    3856 integer(int32), intent(inout), target, optional, dimension(:) :: ipvt
    +
    3857 integer(int32), intent(out), optional :: arnk
    +
    3858 real(real64), intent(out), target, optional, dimension(:) :: work
    +
    3859 integer(int32), intent(out), optional :: olwork
    +
    3860 class(errors), intent(inout), optional, target :: err
    +
    3861 end subroutine
    +
    3862
    +
    3863 module subroutine solve_least_squares_vec_pvt_cmplx(a, b, ipvt, arnk, &
    +
    3864 work, olwork, rwork, err)
    +
    3865 complex(real64), intent(inout), dimension(:,:) :: a
    +
    3866 complex(real64), intent(inout), dimension(:) :: b
    +
    3867 integer(int32), intent(inout), target, optional, dimension(:) :: ipvt
    +
    3868 integer(int32), intent(out), optional :: arnk
    +
    3869 complex(real64), intent(out), target, optional, dimension(:) :: work
    +
    3870 integer(int32), intent(out), optional :: olwork
    +
    3871 real(real64), intent(out), target, optional, dimension(:) :: rwork
    +
    3872 class(errors), intent(inout), optional, target :: err
    +
    3873 end subroutine
    +
    3874
    +
    3875 module subroutine solve_least_squares_mtx_svd(a, b, s, arnk, work, olwork, err)
    +
    3876 real(real64), intent(inout), dimension(:,:) :: a, b
    +
    3877 integer(int32), intent(out), optional :: arnk
    +
    3878 real(real64), intent(out), target, optional, dimension(:) :: work, s
    +
    3879 integer(int32), intent(out), optional :: olwork
    +
    3880 class(errors), intent(inout), optional, target :: err
    +
    3881 end subroutine
    +
    3882
    +
    3883 module subroutine solve_least_squares_mtx_svd_cmplx(a, b, s, arnk, work, &
    +
    3884 olwork, rwork, err)
    +
    3885 complex(real64), intent(inout), dimension(:,:) :: a, b
    +
    3886 integer(int32), intent(out), optional :: arnk
    +
    3887 complex(real64), intent(out), target, optional, dimension(:) :: work
    +
    3888 real(real64), intent(out), target, optional, dimension(:) :: rwork, s
    +
    3889 integer(int32), intent(out), optional :: olwork
    +
    3890 class(errors), intent(inout), optional, target :: err
    +
    3891 end subroutine
    +
    3892
    +
    3893 module subroutine solve_least_squares_vec_svd(a, b, s, arnk, work, olwork, err)
    +
    3894 real(real64), intent(inout), dimension(:,:) :: a
    +
    3895 real(real64), intent(inout), dimension(:) :: b
    +
    3896 integer(int32), intent(out), optional :: arnk
    +
    3897 real(real64), intent(out), target, optional, dimension(:) :: work, s
    +
    3898 integer(int32), intent(out), optional :: olwork
    +
    3899 class(errors), intent(inout), optional, target :: err
    +
    3900 end subroutine
    +
    3901
    +
    3902 module subroutine solve_least_squares_vec_svd_cmplx(a, b, s, arnk, work, &
    +
    3903 olwork, rwork, err)
    +
    3904 complex(real64), intent(inout), dimension(:,:) :: a
    +
    3905 complex(real64), intent(inout), dimension(:) :: b
    +
    3906 integer(int32), intent(out), optional :: arnk
    +
    3907 complex(real64), intent(out), target, optional, dimension(:) :: work
    +
    3908 real(real64), intent(out), target, optional, dimension(:) :: rwork, s
    +
    3909 integer(int32), intent(out), optional :: olwork
    +
    3910 class(errors), intent(inout), optional, target :: err
    +
    3911 end subroutine
    +
    3912
    +
    3913 module subroutine mtx_inverse_dbl(a, iwork, work, olwork, err)
    +
    3914 real(real64), intent(inout), dimension(:,:) :: a
    +
    3915 integer(int32), intent(out), target, optional, dimension(:) :: iwork
    +
    3916 real(real64), intent(out), target, optional, dimension(:) :: work
    +
    3917 integer(int32), intent(out), optional :: olwork
    +
    3918 class(errors), intent(inout), optional, target :: err
    +
    3919 end subroutine
    +
    3920
    +
    3921 module subroutine mtx_inverse_cmplx(a, iwork, work, olwork, err)
    +
    3922 complex(real64), intent(inout), dimension(:,:) :: a
    +
    3923 integer(int32), intent(out), target, optional, dimension(:) :: iwork
    +
    3924 complex(real64), intent(out), target, optional, dimension(:) :: work
    +
    3925 integer(int32), intent(out), optional :: olwork
    +
    3926 class(errors), intent(inout), optional, target :: err
    +
    3927 end subroutine
    +
    3928
    +
    3929 module subroutine mtx_pinverse_dbl(a, ainv, tol, work, olwork, err)
    +
    3930 real(real64), intent(inout), dimension(:,:) :: a
    +
    3931 real(real64), intent(out), dimension(:,:) :: ainv
    +
    3932 real(real64), intent(in), optional :: tol
    +
    3933 real(real64), intent(out), target, dimension(:), optional :: work
    +
    3934 integer(int32), intent(out), optional :: olwork
    +
    3935 class(errors), intent(inout), optional, target :: err
    +
    3936 end subroutine
    +
    3937
    +
    3938 module subroutine mtx_pinverse_cmplx(a, ainv, tol, work, olwork, rwork, err)
    +
    3939 complex(real64), intent(inout), dimension(:,:) :: a
    +
    3940 complex(real64), intent(out), dimension(:,:) :: ainv
    +
    3941 real(real64), intent(in), optional :: tol
    +
    3942 complex(real64), intent(out), target, dimension(:), optional :: work
    +
    3943 integer(int32), intent(out), optional :: olwork
    +
    3944 real(real64), intent(out), target, dimension(:), optional :: rwork
    +
    3945 class(errors), intent(inout), optional, target :: err
    +
    3946 end subroutine
    +
    3947
    +
    3948end interface
    +
    3949
    +
    3950! ******************************************************************************
    +
    3951! LINALG_EIGEN.F90
    +
    3952! ------------------------------------------------------------------------------
    +
    3953interface
    +
    3954 module subroutine eigen_symm(vecs, a, vals, work, olwork, err)
    +
    3955 logical, intent(in) :: vecs
    +
    3956 real(real64), intent(inout), dimension(:,:) :: a
    +
    3957 real(real64), intent(out), dimension(:) :: vals
    +
    3958 real(real64), intent(out), pointer, optional, dimension(:) :: work
    +
    3959 integer(int32), intent(out), optional :: olwork
    +
    3960 class(errors), intent(inout), optional, target :: err
    +
    3961 end subroutine
    +
    3962
    +
    3963 module subroutine eigen_asymm(a, vals, vecs, work, olwork, err)
    +
    3964 real(real64), intent(inout), dimension(:,:) :: a
    +
    3965 complex(real64), intent(out), dimension(:) :: vals
    +
    3966 complex(real64), intent(out), optional, dimension(:,:) :: vecs
    +
    3967 real(real64), intent(out), pointer, optional, dimension(:) :: work
    +
    3968 integer(int32), intent(out), optional :: olwork
    +
    3969 class(errors), intent(inout), optional, target :: err
    +
    3970 end subroutine
    +
    3971
    +
    3972 module subroutine eigen_gen(a, b, alpha, beta, vecs, work, olwork, err)
    +
    3973 real(real64), intent(inout), dimension(:,:) :: a, b
    +
    3974 complex(real64), intent(out), dimension(:) :: alpha
    +
    3975 real(real64), intent(out), optional, dimension(:) :: beta
    +
    3976 complex(real64), intent(out), optional, dimension(:,:) :: vecs
    +
    3977 real(real64), intent(out), optional, pointer, dimension(:) :: work
    +
    3978 integer(int32), intent(out), optional :: olwork
    +
    3979 class(errors), intent(inout), optional, target :: err
    +
    3980 end subroutine
    +
    3981
    +
    3982 module subroutine eigen_cmplx(a, vals, vecs, work, olwork, rwork, err)
    +
    3983 complex(real64), intent(inout), dimension(:,:) :: a
    +
    3984 complex(real64), intent(out), dimension(:) :: vals
    +
    3985 complex(real64), intent(out), optional, dimension(:,:) :: vecs
    +
    3986 complex(real64), intent(out), target, optional, dimension(:) :: work
    +
    3987 real(real64), intent(out), target, optional, dimension(:) :: rwork
    +
    3988 integer(int32), intent(out), optional :: olwork
    +
    3989 class(errors), intent(inout), optional, target :: err
    +
    3990 end subroutine
    +
    3991end interface
    +
    3992
    +
    3993! ******************************************************************************
    +
    3994! LINALG_SORTING.F90
    +
    3995! ------------------------------------------------------------------------------
    +
    3996interface
    +
    3997 module subroutine sort_dbl_array(x, ascend)
    +
    3998 real(real64), intent(inout), dimension(:) :: x
    +
    3999 logical, intent(in), optional :: ascend
    +
    4000 end subroutine
    +
    4001
    +
    4002 module subroutine sort_dbl_array_ind(x, ind, ascend, err)
    +
    4003 real(real64), intent(inout), dimension(:) :: x
    +
    4004 integer(int32), intent(inout), dimension(:) :: ind
    +
    4005 logical, intent(in), optional :: ascend
    +
    4006 class(errors), intent(inout), optional, target :: err
    4007 end subroutine
    4008
    -
    4038 module subroutine sort_cmplx_array_ind(x, ind, ascend, err)
    -
    4039 complex(real64), intent(inout), dimension(:) :: x
    -
    4040 integer(int32), intent(inout), dimension(:) :: ind
    -
    4041 logical, intent(in), optional :: ascend
    -
    4042 class(errors), intent(inout), optional, target :: err
    -
    4043 end subroutine
    -
    4044
    -
    4064 module subroutine sort_eigen_cmplx(vals, vecs, ascend, err)
    -
    4065 complex(real64), intent(inout), dimension(:) :: vals
    -
    4066 complex(real64), intent(inout), dimension(:,:) :: vecs
    -
    4067 logical, intent(in), optional :: ascend
    -
    4068 class(errors), intent(inout), optional, target :: err
    -
    4069 end subroutine
    -
    4070
    -
    4090 module subroutine sort_eigen_dbl(vals, vecs, ascend, err)
    -
    4091 real(real64), intent(inout), dimension(:) :: vals
    -
    4092 real(real64), intent(inout), dimension(:,:) :: vecs
    -
    4093 logical, intent(in), optional :: ascend
    -
    4094 class(errors), intent(inout), optional, target :: err
    -
    4095 end subroutine
    -
    4096
    -
    4097end interface
    -
    4098
    -
    4099end module
    +
    4009 module subroutine sort_cmplx_array(x, ascend)
    +
    4010 complex(real64), intent(inout), dimension(:) :: x
    +
    4011 logical, intent(in), optional :: ascend
    +
    4012 end subroutine
    +
    4013
    +
    4014 module subroutine sort_cmplx_array_ind(x, ind, ascend, err)
    +
    4015 complex(real64), intent(inout), dimension(:) :: x
    +
    4016 integer(int32), intent(inout), dimension(:) :: ind
    +
    4017 logical, intent(in), optional :: ascend
    +
    4018 class(errors), intent(inout), optional, target :: err
    +
    4019 end subroutine
    +
    4020
    +
    4021 module subroutine sort_eigen_cmplx(vals, vecs, ascend, err)
    +
    4022 complex(real64), intent(inout), dimension(:) :: vals
    +
    4023 complex(real64), intent(inout), dimension(:,:) :: vecs
    +
    4024 logical, intent(in), optional :: ascend
    +
    4025 class(errors), intent(inout), optional, target :: err
    +
    4026 end subroutine
    +
    4027
    +
    4028 module subroutine sort_eigen_dbl(vals, vecs, ascend, err)
    +
    4029 real(real64), intent(inout), dimension(:) :: vals
    +
    4030 real(real64), intent(inout), dimension(:,:) :: vecs
    +
    4031 logical, intent(in), optional :: ascend
    +
    4032 class(errors), intent(inout), optional, target :: err
    +
    4033 end subroutine
    +
    4034
    +
    4035end interface
    +
    4036
    +
    4037end module
    Computes the Cholesky factorization of a symmetric, positive definite matrix.
    Computes the rank 1 downdate to a Cholesky factored matrix (upper triangular).
    Computes the rank 1 update to a Cholesky factored matrix (upper triangular).
    Computes the determinant of a square matrix.
    Multiplies a diagonal matrix with another matrix or array.
    -
    Computes the eigenvalues, and optionally the eigenvectors, of a matrix.
    +
    Computes the eigenvalues, and optionally the eigenvectors, of a matrix.
    Extracts the L and U matrices from the condensed [L\U] storage format used by the lu_factor.
    Forms the full M-by-M orthogonal matrix Q from the elementary reflectors returned by the base QR fact...
    Computes the LU factorization of an M-by-N matrix.
    @@ -1294,7 +1292,7 @@
    Solves a system of LU-factored equations.
    Solves a system of M QR-factored equations of N unknowns.
    Solves a triangular system of equations.
    -
    Sorts an array.
    +
    Sorts an array.
    Computes the singular value decomposition of a matrix A. The SVD is defined as: , where is an M-by-M...
    Swaps the contents of two arrays.
    Computes the trace of a matrix (the sum of the main diagonal elements).
    diff --git a/doc/html/linalg__immutable_8f90_source.html b/doc/html/linalg__immutable_8f90_source.html index 92c10010..4434527e 100644 --- a/doc/html/linalg__immutable_8f90_source.html +++ b/doc/html/linalg__immutable_8f90_source.html @@ -850,7 +850,7 @@
    Computes the rank 1 update to a Cholesky factored matrix (upper triangular).
    Computes the determinant of a square matrix.
    Multiplies a diagonal matrix with another matrix or array.
    -
    Computes the eigenvalues, and optionally the eigenvectors, of a matrix.
    +
    Computes the eigenvalues, and optionally the eigenvectors, of a matrix.
    Extracts the L and U matrices from the condensed [L\U] storage format used by the lu_factor.
    Forms the full M-by-M orthogonal matrix Q from the elementary reflectors returned by the base QR fact...
    Computes the LU factorization of an M-by-N matrix.
    @@ -860,7 +860,7 @@
    Computes the rank 1 update to an M-by-N QR factored matrix A (M >= N) where , and such that .
    Performs the rank-1 update to matrix A such that: , where is an M-by-N matrix, is a scalar,...
    Solves a triangular system of equations.
    -
    Sorts an array.
    +
    Sorts an array.
    Computes the singular value decomposition of a matrix A. The SVD is defined as: , where is an M-by-M...
    Computes the eigenvalues and eigenvectors (right) of a general N-by-N matrix.
    Computes the LU factorization of a square matrix. Notice, partial row pivoting is utilized.
    From 44f3a840f60b29d16ae8b044dfe6bd30ac12d69a Mon Sep 17 00:00:00 2001 From: jchristopherson Date: Thu, 15 Dec 2022 17:03:22 -0600 Subject: [PATCH 23/65] Clean up module structure --- src/CMakeLists.txt | 3 +- src/{linalg_core.f90 => linalg.f90} | 502 +++++++++++++--------------- src/linalg_basic.f90 | 56 ++-- src/linalg_c_api.f90 | 39 ++- src/linalg_constants.f90 | 37 -- src/linalg_eigen.f90 | 2 +- src/linalg_factor.f90 | 2 +- src/linalg_immutable.f90 | 13 +- src/linalg_solve.f90 | 2 +- src/linalg_sorting.f90 | 2 +- tests/test_cholesky.f90 | 2 +- tests/test_eigen.f90 | 5 +- tests/test_lu.f90 | 2 +- tests/test_misc.f90 | 2 +- tests/test_mtx_inverse.f90 | 2 +- tests/test_qr.f90 | 2 +- tests/test_sort.f90 | 2 +- tests/test_svd.f90 | 2 +- 18 files changed, 307 insertions(+), 370 deletions(-) rename src/{linalg_core.f90 => linalg.f90} (91%) delete mode 100644 src/linalg_constants.f90 diff --git a/src/CMakeLists.txt b/src/CMakeLists.txt index fffb2b14..6b023aaf 100644 --- a/src/CMakeLists.txt +++ b/src/CMakeLists.txt @@ -81,8 +81,7 @@ set(qrupdate_sources # Define the LINALG source files set(LINALG_SOURCES - ${dir}/linalg_core.f90 - ${dir}/linalg_constants.f90 + ${dir}/linalg.f90 ${dir}/linalg_eigen.f90 ${dir}/linalg_factor.f90 ${dir}/linalg_solve.f90 diff --git a/src/linalg_core.f90 b/src/linalg.f90 similarity index 91% rename from src/linalg_core.f90 rename to src/linalg.f90 index b307693b..acc0ff5a 100644 --- a/src/linalg_core.f90 +++ b/src/linalg.f90 @@ -1,4 +1,4 @@ -! linalg_core.f90 +! linalg.f90 !> @mainpage @@ -12,10 +12,9 @@ !> @brief Provides a set of common linear algebra routines. -module linalg_core +module linalg use, intrinsic :: iso_fortran_env, only : int32, real64 use ferror, only : errors - use linalg_constants implicit none private @@ -51,6 +50,47 @@ module linalg_core public :: solve_least_squares_svd public :: eigen public :: sort + public :: LA_NO_OPERATION + public :: LA_TRANSPOSE + public :: LA_HERMITIAN_TRANSPOSE + public :: LA_NO_ERROR + public :: LA_INVALID_INPUT_ERROR + public :: LA_ARRAY_SIZE_ERROR + public :: LA_SINGULAR_MATRIX_ERROR + public :: LA_MATRIX_FORMAT_ERROR + public :: LA_OUT_OF_MEMORY_ERROR + public :: LA_CONVERGENCE_ERROR + public :: LA_INVALID_OPERATION_ERROR + +! ****************************************************************************** +! CONSTANTS +! ------------------------------------------------------------------------------ + !> @brief Defines no operation should be performed on the matrix. + integer(int32), parameter :: LA_NO_OPERATION = 0 + !> @brief Defines a transpose operation. + integer(int32), parameter :: LA_TRANSPOSE = 1 + !> @brief Defines a Hermitian transpose operation for a complex-valued matrix. + integer(int32), parameter :: LA_HERMITIAN_TRANSPOSE = 2 + +! ****************************************************************************** +! ERROR FLAGS +! ------------------------------------------------------------------------------ + !> A flag denoting no error condition. + integer(int32), parameter :: LA_NO_ERROR = 0 + !> An error flag denoting an invalid input. + integer(int32), parameter :: LA_INVALID_INPUT_ERROR = 101 + !> An error flag denoting an improperly sized array. + integer(int32), parameter :: LA_ARRAY_SIZE_ERROR = 102 + !> An error flag denoting a singular matrix. + integer(int32), parameter :: LA_SINGULAR_MATRIX_ERROR = 103 + !> An error flag denoting an issue with the matrix format. + integer(int32), parameter :: LA_MATRIX_FORMAT_ERROR = 104 + !> An error flag denoting that there is insufficient memory available. + integer(int32), parameter :: LA_OUT_OF_MEMORY_ERROR = 105 + !> An error flag denoting a convergence failure. + integer(int32), parameter :: LA_CONVERGENCE_ERROR = 106 + !> An error resulting from an invalid operation. + integer(int32), parameter :: LA_INVALID_OPERATION_ERROR = 107 ! ****************************************************************************** ! INTERFACES @@ -2850,6 +2890,126 @@ module linalg_core !> @brief Computes the eigenvalues, and optionally the eigenvectors, of a !! matrix. !! +!! @par Syntax 1 (Symmetric Matrices) +!! @code{.f90} +!! subroutine eigen(logical vecs, real(real64) a(:,:), real(real64) vals(:), optional real(real64) work(:), optional integer(int32) olwork, optional class(errors) err) +!! @endcode +!! +!! @param[in] vecs Set to true to compute the eigenvectors as well as the +!! eigenvalues; else, set to false to just compute the eigenvalues. +!! @param[in,out] a On input, the N-by-N symmetric matrix on which to +!! operate. On output, and if @p vecs is set to true, the matrix will +!! contain the eigenvectors (one per column) corresponding to each +!! eigenvalue in @p vals. If @p vecs is set to false, the lower triangular +!! portion of the matrix is overwritten. +!! @param[out] vals An N-element array that will contain the eigenvalues +!! sorted into ascending order. +!! @param[out] work An optional input, that if provided, prevents any local +!! memory allocation. If not provided, the memory required is allocated +!! within. If provided, the length of the array must be at least +!! @p olwork. +!! @param[out] olwork An optional output used to determine workspace size. +!! If supplied, the routine determines the optimal size for @p work, and +!! returns without performing any actual calculations. +!! @param[in,out] err An optional errors-based object that if provided can be +!! used to retrieve information relating to any errors encountered during +!! execution. If not provided, a default implementation of the errors +!! class is used internally to provide error handling. Possible errors and +!! warning messages that may be encountered are as follows. +!! - LA_ARRAY_SIZE_ERROR: Occurs if any of the input arrays are not sized +!! appropriately. +!! - LA_OUT_OF_MEMORY_ERROR: Occurs if local memory must be allocated, and +!! there is insufficient memory available. +!! - LA_CONVERGENCE_ERROR: Occurs if the algorithm failed to converge. +!! +!! @par Notes +!! This routine utilizes the LAPACK routine DSYEV. +!! +!! @par Syntax 2 (Asymmetric Matrices) +!! @code{.f90} +!! subroutine eigen(real(real64) a(:,:), complex(real64) vals(:), optional complex(real64) vecs(:,:), optional real(real64) work(:), optional integer(int32) olwork, optional class(errors) err) +!! subroutine eigen(complex(real64) a(:,:), complex(real64) vals(:), optional complex(real64) vecs(:,:), optional complex(real64) work(:), optional integer(int32) olwork, real(real64) rwork(:), optional class(errors) err) +!! @endcode +!! +!! @param[in,out] a On input, the N-by-N matrix on which to operate. On +!! output, the contents of this matrix are overwritten. +!! @param[out] vals An N-element array containing the eigenvalues of the +!! matrix. The eigenvalues are not sorted. +!! @param[out] vecs An optional N-by-N matrix, that if supplied, signals to +!! compute the right eigenvectors (one per column). If not provided, only +!! the eigenvalues will be computed. +!! @param[out] work An optional input, that if provided, prevents any local +!! memory allocation. If not provided, the memory required is allocated +!! within. If provided, the length of the array must be at least +!! @p olwork. +!! @param[out] olwork An optional output used to determine workspace size. +!! If supplied, the routine determines the optimal size for @p work, and +!! returns without performing any actual calculations. +!! @param[out] rwork An optional input, that if provided, prevents any local +!! memory allocation for real-valued workspaces. If not provided, the +!! memory required is allocated within. If provided, the length of the +!! array must be at least 2 * N. +!! @param[in,out] err An optional errors-based object that if provided can be +!! used to retrieve information relating to any errors encountered during +!! execution. If not provided, a default implementation of the errors +!! class is used internally to provide error handling. Possible errors and +!! warning messages that may be encountered are as follows. +!! - LA_ARRAY_SIZE_ERROR: Occurs if any of the input arrays are not sized +!! appropriately. +!! - LA_OUT_OF_MEMORY_ERROR: Occurs if local memory must be allocated, and +!! there is insufficient memory available. +!! - LA_CONVERGENCE_ERROR: Occurs if the algorithm failed to converge. +!! +!! @par Notes +!! This routine utilizes the LAPACK routine DGEEV (ZGEEV in the complex case). +!! +!! @par Syntax 3 (General Eigen Problem) +!! Computes the eigenvalues, and optionally the right eigenvectors of +!! a square matrix assuming the structure of the eigenvalue problem is +!! \f$ A X = \lambda B X \f$. +!! @code{.f90} +!! subroutine eigen(real(real64) a(:,:), real(real64) b(:,:), complex(real64) alpha(:), optional real(real64) beta(:), optional complex(real64) vecs(:,:), optional real(real64) work(:), optional integer(int32) olwork, optional class(errors) err) +!! @endcode +!! +!! @param[in,out] a On input, the N-by-N matrix A. On output, the contents +!! of this matrix are overwritten. +!! @param[in,out] b On input, the N-by-N matrix B. On output, the contents +!! of this matrix are overwritten. +!! @param[out] alpha An N-element array that, if @p beta is not supplied, +!! contains the eigenvalues. If @p beta is supplied however, the +!! eigenvalues must be computed as ALPHA / BETA. This however, is not as +!! trivial as it seems as it is entirely possible, and likely, that +!! ALPHA / BETA can overflow or underflow. With that said, the values in +!! ALPHA will always be less than and usually comparable with the NORM(A). +!! @param[out] beta An optional N-element array that if provided forces +!! @p alpha to return the numerator, and this array contains the +!! denominator used to determine the eigenvalues as ALPHA / BETA. If used, +!! the values in this array will always be less than and usually comparable +!! with the NORM(B). +!! @param[out] vecs An optional N-by-N matrix, that if supplied, signals to +!! compute the right eigenvectors (one per column). If not provided, only +!! the eigenvalues will be computed. +!! @param[out] work An optional input, that if provided, prevents any local +!! memory allocation. If not provided, the memory required is allocated +!! within. If provided, the length of the array must be at least +!! @p olwork. +!! @param[out] olwork An optional output used to determine workspace size. +!! If supplied, the routine determines the optimal size for @p work, and +!! returns without performing any actual calculations. +!! @param[in,out] err An optional errors-based object that if provided can be +!! used to retrieve information relating to any errors encountered during +!! execution. If not provided, a default implementation of the errors +!! class is used internally to provide error handling. Possible errors and +!! warning messages that may be encountered are as follows. +!! - LA_ARRAY_SIZE_ERROR: Occurs if any of the input arrays are not sized +!! appropriately. +!! - LA_OUT_OF_MEMORY_ERROR: Occurs if local memory must be allocated, and +!! there is insufficient memory available. +!! - LA_CONVERGENCE_ERROR: Occurs if the algorithm failed to converge. +!! +!! @par Notes +!! This routine utilizes the LAPACK routine DGGEV. +!! !! @par Usage !! As an example, consider the eigenvalue problem arising from a mechanical !! system of masses and springs such that the masses are described by @@ -2944,6 +3104,80 @@ module linalg_core ! ------------------------------------------------------------------------------ !> @brief Sorts an array. +!! +!! @par Syntax 1 +!! @code{.f90} +!! subroutine sort(real(real64) x(:), optional logical ascend) +!! subroutine sort(complex(real64) x(:), optional logical ascend) +!! @endcode +!! +!! @param[in,out] x On input, the array to sort. On output, the sorted +!! array. +!! @param[in] ascend An optional input that, if specified, controls if the +!! the array is sorted in an ascending order (default), or a descending +!! order. +!! +!! @par Remarks +!! The routine utilizes a quick sort algorithm unless the size of the array +!! is less than or equal to 20. For such small arrays an insertion sort +!! algorithm is utilized. +!! +!! @par Notes +!! This routine utilizes the LAPACK routine DLASRT. +!! +!! @par Syntax 2 +!! @code{.f90} +!! subroutine sort(real(real64) x(:), integer(int32) ind(:), optional logical ascend, optional class(errors) err) +!! subroutine sort(complex(real64) x(:), integer(int32) ind(:), optional logical ascend, optional class(errors) err) +!! @endcode +!! +!! @param[in,out] x On input, the array to sort. On output, the sorted +!! array. +!! @param[in,out] ind On input, an integer array. On output, the contents +!! of this array are shifted in the same order as that of @p x as a means +!! of tracking the sorting operation. It is often useful to set this +!! array to an ascending group of values (1, 2, ... n) such that this +!! array tracks the original positions of the sorted array. Such an array +!! can then be used to align other arrays. This array must be the same +!! size as @p x. +!! @param[in] ascend An optional input that, if specified, controls if the +!! the array is sorted in an ascending order (default), or a descending +!! order. +!! @param[in,out] err An optional errors-based object that if provided can be +!! used to retrieve information relating to any errors encountered during +!! execution. If not provided, a default implementation of the errors +!! class is used internally to provide error handling. Possible errors and +!! warning messages that may be encountered are as follows. +!! - LA_ARRAY_SIZE_ERROR: Occurs if @p ind is not sized to match @p x. +!! +!! @par Remarks +!! This routine utilizes a quick sort algorithm explained at +!! http://www.fortran.com/qsort_c.f95. +!! +!! @par Syntax 3 (Eigen sorting) +!! A sorting routine specifically tailored for sorting of eigenvalues +!! and their associated eigenvectors using a quick-sort approach. +!! @code{.f90} +!! subroutine sort(real(real64) vals(:), real(real64) vecs(:,:), optional logical ascend, optional class(errors) err) +!! subroutine sort(complex(real64) vals(:), complex(real64) vecs(:,:), optional logical ascend, optional class(errors) err) +!! @endcode +!! +!! @param[in,out] vals On input, an N-element array containing the +!! eigenvalues. On output, the sorted eigenvalues. +!! @param[in,out] vecs On input, an N-by-N matrix containing the +!! eigenvectors associated with @p vals (one vector per column). On +!! output, the sorted eigenvector matrix. +!! @param[in] ascend An optional input that, if specified, controls if the +!! the array is sorted in an ascending order (default), or a descending +!! order. +!! @param[in,out] err An optional errors-based object that if provided can be +!! used to retrieve information relating to any errors encountered during +!! execution. If not provided, a default implementation of the errors +!! class is used internally to provide error handling. Possible errors and +!! warning messages that may be encountered are as follows. +!! - LA_ARRAY_SIZE_ERROR: Occurs if @p vecs is not sized to match @p vals. +!! - LA_OUT_OF_MEMORY_ERROR: Occurs if there is insufficient memory +!! available to comoplete this operation. interface sort module procedure :: sort_dbl_array module procedure :: sort_dbl_array_ind @@ -3757,38 +3991,6 @@ module subroutine mtx_pinverse_cmplx(a, ainv, tol, work, olwork, rwork, err) ! LINALG_EIGEN.F90 ! ------------------------------------------------------------------------------ interface - !> @brief Computes the eigenvalues, and optionally the eigenvectors of a - !! real, symmetric matrix. - !! - !! @param[in] vecs Set to true to compute the eigenvectors as well as the - !! eigenvalues; else, set to false to just compute the eigenvalues. - !! @param[in,out] a On input, the N-by-N symmetric matrix on which to - !! operate. On output, and if @p vecs is set to true, the matrix will - !! contain the eigenvectors (one per column) corresponding to each - !! eigenvalue in @p vals. If @p vecs is set to false, the lower triangular - !! portion of the matrix is overwritten. - !! @param[out] vals An N-element array that will contain the eigenvalues - !! sorted into ascending order. - !! @param[out] work An optional input, that if provided, prevents any local - !! memory allocation. If not provided, the memory required is allocated - !! within. If provided, the length of the array must be at least - !! @p olwork. - !! @param[out] olwork An optional output used to determine workspace size. - !! If supplied, the routine determines the optimal size for @p work, and - !! returns without performing any actual calculations. - !! @param[out] err An optional errors-based object that if provided can be - !! used to retrieve information relating to any errors encountered during - !! execution. If not provided, a default implementation of the errors - !! class is used internally to provide error handling. Possible errors and - !! warning messages that may be encountered are as follows. - !! - LA_ARRAY_SIZE_ERROR: Occurs if any of the input arrays are not sized - !! appropriately. - !! - LA_OUT_OF_MEMORY_ERROR: Occurs if local memory must be allocated, and - !! there is insufficient memory available. - !! - LA_CONVERGENCE_ERROR: Occurs if the algorithm failed to converge. - !! - !! @par Notes - !! This routine utilizes the LAPACK routine DSYEV. module subroutine eigen_symm(vecs, a, vals, work, olwork, err) logical, intent(in) :: vecs real(real64), intent(inout), dimension(:,:) :: a @@ -3797,37 +3999,7 @@ module subroutine eigen_symm(vecs, a, vals, work, olwork, err) integer(int32), intent(out), optional :: olwork class(errors), intent(inout), optional, target :: err end subroutine - - !> @brief Computes the eigenvalues, and optionally the right eigenvectors of - !! a square matrix. - !! - !! @param[in,out] a On input, the N-by-N matrix on which to operate. On - !! output, the contents of this matrix are overwritten. - !! @param[out] vals An N-element array containing the eigenvalues of the - !! matrix. The eigenvalues are not sorted. - !! @param[out] vecs An optional N-by-N matrix, that if supplied, signals to - !! compute the right eigenvectors (one per column). If not provided, only - !! the eigenvalues will be computed. - !! @param[out] work An optional input, that if provided, prevents any local - !! memory allocation. If not provided, the memory required is allocated - !! within. If provided, the length of the array must be at least - !! @p olwork. - !! @param[out] olwork An optional output used to determine workspace size. - !! If supplied, the routine determines the optimal size for @p work, and - !! returns without performing any actual calculations. - !! @param[out] err An optional errors-based object that if provided can be - !! used to retrieve information relating to any errors encountered during - !! execution. If not provided, a default implementation of the errors - !! class is used internally to provide error handling. Possible errors and - !! warning messages that may be encountered are as follows. - !! - LA_ARRAY_SIZE_ERROR: Occurs if any of the input arrays are not sized - !! appropriately. - !! - LA_OUT_OF_MEMORY_ERROR: Occurs if local memory must be allocated, and - !! there is insufficient memory available. - !! - LA_CONVERGENCE_ERROR: Occurs if the algorithm failed to converge. - !! - !! @par Notes - !! This routine utilizes the LAPACK routine DGEEV. + module subroutine eigen_asymm(a, vals, vecs, work, olwork, err) real(real64), intent(inout), dimension(:,:) :: a complex(real64), intent(out), dimension(:) :: vals @@ -3836,49 +4008,7 @@ module subroutine eigen_asymm(a, vals, vecs, work, olwork, err) integer(int32), intent(out), optional :: olwork class(errors), intent(inout), optional, target :: err end subroutine - - !> @brief Computes the eigenvalues, and optionally the right eigenvectors of - !! a square matrix assuming the structure of the eigenvalue problem is - !! A*X = lambda*B*X. - !! - !! @param[in,out] a On input, the N-by-N matrix A. On output, the contents - !! of this matrix are overwritten. - !! @param[in,out] b On input, the N-by-N matrix B. On output, the contents - !! of this matrix are overwritten. - !! @param[out] alpha An N-element array that, if @p beta is not supplied, - !! contains the eigenvalues. If @p beta is supplied however, the - !! eigenvalues must be computed as ALPHA / BETA. This however, is not as - !! trivial as it seems as it is entirely possible, and likely, that - !! ALPHA / BETA can overflow or underflow. With that said, the values in - !! ALPHA will always be less than and usually comparable with the NORM(A). - !! @param[out] beta An optional N-element array that if provided forces - !! @p alpha to return the numerator, and this array contains the - !! denominator used to determine the eigenvalues as ALPHA / BETA. If used, - !! the values in this array will always be less than and usually comparable - !! with the NORM(B). - !! @param[out] vecs An optional N-by-N matrix, that if supplied, signals to - !! compute the right eigenvectors (one per column). If not provided, only - !! the eigenvalues will be computed. - !! @param[out] work An optional input, that if provided, prevents any local - !! memory allocation. If not provided, the memory required is allocated - !! within. If provided, the length of the array must be at least - !! @p olwork. - !! @param[out] olwork An optional output used to determine workspace size. - !! If supplied, the routine determines the optimal size for @p work, and - !! returns without performing any actual calculations. - !! @param[out] err An optional errors-based object that if provided can be - !! used to retrieve information relating to any errors encountered during - !! execution. If not provided, a default implementation of the errors - !! class is used internally to provide error handling. Possible errors and - !! warning messages that may be encountered are as follows. - !! - LA_ARRAY_SIZE_ERROR: Occurs if any of the input arrays are not sized - !! appropriately. - !! - LA_OUT_OF_MEMORY_ERROR: Occurs if local memory must be allocated, and - !! there is insufficient memory available. - !! - LA_CONVERGENCE_ERROR: Occurs if the algorithm failed to converge. - !! - !! @par Notes - !! This routine utilizes the LAPACK routine DGGEV. + module subroutine eigen_gen(a, b, alpha, beta, vecs, work, olwork, err) real(real64), intent(inout), dimension(:,:) :: a, b complex(real64), intent(out), dimension(:) :: alpha @@ -3889,36 +4019,6 @@ module subroutine eigen_gen(a, b, alpha, beta, vecs, work, olwork, err) class(errors), intent(inout), optional, target :: err end subroutine - !> @brief Computes the eigenvalues, and optionally the right eigenvectors of - !! a square matrix. - !! - !! @param[in,out] a On input, the N-by-N matrix on which to operate. On - !! output, the contents of this matrix are overwritten. - !! @param[out] vals An N-element array containing the eigenvalues of the - !! matrix. The eigenvalues are not sorted. - !! @param[out] vecs An optional N-by-N matrix, that if supplied, signals to - !! compute the right eigenvectors (one per column). If not provided, only - !! the eigenvalues will be computed. - !! @param[out] work An optional input, that if provided, prevents any local - !! memory allocation. If not provided, the memory required is allocated - !! within. If provided, the length of the array must be at least - !! @p olwork. - !! @param[out] olwork An optional output used to determine workspace size. - !! If supplied, the routine determines the optimal size for @p work, and - !! returns without performing any actual calculations. - !! @param[out] err An optional errors-based object that if provided can be - !! used to retrieve information relating to any errors encountered during - !! execution. If not provided, a default implementation of the errors - !! class is used internally to provide error handling. Possible errors and - !! warning messages that may be encountered are as follows. - !! - LA_ARRAY_SIZE_ERROR: Occurs if any of the input arrays are not sized - !! appropriately. - !! - LA_OUT_OF_MEMORY_ERROR: Occurs if local memory must be allocated, and - !! there is insufficient memory available. - !! - LA_CONVERGENCE_ERROR: Occurs if the algorithm failed to converge. - !! - !! @par Notes - !! This routine utilizes the LAPACK routine ZGEEV. module subroutine eigen_cmplx(a, vals, vecs, work, olwork, rwork, err) complex(real64), intent(inout), dimension(:,:) :: a complex(real64), intent(out), dimension(:) :: vals @@ -3934,50 +4034,11 @@ module subroutine eigen_cmplx(a, vals, vecs, work, olwork, rwork, err) ! LINALG_SORTING.F90 ! ------------------------------------------------------------------------------ interface - !> @brief Sorts an array. - !! - !! @param[in,out] x On input, the array to sort. On output, the sorted - !! array. - !! @param[in] ascend An optional input that, if specified, controls if the - !! the array is sorted in an ascending order (default), or a descending - !! order. - !! - !! @par Remarks - !! The routine utilizes a quick sort algorithm unless the size of the array - !! is less than or equal to 20. For such small arrays an insertion sort - !! algorithm is utilized. - !! - !! @par Notes - !! This routine utilizes the LAPACK routine DLASRT. module subroutine sort_dbl_array(x, ascend) real(real64), intent(inout), dimension(:) :: x logical, intent(in), optional :: ascend end subroutine - - !> @brief Sorts an array. - !! - !! @param[in,out] x On input, the array to sort. On output, the sorted - !! array. - !! @param[in,out] ind On input, an integer array. On output, the contents - !! of this array are shifted in the same order as that of @p x as a means - !! of tracking the sorting operation. It is often useful to set this - !! array to an ascending group of values (1, 2, ... n) such that this - !! array tracks the original positions of the sorted array. Such an array - !! can then be used to align other arrays. This array must be the same - !! size as @p x. - !! @param[in] ascend An optional input that, if specified, controls if the - !! the array is sorted in an ascending order (default), or a descending - !! order. - !! @param[out] err An optional errors-based object that if provided can be - !! used to retrieve information relating to any errors encountered during - !! execution. If not provided, a default implementation of the errors - !! class is used internally to provide error handling. Possible errors and - !! warning messages that may be encountered are as follows. - !! - LA_ARRAY_SIZE_ERROR: Occurs if @p ind is not sized to match @p x. - !! - !! @par Remarks - !! This routine utilizes a quick sort algorithm explained at - !! http://www.fortran.com/qsort_c.f95. + module subroutine sort_dbl_array_ind(x, ind, ascend, err) real(real64), intent(inout), dimension(:) :: x integer(int32), intent(inout), dimension(:) :: ind @@ -3985,56 +4046,11 @@ module subroutine sort_dbl_array_ind(x, ind, ascend, err) class(errors), intent(inout), optional, target :: err end subroutine - !> @brief Sorts an array. - !! - !! @param[in,out] x On input, the array to sort. On output, the sorted - !! array. - !! @param[in] ascend An optional input that, if specified, controls if the - !! the array is sorted in an ascending order (default), or a descending - !! order. - !! - !! @par Remarks - !! This routine utilizes a quick sort algorithm. As this routine operates - !! on complex valued items, the complex values are sorted based upon the - !! real component of the number. - !! - !! @par Notes - !! This implementation is a slight modification of the code presented at - !! http://www.fortran.com/qsort_c.f95. module subroutine sort_cmplx_array(x, ascend) complex(real64), intent(inout), dimension(:) :: x logical, intent(in), optional :: ascend end subroutine - !> @brief Sorts an array. - !! - !! @param[in,out] x On input, the array to sort. On output, the sorted - !! array. - !! @param[in,out] ind On input, an integer array. On output, the contents - !! of this array are shifted in the same order as that of @p x as a means - !! of tracking the sorting operation. It is often useful to set this - !! array to an ascending group of values (1, 2, ... n) such that this - !! array tracks the original positions of the sorted array. Such an array - !! can then be used to align other arrays. This array must be the same - !! size as @p x. - !! @param[in] ascend An optional input that, if specified, controls if the - !! the array is sorted in an ascending order (default), or a descending - !! order. - !! @param[out] err An optional errors-based object that if provided can be - !! used to retrieve information relating to any errors encountered during - !! execution. If not provided, a default implementation of the errors - !! class is used internally to provide error handling. Possible errors and - !! warning messages that may be encountered are as follows. - !! - LA_ARRAY_SIZE_ERROR: Occurs if @p ind is not sized to match @p x. - !! - !! @par Remarks - !! This routine utilizes a quick sort algorithm. As this routine operates - !! on complex valued items, the complex values are sorted based upon the - !! real component of the number. - !! - !! @par Notes - !! This implementation is a slight modification of the code presented at - !! http://www.fortran.com/qsort_c.f95. module subroutine sort_cmplx_array_ind(x, ind, ascend, err) complex(real64), intent(inout), dimension(:) :: x integer(int32), intent(inout), dimension(:) :: ind @@ -4042,25 +4058,6 @@ module subroutine sort_cmplx_array_ind(x, ind, ascend, err) class(errors), intent(inout), optional, target :: err end subroutine - !> @brief A sorting routine specifically tailored for sorting of eigenvalues - !! and their associated eigenvectors using a quick-sort approach. - !! - !! @param[in,out] vals On input, an N-element array containing the - !! eigenvalues. On output, the sorted eigenvalues. - !! @param[in,out] vecs On input, an N-by-N matrix containing the - !! eigenvectors associated with @p vals (one vector per column). On - !! output, the sorted eigenvector matrix. - !! @param[in] ascend An optional input that, if specified, controls if the - !! the array is sorted in an ascending order (default), or a descending - !! order. - !! @param[out] err An optional errors-based object that if provided can be - !! used to retrieve information relating to any errors encountered during - !! execution. If not provided, a default implementation of the errors - !! class is used internally to provide error handling. Possible errors and - !! warning messages that may be encountered are as follows. - !! - LA_ARRAY_SIZE_ERROR: Occurs if @p vecs is not sized to match @p vals. - !! - LA_OUT_OF_MEMORY_ERROR: Occurs if there is insufficient memory - !! available to comoplete this operation. module subroutine sort_eigen_cmplx(vals, vecs, ascend, err) complex(real64), intent(inout), dimension(:) :: vals complex(real64), intent(inout), dimension(:,:) :: vecs @@ -4068,25 +4065,6 @@ module subroutine sort_eigen_cmplx(vals, vecs, ascend, err) class(errors), intent(inout), optional, target :: err end subroutine - !> @brief A sorting routine specifically tailored for sorting of eigenvalues - !! and their associated eigenvectors using a quick-sort approach. - !! - !! @param[in,out] vals On input, an N-element array containing the - !! eigenvalues. On output, the sorted eigenvalues. - !! @param[in,out] vecs On input, an N-by-N matrix containing the - !! eigenvectors associated with @p vals (one vector per column). On - !! output, the sorted eigenvector matrix. - !! @param[in] ascend An optional input that, if specified, controls if the - !! the array is sorted in an ascending order (default), or a descending - !! order. - !! @param[out] err An optional errors-based object that if provided can be - !! used to retrieve information relating to any errors encountered during - !! execution. If not provided, a default implementation of the errors - !! class is used internally to provide error handling. Possible errors and - !! warning messages that may be encountered are as follows. - !! - LA_ARRAY_SIZE_ERROR: Occurs if @p vecs is not sized to match @p vals. - !! - LA_OUT_OF_MEMORY_ERROR: Occurs if there is insufficient memory - !! available to comoplete this operation. module subroutine sort_eigen_dbl(vals, vecs, ascend, err) real(real64), intent(inout), dimension(:) :: vals real(real64), intent(inout), dimension(:,:) :: vecs diff --git a/src/linalg_basic.f90 b/src/linalg_basic.f90 index ae1058a7..0029c267 100644 --- a/src/linalg_basic.f90 +++ b/src/linalg_basic.f90 @@ -1,6 +1,6 @@ ! linalg_basic.f90 -submodule (linalg_core) linalg_basic +submodule (linalg) linalg_basic contains ! ****************************************************************************** ! MATRIX MULTIPLICATION ROUTINES @@ -157,11 +157,11 @@ module subroutine cmtx_mult_mtx(opa, opb, alpha, a, b, beta, c, err) ! Initialization m = size(c, 1) n = size(c, 2) - if (opa == TRANSPOSE) then ! K = # of columns in op(A) (# of rows in op(B)) + if (opa == LA_TRANSPOSE) then ! K = # of columns in op(A) (# of rows in op(B)) k = size(a, 1) ta = 'T' lda = k - else if (opa == HERMITIAN_TRANSPOSE) then + else if (opa == LA_HERMITIAN_TRANSPOSE) then k = size(a, 1) ta = 'H' lda = k @@ -170,10 +170,10 @@ module subroutine cmtx_mult_mtx(opa, opb, alpha, a, b, beta, c, err) ta = 'N' lda = m end if - if (opb == TRANSPOSE) then + if (opb == LA_TRANSPOSE) then tb = 'T' ldb = n - else if (opb == HERMITIAN_TRANSPOSE) then + else if (opb == LA_HERMITIAN_TRANSPOSE) then tb = 'H' ldb = n else @@ -188,12 +188,12 @@ module subroutine cmtx_mult_mtx(opa, opb, alpha, a, b, beta, c, err) ! Input Check flag = 0 - if (opa == TRANSPOSE .or. opa == HERMITIAN_TRANSPOSE) then + if (opa == LA_TRANSPOSE .or. opa == LA_HERMITIAN_TRANSPOSE) then if (size(a, 2) /= m) flag = 4 else if (size(a, 1) /= m) flag = 4 end if - if (opb == TRANSPOSE .or. opb == HERMITIAN_TRANSPOSE) then + if (opb == LA_TRANSPOSE .or. opb == LA_HERMITIAN_TRANSPOSE) then if (size(b, 2) /= k .or. size(b, 1) /= n) flag = 5 else if (size(b, 1) /= k .or. size(b, 2) /= n) flag = 5 @@ -232,9 +232,9 @@ module subroutine cmtx_mult_vec(opa, alpha, a, b, beta, c, err) ! Initialization m = size(a, 1) n = size(a, 2) - if (opa == TRANSPOSE) then + if (opa == LA_TRANSPOSE) then t = 'T' - else if (opa == HERMITIAN_TRANSPOSE) then + else if (opa == LA_HERMITIAN_TRANSPOSE) then t = 'H' else t = 'N' @@ -247,7 +247,7 @@ module subroutine cmtx_mult_vec(opa, alpha, a, b, beta, c, err) ! Input Check flag = 0 - if (opa == TRANSPOSE .or. opa == HERMITIAN_TRANSPOSE) then + if (opa == LA_TRANSPOSE .or. opa == LA_HERMITIAN_TRANSPOSE) then if (size(b) /= m) then flag = 4 else if (size(c) /= n) then @@ -760,7 +760,7 @@ module subroutine diag_mtx_mult_mtx4(lside, opb, alpha, a, b, beta, c, err) if (k > m) then flag = 4 else - if (opb == TRANSPOSE .or. opb == HERMITIAN_TRANSPOSE) then + if (opb == LA_TRANSPOSE .or. opb == LA_HERMITIAN_TRANSPOSE) then ! Compute C = alpha * A * B**T + beta * C if (nrowb /= n .or. ncolb < k) flag = 5 else @@ -772,7 +772,7 @@ module subroutine diag_mtx_mult_mtx4(lside, opb, alpha, a, b, beta, c, err) if (k > n) then flag = 4 else - if (opb == TRANSPOSE .or. opb == HERMITIAN_TRANSPOSE) then + if (opb == LA_TRANSPOSE .or. opb == LA_HERMITIAN_TRANSPOSE) then ! Compute C = alpha * B**T * A + beta * C if (ncolb /= m .or. nrowb < k) flag = 5 else @@ -802,7 +802,7 @@ module subroutine diag_mtx_mult_mtx4(lside, opb, alpha, a, b, beta, c, err) ! Process if (lside) then - if (opb == TRANSPOSE) then + if (opb == LA_TRANSPOSE) then ! Compute C = alpha * A * B**T + beta * C do i = 1, k if (beta == zero) then @@ -813,7 +813,7 @@ module subroutine diag_mtx_mult_mtx4(lside, opb, alpha, a, b, beta, c, err) temp = alpha * a(i) if (temp /= one) c(i,:) = c(i,:) + temp * b(:,i) end do - else if (opb == HERMITIAN_TRANSPOSE) then + else if (opb == LA_HERMITIAN_TRANSPOSE) then ! Compute C = alpha * A * B**H + beta * C do i = 1, k if (beta == zero) then @@ -846,7 +846,7 @@ module subroutine diag_mtx_mult_mtx4(lside, opb, alpha, a, b, beta, c, err) end if end if else - if (opb == TRANSPOSE) then + if (opb == LA_TRANSPOSE) then ! Compute C = alpha * B**T * A + beta * C do i = 1, k if (beta == zero) then @@ -857,7 +857,7 @@ module subroutine diag_mtx_mult_mtx4(lside, opb, alpha, a, b, beta, c, err) temp = alpha * a(i) if (temp /= one) c(:,i) = c(:,i) + temp * b(i,:) end do - else if (opb == HERMITIAN_TRANSPOSE) then + else if (opb == LA_HERMITIAN_TRANSPOSE) then ! Compute C = alpha * B**H * A + beta * C do i = 1, k if (beta == zero) then @@ -932,7 +932,7 @@ module subroutine diag_mtx_mult_mtx_cmplx(lside, opb, alpha, a, b, beta, c, err) if (k > m) then flag = 4 else - if (opb == TRANSPOSE .or. opb == HERMITIAN_TRANSPOSE) then + if (opb == LA_TRANSPOSE .or. opb == LA_HERMITIAN_TRANSPOSE) then ! Compute C = alpha * A * B**T + beta * C if (nrowb /= n .or. ncolb < k) flag = 5 else @@ -944,7 +944,7 @@ module subroutine diag_mtx_mult_mtx_cmplx(lside, opb, alpha, a, b, beta, c, err) if (k > n) then flag = 4 else - if (opb == TRANSPOSE .or. opb == HERMITIAN_TRANSPOSE) then + if (opb == LA_TRANSPOSE .or. opb == LA_HERMITIAN_TRANSPOSE) then ! Compute C = alpha * B**T * A + beta * C if (ncolb /= m .or. nrowb < k) flag = 5 else @@ -974,7 +974,7 @@ module subroutine diag_mtx_mult_mtx_cmplx(lside, opb, alpha, a, b, beta, c, err) ! Process if (lside) then - if (opb == TRANSPOSE) then + if (opb == LA_TRANSPOSE) then ! Compute C = alpha * A * B**T + beta * C do i = 1, k if (beta == zero) then @@ -985,7 +985,7 @@ module subroutine diag_mtx_mult_mtx_cmplx(lside, opb, alpha, a, b, beta, c, err) temp = alpha * a(i) if (temp /= one) c(i,:) = c(i,:) + temp * b(:,i) end do - else if (opb == HERMITIAN_TRANSPOSE) then + else if (opb == LA_HERMITIAN_TRANSPOSE) then ! Compute C = alpha * A * B**H + beta * C do i = 1, k if (beta == zero) then @@ -1018,7 +1018,7 @@ module subroutine diag_mtx_mult_mtx_cmplx(lside, opb, alpha, a, b, beta, c, err) end if end if else - if (opb == TRANSPOSE) then + if (opb == LA_TRANSPOSE) then ! Compute C = alpha * B**T * A + beta * C do i = 1, k if (beta == zero) then @@ -1029,7 +1029,7 @@ module subroutine diag_mtx_mult_mtx_cmplx(lside, opb, alpha, a, b, beta, c, err) temp = alpha * a(i) if (temp /= one) c(:,i) = c(:,i) + temp * b(i,:) end do - else if (opb == HERMITIAN_TRANSPOSE) then + else if (opb == LA_HERMITIAN_TRANSPOSE) then ! Compute C = alpha * B**H * A + beta * C do i = 1, k if (beta == zero) then @@ -1160,7 +1160,7 @@ module subroutine diag_mtx_mult_mtx_mix(lside, opb, alpha, a, b, beta, c, err) if (k > m) then flag = 4 else - if (opb == TRANSPOSE .or. opb == HERMITIAN_TRANSPOSE) then + if (opb == LA_TRANSPOSE .or. opb == LA_HERMITIAN_TRANSPOSE) then ! Compute C = alpha * A * B**T + beta * C if (nrowb /= n .or. ncolb < k) flag = 5 else @@ -1172,7 +1172,7 @@ module subroutine diag_mtx_mult_mtx_mix(lside, opb, alpha, a, b, beta, c, err) if (k > n) then flag = 4 else - if (opb == TRANSPOSE .or. opb == HERMITIAN_TRANSPOSE) then + if (opb == LA_TRANSPOSE .or. opb == LA_HERMITIAN_TRANSPOSE) then ! Compute C = alpha * B**T * A + beta * C if (ncolb /= m .or. nrowb < k) flag = 5 else @@ -1202,7 +1202,7 @@ module subroutine diag_mtx_mult_mtx_mix(lside, opb, alpha, a, b, beta, c, err) ! Process if (lside) then - if (opb == TRANSPOSE) then + if (opb == LA_TRANSPOSE) then ! Compute C = alpha * A * B**T + beta * C do i = 1, k if (beta == zero) then @@ -1213,7 +1213,7 @@ module subroutine diag_mtx_mult_mtx_mix(lside, opb, alpha, a, b, beta, c, err) temp = alpha * a(i) if (temp /= one) c(i,:) = c(i,:) + temp * b(:,i) end do - else if (opb == HERMITIAN_TRANSPOSE) then + else if (opb == LA_HERMITIAN_TRANSPOSE) then ! Compute C = alpha * A * B**H + beta * C do i = 1, k if (beta == zero) then @@ -1246,7 +1246,7 @@ module subroutine diag_mtx_mult_mtx_mix(lside, opb, alpha, a, b, beta, c, err) end if end if else - if (opb == TRANSPOSE) then + if (opb == LA_TRANSPOSE) then ! Compute C = alpha * B**T * A + beta * C do i = 1, k if (beta == zero) then @@ -1257,7 +1257,7 @@ module subroutine diag_mtx_mult_mtx_mix(lside, opb, alpha, a, b, beta, c, err) temp = alpha * a(i) if (temp /= one) c(:,i) = c(:,i) + temp * b(i,:) end do - else if (opb == HERMITIAN_TRANSPOSE) then + else if (opb == LA_HERMITIAN_TRANSPOSE) then ! Compute C = alpha * B**H * A + beta * C do i = 1, k if (beta == zero) then diff --git a/src/linalg_c_api.f90 b/src/linalg_c_api.f90 index 5f213ecf..762b22f0 100644 --- a/src/linalg_c_api.f90 +++ b/src/linalg_c_api.f90 @@ -4,8 +4,7 @@ !! LINALG routines begin with the prefix "la_". module linalg_c_api use iso_c_binding - use linalg_core - use linalg_constants + use linalg use ferror implicit none @@ -228,20 +227,20 @@ function la_mtx_mult(transa, transb, m, n, k, alpha, a, lda, b, ldb, & ! ------------------------------------------------------------------------------ !> @brief Computes the matrix operation C = alpha * op(A) * op(B) + beta * C. !! - !! @param opa Set to TRANSPOSE to compute op(A) as a direct transpose of A, - !! set to HERMITIAN_TRANSPOSE to compute op(A) as the Hermitian transpose + !! @param opa Set to LA_TRANSPOSE to compute op(A) as a direct transpose of A, + !! set to LA_HERMITIAN_TRANSPOSE to compute op(A) as the Hermitian transpose !! of A, otherwise, set to NO_OPERATION to compute op(A) as A. - !! @param opb Set to TRANSPOSE to compute op(B) as a direct transpose of B, - !! set to HERMITIAN_TRANSPOSE to compute op(B) as the Hermitian transpose + !! @param opb Set to LA_TRANSPOSE to compute op(B) as a direct transpose of B, + !! set to LA_HERMITIAN_TRANSPOSE to compute op(B) as the Hermitian transpose !! of B, otherwise, set to NO_OPERATION to compute op(B) as B. !! @param mThe number of rows in @p c. !! @param n The number of columns in @p c. !! @param k The interior dimension of the product @p a and @p b. !! @param alpha A scalar multiplier. - !! @param a If @p opa is TRANSPOSE or HERMITIAN_TRANSPOSE, this matrix must + !! @param a If @p opa is LA_TRANSPOSE or LA_HERMITIAN_TRANSPOSE, this matrix must !! be @p k by @p m; else, this matrix must be @p m by @p k. !! @param lda The leading dimension of matrix @p a. - !! @param b If @p opb is TRANSPOSE or HERMITIAN_TRANSPOSE, this matrix must + !! @param b If @p opb is LA_TRANSPOSE or LA_HERMITIAN_TRANSPOSE, this matrix must !! be @p n by @p k; else, this matrix must be @p k by @p n. !! @param ldb The leading dimension of matrix @p b. !! @param beta A scalar multiplier. @@ -267,29 +266,29 @@ function la_mtx_mult_cmplx(opa, opb, m, n, k, alpha, a, lda, b, ldb, & ! Initialization flag = LA_NO_ERROR - if (opa == TRANSPOSE) then + if (opa == LA_TRANSPOSE) then ta = "T" - else if (opa == HERMITIAN_TRANSPOSE) then + else if (opa == LA_HERMITIAN_TRANSPOSE) then ta = "H" else ta = "N" end if - if (opb == TRANSPOSE) then + if (opb == LA_TRANSPOSE) then tb = "T" - else if (opb == HERMITIAN_TRANSPOSE) then + else if (opb == LA_HERMITIAN_TRANSPOSE) then tb = "H" else tb = "N" end if - if (opa == TRANSPOSE .or. opa == HERMITIAN_TRANSPOSE) then + if (opa == LA_TRANSPOSE .or. opa == LA_HERMITIAN_TRANSPOSE) then nrowa = k else nrowa = m end if - if (opb == TRANSPOSE .or. opb == HERMITIAN_TRANSPOSE) then + if (opb == LA_TRANSPOSE .or. opb == LA_HERMITIAN_TRANSPOSE) then nrowb = n else nrowb = k @@ -399,8 +398,8 @@ function la_diag_mtx_mult(lside, transb, m, n, k, alpha, a, b, ldb, & !! !! @param lside Set to true to apply matrix A from the left; else, set !! to false to apply matrix A from the left. - !! @param opb Set to TRANSPOSE to compute op(B) as a direct transpose of B, - !! set to HERMITIAN_TRANSPOSE to compute op(B) as the Hermitian transpose + !! @param opb Set to LA_TRANSPOSE to compute op(B) as a direct transpose of B, + !! set to LA_HERMITIAN_TRANSPOSE to compute op(B) as the Hermitian transpose !! of B, otherwise, set to NO_OPERATION to compute op(B) as B. !! @param m The number of rows in the matrix C. !! @param n The number of columns in the matrix C. @@ -446,7 +445,7 @@ function la_diag_mtx_mult_mixed(lside, opb, m, n, k, alpha, a, b, ldb, & call err%set_exit_on_error(.false.) flag = LA_NO_ERROR tb = .false. - if (opb == TRANSPOSE .or. opb == HERMITIAN_TRANSPOSE) tb = .true. + if (opb == LA_TRANSPOSE .or. opb == LA_HERMITIAN_TRANSPOSE) tb = .true. if (lside .and. tb) then nrows = n ncols = k @@ -487,8 +486,8 @@ function la_diag_mtx_mult_mixed(lside, opb, m, n, k, alpha, a, b, ldb, & !! !! @param lside Set to true to apply matrix A from the left; else, set !! to false to apply matrix A from the left. - !! @param opb Set to TRANSPOSE to compute op(B) as a direct transpose of B, - !! set to HERMITIAN_TRANSPOSE to compute op(B) as the Hermitian transpose + !! @param opb Set to LA_TRANSPOSE to compute op(B) as a direct transpose of B, + !! set to LA_HERMITIAN_TRANSPOSE to compute op(B) as the Hermitian transpose !! of B, otherwise, set to NO_OPERATION to compute op(B) as B. !! @param m The number of rows in the matrix C. !! @param n The number of columns in the matrix C. @@ -534,7 +533,7 @@ function la_diag_mtx_mult_cmplx(lside, opb, m, n, k, alpha, a, b, & call err%set_exit_on_error(.false.) flag = LA_NO_ERROR tb = .false. - if (opb == TRANSPOSE .or. opb == HERMITIAN_TRANSPOSE) tb = .true. + if (opb == LA_TRANSPOSE .or. opb == LA_HERMITIAN_TRANSPOSE) tb = .true. if (lside .and. tb) then nrows = n ncols = k diff --git a/src/linalg_constants.f90 b/src/linalg_constants.f90 deleted file mode 100644 index 2b23eaf8..00000000 --- a/src/linalg_constants.f90 +++ /dev/null @@ -1,37 +0,0 @@ -! linalg_constants.f90 - -!> @brief Provides a set of constants and error flags for the library. -module linalg_constants - use, intrinsic :: iso_fortran_env, only : int32 - implicit none - -! ****************************************************************************** -! CONSTANTS -! ------------------------------------------------------------------------------ - !> @brief Defines no operation should be performed on the matrix. - integer(int32), parameter :: NO_OPERATION = 0 - !> @brief Defines a transpose operation. - integer(int32), parameter :: TRANSPOSE = 1 - !> @brief Defines a Hermitian transpose operation for a complex-valued matrix. - integer(int32), parameter :: HERMITIAN_TRANSPOSE = 2 - -! ****************************************************************************** -! ERROR FLAGS -! ------------------------------------------------------------------------------ - !> A flag denoting no error condition. - integer(int32), parameter :: LA_NO_ERROR = 0 - !> An error flag denoting an invalid input. - integer(int32), parameter :: LA_INVALID_INPUT_ERROR = 101 - !> An error flag denoting an improperly sized array. - integer(int32), parameter :: LA_ARRAY_SIZE_ERROR = 102 - !> An error flag denoting a singular matrix. - integer(int32), parameter :: LA_SINGULAR_MATRIX_ERROR = 103 - !> An error flag denoting an issue with the matrix format. - integer(int32), parameter :: LA_MATRIX_FORMAT_ERROR = 104 - !> An error flag denoting that there is insufficient memory available. - integer(int32), parameter :: LA_OUT_OF_MEMORY_ERROR = 105 - !> An error flag denoting a convergence failure. - integer(int32), parameter :: LA_CONVERGENCE_ERROR = 106 - !> An error resulting from an invalid operation. - integer(int32), parameter :: LA_INVALID_OPERATION_ERROR = 107 -end module diff --git a/src/linalg_eigen.f90 b/src/linalg_eigen.f90 index 886d1edb..d914644e 100644 --- a/src/linalg_eigen.f90 +++ b/src/linalg_eigen.f90 @@ -4,7 +4,7 @@ !! !! @par Purpose !! Provides routines for computing the eigenvalues and eigenvectors of matrices. -submodule (linalg_core) linalg_eigen +submodule (linalg) linalg_eigen contains ! ------------------------------------------------------------------------------ module subroutine eigen_symm(vecs, a, vals, work, olwork, err) diff --git a/src/linalg_factor.f90 b/src/linalg_factor.f90 index e08ef7d8..2adb352e 100644 --- a/src/linalg_factor.f90 +++ b/src/linalg_factor.f90 @@ -4,7 +4,7 @@ !! !! @par Purpose !! Provides a set of matrix factorization routines. -submodule (linalg_core) linalg_factor +submodule (linalg) linalg_factor contains ! ****************************************************************************** ! LU FACTORIZATION diff --git a/src/linalg_immutable.f90 b/src/linalg_immutable.f90 index 2577abd0..d2f80f33 100644 --- a/src/linalg_immutable.f90 +++ b/src/linalg_immutable.f90 @@ -13,8 +13,7 @@ !! termination of the program. module linalg_immutable use, intrinsic :: iso_fortran_env, only : int32, real64 - use linalg_core - use linalg_constants + use linalg implicit none private public :: mat_rank1_update @@ -301,10 +300,10 @@ function mat_mult_diag_1_cmplx(a, b) result(c) ! Process if (size(b, 1) > size(a)) then - call diag_mtx_mult(.true., NO_OPERATION, one, a, b(1:size(a),:), & + call diag_mtx_mult(.true., LA_NO_OPERATION, one, a, b(1:size(a),:), & zero, c) else - call diag_mtx_mult(.true., NO_OPERATION, one, a, b, zero, c) + call diag_mtx_mult(.true., LA_NO_OPERATION, one, a, b, zero, c) end if end function @@ -330,7 +329,7 @@ function mat_mult_diag_2_cmplx(a, b) result(c) ! Process bc(:,1) = b(1:min(size(a), size(b))) - call diag_mtx_mult(.true., NO_OPERATION, one, a, bc, zero, cc) + call diag_mtx_mult(.true., LA_NO_OPERATION, one, a, bc, zero, cc) c = cc(:,1) end function @@ -350,10 +349,10 @@ function mat_mult_diag_3_cmplx(a, b) result(c) ! Process if (size(a, 2) > size(b)) then - call diag_mtx_mult(.false., NO_OPERATION, 1.0d0, b, a(:,1:size(b)), & + call diag_mtx_mult(.false., LA_NO_OPERATION, 1.0d0, b, a(:,1:size(b)), & 0.0d0, c) else - call diag_mtx_mult(.false., NO_OPERATION, 1.0d0, b, a, 0.0d0, c) + call diag_mtx_mult(.false., LA_NO_OPERATION, 1.0d0, b, a, 0.0d0, c) end if end function diff --git a/src/linalg_solve.f90 b/src/linalg_solve.f90 index 89a2dce6..3fbf5c38 100644 --- a/src/linalg_solve.f90 +++ b/src/linalg_solve.f90 @@ -4,7 +4,7 @@ !! !! @par Purpose !! Provides a set of routines for solving systems of linear equations. -submodule (linalg_core) linalg_solve +submodule (linalg) linalg_solve contains ! ****************************************************************************** ! TRIANGULAR MATRIX SOLUTION ROUTINES diff --git a/src/linalg_sorting.f90 b/src/linalg_sorting.f90 index ea56b342..df827ea7 100644 --- a/src/linalg_sorting.f90 +++ b/src/linalg_sorting.f90 @@ -4,7 +4,7 @@ !! !! @par Purpose !! Provides sorting routines. -submodule (linalg_core) linalg_sorting +submodule (linalg) linalg_sorting contains ! ****************************************************************************** ! SORTING ROUTINES diff --git a/tests/test_cholesky.f90 b/tests/test_cholesky.f90 index b9e7870d..87649bc8 100644 --- a/tests/test_cholesky.f90 +++ b/tests/test_cholesky.f90 @@ -4,7 +4,7 @@ module test_cholesky use, intrinsic :: iso_fortran_env, only : int32, real64 use test_core - use linalg_core + use linalg implicit none contains ! ****************************************************************************** diff --git a/tests/test_eigen.f90 b/tests/test_eigen.f90 index 3d78ea2b..bf12b94e 100644 --- a/tests/test_eigen.f90 +++ b/tests/test_eigen.f90 @@ -3,8 +3,7 @@ ! Tests the eigenvalue/eigenvector routines module test_eigen use, intrinsic :: iso_fortran_env, only : int32, real64 - use linalg_core - use linalg_constants + use linalg use test_core implicit none contains @@ -110,7 +109,7 @@ function test_eigen_gen() result(rst) x = matmul(a, vecs) ! And Y = B * (VECS * LAMBDA) - call diag_mtx_mult(.false., NO_OPERATION, 1.0d0, vals, vecs, 0.0d0, y) + call diag_mtx_mult(.false., LA_NO_OPERATION, 1.0d0, vals, vecs, 0.0d0, y) y = matmul(b, y) ! Check diff --git a/tests/test_lu.f90 b/tests/test_lu.f90 index c88e58e4..31cae68f 100644 --- a/tests/test_lu.f90 +++ b/tests/test_lu.f90 @@ -4,7 +4,7 @@ module test_lu use, intrinsic :: iso_fortran_env, only : int32, real64 use test_core - use linalg_core + use linalg contains ! ****************************************************************************** ! LU FACTORIZATION TEST diff --git a/tests/test_misc.f90 b/tests/test_misc.f90 index a7bee80e..1861b396 100644 --- a/tests/test_misc.f90 +++ b/tests/test_misc.f90 @@ -3,7 +3,7 @@ ! Tests miscellaneous routines. module test_misc use, intrinsic :: iso_fortran_env, only : int32, real64 - use linalg_core + use linalg use test_core implicit none contains diff --git a/tests/test_mtx_inverse.f90 b/tests/test_mtx_inverse.f90 index 2f099968..4e280f9e 100644 --- a/tests/test_mtx_inverse.f90 +++ b/tests/test_mtx_inverse.f90 @@ -4,7 +4,7 @@ module test_mtx_inverse use, intrinsic :: iso_fortran_env, only : int32, real64 use test_core - use linalg_core + use linalg implicit none contains ! ****************************************************************************** diff --git a/tests/test_qr.f90 b/tests/test_qr.f90 index 1c5ef3f5..0f118dfd 100644 --- a/tests/test_qr.f90 +++ b/tests/test_qr.f90 @@ -4,7 +4,7 @@ module test_qr use, intrinsic :: iso_fortran_env, only : int32, real64 use test_core - use linalg_core + use linalg implicit none contains ! ****************************************************************************** diff --git a/tests/test_sort.f90 b/tests/test_sort.f90 index a33c6e52..3049f581 100644 --- a/tests/test_sort.f90 +++ b/tests/test_sort.f90 @@ -4,7 +4,7 @@ module test_sort use, intrinsic :: iso_fortran_env, only : int32, real64 use test_core - use linalg_core + use linalg implicit none contains diff --git a/tests/test_svd.f90 b/tests/test_svd.f90 index dd70154d..a207a329 100644 --- a/tests/test_svd.f90 +++ b/tests/test_svd.f90 @@ -4,7 +4,7 @@ module test_svd_ops use, intrinsic :: iso_fortran_env, only : int32, real64 use test_core - use linalg_core + use linalg implicit none contains ! ------------------------------------------------------------------------------ From 7d7d2e89ce0a238f256923e8639d364bedb6690a Mon Sep 17 00:00:00 2001 From: jchristopherson Date: Thu, 15 Dec 2022 17:05:59 -0600 Subject: [PATCH 24/65] Update documentation --- doc/Doxyfile | 8 +- doc/html/annotated.html | 66 +- doc/html/annotated_dup.js | 66 +- doc/html/classes.html | 20 +- .../dir_68267d1309a1af8e8297ef4c3efbcdba.html | 8 +- .../dir_68267d1309a1af8e8297ef4c3efbcdba.js | 4 +- doc/html/files.html | 16 +- ...acelinalg_1_1cholesky__factor-members.html | 114 + .../interfacelinalg_1_1cholesky__factor.html | 200 + ..._1_1cholesky__rank1__downdate-members.html | 114 + ...celinalg_1_1cholesky__rank1__downdate.html | 201 + ...lg_1_1cholesky__rank1__update-members.html | 114 + ...facelinalg_1_1cholesky__rank1__update.html | 195 + doc/html/interfacelinalg_1_1det-members.html | 114 + doc/html/interfacelinalg_1_1det.html | 141 + ...facelinalg_1_1diag__mtx__mult-members.html | 114 + .../interfacelinalg_1_1diag__mtx__mult.html | 226 + .../interfacelinalg_1_1eigen-members.html | 114 + doc/html/interfacelinalg_1_1eigen.html | 263 ++ .../interfacelinalg_1_1form__lu-members.html | 114 + doc/html/interfacelinalg_1_1form__lu.html | 220 + .../interfacelinalg_1_1form__qr-members.html | 114 + doc/html/interfacelinalg_1_1form__qr.html | 230 + ...interfacelinalg_1_1lu__factor-members.html | 114 + doc/html/interfacelinalg_1_1lu__factor.html | 189 + ...terfacelinalg_1_1mtx__inverse-members.html | 114 + doc/html/interfacelinalg_1_1mtx__inverse.html | 194 + .../interfacelinalg_1_1mtx__mult-members.html | 114 + doc/html/interfacelinalg_1_1mtx__mult.html | 163 + ...erfacelinalg_1_1mtx__pinverse-members.html | 114 + .../interfacelinalg_1_1mtx__pinverse.html | 196 + .../interfacelinalg_1_1mtx__rank-members.html | 114 + doc/html/interfacelinalg_1_1mtx__rank.html | 148 + .../interfacelinalg_1_1mult__qr-members.html | 114 + doc/html/interfacelinalg_1_1mult__qr.html | 224 + .../interfacelinalg_1_1mult__rz-members.html | 114 + doc/html/interfacelinalg_1_1mult__rz.html | 167 + ...interfacelinalg_1_1qr__factor-members.html | 114 + doc/html/interfacelinalg_1_1qr__factor.html | 218 + ...celinalg_1_1qr__rank1__update-members.html | 114 + .../interfacelinalg_1_1qr__rank1__update.html | 231 + ...erfacelinalg_1_1rank1__update-members.html | 114 + .../interfacelinalg_1_1rank1__update.html | 142 + ...elinalg_1_1recip__mult__array-members.html | 114 + ...interfacelinalg_1_1recip__mult__array.html | 135 + ...interfacelinalg_1_1rz__factor-members.html | 114 + doc/html/interfacelinalg_1_1rz__factor.html | 152 + ...facelinalg_1_1solve__cholesky-members.html | 114 + .../interfacelinalg_1_1solve__cholesky.html | 202 + ...nalg_1_1solve__least__squares-members.html | 114 + ...erfacelinalg_1_1solve__least__squares.html | 182 + ..._1solve__least__squares__full-members.html | 114 + ...linalg_1_1solve__least__squares__full.html | 184 + ...1_1solve__least__squares__svd-members.html | 114 + ...elinalg_1_1solve__least__squares__svd.html | 186 + .../interfacelinalg_1_1solve__lu-members.html | 114 + doc/html/interfacelinalg_1_1solve__lu.html | 191 + .../interfacelinalg_1_1solve__qr-members.html | 114 + doc/html/interfacelinalg_1_1solve__qr.html | 219 + ..._1_1solve__triangular__system-members.html | 114 + ...celinalg_1_1solve__triangular__system.html | 217 + doc/html/interfacelinalg_1_1sort-members.html | 114 + doc/html/interfacelinalg_1_1sort.html | 169 + doc/html/interfacelinalg_1_1svd-members.html | 114 + doc/html/interfacelinalg_1_1svd.html | 208 + doc/html/interfacelinalg_1_1swap-members.html | 114 + doc/html/interfacelinalg_1_1swap.html | 139 + .../interfacelinalg_1_1trace-members.html | 114 + doc/html/interfacelinalg_1_1trace.html | 135 + ...rfacelinalg_1_1tri__mtx__mult-members.html | 114 + .../interfacelinalg_1_1tri__mtx__mult.html | 142 + ...erfacelinalg__immutable_1_1mat__eigen.html | 2 +- ...interfacelinalg__immutable_1_1mat__lu.html | 2 +- ...elinalg__immutable_1_1mat__mult__diag.html | 2 +- ...g__immutable_1_1mat__mult__lower__tri.html | 2 +- ...g__immutable_1_1mat__mult__upper__tri.html | 2 +- ...__immutable_1_1mat__solve__lower__tri.html | 2 +- ...__immutable_1_1mat__solve__upper__tri.html | 2 +- doc/html/linalg_8f90_source.html | 1340 ++++++ doc/html/linalg_8h_source.html | 183 +- doc/html/linalg__basic_8f90_source.html | 58 +- doc/html/linalg__c__api_8f90_source.html | 3888 ++++++++--------- doc/html/linalg__eigen_8f90_source.html | 4 +- doc/html/linalg__factor_8f90_source.html | 4 +- doc/html/linalg__immutable_8f90_source.html | 1546 ++++--- doc/html/linalg__solve_8f90_source.html | 4 +- doc/html/linalg__sorting_8f90_source.html | 4 +- doc/html/menudata.js | 13 +- doc/html/namespacelinalg.html | 456 ++ doc/html/namespacelinalg.js | 46 + doc/html/namespacelinalg__c__api.html | 134 +- doc/html/namespacelinalg__immutable.html | 22 +- doc/html/namespacemembers.html | 107 +- doc/html/namespacemembers_func.html | 73 +- doc/html/namespacemembers_vars.html | 22 +- doc/html/namespaces.html | 98 +- doc/html/namespaces_dup.js | 78 +- doc/html/navtreeindex0.js | 325 +- doc/html/search/all_0.js | 6 +- doc/html/search/all_1.js | 4 +- doc/html/search/all_2.js | 2 +- doc/html/search/all_3.js | 4 +- doc/html/search/all_4.js | 2 +- doc/html/search/all_5.js | 18 +- doc/html/search/all_6.js | 101 +- doc/html/search/all_7.js | 24 +- doc/html/search/all_8.js | 6 +- doc/html/search/all_9.js | 5 +- doc/html/search/all_a.js | 18 +- doc/html/search/all_b.js | 6 +- doc/html/search/all_c.js | 14 +- doc/html/search/all_d.js | 6 +- doc/html/search/classes_0.js | 6 +- doc/html/search/classes_1.js | 4 +- doc/html/search/classes_2.js | 2 +- doc/html/search/classes_3.js | 4 +- doc/html/search/classes_4.js | 2 +- doc/html/search/classes_5.js | 12 +- doc/html/search/classes_6.js | 4 +- doc/html/search/classes_7.js | 6 +- doc/html/search/classes_8.js | 20 +- doc/html/search/classes_9.js | 4 +- doc/html/search/functions_1.js | 71 +- doc/html/search/namespaces_0.js | 6 +- doc/html/search/searchdata.js | 6 +- doc/html/search/variables_0.js | 13 +- doc/html/search/variables_1.js | 10 +- doc/html/search/variables_2.js | 2 +- doc/html/search/variables_3.js | 2 +- doc/html/search/variables_4.js | 2 +- doc/html/search/variables_5.js | 2 +- doc/html/search/variables_6.js | 4 +- ...ctlinalg__immutable_1_1eigen__results.html | 6 +- ...tructlinalg__immutable_1_1lu__results.html | 8 +- ...nalg__immutable_1_1lu__results__cmplx.html | 8 +- ...tructlinalg__immutable_1_1qr__results.html | 8 +- ...nalg__immutable_1_1qr__results__cmplx.html | 8 +- ...ructlinalg__immutable_1_1svd__results.html | 8 +- ...alg__immutable_1_1svd__results__cmplx.html | 8 +- 139 files changed, 14861 insertions(+), 3855 deletions(-) create mode 100644 doc/html/interfacelinalg_1_1cholesky__factor-members.html create mode 100644 doc/html/interfacelinalg_1_1cholesky__factor.html create mode 100644 doc/html/interfacelinalg_1_1cholesky__rank1__downdate-members.html create mode 100644 doc/html/interfacelinalg_1_1cholesky__rank1__downdate.html create mode 100644 doc/html/interfacelinalg_1_1cholesky__rank1__update-members.html create mode 100644 doc/html/interfacelinalg_1_1cholesky__rank1__update.html create mode 100644 doc/html/interfacelinalg_1_1det-members.html create mode 100644 doc/html/interfacelinalg_1_1det.html create mode 100644 doc/html/interfacelinalg_1_1diag__mtx__mult-members.html create mode 100644 doc/html/interfacelinalg_1_1diag__mtx__mult.html create mode 100644 doc/html/interfacelinalg_1_1eigen-members.html create mode 100644 doc/html/interfacelinalg_1_1eigen.html create mode 100644 doc/html/interfacelinalg_1_1form__lu-members.html create mode 100644 doc/html/interfacelinalg_1_1form__lu.html create mode 100644 doc/html/interfacelinalg_1_1form__qr-members.html create mode 100644 doc/html/interfacelinalg_1_1form__qr.html create mode 100644 doc/html/interfacelinalg_1_1lu__factor-members.html create mode 100644 doc/html/interfacelinalg_1_1lu__factor.html create mode 100644 doc/html/interfacelinalg_1_1mtx__inverse-members.html create mode 100644 doc/html/interfacelinalg_1_1mtx__inverse.html create mode 100644 doc/html/interfacelinalg_1_1mtx__mult-members.html create mode 100644 doc/html/interfacelinalg_1_1mtx__mult.html create mode 100644 doc/html/interfacelinalg_1_1mtx__pinverse-members.html create mode 100644 doc/html/interfacelinalg_1_1mtx__pinverse.html create mode 100644 doc/html/interfacelinalg_1_1mtx__rank-members.html create mode 100644 doc/html/interfacelinalg_1_1mtx__rank.html create mode 100644 doc/html/interfacelinalg_1_1mult__qr-members.html create mode 100644 doc/html/interfacelinalg_1_1mult__qr.html create mode 100644 doc/html/interfacelinalg_1_1mult__rz-members.html create mode 100644 doc/html/interfacelinalg_1_1mult__rz.html create mode 100644 doc/html/interfacelinalg_1_1qr__factor-members.html create mode 100644 doc/html/interfacelinalg_1_1qr__factor.html create mode 100644 doc/html/interfacelinalg_1_1qr__rank1__update-members.html create mode 100644 doc/html/interfacelinalg_1_1qr__rank1__update.html create mode 100644 doc/html/interfacelinalg_1_1rank1__update-members.html create mode 100644 doc/html/interfacelinalg_1_1rank1__update.html create mode 100644 doc/html/interfacelinalg_1_1recip__mult__array-members.html create mode 100644 doc/html/interfacelinalg_1_1recip__mult__array.html create mode 100644 doc/html/interfacelinalg_1_1rz__factor-members.html create mode 100644 doc/html/interfacelinalg_1_1rz__factor.html create mode 100644 doc/html/interfacelinalg_1_1solve__cholesky-members.html create mode 100644 doc/html/interfacelinalg_1_1solve__cholesky.html create mode 100644 doc/html/interfacelinalg_1_1solve__least__squares-members.html create mode 100644 doc/html/interfacelinalg_1_1solve__least__squares.html create mode 100644 doc/html/interfacelinalg_1_1solve__least__squares__full-members.html create mode 100644 doc/html/interfacelinalg_1_1solve__least__squares__full.html create mode 100644 doc/html/interfacelinalg_1_1solve__least__squares__svd-members.html create mode 100644 doc/html/interfacelinalg_1_1solve__least__squares__svd.html create mode 100644 doc/html/interfacelinalg_1_1solve__lu-members.html create mode 100644 doc/html/interfacelinalg_1_1solve__lu.html create mode 100644 doc/html/interfacelinalg_1_1solve__qr-members.html create mode 100644 doc/html/interfacelinalg_1_1solve__qr.html create mode 100644 doc/html/interfacelinalg_1_1solve__triangular__system-members.html create mode 100644 doc/html/interfacelinalg_1_1solve__triangular__system.html create mode 100644 doc/html/interfacelinalg_1_1sort-members.html create mode 100644 doc/html/interfacelinalg_1_1sort.html create mode 100644 doc/html/interfacelinalg_1_1svd-members.html create mode 100644 doc/html/interfacelinalg_1_1svd.html create mode 100644 doc/html/interfacelinalg_1_1swap-members.html create mode 100644 doc/html/interfacelinalg_1_1swap.html create mode 100644 doc/html/interfacelinalg_1_1trace-members.html create mode 100644 doc/html/interfacelinalg_1_1trace.html create mode 100644 doc/html/interfacelinalg_1_1tri__mtx__mult-members.html create mode 100644 doc/html/interfacelinalg_1_1tri__mtx__mult.html create mode 100644 doc/html/linalg_8f90_source.html create mode 100644 doc/html/namespacelinalg.html create mode 100644 doc/html/namespacelinalg.js diff --git a/doc/Doxyfile b/doc/Doxyfile index 0510c5ea..29090f1a 100644 --- a/doc/Doxyfile +++ b/doc/Doxyfile @@ -1006,13 +1006,7 @@ RECURSIVE = NO # Note that relative paths are relative to the directory from which doxygen is # run. -EXCLUDE = ../src/test_cholesky.f90 \ - ../src/test_core.f90 \ - ../src/test_eigen.f90 \ - ../src/test_mtx_inverse.f90 \ - ../src/test_qr.f90 \ - ../src/test_svd.f90 \ - ../src/test.f90 +EXCLUDE = ../src/linalg_c_api.f90 # The EXCLUDE_SYMLINKS tag can be used to select whether or not files or # directories that are symbolic links (a Unix file system feature) are excluded diff --git a/doc/html/annotated.html b/doc/html/annotated.html index a1b7d91f..9d5b16b3 100644 --- a/doc/html/annotated.html +++ b/doc/html/annotated.html @@ -102,39 +102,39 @@
    Here are the data types with brief descriptions:
    [detail level 12]
    - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/doc/html/annotated_dup.js b/doc/html/annotated_dup.js index 729b90c4..737fb99b 100644 --- a/doc/html/annotated_dup.js +++ b/doc/html/annotated_dup.js @@ -1,38 +1,38 @@ var annotated_dup = [ - [ "linalg_core", "namespacelinalg__core.html", [ - [ "cholesky_factor", "interfacelinalg__core_1_1cholesky__factor.html", null ], - [ "cholesky_rank1_downdate", "interfacelinalg__core_1_1cholesky__rank1__downdate.html", null ], - [ "cholesky_rank1_update", "interfacelinalg__core_1_1cholesky__rank1__update.html", null ], - [ "det", "interfacelinalg__core_1_1det.html", null ], - [ "diag_mtx_mult", "interfacelinalg__core_1_1diag__mtx__mult.html", null ], - [ "eigen", "interfacelinalg__core_1_1eigen.html", null ], - [ "form_lu", "interfacelinalg__core_1_1form__lu.html", null ], - [ "form_qr", "interfacelinalg__core_1_1form__qr.html", null ], - [ "lu_factor", "interfacelinalg__core_1_1lu__factor.html", null ], - [ "mtx_inverse", "interfacelinalg__core_1_1mtx__inverse.html", null ], - [ "mtx_mult", "interfacelinalg__core_1_1mtx__mult.html", null ], - [ "mtx_pinverse", "interfacelinalg__core_1_1mtx__pinverse.html", null ], - [ "mtx_rank", "interfacelinalg__core_1_1mtx__rank.html", null ], - [ "mult_qr", "interfacelinalg__core_1_1mult__qr.html", null ], - [ "mult_rz", "interfacelinalg__core_1_1mult__rz.html", null ], - [ "qr_factor", "interfacelinalg__core_1_1qr__factor.html", null ], - [ "qr_rank1_update", "interfacelinalg__core_1_1qr__rank1__update.html", null ], - [ "rank1_update", "interfacelinalg__core_1_1rank1__update.html", null ], - [ "recip_mult_array", "interfacelinalg__core_1_1recip__mult__array.html", null ], - [ "rz_factor", "interfacelinalg__core_1_1rz__factor.html", null ], - [ "solve_cholesky", "interfacelinalg__core_1_1solve__cholesky.html", null ], - [ "solve_least_squares", "interfacelinalg__core_1_1solve__least__squares.html", null ], - [ "solve_least_squares_full", "interfacelinalg__core_1_1solve__least__squares__full.html", null ], - [ "solve_least_squares_svd", "interfacelinalg__core_1_1solve__least__squares__svd.html", null ], - [ "solve_lu", "interfacelinalg__core_1_1solve__lu.html", null ], - [ "solve_qr", "interfacelinalg__core_1_1solve__qr.html", null ], - [ "solve_triangular_system", "interfacelinalg__core_1_1solve__triangular__system.html", null ], - [ "sort", "interfacelinalg__core_1_1sort.html", null ], - [ "svd", "interfacelinalg__core_1_1svd.html", null ], - [ "swap", "interfacelinalg__core_1_1swap.html", null ], - [ "trace", "interfacelinalg__core_1_1trace.html", null ], - [ "tri_mtx_mult", "interfacelinalg__core_1_1tri__mtx__mult.html", null ] + [ "linalg", "namespacelinalg.html", [ + [ "cholesky_factor", "interfacelinalg_1_1cholesky__factor.html", null ], + [ "cholesky_rank1_downdate", "interfacelinalg_1_1cholesky__rank1__downdate.html", null ], + [ "cholesky_rank1_update", "interfacelinalg_1_1cholesky__rank1__update.html", null ], + [ "det", "interfacelinalg_1_1det.html", null ], + [ "diag_mtx_mult", "interfacelinalg_1_1diag__mtx__mult.html", null ], + [ "eigen", "interfacelinalg_1_1eigen.html", null ], + [ "form_lu", "interfacelinalg_1_1form__lu.html", null ], + [ "form_qr", "interfacelinalg_1_1form__qr.html", null ], + [ "lu_factor", "interfacelinalg_1_1lu__factor.html", null ], + [ "mtx_inverse", "interfacelinalg_1_1mtx__inverse.html", null ], + [ "mtx_mult", "interfacelinalg_1_1mtx__mult.html", null ], + [ "mtx_pinverse", "interfacelinalg_1_1mtx__pinverse.html", null ], + [ "mtx_rank", "interfacelinalg_1_1mtx__rank.html", null ], + [ "mult_qr", "interfacelinalg_1_1mult__qr.html", null ], + [ "mult_rz", "interfacelinalg_1_1mult__rz.html", null ], + [ "qr_factor", "interfacelinalg_1_1qr__factor.html", null ], + [ "qr_rank1_update", "interfacelinalg_1_1qr__rank1__update.html", null ], + [ "rank1_update", "interfacelinalg_1_1rank1__update.html", null ], + [ "recip_mult_array", "interfacelinalg_1_1recip__mult__array.html", null ], + [ "rz_factor", "interfacelinalg_1_1rz__factor.html", null ], + [ "solve_cholesky", "interfacelinalg_1_1solve__cholesky.html", null ], + [ "solve_least_squares", "interfacelinalg_1_1solve__least__squares.html", null ], + [ "solve_least_squares_full", "interfacelinalg_1_1solve__least__squares__full.html", null ], + [ "solve_least_squares_svd", "interfacelinalg_1_1solve__least__squares__svd.html", null ], + [ "solve_lu", "interfacelinalg_1_1solve__lu.html", null ], + [ "solve_qr", "interfacelinalg_1_1solve__qr.html", null ], + [ "solve_triangular_system", "interfacelinalg_1_1solve__triangular__system.html", null ], + [ "sort", "interfacelinalg_1_1sort.html", null ], + [ "svd", "interfacelinalg_1_1svd.html", null ], + [ "swap", "interfacelinalg_1_1swap.html", null ], + [ "trace", "interfacelinalg_1_1trace.html", null ], + [ "tri_mtx_mult", "interfacelinalg_1_1tri__mtx__mult.html", null ] ] ], [ "linalg_immutable", "namespacelinalg__immutable.html", [ [ "eigen_results", "structlinalg__immutable_1_1eigen__results.html", "structlinalg__immutable_1_1eigen__results" ], diff --git a/doc/html/classes.html b/doc/html/classes.html index 8805fbbe..dee12caa 100644 --- a/doc/html/classes.html +++ b/doc/html/classes.html @@ -104,34 +104,34 @@
    C
    -
    cholesky_factor (linalg_core)
    cholesky_rank1_downdate (linalg_core)
    cholesky_rank1_update (linalg_core)
    +
    cholesky_factor (linalg)
    cholesky_rank1_downdate (linalg)
    cholesky_rank1_update (linalg)
    D
    -
    det (linalg_core)
    diag_mtx_mult (linalg_core)
    +
    det (linalg)
    diag_mtx_mult (linalg)
    E
    -
    eigen (linalg_core)
    eigen_results (linalg_immutable)
    +
    eigen (linalg)
    eigen_results (linalg_immutable)
    F
    -
    form_lu (linalg_core)
    form_qr (linalg_core)
    +
    form_lu (linalg)
    form_qr (linalg)
    L
    -
    lu_factor (linalg_core)
    lu_results (linalg_immutable)
    lu_results_cmplx (linalg_immutable)
    +
    lu_factor (linalg)
    lu_results (linalg_immutable)
    lu_results_cmplx (linalg_immutable)
    M
    -
    mat_eigen (linalg_immutable)
    mat_lu (linalg_immutable)
    mat_mult_diag (linalg_immutable)
    mat_mult_lower_tri (linalg_immutable)
    mat_mult_upper_tri (linalg_immutable)
    mat_solve_lower_tri (linalg_immutable)
    mat_solve_upper_tri (linalg_immutable)
    mtx_inverse (linalg_core)
    mtx_mult (linalg_core)
    mtx_pinverse (linalg_core)
    mtx_rank (linalg_core)
    mult_qr (linalg_core)
    mult_rz (linalg_core)
    +
    mat_eigen (linalg_immutable)
    mat_lu (linalg_immutable)
    mat_mult_diag (linalg_immutable)
    mat_mult_lower_tri (linalg_immutable)
    mat_mult_upper_tri (linalg_immutable)
    mat_solve_lower_tri (linalg_immutable)
    mat_solve_upper_tri (linalg_immutable)
    mtx_inverse (linalg)
    mtx_mult (linalg)
    mtx_pinverse (linalg)
    mtx_rank (linalg)
    mult_qr (linalg)
    mult_rz (linalg)
    Q
    -
    qr_factor (linalg_core)
    qr_rank1_update (linalg_core)
    qr_results (linalg_immutable)
    qr_results_cmplx (linalg_immutable)
    +
    qr_factor (linalg)
    qr_rank1_update (linalg)
    qr_results (linalg_immutable)
    qr_results_cmplx (linalg_immutable)
    R
    -
    rank1_update (linalg_core)
    recip_mult_array (linalg_core)
    rz_factor (linalg_core)
    +
    rank1_update (linalg)
    recip_mult_array (linalg)
    rz_factor (linalg)
    S
    -
    solve_cholesky (linalg_core)
    solve_least_squares (linalg_core)
    solve_least_squares_full (linalg_core)
    solve_least_squares_svd (linalg_core)
    solve_lu (linalg_core)
    solve_qr (linalg_core)
    solve_triangular_system (linalg_core)
    sort (linalg_core)
    svd (linalg_core)
    svd_results (linalg_immutable)
    svd_results_cmplx (linalg_immutable)
    swap (linalg_core)
    +
    solve_cholesky (linalg)
    solve_least_squares (linalg)
    solve_least_squares_full (linalg)
    solve_least_squares_svd (linalg)
    solve_lu (linalg)
    solve_qr (linalg)
    solve_triangular_system (linalg)
    sort (linalg)
    svd (linalg)
    svd_results (linalg_immutable)
    svd_results_cmplx (linalg_immutable)
    swap (linalg)
    T
    -
    trace (linalg_core)
    tri_mtx_mult (linalg_core)
    +
    trace (linalg)
    tri_mtx_mult (linalg)
    diff --git a/doc/html/dir_68267d1309a1af8e8297ef4c3efbcdba.html b/doc/html/dir_68267d1309a1af8e8297ef4c3efbcdba.html index 42eca553..bb4c5baf 100644 --- a/doc/html/dir_68267d1309a1af8e8297ef4c3efbcdba.html +++ b/doc/html/dir_68267d1309a1af8e8297ef4c3efbcdba.html @@ -103,13 +103,9 @@
     Nlinalg_coreProvides a set of common linear algebra routines
     Ccholesky_factorComputes the Cholesky factorization of a symmetric, positive definite matrix
     Ccholesky_rank1_downdateComputes the rank 1 downdate to a Cholesky factored matrix (upper triangular)
     Ccholesky_rank1_updateComputes the rank 1 update to a Cholesky factored matrix (upper triangular)
     CdetComputes the determinant of a square matrix
     Cdiag_mtx_multMultiplies a diagonal matrix with another matrix or array
     CeigenComputes the eigenvalues, and optionally the eigenvectors, of a matrix
     Cform_luExtracts the L and U matrices from the condensed [L\U] storage format used by the lu_factor
     Cform_qrForms the full M-by-M orthogonal matrix Q from the elementary reflectors returned by the base QR factorization algorithm
     Clu_factorComputes the LU factorization of an M-by-N matrix
     Cmtx_inverseComputes the inverse of a square matrix
     Cmtx_multPerforms the matrix operation: \( C = \alpha op(A) op(B) + \beta C \)
     Cmtx_pinverseComputes the Moore-Penrose pseudo-inverse of a M-by-N matrix using the singular value decomposition of the matrix
     Cmtx_rankComputes the rank of a matrix
     Cmult_qrMultiplies a general matrix by the orthogonal matrix Q from a QR factorization
     Cmult_rzMultiplies a general matrix by the orthogonal matrix Z from an RZ factorization
     Cqr_factorComputes the QR factorization of an M-by-N matrix
     Cqr_rank1_updateComputes the rank 1 update to an M-by-N QR factored matrix A (M >= N) where \( A = Q R \), and \( A1 = A + U V^T \) such that \( A1 = Q1 R1 \)
     Crank1_updatePerforms the rank-1 update to matrix A such that: \( A = \alpha X Y^T + A \), where \( A \) is an M-by-N matrix, \( \alpha \)is a scalar, \( X \) is an M-element array, and \( Y \) is an N-element array. In the event that \( Y \) is complex, \( Y^H \) is used instead of \( Y^T \)
     Crecip_mult_arrayMultiplies a vector by the reciprocal of a real scalar
     Crz_factorFactors an upper trapezoidal matrix by means of orthogonal transformations such that \( A = R Z = (R 0) Z \). Z is an orthogonal matrix of dimension N-by-N, and R is an M-by-M upper triangular matrix
     Csolve_choleskySolves a system of Cholesky factored equations
     Csolve_least_squaresSolves the overdetermined or underdetermined system \( A X = B \) of M equations of N unknowns. Notice, it is assumed that matrix A has full rank
     Csolve_least_squares_fullSolves the overdetermined or underdetermined system \( A X = B \) of M equations of N unknowns, but uses a full orthogonal factorization of the system
     Csolve_least_squares_svdSolves the overdetermined or underdetermined system \( A X = B \) of M equations of N unknowns using a singular value decomposition of matrix A
     Csolve_luSolves a system of LU-factored equations
     Csolve_qrSolves a system of M QR-factored equations of N unknowns
     Csolve_triangular_systemSolves a triangular system of equations
     CsortSorts an array
     CsvdComputes the singular value decomposition of a matrix A. The SVD is defined as: \( A = U S V^T \), where \( U \) is an M-by-M orthogonal matrix, \( S \) is an M-by-N diagonal matrix, and \( V \) is an N-by-N orthogonal matrix
     CswapSwaps the contents of two arrays
     CtraceComputes the trace of a matrix (the sum of the main diagonal elements)
     Ctri_mtx_multComputes the triangular matrix operation: \( B = \alpha A^T A + \beta B \), or \( B = \alpha A A^T + \beta B \), where A is a triangular matrix
     NlinalgProvides a set of common linear algebra routines
     Ccholesky_factorComputes the Cholesky factorization of a symmetric, positive definite matrix
     Ccholesky_rank1_downdateComputes the rank 1 downdate to a Cholesky factored matrix (upper triangular)
     Ccholesky_rank1_updateComputes the rank 1 update to a Cholesky factored matrix (upper triangular)
     CdetComputes the determinant of a square matrix
     Cdiag_mtx_multMultiplies a diagonal matrix with another matrix or array
     CeigenComputes the eigenvalues, and optionally the eigenvectors, of a matrix
     Cform_luExtracts the L and U matrices from the condensed [L\U] storage format used by the lu_factor
     Cform_qrForms the full M-by-M orthogonal matrix Q from the elementary reflectors returned by the base QR factorization algorithm
     Clu_factorComputes the LU factorization of an M-by-N matrix
     Cmtx_inverseComputes the inverse of a square matrix
     Cmtx_multPerforms the matrix operation: \( C = \alpha op(A) op(B) + \beta C \)
     Cmtx_pinverseComputes the Moore-Penrose pseudo-inverse of a M-by-N matrix using the singular value decomposition of the matrix
     Cmtx_rankComputes the rank of a matrix
     Cmult_qrMultiplies a general matrix by the orthogonal matrix Q from a QR factorization
     Cmult_rzMultiplies a general matrix by the orthogonal matrix Z from an RZ factorization
     Cqr_factorComputes the QR factorization of an M-by-N matrix
     Cqr_rank1_updateComputes the rank 1 update to an M-by-N QR factored matrix A (M >= N) where \( A = Q R \), and \( A1 = A + U V^T \) such that \( A1 = Q1 R1 \)
     Crank1_updatePerforms the rank-1 update to matrix A such that: \( A = \alpha X Y^T + A \), where \( A \) is an M-by-N matrix, \( \alpha \)is a scalar, \( X \) is an M-element array, and \( Y \) is an N-element array. In the event that \( Y \) is complex, \( Y^H \) is used instead of \( Y^T \)
     Crecip_mult_arrayMultiplies a vector by the reciprocal of a real scalar
     Crz_factorFactors an upper trapezoidal matrix by means of orthogonal transformations such that \( A = R Z = (R 0) Z \). Z is an orthogonal matrix of dimension N-by-N, and R is an M-by-M upper triangular matrix
     Csolve_choleskySolves a system of Cholesky factored equations
     Csolve_least_squaresSolves the overdetermined or underdetermined system \( A X = B \) of M equations of N unknowns. Notice, it is assumed that matrix A has full rank
     Csolve_least_squares_fullSolves the overdetermined or underdetermined system \( A X = B \) of M equations of N unknowns, but uses a full orthogonal factorization of the system
     Csolve_least_squares_svdSolves the overdetermined or underdetermined system \( A X = B \) of M equations of N unknowns using a singular value decomposition of matrix A
     Csolve_luSolves a system of LU-factored equations
     Csolve_qrSolves a system of M QR-factored equations of N unknowns
     Csolve_triangular_systemSolves a triangular system of equations
     CsortSorts an array
     CsvdComputes the singular value decomposition of a matrix A. The SVD is defined as: \( A = U S V^T \), where \( U \) is an M-by-M orthogonal matrix, \( S \) is an M-by-N diagonal matrix, and \( V \) is an N-by-N orthogonal matrix
     CswapSwaps the contents of two arrays
     CtraceComputes the trace of a matrix (the sum of the main diagonal elements)
     Ctri_mtx_multComputes the triangular matrix operation: \( B = \alpha A^T A + \beta B \), or \( B = \alpha A A^T + \beta B \), where A is a triangular matrix
     Nlinalg_immutableProvides an immutable interface to many of the core linear algebra routines in this library. The intent is to allow for ease of use in situations where memory allocation, or absolute speed are of lesser importance to code readability
     Ceigen_resultsDefines a container for the output of an Eigen analysis of a square matrix
     Clu_resultsDefines a container for the output of an LU factorization
    - - - + - - - + diff --git a/doc/html/dir_68267d1309a1af8e8297ef4c3efbcdba.js b/doc/html/dir_68267d1309a1af8e8297ef4c3efbcdba.js index f832ad4d..4add8d95 100644 --- a/doc/html/dir_68267d1309a1af8e8297ef4c3efbcdba.js +++ b/doc/html/dir_68267d1309a1af8e8297ef4c3efbcdba.js @@ -1,9 +1,7 @@ var dir_68267d1309a1af8e8297ef4c3efbcdba = [ + [ "linalg.f90", "linalg_8f90_source.html", null ], [ "linalg_basic.f90", "linalg__basic_8f90_source.html", null ], - [ "linalg_c_api.f90", "linalg__c__api_8f90_source.html", null ], - [ "linalg_constants.f90", "linalg__constants_8f90_source.html", null ], - [ "linalg_core.f90", "linalg__core_8f90_source.html", null ], [ "linalg_eigen.f90", "linalg__eigen_8f90_source.html", null ], [ "linalg_factor.f90", "linalg__factor_8f90_source.html", null ], [ "linalg_immutable.f90", "linalg__immutable_8f90_source.html", null ], diff --git a/doc/html/files.html b/doc/html/files.html index 1696e0a6..ad089dc8 100644 --- a/doc/html/files.html +++ b/doc/html/files.html @@ -105,15 +105,13 @@ - - - - - - - - - + + + + + + +

    Files

    file  linalg_basic.f90 [code]
     
    file  linalg_c_api.f90 [code]
    file  linalg.f90 [code]
     
    file  linalg_constants.f90 [code]
     
    file  linalg_core.f90 [code]
    file  linalg_basic.f90 [code]
     
    file  linalg_eigen.f90 [code]
     
      include
     linalg.h
      src
     linalg_basic.f90
     linalg_c_api.f90
     linalg_constants.f90
     linalg_core.f90
     linalg_eigen.f90
     linalg_factor.f90
     linalg_immutable.f90
     linalg_solve.f90
     linalg_sorting.f90
     linalg.f90
     linalg_basic.f90
     linalg_eigen.f90
     linalg_factor.f90
     linalg_immutable.f90
     linalg_solve.f90
     linalg_sorting.f90
    diff --git a/doc/html/interfacelinalg_1_1cholesky__factor-members.html b/doc/html/interfacelinalg_1_1cholesky__factor-members.html new file mode 100644 index 00000000..abf1be03 --- /dev/null +++ b/doc/html/interfacelinalg_1_1cholesky__factor-members.html @@ -0,0 +1,114 @@ + + + + + + + +linalg: Member List + + + + + + + + + + + + + + + +
    +
    + + + + + + +
    +
    linalg 1.6.1 +
    +
    A linear algebra library that provides a user-friendly interface to several BLAS and LAPACK routines.
    +
    +
    + + + + + + + +
    +
    + +
    +
    +
    + +
    + +
    +
    + + +
    +
    +
    +
    +
    +
    Loading...
    +
    Searching...
    +
    No Matches
    +
    +
    +
    +
    + +
    +
    linalg::cholesky_factor Member List
    +
    +
    + +

    This is the complete list of members for linalg::cholesky_factor, including all inherited members.

    +
    +
    + + + + diff --git a/doc/html/interfacelinalg_1_1cholesky__factor.html b/doc/html/interfacelinalg_1_1cholesky__factor.html new file mode 100644 index 00000000..ed6e6bf5 --- /dev/null +++ b/doc/html/interfacelinalg_1_1cholesky__factor.html @@ -0,0 +1,200 @@ + + + + + + + +linalg: linalg::cholesky_factor Interface Reference + + + + + + + + + + + + + + + +
    +
    + + + + + + +
    +
    linalg 1.6.1 +
    +
    A linear algebra library that provides a user-friendly interface to several BLAS and LAPACK routines.
    +
    +
    + + + + + + + +
    +
    + +
    +
    +
    + +
    + +
    +
    + + +
    +
    +
    +
    +
    +
    Loading...
    +
    Searching...
    +
    No Matches
    +
    +
    +
    +
    + +
    + +
    linalg::cholesky_factor Interface Reference
    +
    +
    + +

    Computes the Cholesky factorization of a symmetric, positive definite matrix. + More...

    +

    Detailed Description

    +

    Computes the Cholesky factorization of a symmetric, positive definite matrix.

    +
    Syntax
    subroutine cholesky_factor(real(real64) a(:,:), optional logical upper, optional class(errors) err)
    +
    subroutine cholesky_factor(complex(real64) a(:,:), optional logical upper, optional class(errors) err)
    +
    +
    Parameters
    + + + + +
    [in,out]aOn input, the N-by-N matrix to factor. On output, the factored matrix is returned in either the upper or lower triangular portion of the matrix, dependent upon the value of upper.
    [in]upperAn optional input that, if specified, provides control over whether the factorization is computed as \( A = U^T U \) (set to true), or as \( A = L L^T \) (set to false). The default value is true such that \( A = U^T U \).
    [in,out]errAn optional errors-based object that if provided can be used to retrieve information relating to any errors encountered during execution. If not provided, a default implementation of the errors class is used internally to provide error handling. Possible errors and warning messages that may be encountered are as follows.
      +
    • LA_ARRAY_SIZE_ERROR: Occurs if a is not square.
    • +
    • LA_MATRIX_FORMAT_ERROR: Occurs if a is not positive definite.
    • +
    +
    +
    +
    +
    Notes
    This routine utilizes the LAPACK routine DPOTRF (ZPOTRF in the complex case).
    +
    Usage
    The following example illustrates the solution of a positive-definite system of equations via Cholesky factorization.
    program example
    +
    use iso_fortran_env, only : real64, int32
    +
    use linalg_core
    +
    implicit none
    +
    +
    ! Variables
    +
    real(real64) :: a(3, 3), b(3), bu(3)
    +
    integer(int32) :: i
    +
    +
    ! Build the 3-by-3 positive-definite matrix A.
    +
    ! | 4 12 -16 |
    +
    ! A = | 12 37 -43 |
    +
    ! |-16 -43 98 |
    +
    a = reshape([4.0d0, 12.0d0, -16.0d0, 12.0d0, 37.0d0, -43.0d0, -16.0d0, &
    +
    -43.0d0, 98.0d0], [3, 3])
    +
    +
    ! Build the 3-element array B
    +
    ! | 5 |
    +
    ! b = | 1 |
    +
    ! | 3 |
    +
    b = [5.0d0, 1.0d0, 3.0d0]
    +
    +
    ! Make a copy of B for later use - not necessary, but just for example to
    +
    ! illustrate the long or manual method of solving a Cholesky factored system
    +
    bu = b
    +
    +
    ! Compute the Cholesky factorization of A considering only the upper
    +
    ! triangular portion of A (the default configuration).
    +
    call cholesky_factor(a)
    +
    +
    ! Compute the solution
    +
    call solve_cholesky(.true., a, b)
    +
    +
    ! Display the results
    +
    print '(A)', "Cholesky Solution: X = "
    +
    print '(F8.4)', (b(i), i = 1, size(b))
    +
    +
    ! The solution could also be computed manually noting the Cholesky
    +
    ! factorization causes A = U**T * U. Then U**T * U * X = B.
    +
    +
    ! Step 1 would then be to solve the problem U**T * Y = B, for Y.
    +
    call solve_triangular_system(.true., .true., .true., a, bu)
    +
    +
    ! Now, solve the problem U * X = Y, for X
    +
    call solve_triangular_system(.true., .false., .true., a, bu)
    +
    +
    ! Display the results
    +
    print '(A)', "Cholesky Solution (Manual Approach): X = "
    +
    print '(F8.4)', (bu(i), i = 1, size(bu))
    +
    end program
    +
    The above program produces the following output.
    Cholesky Solution: X =
    +
    239.5833
    +
    -65.6667
    +
    10.3333
    +
    Cholesky Solution (Manual Approach): X =
    +
    239.5833
    +
    -65.6667
    +
    10.3333
    +
    + +

    Definition at line 1433 of file linalg.f90.

    +

    The documentation for this interface was generated from the following file: +
    +
    + + + + diff --git a/doc/html/interfacelinalg_1_1cholesky__rank1__downdate-members.html b/doc/html/interfacelinalg_1_1cholesky__rank1__downdate-members.html new file mode 100644 index 00000000..f1c6480e --- /dev/null +++ b/doc/html/interfacelinalg_1_1cholesky__rank1__downdate-members.html @@ -0,0 +1,114 @@ + + + + + + + +linalg: Member List + + + + + + + + + + + + + + + +
    +
    + + + + + + +
    +
    linalg 1.6.1 +
    +
    A linear algebra library that provides a user-friendly interface to several BLAS and LAPACK routines.
    +
    +
    + + + + + + + +
    +
    + +
    +
    +
    + +
    + +
    +
    + + +
    +
    +
    +
    +
    +
    Loading...
    +
    Searching...
    +
    No Matches
    +
    +
    +
    +
    + +
    +
    linalg::cholesky_rank1_downdate Member List
    +
    +
    + +

    This is the complete list of members for linalg::cholesky_rank1_downdate, including all inherited members.

    +
    +
    + + + + diff --git a/doc/html/interfacelinalg_1_1cholesky__rank1__downdate.html b/doc/html/interfacelinalg_1_1cholesky__rank1__downdate.html new file mode 100644 index 00000000..3e3f11a8 --- /dev/null +++ b/doc/html/interfacelinalg_1_1cholesky__rank1__downdate.html @@ -0,0 +1,201 @@ + + + + + + + +linalg: linalg::cholesky_rank1_downdate Interface Reference + + + + + + + + + + + + + + + +
    +
    + + + + + + +
    +
    linalg 1.6.1 +
    +
    A linear algebra library that provides a user-friendly interface to several BLAS and LAPACK routines.
    +
    +
    + + + + + + + +
    +
    + +
    +
    +
    + +
    + +
    +
    + + +
    +
    +
    +
    +
    +
    Loading...
    +
    Searching...
    +
    No Matches
    +
    +
    +
    +
    + +
    + +
    linalg::cholesky_rank1_downdate Interface Reference
    +
    +
    + +

    Computes the rank 1 downdate to a Cholesky factored matrix (upper triangular). + More...

    +

    Detailed Description

    +

    Computes the rank 1 downdate to a Cholesky factored matrix (upper triangular).

    +
    Syntax
    subroutine cholesky_rank1_downdate(real(real64) r(:,:), real(real64) u(:), optional real(real64) work(:), optional class(errors) err)
    +
    subroutine cholesky_rank1_downdate(complex(real64) r(:,:), complex(real64) u(:), optional complex(real64) work(:), optional class(errors) err)
    +
    +
    Parameters
    + + + + + +
    [in,out]rOn input, the N-by-N upper triangular matrix R. On output, the updated matrix R1.
    [in,out]uOn input, the N-element update vector U. On output, the rotation sines used to transform R to R1.
    [out]workAn optional argument that if supplied prevents local memory allocation. If provided, the array must have at least N elements. Additionally, this workspace array is used to contain the rotation cosines used to transform R to R1.
    [in,out]errAn optional errors-based object that if provided can be used to retrieve information relating to any errors encountered during execution. If not provided, a default implementation of the errors class is used internally to provide error handling. Possible errors and warning messages that may be encountered are as follows.
      +
    • LA_ARRAY_SIZE_ERROR: Occurs if any of the input array sizes are incorrect.
    • +
    • LA_OUT_OF_MEMORY_ERROR: Occurs if local memory must be allocated, and there is insufficient memory available.
    • +
    • LA_MATRIX_FORMAT_ERROR: Occurs if the downdated matrix is not positive definite.
    • +
    • LA_SINGULAR_MATRIX_ERROR: Occurs if r is singular.
    • +
    +
    +
    +
    +
    Notes
    This routine utilizes the QRUPDATE routine DCH1DN (ZCH1DN in the complex case).
    +
    See Also
    Source
    +
    Usage
    The following example illustrates the use of the rank 1 Cholesky downdate, and compares the results to factoring the original rank 1 downdated matrix.
    program example
    +
    use iso_fortran_env, only : real64, int32
    +
    use linalg_factor, only : cholesky_factor, cholesky_rank1_downdate
    +
    use linalg_core, only : rank1_update
    +
    implicit none
    +
    +
    ! Variables
    +
    real(real64) :: a(3,3), u(3), ad(3,3)
    +
    integer(int32) :: i
    +
    +
    ! Build the 3-by-3 matrix A.
    +
    ! | 4.25 11.25 -15 |
    +
    ! A = | 11.25 39.25 -46 |
    +
    ! | -15 -46 102 |
    +
    a = reshape([4.25d0, 11.25d0, -15.0d0, 11.25d0, 39.25d0, -46.0d0, &
    +
    -15.0d0, -46.0d0, 102.0d0], [3, 3])
    +
    +
    ! The downdate vector
    +
    ! | 0.5 |
    +
    ! u = | -1.5 |
    +
    ! | 2 |
    +
    u = [0.5d0, -1.5d0, 2.0d0]
    +
    +
    ! Compute the rank 1 downdate of A
    +
    ad = a
    +
    call rank1_update(-1.0d0, u, u, ad)
    +
    +
    ! Compute the Cholesky factorization of the original matrix
    +
    call cholesky_factor(a)
    +
    +
    ! Apply the rank 1 downdate to the factored matrix
    +
    call cholesky_rank1_downdate(a, u)
    +
    +
    ! Compute the Cholesky factorization of the downdate to the original matrix
    +
    call cholesky_factor(ad)
    +
    +
    ! Display the matrices
    +
    print '(A)', "Downdating the Factored Form:"
    +
    do i = 1, size(a, 1)
    +
    print *, a(i,:)
    +
    end do
    +
    +
    print '(A)', "Downdating A Directly:"
    +
    do i = 1, size(ad, 1)
    +
    print *, ad(i,:)
    +
    end do
    +
    end program
    +
    The above program produces the following output.
    Downdating the Factored Form:
    +
    2.0000000000000000 6.0000000000000000 -8.0000000000000000
    +
    0.0000000000000000 1.0000000000000000 4.9999999999999973
    +
    0.0000000000000000 0.0000000000000000 3.0000000000000049
    +
    Downdating A Directly:
    +
    2.0000000000000000 6.0000000000000000 -8.0000000000000000
    +
    0.0000000000000000 1.0000000000000000 5.0000000000000000
    +
    0.0000000000000000 0.0000000000000000 3.0000000000000000
    +
    + +

    Definition at line 1639 of file linalg.f90.

    +

    The documentation for this interface was generated from the following file: +
    +
    + + + + diff --git a/doc/html/interfacelinalg_1_1cholesky__rank1__update-members.html b/doc/html/interfacelinalg_1_1cholesky__rank1__update-members.html new file mode 100644 index 00000000..1bd34a89 --- /dev/null +++ b/doc/html/interfacelinalg_1_1cholesky__rank1__update-members.html @@ -0,0 +1,114 @@ + + + + + + + +linalg: Member List + + + + + + + + + + + + + + + +
    +
    + + + + + + +
    +
    linalg 1.6.1 +
    +
    A linear algebra library that provides a user-friendly interface to several BLAS and LAPACK routines.
    +
    +
    + + + + + + + +
    +
    + +
    +
    +
    + +
    + +
    +
    + + +
    +
    +
    +
    +
    +
    Loading...
    +
    Searching...
    +
    No Matches
    +
    +
    +
    +
    + +
    +
    linalg::cholesky_rank1_update Member List
    +
    +
    + +

    This is the complete list of members for linalg::cholesky_rank1_update, including all inherited members.

    +
    +
    + + + + diff --git a/doc/html/interfacelinalg_1_1cholesky__rank1__update.html b/doc/html/interfacelinalg_1_1cholesky__rank1__update.html new file mode 100644 index 00000000..0b7cd9bd --- /dev/null +++ b/doc/html/interfacelinalg_1_1cholesky__rank1__update.html @@ -0,0 +1,195 @@ + + + + + + + +linalg: linalg::cholesky_rank1_update Interface Reference + + + + + + + + + + + + + + + +
    +
    + + + + + + +
    +
    linalg 1.6.1 +
    +
    A linear algebra library that provides a user-friendly interface to several BLAS and LAPACK routines.
    +
    +
    + + + + + + + +
    +
    + +
    +
    +
    + +
    + +
    +
    + + +
    +
    +
    +
    +
    +
    Loading...
    +
    Searching...
    +
    No Matches
    +
    +
    +
    +
    + +
    + +
    linalg::cholesky_rank1_update Interface Reference
    +
    +
    + +

    Computes the rank 1 update to a Cholesky factored matrix (upper triangular). + More...

    +

    Detailed Description

    +

    Computes the rank 1 update to a Cholesky factored matrix (upper triangular).

    +
    Syntax
    subroutine cholesky_rank1_update(real(real64) r(:,:), real(real64) u(:), optional real(real64) work(:), optional class(errors) err)
    +
    subroutine cholesky_rank1_update(complex(real64) r(:,:), complex(real64) u(:), optional complex(real64) work(:), optional class(errors) err)
    +
    +
    Parameters
    + + + + + +
    [in,out]rOn input, the N-by-N upper triangular matrix R. On output, the updated matrix R1.
    [in,out]uOn input, the N-element update vector U. On output, the rotation sines used to transform R to R1.
    [out]workAn optional argument that if supplied prevents local memory allocation. If provided, the array must have at least N elements. Additionally, this workspace array is used to contain the rotation cosines used to transform R to R1.
    [in,out]errAn optional errors-based object that if provided can be used to retrieve information relating to any errors encountered during execution. If not provided, a default implementation of the errors class is used internally to provide error handling. Possible errors and warning messages that may be encountered are as follows.
      +
    • LA_ARRAY_SIZE_ERROR: Occurs if any of the input array sizes are incorrect.
    • +
    • LA_OUT_OF_MEMORY_ERROR: Occurs if local memory must be allocated, and there is insufficient memory available.
    • +
    +
    +
    +
    +
    Notes
    This routine utilizes the QRUPDATE routine DCH1UP (ZCH1UP in the complex case).
    +
    See Also
    Source
    +
    Usage
    The following example illustrates the use of the rank 1 Cholesky update, and compares the results to factoring the original rank 1 updated matrix.
    program example
    +
    use iso_fortran_env, only : real64, int32
    +
    use linalg_core
    +
    implicit none
    +
    +
    ! Variables
    +
    real(real64) :: a(3,3), u(3), au(3,3)
    +
    integer(int32) :: i
    +
    +
    ! Build the 3-by-3 positive-definite matrix A.
    +
    ! | 4 12 -16 |
    +
    ! A = | 12 37 -43 |
    +
    ! |-16 -43 98 |
    +
    a = reshape([4.0d0, 12.0d0, -16.0d0, 12.0d0, 37.0d0, -43.0d0, -16.0d0, &
    +
    -43.0d0, 98.0d0], [3, 3])
    +
    +
    ! Build the update vector U
    +
    u = [0.5d0, -1.5d0, 2.0d0]
    +
    +
    ! Compute the rank 1 update of A
    +
    au = a
    +
    call rank1_update(1.0d0, u, u, au)
    +
    +
    ! Compute the Cholesky factorization of the original matrix
    +
    call cholesky_factor(a)
    +
    +
    ! Apply the rank 1 update to the factored matrix
    +
    call cholesky_rank1_update(a, u)
    +
    +
    ! Compute the Cholesky factorization of the update of the original matrix
    +
    call cholesky_factor(au)
    +
    +
    ! Display the matrices
    +
    print '(A)', "Updating the Factored Form:"
    +
    do i = 1, size(a, 1)
    +
    print *, a(i,:)
    +
    end do
    +
    +
    print '(A)', "Updating A Directly:"
    +
    do i = 1, size(au, 1)
    +
    print *, au(i,:)
    +
    end do
    +
    end program
    +
    The above program produces the following output.
    Updating the Factored Form:
    +
    2.0615528128088303 5.4570515633174921 -7.2760687510899889
    +
    0.0000000000000000 3.0774320845949008 -2.0452498947307731
    +
    0.0000000000000000 0.0000000000000000 6.6989384530323566
    +
    Updating A Directly:
    +
    2.0615528128088303 5.4570515633174921 -7.2760687510899889
    +
    0.0000000000000000 3.0774320845949008 -2.0452498947307736
    +
    0.0000000000000000 0.0000000000000000 6.6989384530323557
    +
    + +

    Definition at line 1532 of file linalg.f90.

    +

    The documentation for this interface was generated from the following file: +
    +
    + + + + diff --git a/doc/html/interfacelinalg_1_1det-members.html b/doc/html/interfacelinalg_1_1det-members.html new file mode 100644 index 00000000..261366d7 --- /dev/null +++ b/doc/html/interfacelinalg_1_1det-members.html @@ -0,0 +1,114 @@ + + + + + + + +linalg: Member List + + + + + + + + + + + + + + + +
    +
    + + + + + + +
    +
    linalg 1.6.1 +
    +
    A linear algebra library that provides a user-friendly interface to several BLAS and LAPACK routines.
    +
    +
    + + + + + + + +
    +
    + +
    +
    +
    + +
    + +
    +
    + + +
    +
    +
    +
    +
    +
    Loading...
    +
    Searching...
    +
    No Matches
    +
    +
    +
    +
    + +
    +
    linalg::det Member List
    +
    +
    + +

    This is the complete list of members for linalg::det, including all inherited members.

    +
    +
    + + + + diff --git a/doc/html/interfacelinalg_1_1det.html b/doc/html/interfacelinalg_1_1det.html new file mode 100644 index 00000000..0b464ec7 --- /dev/null +++ b/doc/html/interfacelinalg_1_1det.html @@ -0,0 +1,141 @@ + + + + + + + +linalg: linalg::det Interface Reference + + + + + + + + + + + + + + + +
    +
    + + + + + + +
    +
    linalg 1.6.1 +
    +
    A linear algebra library that provides a user-friendly interface to several BLAS and LAPACK routines.
    +
    +
    + + + + + + + +
    +
    + +
    +
    +
    + +
    + +
    +
    + + +
    +
    +
    +
    +
    +
    Loading...
    +
    Searching...
    +
    No Matches
    +
    +
    +
    +
    + +
    + +
    linalg::det Interface Reference
    +
    +
    + +

    Computes the determinant of a square matrix. + More...

    +

    Detailed Description

    +

    Computes the determinant of a square matrix.

    +
    Syntax
    real(real64) function det(real(real64) a(:,:), optional integer(int32) iwork(:), optional class(errors) err)
    +
    complex(real64) function det(complex(real64) a(:,:), optional integer(int32) iwork(:), optional class(errors) err)
    +
    +
    Parameters
    + + + + +
    [in,out]aOn input, the N-by-N matrix on which to operate. On output the contents are overwritten by the LU factorization of the original matrix.
    [out]iworkAn optional input, that if provided, prevents any local memory allocation. If not provided, the memory required is allocated within. If provided, the length of the array must be at least N-elements.
    [in,out]errAn optional errors-based object that if provided can be used to retrieve information relating to any errors encountered during execution. If not provided, a default implementation of the errors class is used internally to provide error handling. Possible errors and warning messages that may be encountered are as follows.
      +
    • LA_ARRAY_SIZE_ERROR: Occurs if any of the input arrays are not sized appropriately.
    • +
    • LA_OUT_OF_MEMORY_ERROR: Occurs if local memory must be allocated, and there is insufficient memory available.
    • +
    +
    +
    +
    +
    Returns
    The determinant of a.
    + +

    Definition at line 434 of file linalg.f90.

    +

    The documentation for this interface was generated from the following file: +
    +
    + + + + diff --git a/doc/html/interfacelinalg_1_1diag__mtx__mult-members.html b/doc/html/interfacelinalg_1_1diag__mtx__mult-members.html new file mode 100644 index 00000000..d96b786d --- /dev/null +++ b/doc/html/interfacelinalg_1_1diag__mtx__mult-members.html @@ -0,0 +1,114 @@ + + + + + + + +linalg: Member List + + + + + + + + + + + + + + + +
    +
    + + + + + + +
    +
    linalg 1.6.1 +
    +
    A linear algebra library that provides a user-friendly interface to several BLAS and LAPACK routines.
    +
    +
    + + + + + + + +
    +
    + +
    +
    +
    + +
    + +
    +
    + + +
    +
    +
    +
    +
    +
    Loading...
    +
    Searching...
    +
    No Matches
    +
    +
    +
    +
    + +
    +
    linalg::diag_mtx_mult Member List
    +
    +
    + +

    This is the complete list of members for linalg::diag_mtx_mult, including all inherited members.

    +
    +
    + + + + diff --git a/doc/html/interfacelinalg_1_1diag__mtx__mult.html b/doc/html/interfacelinalg_1_1diag__mtx__mult.html new file mode 100644 index 00000000..5ff7b0e7 --- /dev/null +++ b/doc/html/interfacelinalg_1_1diag__mtx__mult.html @@ -0,0 +1,226 @@ + + + + + + + +linalg: linalg::diag_mtx_mult Interface Reference + + + + + + + + + + + + + + + +
    +
    + + + + + + +
    +
    linalg 1.6.1 +
    +
    A linear algebra library that provides a user-friendly interface to several BLAS and LAPACK routines.
    +
    +
    + + + + + + + +
    +
    + +
    +
    +
    + +
    + +
    +
    + + +
    +
    +
    +
    +
    +
    Loading...
    +
    Searching...
    +
    No Matches
    +
    +
    +
    +
    + +
    + +
    linalg::diag_mtx_mult Interface Reference
    +
    +
    + +

    Multiplies a diagonal matrix with another matrix or array. + More...

    +

    Detailed Description

    +

    Multiplies a diagonal matrix with another matrix or array.

    +
    Syntax 1
    Computes the matrix operation: \( C = \alpha A op(B) + \beta C \), or \( C = \alpha op(B) A + \beta C \).
    subroutine diag_mtx_mult(logical lside, logical trans, real(real64) alpha, real(real64) a(:), real(real64) b(:,:), real(real64) beta, real(real64) c(:,:), optional class(errors) err)
    +
    subroutine diag_mtx_mult(logical lside, logical trans, real(real64) alpha, complex(real64) a(:), complex(real64) b(:,:), real(real64) beta, complex(real64) c(:,:), optional class(errors) err)
    +
    subroutine diag_mtx_mult(logical lside, logical trans, real(real64) alpha, complex(real64) a(:), real(real64) b(:,:), real(real64) beta, complex(real64) c(:,:), optional class(errors) err)
    +
    subroutine diag_mtx_mult(logical lside, logical trans, complex(real64) alpha, complex(real64) a(:), complex(real64) b(:,:), complex(real64) beta, complex(real64) c(:,:), optional class(errors) err)
    +
    subroutine diag_mtx_mult(logical lside, logical trans, complex(real64) alpha, real(real64) a(:), complex(real64) b(:,:), complex(real64) beta, complex(real64) c(:,:), optional class(errors) err)
    +
    +
    Parameters
    + + + + + + + + + +
    [in]lsideSet to true to apply matrix A from the left; else, set to false to apply matrix A from the left.
    [in]transSet to true if \( op(B) = B^T \); else, set to false for \( op(B) = B\). In the complex case set to LA_TRANSPOSE if \( op(B) = B^T \), set to LA_HERMITIAN_TRANSPOSE if \( op(B) = B^H \), otherwise set to LA_NO_OPERATION if \( op(B) = B \).
    [in]alphaA scalar multiplier.
    [in]aA K-element array containing the diagonal elements of A where K = MIN(M,P) if lside is true; else, if lside is false, K = MIN(N,P).
    [in]bThe LDB-by-TDB matrix B where (LDB = leading dimension of B, and TDB = trailing dimension of B):
      +
    • lside == true & trans == true: LDB = N, TDB = P
    • +
    • lside == true & trans == false: LDB = P, TDB = N
    • +
    • lside == false & trans == true: LDB = P, TDB = M
    • +
    • lside == false & trans == false: LDB = M, TDB = P
    • +
    +
    [in]betaA scalar multiplier.
    [in,out]cOn input, the M-by-N matrix C. On output, the resulting M-by-N matrix.
    [in,out]errAn optional errors-based object that if provided can be used to retrieve information relating to any errors encountered during execution. If not provided, a default implementation of the errors class is used internally to provide error handling. Possible errors and warning messages that may be encountered are as follows.
      +
    • LA_ARRAY_SIZE_ERROR: Occurs if any of the input array sizes are incorrect.
    • +
    +
    +
    +
    +
    Syntax 2
    Computes the matrix operation: \( B = \alpha A op(B) \), or \( B = \alpha op(B) * A \).
    subroutine diag_mtx_mult(logical lside, real(real64) alpha, real(real64) a(:), real(real64) b(:,:), optional class(errors) err)
    +
    subroutine diag_mtx_mult(logical lside, complex(real64) alpha, complex(real64) a(:), complex(real64) b(:,:), optional class(errors) err)
    +
    subroutine diag_mtx_mult(logical lside, complex(real64) alpha, real(real64) a(:), complex(real64) b(:,:), optional class(errors) err)
    +
    +
    Parameters
    + + + + + + +
    [in]lsideSet to true to apply matrix A from the left; else, set to false to apply matrix A from the left.
    [in]alphaA scalar multiplier.
    [in]aA K-element array containing the diagonal elements of A where K = MIN(M,P) if lside is true; else, if lside is false, K = MIN(N,P).
    [in]bOn input, the M-by-N matrix B. On output, the resulting M-by-N matrix.
    [in,out]errAn optional errors-based object that if provided can be used to retrieve information relating to any errors encountered during execution. If not provided, a default implementation of the errors class is used internally to provide error handling. Possible errors and warning messages that may be encountered are as follows.
      +
    • LA_ARRAY_SIZE_ERROR: Occurs if any of the input array sizes are incorrect.
    • +
    +
    +
    +
    +
    Usage
    The following example illustrates the use of the diagonal matrix multiplication routine to compute the \( S V^T \) component of a singular value decomposition.
    program example
    +
    use iso_fortran_env, only : int32, real64
    +
    use linalg_core
    +
    implicit none
    +
    +
    ! Variables
    +
    real(real64) :: a(3,2), s(2), u(3,3), vt(2,2), ac(3,2)
    +
    integer(int32) :: i
    +
    +
    ! Initialize the 3-by-2 matrix A
    +
    ! | 2 1 |
    +
    ! A = |-3 1 |
    +
    ! |-1 1 |
    +
    a = reshape([2.0d0, -3.0d0, -1.0d0, 1.0d0, 1.0d0, 1.0d0], [3, 2])
    +
    +
    ! Compute the singular value decomposition of A. Notice, V**T is returned
    +
    ! instead of V. Also note, A is overwritten.
    +
    call svd(a, s, u, vt)
    +
    +
    ! Display the results
    +
    print '(A)', "U ="
    +
    do i = 1, size(u, 1)
    +
    print *, u(i,:)
    +
    end do
    +
    +
    print '(A)', "S ="
    +
    print '(F9.5)', (s(i), i = 1, size(a, 2))
    +
    +
    print '(A)', "V**T ="
    +
    do i = 1, size(vt, 1)
    +
    print *, vt(i,:)
    +
    end do
    +
    +
    ! Compute U * S * V**T
    +
    call diag_mtx_mult(.true., 1.0d0, s, vt) ! Compute: VT = S * V**T
    +
    ac = matmul(u(:,1:2), vt)
    +
    print '(A)', "U * S * V**T ="
    +
    do i = 1, size(ac, 1)
    +
    print *, ac(i,:)
    +
    end do
    +
    end program
    +
    The above program produces the following output.
    U =
    +
    -0.47411577501825380 -0.81850539032073777 -0.32444284226152509
    +
    0.82566838523833064 -0.28535874325972488 -0.48666426339228758
    +
    0.30575472113569685 -0.49861740208412991 0.81110710565381272
    +
    S =
    +
    3.78845
    +
    1.62716
    +
    V**T =
    +
    -0.98483334211643059 0.17350299206578967
    +
    -0.17350299206578967 -0.98483334211643059
    +
    U * S * V**T =
    +
    1.9999999999999993 0.99999999999999956
    +
    -3.0000000000000000 1.0000000000000000
    +
    -1.0000000000000000 0.99999999999999967
    +
    + +

    Definition at line 329 of file linalg.f90.

    +

    The documentation for this interface was generated from the following file: +
    +
    + + + + diff --git a/doc/html/interfacelinalg_1_1eigen-members.html b/doc/html/interfacelinalg_1_1eigen-members.html new file mode 100644 index 00000000..b3ebdf8d --- /dev/null +++ b/doc/html/interfacelinalg_1_1eigen-members.html @@ -0,0 +1,114 @@ + + + + + + + +linalg: Member List + + + + + + + + + + + + + + + +
    +
    + + + + + + +
    +
    linalg 1.6.1 +
    +
    A linear algebra library that provides a user-friendly interface to several BLAS and LAPACK routines.
    +
    +
    + + + + + + + +
    +
    + +
    +
    +
    + +
    + +
    +
    + + +
    +
    +
    +
    +
    +
    Loading...
    +
    Searching...
    +
    No Matches
    +
    +
    +
    +
    + +
    +
    linalg::eigen Member List
    +
    +
    + +

    This is the complete list of members for linalg::eigen, including all inherited members.

    +
    +
    + + + + diff --git a/doc/html/interfacelinalg_1_1eigen.html b/doc/html/interfacelinalg_1_1eigen.html new file mode 100644 index 00000000..147478e2 --- /dev/null +++ b/doc/html/interfacelinalg_1_1eigen.html @@ -0,0 +1,263 @@ + + + + + + + +linalg: linalg::eigen Interface Reference + + + + + + + + + + + + + + + +
    +
    + + + + + + +
    +
    linalg 1.6.1 +
    +
    A linear algebra library that provides a user-friendly interface to several BLAS and LAPACK routines.
    +
    +
    + + + + + + + +
    +
    + +
    +
    +
    + +
    + +
    +
    + + +
    +
    +
    +
    +
    +
    Loading...
    +
    Searching...
    +
    No Matches
    +
    +
    +
    +
    + +
    + +
    linalg::eigen Interface Reference
    +
    +
    + +

    Computes the eigenvalues, and optionally the eigenvectors, of a matrix. + More...

    +

    Detailed Description

    +

    Computes the eigenvalues, and optionally the eigenvectors, of a matrix.

    +
    Syntax 1 (Symmetric Matrices)
    subroutine eigen(logical vecs, real(real64) a(:,:), real(real64) vals(:), optional real(real64) work(:), optional integer(int32) olwork, optional class(errors) err)
    +
    +
    Parameters
    + + + + + + + +
    [in]vecsSet to true to compute the eigenvectors as well as the eigenvalues; else, set to false to just compute the eigenvalues.
    [in,out]aOn input, the N-by-N symmetric matrix on which to operate. On output, and if vecs is set to true, the matrix will contain the eigenvectors (one per column) corresponding to each eigenvalue in vals. If vecs is set to false, the lower triangular portion of the matrix is overwritten.
    [out]valsAn N-element array that will contain the eigenvalues sorted into ascending order.
    [out]workAn optional input, that if provided, prevents any local memory allocation. If not provided, the memory required is allocated within. If provided, the length of the array must be at least olwork.
    [out]olworkAn optional output used to determine workspace size. If supplied, the routine determines the optimal size for work, and returns without performing any actual calculations.
    [in,out]errAn optional errors-based object that if provided can be used to retrieve information relating to any errors encountered during execution. If not provided, a default implementation of the errors class is used internally to provide error handling. Possible errors and warning messages that may be encountered are as follows.
      +
    • LA_ARRAY_SIZE_ERROR: Occurs if any of the input arrays are not sized appropriately.
    • +
    • LA_OUT_OF_MEMORY_ERROR: Occurs if local memory must be allocated, and there is insufficient memory available.
    • +
    • LA_CONVERGENCE_ERROR: Occurs if the algorithm failed to converge.
    • +
    +
    +
    +
    +
    Notes
    This routine utilizes the LAPACK routine DSYEV.
    +
    Syntax 2 (Asymmetric Matrices)
    subroutine eigen(real(real64) a(:,:), complex(real64) vals(:), optional complex(real64) vecs(:,:), optional real(real64) work(:), optional integer(int32) olwork, optional class(errors) err)
    +
    subroutine eigen(complex(real64) a(:,:), complex(real64) vals(:), optional complex(real64) vecs(:,:), optional complex(real64) work(:), optional integer(int32) olwork, real(real64) rwork(:), optional class(errors) err)
    +
    +
    Parameters
    + + + + + + + + +
    [in,out]aOn input, the N-by-N matrix on which to operate. On output, the contents of this matrix are overwritten.
    [out]valsAn N-element array containing the eigenvalues of the matrix. The eigenvalues are not sorted.
    [out]vecsAn optional N-by-N matrix, that if supplied, signals to compute the right eigenvectors (one per column). If not provided, only the eigenvalues will be computed.
    [out]workAn optional input, that if provided, prevents any local memory allocation. If not provided, the memory required is allocated within. If provided, the length of the array must be at least olwork.
    [out]olworkAn optional output used to determine workspace size. If supplied, the routine determines the optimal size for work, and returns without performing any actual calculations.
    [out]rworkAn optional input, that if provided, prevents any local memory allocation for real-valued workspaces. If not provided, the memory required is allocated within. If provided, the length of the array must be at least 2 * N.
    [in,out]errAn optional errors-based object that if provided can be used to retrieve information relating to any errors encountered during execution. If not provided, a default implementation of the errors class is used internally to provide error handling. Possible errors and warning messages that may be encountered are as follows.
      +
    • LA_ARRAY_SIZE_ERROR: Occurs if any of the input arrays are not sized appropriately.
    • +
    • LA_OUT_OF_MEMORY_ERROR: Occurs if local memory must be allocated, and there is insufficient memory available.
    • +
    • LA_CONVERGENCE_ERROR: Occurs if the algorithm failed to converge.
    • +
    +
    +
    +
    +
    Notes
    This routine utilizes the LAPACK routine DGEEV (ZGEEV in the complex case).
    +
    Syntax 3 (General Eigen Problem)
    Computes the eigenvalues, and optionally the right eigenvectors of a square matrix assuming the structure of the eigenvalue problem is \( A X = \lambda B X \).
    subroutine eigen(real(real64) a(:,:), real(real64) b(:,:), complex(real64) alpha(:), optional real(real64) beta(:), optional complex(real64) vecs(:,:), optional real(real64) work(:), optional integer(int32) olwork, optional class(errors) err)
    +
    +
    Parameters
    + + + + + + + + + +
    [in,out]aOn input, the N-by-N matrix A. On output, the contents of this matrix are overwritten.
    [in,out]bOn input, the N-by-N matrix B. On output, the contents of this matrix are overwritten.
    [out]alphaAn N-element array that, if beta is not supplied, contains the eigenvalues. If beta is supplied however, the eigenvalues must be computed as ALPHA / BETA. This however, is not as trivial as it seems as it is entirely possible, and likely, that ALPHA / BETA can overflow or underflow. With that said, the values in ALPHA will always be less than and usually comparable with the NORM(A).
    [out]betaAn optional N-element array that if provided forces alpha to return the numerator, and this array contains the denominator used to determine the eigenvalues as ALPHA / BETA. If used, the values in this array will always be less than and usually comparable with the NORM(B).
    [out]vecsAn optional N-by-N matrix, that if supplied, signals to compute the right eigenvectors (one per column). If not provided, only the eigenvalues will be computed.
    [out]workAn optional input, that if provided, prevents any local memory allocation. If not provided, the memory required is allocated within. If provided, the length of the array must be at least olwork.
    [out]olworkAn optional output used to determine workspace size. If supplied, the routine determines the optimal size for work, and returns without performing any actual calculations.
    [in,out]errAn optional errors-based object that if provided can be used to retrieve information relating to any errors encountered during execution. If not provided, a default implementation of the errors class is used internally to provide error handling. Possible errors and warning messages that may be encountered are as follows.
      +
    • LA_ARRAY_SIZE_ERROR: Occurs if any of the input arrays are not sized appropriately.
    • +
    • LA_OUT_OF_MEMORY_ERROR: Occurs if local memory must be allocated, and there is insufficient memory available.
    • +
    • LA_CONVERGENCE_ERROR: Occurs if the algorithm failed to converge.
    • +
    +
    +
    +
    +
    Notes
    This routine utilizes the LAPACK routine DGGEV.
    +
    Usage
    As an example, consider the eigenvalue problem arising from a mechanical system of masses and springs such that the masses are described by a mass matrix M, and the arrangement of springs are described by a stiffness matrix K.
    ! This is an example illustrating the use of the eigenvalue and eigenvector
    +
    ! routines to solve a free vibration problem of 3 masses connected by springs.
    +
    !
    +
    ! k1 k2 k3 k4
    +
    ! |-\/\/\-| m1 |-\/\/\-| m2 |-\/\/\-| m3 |-\/\/\-|
    +
    !
    +
    ! As illustrated above, the system consists of 3 masses connected by springs.
    +
    ! Spring k1 and spring k4 connect the end masses to ground. The equations of
    +
    ! motion for this system are as follows.
    +
    !
    +
    ! | m1 0 0 | |x1"| | k1+k2 -k2 0 | |x1| |0|
    +
    ! | 0 m2 0 | |x2"| + | -k2 k2+k3 -k3 | |x2| = |0|
    +
    ! | 0 0 m3| |x3"| | 0 -k3 k3+k4| |x3| |0|
    +
    !
    +
    ! Notice: x1" = the second time derivative of x1.
    +
    program example
    +
    use iso_fortran_env, only : int32, real64
    +
    use linalg_core
    +
    implicit none
    +
    +
    ! Define the model parameters
    +
    real(real64), parameter :: pi = 3.14159265359d0
    +
    real(real64), parameter :: m1 = 0.5d0
    +
    real(real64), parameter :: m2 = 2.5d0
    +
    real(real64), parameter :: m3 = 0.75d0
    +
    real(real64), parameter :: k1 = 5.0d6
    +
    real(real64), parameter :: k2 = 10.0d6
    +
    real(real64), parameter :: k3 = 10.0d6
    +
    real(real64), parameter :: k4 = 5.0d6
    +
    +
    ! Local Variables
    +
    integer(int32) :: i, j
    +
    real(real64) :: m(3,3), k(3,3), natFreq(3)
    +
    complex(real64) :: vals(3), modeShapes(3,3)
    +
    +
    ! Define the mass matrix
    +
    m = reshape([m1, 0.0d0, 0.0d0, 0.0d0, m2, 0.0d0, 0.0d0, 0.0d0, m3], [3, 3])
    +
    +
    ! Define the stiffness matrix
    +
    k = reshape([k1 + k2, -k2, 0.0d0, -k2, k2 + k3, -k3, 0.0d0, -k3, k3 + k4], &
    +
    [3, 3])
    +
    +
    ! Compute the eigenvalues and eigenvectors.
    +
    call eigen(k, m, vals, vecs = modeshapes)
    +
    +
    ! Compute the natural frequency values, and return them with units of Hz.
    +
    ! Notice, all eigenvalues and eigenvectors are real for this example.
    +
    natfreq = sqrt(real(vals)) / (2.0d0 * pi)
    +
    +
    ! Display the natural frequency and mode shape values. Notice, the eigen
    +
    ! routine does not necessarily sort the values.
    +
    print '(A)', "Modal Information (Not Sorted):"
    +
    do i = 1, size(natfreq)
    +
    print '(AI0AF8.4A)', "Mode ", i, ": (", natfreq(i), " Hz)"
    +
    print '(F10.3)', (real(modeshapes(j,i)), j = 1, size(natfreq))
    +
    end do
    +
    end program
    +
    The above program produces the following output.
    Modal Information:
    +
    Mode 1: (232.9225 Hz)
    +
    -0.718
    +
    -1.000
    +
    -0.747
    +
    Mode 2: (749.6189 Hz)
    +
    -0.419
    +
    -0.164
    +
    1.000
    +
    Mode 3: (923.5669 Hz)
    +
    1.000
    +
    -0.184
    +
    0.179
    +
    +
    See Also
    +
    + +

    Definition at line 3098 of file linalg.f90.

    +

    The documentation for this interface was generated from the following file: +
    +
    + + + + diff --git a/doc/html/interfacelinalg_1_1form__lu-members.html b/doc/html/interfacelinalg_1_1form__lu-members.html new file mode 100644 index 00000000..0955c56d --- /dev/null +++ b/doc/html/interfacelinalg_1_1form__lu-members.html @@ -0,0 +1,114 @@ + + + + + + + +linalg: Member List + + + + + + + + + + + + + + + +
    +
    + + + + + + +
    +
    linalg 1.6.1 +
    +
    A linear algebra library that provides a user-friendly interface to several BLAS and LAPACK routines.
    +
    +
    + + + + + + + +
    +
    + +
    +
    +
    + +
    + +
    +
    + + +
    +
    +
    +
    +
    +
    Loading...
    +
    Searching...
    +
    No Matches
    +
    +
    +
    +
    + +
    +
    linalg::form_lu Member List
    +
    +
    + +

    This is the complete list of members for linalg::form_lu, including all inherited members.

    +
    +
    + + + + diff --git a/doc/html/interfacelinalg_1_1form__lu.html b/doc/html/interfacelinalg_1_1form__lu.html new file mode 100644 index 00000000..124e3e74 --- /dev/null +++ b/doc/html/interfacelinalg_1_1form__lu.html @@ -0,0 +1,220 @@ + + + + + + + +linalg: linalg::form_lu Interface Reference + + + + + + + + + + + + + + + +
    +
    + + + + + + +
    +
    linalg 1.6.1 +
    +
    A linear algebra library that provides a user-friendly interface to several BLAS and LAPACK routines.
    +
    +
    + + + + + + + +
    +
    + +
    +
    +
    + +
    + +
    +
    + + +
    +
    +
    +
    +
    +
    Loading...
    +
    Searching...
    +
    No Matches
    +
    +
    +
    +
    + +
    + +
    linalg::form_lu Interface Reference
    +
    +
    + +

    Extracts the L and U matrices from the condensed [L\U] storage format used by the lu_factor. + More...

    +

    Detailed Description

    +

    Extracts the L and U matrices from the condensed [L\U] storage format used by the lu_factor.

    +
    Syntax 1
    subroutine form_lu(real(real64) lu(:,:), integer(int32) ipvt(:), real(real64) u(:,:), real(real64) p(:,:), optional class(errors) err)
    +
    subroutine form_lu(complex(real64) lu(:,:), integer(int32) ipvt(:), complex(real64) u(:,:), real(real64) p(:,:), optional class(errors) err)
    +
    +
    Parameters
    + + + + + + +
    [in,out]luOn input, the N-by-N matrix as output by lu_factor. On output, the N-by-N lower triangular matrix L.
    [in]ipvtThe N-element pivot array as output by lu_factor.
    [out]uAn N-by-N matrix where the U matrix will be written.
    [out]pAn N-by-N matrix where the row permutation matrix will be written.
    [in,out]errAn optional errors-based object that if provided can be used to retrieve information relating to any errors encountered during execution. If not provided, a default implementation of the errors class is used internally to provide error handling. Possible errors and warning messages that may be encountered are as follows.
      +
    • LA_ARRAY_SIZE_ERROR: Occurs if any of the input array sizes are incorrect.
    • +
    +
    +
    +
    +
    Syntax 2
    subroutine form_lu(real(real64) lu(:,:), real(real64) u(:,:), optional class(errors) err)
    +
    subroutine form_lu(complex(real64) lu(:,:), complex(real64) u(:,:), optional class(errors) err)
    +
    +
    Parameters
    + + + + +
    [in,out]luOn input, the N-by-N matrix as output by lu_factor. On output, the N-by-N lower triangular matrix L.
    [out]uAn N-by-N matrix where the U matrix will be written.
    [in,out]errAn optional errors-based object that if provided can be used to retrieve information relating to any errors encountered during execution. If not provided, a default implementation of the errors class is used internally to provide error handling. Possible errors and warning messages that may be encountered are as follows.
      +
    • LA_ARRAY_SIZE_ERROR: Occurs if any of the input array sizes are incorrect.
    • +
    +
    +
    +
    +
    Remarks
    This routine allows extraction of the actual "L", "U", and "P" matrices of the decomposition. To use these matrices to solve the system \( A X = B \), the following approach is used.
    +
      +
    1. First, solve the linear system: \( L Y = P B \) for \( Y \).
    2. +
    3. Second, solve the linear system: \( U X = Y \) for \( X \).
    4. +
    +

    Notice, as both L and U are triangular in structure, the above equations can be solved by forward and backward substitution.

    +
    See Also
    +
    +
    Usage
    The following example illustrates how to extract the L, U, and P matrices in order to solve a system of LU factored equations.
    program example
    +
    use iso_fortran_env, only : real64, int32
    +
    use linalg_core
    +
    implicit none
    +
    +
    ! Variables
    +
    real(real64) :: a(3,3), b(3), u(3,3), p(3,3)
    +
    integer(int32) :: i, pvt(3)
    +
    +
    ! Build the 3-by-3 matrix A.
    +
    ! | 1 2 3 |
    +
    ! A = | 4 5 6 |
    +
    ! | 7 8 0 |
    +
    a = reshape( &
    +
    [1.0d0, 4.0d0, 7.0d0, 2.0d0, 5.0d0, 8.0d0, 3.0d0, 6.0d0, 0.0d0], &
    +
    [3, 3])
    +
    +
    ! Build the right-hand-side vector B.
    +
    ! | -1 |
    +
    ! b = | -2 |
    +
    ! | -3 |
    +
    b = [-1.0d0, -2.0d0, -3.0d0]
    +
    +
    ! The solution is:
    +
    ! | 1/3 |
    +
    ! x = | -2/3 |
    +
    ! | 0 |
    +
    +
    ! Compute the LU factorization
    +
    call lu_factor(a, pvt)
    +
    +
    ! Extract the L and U matrices. A is overwritten with L.
    +
    call form_lu(a, pvt, u, p)
    +
    +
    ! Solve the lower triangular system L * Y = P * B for Y, but first compute
    +
    ! P * B, and store the results in B
    +
    b = matmul(p, b)
    +
    +
    ! Now, compute the solution to the lower triangular system. Store the
    +
    ! result in B. Remember, L is unit diagonal (ones on its diagonal)
    +
    call solve_triangular_system(.false., .false., .false., a, b)
    +
    +
    ! Solve the upper triangular system U * X = Y for X.
    +
    call solve_triangular_system(.true., .false., .true., u, b)
    +
    +
    ! Display the results.
    +
    print '(A)', "LU Solution: X = "
    +
    print '(F8.4)', (b(i), i = 1, size(b))
    +
    end program
    +
    The above program produces the following output.
    LU Solution: X =
    +
    0.3333
    +
    -0.6667
    +
    0.0000
    +
    + +

    Definition at line 717 of file linalg.f90.

    +

    The documentation for this interface was generated from the following file: +
    +
    + + + + diff --git a/doc/html/interfacelinalg_1_1form__qr-members.html b/doc/html/interfacelinalg_1_1form__qr-members.html new file mode 100644 index 00000000..ba5a8619 --- /dev/null +++ b/doc/html/interfacelinalg_1_1form__qr-members.html @@ -0,0 +1,114 @@ + + + + + + + +linalg: Member List + + + + + + + + + + + + + + + +
    +
    + + + + + + +
    +
    linalg 1.6.1 +
    +
    A linear algebra library that provides a user-friendly interface to several BLAS and LAPACK routines.
    +
    +
    + + + + + + + +
    +
    + +
    +
    +
    + +
    + +
    +
    + + +
    +
    +
    +
    +
    +
    Loading...
    +
    Searching...
    +
    No Matches
    +
    +
    +
    +
    + +
    +
    linalg::form_qr Member List
    +
    +
    + +

    This is the complete list of members for linalg::form_qr, including all inherited members.

    +
    +
    + + + + diff --git a/doc/html/interfacelinalg_1_1form__qr.html b/doc/html/interfacelinalg_1_1form__qr.html new file mode 100644 index 00000000..706689e9 --- /dev/null +++ b/doc/html/interfacelinalg_1_1form__qr.html @@ -0,0 +1,230 @@ + + + + + + + +linalg: linalg::form_qr Interface Reference + + + + + + + + + + + + + + + +
    +
    + + + + + + +
    +
    linalg 1.6.1 +
    +
    A linear algebra library that provides a user-friendly interface to several BLAS and LAPACK routines.
    +
    +
    + + + + + + + +
    +
    + +
    +
    +
    + +
    + +
    +
    + + +
    +
    +
    +
    +
    +
    Loading...
    +
    Searching...
    +
    No Matches
    +
    +
    +
    +
    + +
    + +
    linalg::form_qr Interface Reference
    +
    +
    + +

    Forms the full M-by-M orthogonal matrix Q from the elementary reflectors returned by the base QR factorization algorithm. + More...

    +

    Detailed Description

    +

    Forms the full M-by-M orthogonal matrix Q from the elementary reflectors returned by the base QR factorization algorithm.

    +
    Syntax 1
    subroutine form_qr(real(real64) r(:,:), real(real64) tau(:), real(real64) q(:,:), optional real(real64) work(:), optional integer(int32) olwork, optional class(errors) err)
    +
    subroutine form_qr(complex(real64) r(:,:), complex(real64) tau(:), complex(real64) q(:,:), optional complex(real64) work(:), optional integer(int32) olwork, optional class(errors) err)
    +
    +
    Parameters
    + + + + + + + +
    [in,out]rOn input, an M-by-N matrix where the elements below the diagonal contain the elementary reflectors generated from the QR factorization. On and above the diagonal, the matrix contains the matrix R. On output, the elements below the diagonal are zeroed such that the remaining matrix is simply the M-by-N matrix R.
    [in]tauA MIN(M, N)-element array containing the scalar factors of each elementary reflector defined in r.
    [out]qAn M-by-M matrix where the full orthogonal matrix Q will be written. In the event that M > N, Q may be supplied as M-by-N, and therefore only return the useful submatrix Q1 (Q = [Q1, Q2]) as the factorization can be written as Q * R = [Q1, Q2] * [R1; 0].
    [out]workAn optional input, that if provided, prevents any local memory allocation. If not provided, the memory required is allocated within. If provided, the length of the array must be at least olwork.
    [out]olworkAn optional output used to determine workspace size. If supplied, the routine determines the optimal size for work, and returns without performing any actual calculations.
    [in,out]errAn optional errors-based object that if provided can be used to retrieve information relating to any errors encountered during execution. If not provided, a default implementation of the errors class is used internally to provide error handling. Possible errors and warning messages that may be encountered are as follows.
      +
    • LA_ARRAY_SIZE_ERROR: Occurs if any of the input arrays are not sized appropriately.
    • +
    • LA_OUT_OF_MEMORY_ERROR: Occurs if local memory must be allocated, and there is insufficient memory available.
    • +
    +
    +
    +
    +
    Notes
    This routine utilizes the LAPACK routine DORGQR (ZUNQR in the complex case).
    +
    Syntax 2
    subroutine form_qr(real(real64) r(:,:), real(real64) tau(:), integer(int32) pvt(:), real(real64) q(:,:), real(real64) p(:,:), optional real(real64) work(:), optional integer(int32) olwork, optional class(errors) err)
    +
    subroutine form_qr(complex(real64) r(:,:), complex(real64) tau(:), integer(int32) pvt(:), complex(real64) q(:,:), complex(real64) p(:,:), optional complex(real64) work(:), optional integer(int32) olwork, optional class(errors) err)
    +
    +
    Parameters
    + + + + + + + + + +
    [in,out]rOn input, an M-by-N matrix where the elements below the diagonal contain the elementary reflectors generated from the QR factorization. On and above the diagonal, the matrix contains the matrix R. On output, the elements below the diagonal are zeroed such that the remaining matrix is simply the M-by-N matrix R.
    [in]tauA MIN(M, N)-element array containing the scalar factors of each elementary reflector defined in r.
    [in]pvtAn N-element column pivot array as returned by the QR factorization.
    [out]qAn M-by-M matrix where the full orthogonal matrix Q will be written. In the event that M > N, Q may be supplied as M-by-N, and therefore only return the useful submatrix Q1 (Q = [Q1, Q2]) as the factorization can be written as Q * R = [Q1, Q2] * [R1; 0].
    [out]pAn N-by-N matrix where the pivot matrix will be written.
    [out]workAn optional input, that if provided, prevents any local memory allocation. If not provided, the memory required is allocated within. If provided, the length of the array must be at least olwork.
    [out]olworkAn optional output used to determine workspace size. If supplied, the routine determines the optimal size for work, and returns without performing any actual calculations.
    [in,out]errAn optional errors-based object that if provided can be used to retrieve information relating to any errors encountered during execution. If not provided, a default implementation of the errors class is used internally to provide error handling. Possible errors and warning messages that may be encountered are as follows.
      +
    • LA_ARRAY_SIZE_ERROR: Occurs if any of the input arrays are not sized appropriately.
    • +
    • LA_OUT_OF_MEMORY_ERROR: Occurs if local memory must be allocated, and there is insufficient memory available.
    • +
    +
    +
    +
    +
    Notes
    This routine utilizes the LAPACK routine DORGQR (ZUNQR in the complex case).
    +
    Usage
    The following example illustrates how to explicitly form the Q and R matrices from the output of qr_factor, and then use the resulting matrices to solve a system of linear equations.
    program example
    +
    use iso_fortran_env, only : real64, int32
    +
    use linalg_core
    +
    implicit none
    +
    +
    ! Variables
    +
    real(real64) :: a(3,3), b(3), q(3,3), tau(3)
    +
    integer(int32) :: i
    +
    +
    ! Build the 3-by-3 matrix A.
    +
    ! | 1 2 3 |
    +
    ! A = | 4 5 6 |
    +
    ! | 7 8 0 |
    +
    a = reshape( &
    +
    [1.0d0, 4.0d0, 7.0d0, 2.0d0, 5.0d0, 8.0d0, 3.0d0, 6.0d0, 0.0d0], &
    +
    [3, 3])
    +
    +
    ! Build the right-hand-side vector B.
    +
    ! | -1 |
    +
    ! b = | -2 |
    +
    ! | -3 |
    +
    b = [-1.0d0, -2.0d0, -3.0d0]
    +
    +
    ! The solution is:
    +
    ! | 1/3 |
    +
    ! x = | -2/3 |
    +
    ! | 0 |
    +
    +
    ! Compute the QR factorization without column pivoting
    +
    call qr_factor(a, tau)
    +
    +
    ! Build Q and R. A is overwritten with R
    +
    call form_qr(a, tau, q)
    +
    +
    ! As this system is square, matrix R is upper triangular. Also, Q is
    +
    ! always orthogonal such that it's inverse and transpose are equal. As the
    +
    ! system is now factored, its form is: Q * R * X = B. Solving this system
    +
    ! is then as simple as solving the upper triangular system:
    +
    ! R * X = Q**T * B.
    +
    +
    ! Compute Q**T * B, and store the results in B
    +
    b = matmul(transpose(q), b)
    +
    +
    ! Solve the upper triangular system R * X = Q**T * B for X
    +
    call solve_triangular_system(.true., .false., .true., a, b)
    +
    +
    ! Display the results
    +
    print '(A)', "QR Solution: X = "
    +
    print '(F8.4)', (b(i), i = 1, size(b))
    +
    +
    ! Notice, QR factorization with column pivoting could be accomplished via
    +
    ! a similar approach, but the column pivoting would need to be accounted
    +
    ! for by noting that Q * R = A * P, where P is an N-by-N matrix describing
    +
    ! the column pivoting operations.
    +
    end program
    +
    The above program produces the following output.
    QR Solution: X =
    +
    0.3333
    +
    -0.6667
    +
    0.0000
    +
    +
    See Also
    +
    + +

    Definition at line 1031 of file linalg.f90.

    +

    The documentation for this interface was generated from the following file: +
    +
    + + + + diff --git a/doc/html/interfacelinalg_1_1lu__factor-members.html b/doc/html/interfacelinalg_1_1lu__factor-members.html new file mode 100644 index 00000000..99ed60f5 --- /dev/null +++ b/doc/html/interfacelinalg_1_1lu__factor-members.html @@ -0,0 +1,114 @@ + + + + + + + +linalg: Member List + + + + + + + + + + + + + + + +
    +
    + + + + + + +
    +
    linalg 1.6.1 +
    +
    A linear algebra library that provides a user-friendly interface to several BLAS and LAPACK routines.
    +
    +
    + + + + + + + +
    +
    + +
    +
    +
    + +
    + +
    +
    + + +
    +
    +
    +
    +
    +
    Loading...
    +
    Searching...
    +
    No Matches
    +
    +
    +
    +
    + +
    +
    linalg::lu_factor Member List
    +
    +
    + +

    This is the complete list of members for linalg::lu_factor, including all inherited members.

    +
    +
    + + + + diff --git a/doc/html/interfacelinalg_1_1lu__factor.html b/doc/html/interfacelinalg_1_1lu__factor.html new file mode 100644 index 00000000..a57eb38b --- /dev/null +++ b/doc/html/interfacelinalg_1_1lu__factor.html @@ -0,0 +1,189 @@ + + + + + + + +linalg: linalg::lu_factor Interface Reference + + + + + + + + + + + + + + + +
    +
    + + + + + + +
    +
    linalg 1.6.1 +
    +
    A linear algebra library that provides a user-friendly interface to several BLAS and LAPACK routines.
    +
    +
    + + + + + + + +
    +
    + +
    +
    +
    + +
    + +
    +
    + + +
    +
    +
    +
    +
    +
    Loading...
    +
    Searching...
    +
    No Matches
    +
    +
    +
    +
    + +
    + +
    linalg::lu_factor Interface Reference
    +
    +
    + +

    Computes the LU factorization of an M-by-N matrix. + More...

    +

    Detailed Description

    +

    Computes the LU factorization of an M-by-N matrix.

    +
    Syntax
    subroutine lu_factor(real(real64) a(:,:), integer(int32) ipvt(:), optional class(errors))
    +
    subroutine lu_factor(complex(real64) a(:,:), integer(int32) ipvt(:), optional class(errors))
    +
    +
    Parameters
    + + + + +
    [in,out]aOn input, the M-by-N matrix on which to operate. On output, the LU factored matrix in the form [L\U] where the unit diagonal elements of L are not stored.
    [out]ipvtAn MIN(M, N)-element array used to track row-pivot operations. The array stored pivot information such that row I is interchanged with row IPVT(I).
    [in,out]errAn optional errors-based object that if provided can be used to retrieve information relating to any errors encountered during execution. If not provided, a default implementation of the errors class is used internally to provide error handling. Possible errors and warning messages that may be encountered are as follows.
      +
    • LA_ARRAY_SIZE_ERROR: Occurs if ipvt is not sized appropriately.
    • +
    • LA_SINGULAR_MATRIX_ERROR: Occurs as a warning if a is found to be singular.
    • +
    +
    +
    +
    +
    Notes
    This routine utilizes the LAPACK routine DGETRF.
    +
    See Also
    +
    +
    Usage
    To solve a system of 3 equations of 3 unknowns using LU factorization, the following code will suffice.
    program example
    +
    use iso_fortran_env
    +
    use linalg_core
    +
    implicit none
    +
    +
    ! Local Variables
    +
    real(real64) :: a(3,3), b(3)
    +
    integer(int32) :: i, pvt(3)
    +
    +
    ! Build the 3-by-3 matrix A.
    +
    ! | 1 2 3 |
    +
    ! A = | 4 5 6 |
    +
    ! | 7 8 0 |
    +
    a = reshape( &
    +
    [1.0d0, 4.0d0, 7.0d0, 2.0d0, 5.0d0, 8.0d0, 3.0d0, 6.0d0, 0.0d0], &
    +
    [3, 3])
    +
    +
    ! Build the right-hand-side vector B.
    +
    ! | -1 |
    +
    ! b = | -2 |
    +
    ! | -3 |
    +
    b = [-1.0d0, -2.0d0, -3.0d0]
    +
    +
    ! The solution is:
    +
    ! | 1/3 |
    +
    ! x = | -2/3 |
    +
    ! | 0 |
    +
    +
    ! Compute the LU factorization
    +
    call lu_factor(a, pvt)
    +
    +
    ! Compute the solution. The results overwrite b.
    +
    call solve_lu(a, pvt, b)
    +
    +
    ! Display the results.
    +
    print '(A)', "LU Solution: X = "
    +
    print '(F8.4)', (b(i), i = 1, size(b))
    +
    end program
    +
    The program generates the following output.
    LU Solution: X =
    +
    0.3333
    +
    -0.6667
    +
    0.0000
    +
    + +

    Definition at line 595 of file linalg.f90.

    +

    The documentation for this interface was generated from the following file: +
    +
    + + + + diff --git a/doc/html/interfacelinalg_1_1mtx__inverse-members.html b/doc/html/interfacelinalg_1_1mtx__inverse-members.html new file mode 100644 index 00000000..8d5ebb64 --- /dev/null +++ b/doc/html/interfacelinalg_1_1mtx__inverse-members.html @@ -0,0 +1,114 @@ + + + + + + + +linalg: Member List + + + + + + + + + + + + + + + +
    +
    + + + + + + +
    +
    linalg 1.6.1 +
    +
    A linear algebra library that provides a user-friendly interface to several BLAS and LAPACK routines.
    +
    +
    + + + + + + + +
    +
    + +
    +
    +
    + +
    + +
    +
    + + +
    +
    +
    +
    +
    +
    Loading...
    +
    Searching...
    +
    No Matches
    +
    +
    +
    +
    + +
    +
    linalg::mtx_inverse Member List
    +
    +
    + +

    This is the complete list of members for linalg::mtx_inverse, including all inherited members.

    +
    +
    + + + + diff --git a/doc/html/interfacelinalg_1_1mtx__inverse.html b/doc/html/interfacelinalg_1_1mtx__inverse.html new file mode 100644 index 00000000..5bbe00b4 --- /dev/null +++ b/doc/html/interfacelinalg_1_1mtx__inverse.html @@ -0,0 +1,194 @@ + + + + + + + +linalg: linalg::mtx_inverse Interface Reference + + + + + + + + + + + + + + + +
    +
    + + + + + + +
    +
    linalg 1.6.1 +
    +
    A linear algebra library that provides a user-friendly interface to several BLAS and LAPACK routines.
    +
    +
    + + + + + + + +
    +
    + +
    +
    +
    + +
    + +
    +
    + + +
    +
    +
    +
    +
    +
    Loading...
    +
    Searching...
    +
    No Matches
    +
    +
    +
    +
    + +
    + +
    linalg::mtx_inverse Interface Reference
    +
    +
    + +

    Computes the inverse of a square matrix. + More...

    +

    Detailed Description

    +

    Computes the inverse of a square matrix.

    +
    Syntax
    subroutine mtx_inverse(real(real64) a(:,:), optional integer(int32) iwork, optional real(real64) work(:), optional integer olwork, optional class(errors) err)
    +
    subroutine mtx_inverse(complex(real64) a(:,:), optional integer(int32) iwork, optional complex(real64) work(:), optional integer olwork, optional class(errors) err)
    +
    +
    Parameters
    + + + + + + +
    [in,out]aOn input, the N-by-N matrix to invert. On output, the inverted matrix.
    [out]iworkAn optional N-element integer workspace array.
    [out]workAn optional input, that if provided, prevents any local memory allocation. If not provided, the memory required is allocated within. If provided, the length of the array must be at least olwork.
    [out]olworkAn optional output used to determine workspace size. If supplied, the routine determines the optimal size for work, and returns without performing any actual calculations.
    [in,out]errAn optional errors-based object that if provided can be used to retrieve information relating to any errors encountered during execution. If not provided, a default implementation of the errors class is used internally to provide error handling. Possible errors and warning messages that may be encountered are as follows.
      +
    • LA_ARRAY_SIZE_ERROR: Occurs if a is not square. Will also occur if incorrectly sized workspace arrays are provided.
    • +
    • LA_OUT_OF_MEMORY_ERROR: Occurs if local memory must be allocated, and there is insufficient memory available.
    • +
    • LA_SINGULAR_MATRIX_ERROR: Occurs if the input matrix is singular.
    • +
    +
    +
    +
    +
    Notes
    This routine utilizes the LAPACK routines DGETRF to perform an LU factorization of the matrix, and DGETRI to invert the LU factored matrix (ZGETRF and ZGETRI in the complex case).
    +
    See Also
    +
    +
    Usage
    The following example illustrates the inversion of a 3-by-3 matrix.
    program example
    +
    use iso_fortran_env, only : real64, int32
    +
    use linalg_core
    +
    implicit none
    +
    +
    ! Variables
    +
    real(real64) :: a(3,3), ai(3,3), c(3,3)
    +
    integer(int32) :: i
    +
    +
    ! Construct the 3-by-3 matrix A to invert
    +
    ! | 1 2 3 |
    +
    ! A = | 4 5 6 |
    +
    ! | 7 8 0 |
    +
    a = reshape([1.0d0, 4.0d0, 7.0d0, 2.0d0, 5.0d0, 8.0d0, 3.0d0, 6.0d0, &
    +
    0.0d0], [3, 3])
    +
    +
    ! Compute the inverse of A. Notice, the original matrix is overwritten
    +
    ! with it's inverse.
    +
    ai = a
    +
    call mtx_inverse(ai)
    +
    +
    ! Show that A * inv(A) = I
    +
    c = matmul(a, ai)
    +
    +
    ! Display the inverse
    +
    print '(A)', "Inverse:"
    +
    do i = 1, size(ai, 1)
    +
    print *, ai(i,:)
    +
    end do
    +
    +
    ! Display the result of A * inv(A)
    +
    print '(A)', "A * A**-1:"
    +
    do i = 1, size(c, 1)
    +
    print *, c(i,:)
    +
    end do
    +
    end program
    +
    The above program produces the following output.
    Inverse:
    +
    -1.7777777777777777 0.88888888888888884 -0.11111111111111110
    +
    1.5555555555555556 -0.77777777777777779 0.22222222222222221
    +
    -0.11111111111111119 0.22222222222222227 -0.11111111111111112
    +
    A * A**-1:
    +
    0.99999999999999989 5.5511151231257827E-017 -4.1633363423443370E-017
    +
    5.5511151231257827E-017 1.0000000000000000 -8.3266726846886741E-017
    +
    1.7763568394002505E-015 -8.8817841970012523E-016 1.0000000000000000
    +
    + +

    Definition at line 2778 of file linalg.f90.

    +

    The documentation for this interface was generated from the following file: +
    +
    + + + + diff --git a/doc/html/interfacelinalg_1_1mtx__mult-members.html b/doc/html/interfacelinalg_1_1mtx__mult-members.html new file mode 100644 index 00000000..0e93fa36 --- /dev/null +++ b/doc/html/interfacelinalg_1_1mtx__mult-members.html @@ -0,0 +1,114 @@ + + + + + + + +linalg: Member List + + + + + + + + + + + + + + + +
    +
    + + + + + + +
    +
    linalg 1.6.1 +
    +
    A linear algebra library that provides a user-friendly interface to several BLAS and LAPACK routines.
    +
    +
    + + + + + + + +
    +
    + +
    +
    +
    + +
    + +
    +
    + + +
    +
    +
    +
    +
    +
    Loading...
    +
    Searching...
    +
    No Matches
    +
    +
    +
    +
    + +
    +
    linalg::mtx_mult Member List
    +
    +
    + +

    This is the complete list of members for linalg::mtx_mult, including all inherited members.

    +
    +
    + + + + diff --git a/doc/html/interfacelinalg_1_1mtx__mult.html b/doc/html/interfacelinalg_1_1mtx__mult.html new file mode 100644 index 00000000..4c5d9131 --- /dev/null +++ b/doc/html/interfacelinalg_1_1mtx__mult.html @@ -0,0 +1,163 @@ + + + + + + + +linalg: linalg::mtx_mult Interface Reference + + + + + + + + + + + + + + + +
    +
    + + + + + + +
    +
    linalg 1.6.1 +
    +
    A linear algebra library that provides a user-friendly interface to several BLAS and LAPACK routines.
    +
    +
    + + + + + + + +
    +
    + +
    +
    +
    + +
    + +
    +
    + + +
    +
    +
    +
    +
    +
    Loading...
    +
    Searching...
    +
    No Matches
    +
    +
    +
    +
    + +
    + +
    linalg::mtx_mult Interface Reference
    +
    +
    + +

    Performs the matrix operation: \( C = \alpha op(A) op(B) + \beta C \). + More...

    +

    Detailed Description

    +

    Performs the matrix operation: \( C = \alpha op(A) op(B) + \beta C \).

    +
    Syntax 1
    subroutine mtx_mult(logical transa, logical transb, real(real64) alpha, real(real64) a(:,:), real(real64) b(:,:), real(real64) beta, real(real64) c(:,:), optional class(errors) err)
    +
    subroutine mtx_mult(integer(int32) transa, integer(int32) transb, complex(real64) alpha, complex(real64) a(:,:), complex(real64) b(:,:), complex(real64) beta, complex(real64) c(:,:), optional class(errors) err)
    +
    +
    Parameters
    + + + + + + + + + +
    [in]transaSet to true if \( op(A) = A^T \); else, set to false for \( op(A) = A\). In the complex case set to LA_TRANSPOSE if \( op(A) = A^T \), set to LA_HERMITIAN_TRANSPOSE if \( op(A) = A^H \), otherwise set to LA_NO_OPERATION if \( op(A) = A \).
    [in]transbSet to true if \( op(B) = B^T \); else, set to false for \( op(B) = B\). In the complex case set to LA_TRANSPOSE if \( op(B) = B^T \), set to LA_HERMITIAN_TRANSPOSE if \( op(B) = B^H \), otherwise set to LA_NO_OPERATION if \( op(B) = B \).
    [in]alphaA scalar multiplier.
    [in]aIf transa is set to true, an K-by-M matrix; else, if transa is set to false, an M-by-K matrix.
    [in]bIf transb is set to true, an N-by-K matrix; else, if transb is set to false, a K-by-N matrix.
    [in]betaA scalar multiplier.
    [in,out]cOn input, the M-by-N matrix C. On output, the M-by-N result.
    [in,out]errAn optional errors-based object that if provided can be used to retrieve information relating to any errors encountered during execution. If not provided, a default implementation of the errors class is used internally to provide error handling. Possible errors and warning messages that may be encountered are as follows.
      +
    • LA_ARRAY_SIZE_ERROR: Occurs if any of the input array sizes are incorrect.
    • +
    +
    +
    +
    +
    Syntax 2
    subroutine mtx_mult(logical trans, real(real64) alpha, real(real64) a(:,:), real(real64) b(:), real(real64) beta, real(real64) c(:))
    +
    subroutine mtx_mult(logical trans, complex(real64) alpha, complex(real64) a(:,:), complex(real64) b(:), complex(real64) beta, complex(real64) c(:))
    +
    +
    Parameters
    + + + + + + + + +
    [in]transSet to true if \( op(A) = A^T \); else, set to false for \( op(A) = A\). In the complex case set to LA_TRANSPOSE if \( op(A) = A^T \), set to LA_HERMITIAN_TRANSPOSE if \( op(A) = A^H \), otherwise set to LA_NO_OPERATION if \( op(A) = A \).
    [in]alphaA scalar multiplier.
    [in]aThe M-by-N matrix A.
    [in]bIf trans is set to true, an M-element array; else, if trans is set to false, an N-element array.
    [in]betaA scalar multiplier.
    [in,out]cOn input, if trans is set to true, an N-element array; else, if trans is set to false, an M-element array. On output, the results of the operation.
    [in,out]errAn optional errors-based object that if provided can be used to retrieve information relating to any errors encountered during execution. If not provided, a default implementation of the errors class is used internally to provide error handling. Possible errors and warning messages that may be encountered are as follows.
      +
    • LA_ARRAY_SIZE_ERROR: Occurs if any of the input array sizes are incorrect.
    • +
    +
    +
    +
    +
    Notes
    This routine utilizes the BLAS routines DGEMM, ZGEMM, DGEMV, or ZGEMV.
    + +

    Definition at line 159 of file linalg.f90.

    +

    The documentation for this interface was generated from the following file: +
    +
    + + + + diff --git a/doc/html/interfacelinalg_1_1mtx__pinverse-members.html b/doc/html/interfacelinalg_1_1mtx__pinverse-members.html new file mode 100644 index 00000000..f1cf4563 --- /dev/null +++ b/doc/html/interfacelinalg_1_1mtx__pinverse-members.html @@ -0,0 +1,114 @@ + + + + + + + +linalg: Member List + + + + + + + + + + + + + + + +
    +
    + + + + + + +
    +
    linalg 1.6.1 +
    +
    A linear algebra library that provides a user-friendly interface to several BLAS and LAPACK routines.
    +
    +
    + + + + + + + +
    +
    + +
    +
    +
    + +
    + +
    +
    + + +
    +
    +
    +
    +
    +
    Loading...
    +
    Searching...
    +
    No Matches
    +
    +
    +
    +
    + +
    +
    linalg::mtx_pinverse Member List
    +
    +
    + +

    This is the complete list of members for linalg::mtx_pinverse, including all inherited members.

    +
    +
    + + + + diff --git a/doc/html/interfacelinalg_1_1mtx__pinverse.html b/doc/html/interfacelinalg_1_1mtx__pinverse.html new file mode 100644 index 00000000..c984ec17 --- /dev/null +++ b/doc/html/interfacelinalg_1_1mtx__pinverse.html @@ -0,0 +1,196 @@ + + + + + + + +linalg: linalg::mtx_pinverse Interface Reference + + + + + + + + + + + + + + + +
    +
    + + + + + + +
    +
    linalg 1.6.1 +
    +
    A linear algebra library that provides a user-friendly interface to several BLAS and LAPACK routines.
    +
    +
    + + + + + + + +
    +
    + +
    +
    +
    + +
    + +
    +
    + + +
    +
    +
    +
    +
    +
    Loading...
    +
    Searching...
    +
    No Matches
    +
    +
    +
    +
    + +
    + +
    linalg::mtx_pinverse Interface Reference
    +
    +
    + +

    Computes the Moore-Penrose pseudo-inverse of a M-by-N matrix using the singular value decomposition of the matrix. + More...

    +

    Detailed Description

    +

    Computes the Moore-Penrose pseudo-inverse of a M-by-N matrix using the singular value decomposition of the matrix.

    +
    Syntax
    subroutine mtx_pinverse(real(real64) a(:,:), real(real64) ainv(:,:), optional real(real64) tol, optional real(real64) work(:), optional integer(int32) olwork, optional class(errors) err)
    +
    subroutine mtx_pinverse(complex(real64) a(:,:), complex(real64) ainv(:,:), optional real(real64) tol, optional complex(real64) work(:), optional integer(int32) olwork, optional real(real64) rwork(:), optional class(errors) err)
    +
    +
    Parameters
    + + + + + + + + +
    [in,out]aOn input, the M-by-N matrix to invert. The matrix is overwritten on output.
    [out]ainvThe N-by-M matrix where the pseudo-inverse of a will be written.
    [in]tolAn optional input, that if supplied, overrides the default tolerance on singular values such that singular values less than this tolerance are forced to have a reciprocal of zero, as opposed to 1/S(I). The default tolerance is: MAX(M, N) * EPS * MAX(S). If the supplied value is less than a value that causes an overflow, the tolerance reverts back to its default value, and the operation continues; however, a warning message is issued.
    [out]workAn optional input, that if provided, prevents any local memory allocation. If not provided, the memory required is allocated within. If provided, the length of the array must be at least olwork.
    [out]olworkAn optional output used to determine workspace size. If supplied, the routine determines the optimal size for work, and returns without performing any actual calculations.
    [out]rworkAn optional input, that if provided, prevents any local memory allocation for real-valued workspaces. If not provided, the memory required is allocated within. If provided, the length of the array must be at least 6 * MIN(M, N).
    [in,out]errAn optional errors-based object that if provided can be used to retrieve information relating to any errors encountered during execution. If not provided, a default implementation of the errors class is used internally to provide error handling. Possible errors and warning messages that may be encountered are as follows.
      +
    • LA_ARRAY_SIZE_ERROR: Occurs if any of the input arrays are not sized appropriately.
    • +
    • LA_OUT_OF_MEMORY_ERROR: Occurs if local memory must be allocated, and there is insufficient memory available.
    • +
    • LA_CONVERGENCE_ERROR: Occurs as a warning if the QR iteration process could not converge to a zero value.
    • +
    +
    +
    +
    +
    See Also
    +
    +
    Usage
    The following example illustrates how to compute the Moore-Penrose pseudo-inverse of a matrix.
    program example
    +
    use iso_fortran_env, only : int32, real64
    +
    use linalg_core
    +
    implicit none
    +
    +
    ! Variables
    +
    real(real64) :: a(3,2), ai(2,3), ao(3,2), c(2,2)
    +
    integer(int32) :: i
    +
    +
    ! Create the 3-by-2 matrix A
    +
    ! | 1 0 |
    +
    ! A = | 0 1 |
    +
    ! | 0 1 |
    +
    a = reshape([1.0d0, 0.0d0, 0.0d0, 0.0d0, 1.0d0, 1.0d0], [3, 2])
    +
    ao = a ! Just making a copy for later as mtx_pinverse will destroy the
    +
    ! contents of the original matrix
    +
    +
    ! The Moore-Penrose pseudo-inverse of this matrix is:
    +
    ! | 1 0 0 |
    +
    ! A**-1 = | |
    +
    ! | 0 1/2 1/2 |
    +
    call mtx_pinverse(a, ai)
    +
    +
    ! Notice, A**-1 * A is an identity matrix.
    +
    c = matmul(ai, ao)
    +
    +
    ! Display the inverse
    +
    print '(A)', "Inverse:"
    +
    do i = 1, size(ai, 1)
    +
    print *, ai(i,:)
    +
    end do
    +
    +
    ! Display the result of inv(A) * A
    +
    print '(A)', "A**-1 * A:"
    +
    do i = 1, size(c, 1)
    +
    print *, c(i,:)
    +
    end do
    +
    end program
    +
    The above program produces the following output.
    Inverse:
    +
    1.0000000000000000 0.0000000000000000 0.0000000000000000
    +
    0.0000000000000000 0.49999999999999978 0.49999999999999989
    +
    A**-1 * A:
    +
    1.0000000000000000 0.0000000000000000
    +
    0.0000000000000000 0.99999999999999967
    +
    + +

    Definition at line 2884 of file linalg.f90.

    +

    The documentation for this interface was generated from the following file: +
    +
    + + + + diff --git a/doc/html/interfacelinalg_1_1mtx__rank-members.html b/doc/html/interfacelinalg_1_1mtx__rank-members.html new file mode 100644 index 00000000..efb68bc3 --- /dev/null +++ b/doc/html/interfacelinalg_1_1mtx__rank-members.html @@ -0,0 +1,114 @@ + + + + + + + +linalg: Member List + + + + + + + + + + + + + + + +
    +
    + + + + + + +
    +
    linalg 1.6.1 +
    +
    A linear algebra library that provides a user-friendly interface to several BLAS and LAPACK routines.
    +
    +
    + + + + + + + +
    +
    + +
    +
    +
    + +
    + +
    +
    + + +
    +
    +
    +
    +
    +
    Loading...
    +
    Searching...
    +
    No Matches
    +
    +
    +
    +
    + +
    +
    linalg::mtx_rank Member List
    +
    +
    + +

    This is the complete list of members for linalg::mtx_rank, including all inherited members.

    +
    +
    + + + + diff --git a/doc/html/interfacelinalg_1_1mtx__rank.html b/doc/html/interfacelinalg_1_1mtx__rank.html new file mode 100644 index 00000000..4454d4b5 --- /dev/null +++ b/doc/html/interfacelinalg_1_1mtx__rank.html @@ -0,0 +1,148 @@ + + + + + + + +linalg: linalg::mtx_rank Interface Reference + + + + + + + + + + + + + + + +
    +
    + + + + + + +
    +
    linalg 1.6.1 +
    +
    A linear algebra library that provides a user-friendly interface to several BLAS and LAPACK routines.
    +
    +
    + + + + + + + +
    +
    + +
    +
    +
    + +
    + +
    +
    + + +
    +
    +
    +
    +
    +
    Loading...
    +
    Searching...
    +
    No Matches
    +
    +
    +
    +
    + +
    + +
    linalg::mtx_rank Interface Reference
    +
    +
    + +

    Computes the rank of a matrix. + More...

    +

    Detailed Description

    +

    Computes the rank of a matrix.

    +
    Syntax
    integer(int32) function mtx_rank(real(real64) a(:,:), optional real(real64) tol, optional real(real64) work(:), optional integer(int32) olwork, optional class(errors) err)
    +
    integer(int32) function mtx_rank(complex(real64) a(:,:), optional real(real64) tol, optional complex(real64) work(:), optional integer(int32) olwork, optional real(real64) rwork(:), optional class(errors) err)
    +
    +
    Parameters
    + + + + + + + +
    [in,out]aOn input, the M-by-N matrix of interest. On output, the contents of the matrix are overwritten.
    [in]tolAn optional input, that if supplied, overrides the default tolerance on singular values such that singular values less than this tolerance are treated as zero. The default tolerance is: MAX(M, N) * EPS * MAX(S). If the supplied value is less than the smallest value that causes an overflow if inverted, the tolerance reverts back to its default value, and the operation continues; however, a warning message is issued.
    [out]workAn optional input, that if provided, prevents any local memory allocation. If not provided, the memory required is allocated within. If provided, the length of the array must be at least olwork.
    [out]olworkAn optional output used to determine workspace size. If supplied, the routine determines the optimal size for work, and returns without performing any actual calculations.
    [out]rworkAn optional input, that if provided, prevents any local memory allocation for real-valued workspace arrays. If not provided, the memory required is allocated within. If provided, the length of the array must be at least 6 * MIN(M, N).
    [in,out]errAn optional errors-based object that if provided can be used to retrieve information relating to any errors encountered during execution. If not provided, a default implementation of the errors class is used internally to provide error handling. Possible errors and warning messages that may be encountered are as follows.
      +
    • LA_ARRAY_SIZE_ERROR: Occurs if any of the input arrays are not sized appropriately.
    • +
    • LA_OUT_OF_MEMORY_ERROR: Occurs if local memory must be allocated, and there is insufficient memory available.
    • +
    • LA_CONVERGENCE_ERROR: Occurs as a warning if the QR iteration process could not converge to a zero value.
    • +
    +
    +
    +
    +
    See Also
    +
    + +

    Definition at line 401 of file linalg.f90.

    +

    The documentation for this interface was generated from the following file: +
    +
    + + + + diff --git a/doc/html/interfacelinalg_1_1mult__qr-members.html b/doc/html/interfacelinalg_1_1mult__qr-members.html new file mode 100644 index 00000000..14110114 --- /dev/null +++ b/doc/html/interfacelinalg_1_1mult__qr-members.html @@ -0,0 +1,114 @@ + + + + + + + +linalg: Member List + + + + + + + + + + + + + + + +
    +
    + + + + + + +
    +
    linalg 1.6.1 +
    +
    A linear algebra library that provides a user-friendly interface to several BLAS and LAPACK routines.
    +
    +
    + + + + + + + +
    +
    + +
    +
    +
    + +
    + +
    +
    + + +
    +
    +
    +
    +
    +
    Loading...
    +
    Searching...
    +
    No Matches
    +
    +
    +
    +
    + +
    +
    linalg::mult_qr Member List
    +
    +
    + +

    This is the complete list of members for linalg::mult_qr, including all inherited members.

    +
    +
    + + + + diff --git a/doc/html/interfacelinalg_1_1mult__qr.html b/doc/html/interfacelinalg_1_1mult__qr.html new file mode 100644 index 00000000..fc7a037e --- /dev/null +++ b/doc/html/interfacelinalg_1_1mult__qr.html @@ -0,0 +1,224 @@ + + + + + + + +linalg: linalg::mult_qr Interface Reference + + + + + + + + + + + + + + + +
    +
    + + + + + + +
    +
    linalg 1.6.1 +
    +
    A linear algebra library that provides a user-friendly interface to several BLAS and LAPACK routines.
    +
    +
    + + + + + + + +
    +
    + +
    +
    +
    + +
    + +
    +
    + + +
    +
    +
    +
    +
    +
    Loading...
    +
    Searching...
    +
    No Matches
    +
    +
    +
    +
    + +
    + +
    linalg::mult_qr Interface Reference
    +
    +
    + +

    Multiplies a general matrix by the orthogonal matrix Q from a QR factorization. + More...

    +

    Detailed Description

    +

    Multiplies a general matrix by the orthogonal matrix Q from a QR factorization.

    +
    Syntax 1
    Multiplies a general matrix by the orthogonal matrix \( Q \) from a QR factorization such that: \( C = op(Q) C \), or \( C = C op(Q) \).
    subroutine mult_qr(logical lside, logical trans, real(real64) a(:,:), real(real64) tau(:), real(real64) c(:,:), optional real(real64) work(:), optional integer(int32) olwork, optional class(errors) err)
    +
    subroutine mult_qr(logical lside, logical trans, complex(real64) a(:,:), complex(real64) tau(:), complex(real64) c(:,:), optional complex(real64) work(:), optional integer(int32) olwork, optional class(errors) err)
    +
    +
    Parameters
    + + + + + + + + + +
    [in]lsideSet to true to apply \( Q \) or \( Q^T \) from the left; else, set to false to apply \( Q \) or \( Q^T \) from the right.
    [in]transSet to true to apply \( Q^T \); else, set to false.
    [in]aOn input, an LDA-by-K matrix containing the elementary reflectors output from the QR factorization. If lside is set to true, LDA = M, and M >= K >= 0; else, if lside is set to false, LDA = N, and N >= K >= 0. Notice, the contents of this matrix are restored on exit.
    [in]tauA K-element array containing the scalar factors of each elementary reflector defined in a.
    [in,out]cOn input, the M-by-N matrix C. On output, the product of the orthogonal matrix Q and the original matrix C.
    [out]workAn optional input, that if provided, prevents any local memory allocation. If not provided, the memory required is allocated within. If provided, the length of the array must be at least olwork.
    [in,out]olworkAn optional output used to determine workspace size. If supplied, the routine determines the optimal size for work, and returns without performing any actual calculations.
    [out]errAn optional errors-based object that if provided can be used to retrieve information relating to any errors encountered during execution. If not provided, a default implementation of the errors class is used internally to provide error handling. Possible errors and warning messages that may be encountered are as follows.
      +
    • LA_ARRAY_SIZE_ERROR: Occurs if any of the input arrays are not sized appropriately.
    • +
    • LA_OUT_OF_MEMORY_ERROR: Occurs if local memory must be allocated, and there is insufficient memory available.
    • +
    +
    +
    +
    +
    Notes
    This routine utilizes the LAPACK routine DORMQR (ZUNMQR in the complex case).
    +
    Syntax 2
    Multiplies a vector by the orthogonal matrix \( Q \) from a QR factorization such that: \( C = op(Q) C\).
    subroutine mult_qr(logical trans, real(real64) a(:,:), real(real64) tau(:), real(real64) c(:), optional real(real64) work(:), optional integer(int32) olwork, optional class(errors) err)
    +
    subroutine mult_qr(logical trans, complex(real64) a(:,:), complex(real64) tau(:), complex(real64) c(:), optional complex(real64) work(:), optional integer(int32) olwork, optional class(errors) err)
    +
    +
    Parameters
    + + + + + + + + +
    [in]transSet to true to apply \( Q^T \); else, set to false.
    [in]aOn input, an M-by-K matrix containing the elementary reflectors output from the QR factorization. Notice, the contents of this matrix are restored on exit.
    [in]tauA K-element array containing the scalar factors of each elementary reflector defined in a.
    [in,out]cOn input, the M-element vector C. On output, the product of the orthogonal matrix Q and the original vector C.
    [out]workAn optional input, that if provided, prevents any local memory allocation. If not provided, the memory required is allocated within. If provided, the length of the array must be at least olwork.
    [out]olworkAn optional output used to determine workspace size. If supplied, the routine determines the optimal size for work, and returns without performing any actual calculations.
    [in,out]errAn optional errors-based object that if provided can be used to retrieve information relating to any errors encountered during execution. If not provided, a default implementation of the errors class is used internally to provide error handling. Possible errors and warning messages that may be encountered are as follows.
      +
    • LA_ARRAY_SIZE_ERROR: Occurs if any of the input arrays are not sized appropriately.
    • +
    • LA_OUT_OF_MEMORY_ERROR: Occurs if local memory must be allocated, and there is insufficient memory available.
    • +
    +
    +
    +
    +
    Notes
    This routine utilizes the LAPACK routine DORMQR (ZUNMQR in the complex case).
    +
    Usage
    The following example illustrates how to perform the multiplication \( Q^T B \) when solving a system of QR factored equations without explicitly forming the matrix \( Q \).
    program example
    +
    use iso_fortran_env, only : real64, int32
    +
    use linalg_core
    +
    implicit none
    +
    +
    ! Variables
    +
    real(real64) :: a(3,3), b(3), tau(3)
    +
    integer(int32) :: i
    +
    +
    ! Build the 3-by-3 matrix A.
    +
    ! | 1 2 3 |
    +
    ! A = | 4 5 6 |
    +
    ! | 7 8 0 |
    +
    a = reshape( &
    +
    [1.0d0, 4.0d0, 7.0d0, 2.0d0, 5.0d0, 8.0d0, 3.0d0, 6.0d0, 0.0d0], &
    +
    [3, 3])
    +
    +
    ! Build the right-hand-side vector B.
    +
    ! | -1 |
    +
    ! b = | -2 |
    +
    ! | -3 |
    +
    b = [-1.0d0, -2.0d0, -3.0d0]
    +
    +
    ! The solution is:
    +
    ! | 1/3 |
    +
    ! x = | -2/3 |
    +
    ! | 0 |
    +
    +
    ! Compute the QR factorization without column pivoting
    +
    call qr_factor(a, tau)
    +
    +
    ! As this system is square, matrix R is upper triangular. Also, Q is
    +
    ! always orthogonal such that it's inverse and transpose are equal. As the
    +
    ! system is now factored, its form is: Q * R * X = B. Solving this system
    +
    ! is then as simple as solving the upper triangular system:
    +
    ! R * X = Q**T * B.
    +
    +
    ! Compute Q**T * B, and store the results in B. Notice, using mult_qr
    +
    ! avoids direct construction of the full Q and R matrices.
    +
    call mult_qr(.true., a, tau, b)
    +
    +
    ! Solve the upper triangular system R * X = Q**T * B for X
    +
    call solve_triangular_system(.true., .false., .true., a, b)
    +
    +
    ! Display the results
    +
    print '(A)', "QR Solution: X = "
    +
    print '(F8.4)', (b(i), i = 1, size(b))
    +
    +
    ! Notice, QR factorization with column pivoting could be accomplished via
    +
    ! a similar approach, but the column pivoting would need to be accounted
    +
    ! for by noting that Q * R = A * P, where P is an N-by-N matrix describing
    +
    ! the column pivoting operations.
    +
    end program
    +
    The above program produces the following output.
    QR Solution: X =
    +
    0.3333
    +
    -0.6667
    +
    0.0000
    +
    + +

    Definition at line 1185 of file linalg.f90.

    +

    The documentation for this interface was generated from the following file: +
    +
    + + + + diff --git a/doc/html/interfacelinalg_1_1mult__rz-members.html b/doc/html/interfacelinalg_1_1mult__rz-members.html new file mode 100644 index 00000000..fd5eab53 --- /dev/null +++ b/doc/html/interfacelinalg_1_1mult__rz-members.html @@ -0,0 +1,114 @@ + + + + + + + +linalg: Member List + + + + + + + + + + + + + + + +
    +
    + + + + + + +
    +
    linalg 1.6.1 +
    +
    A linear algebra library that provides a user-friendly interface to several BLAS and LAPACK routines.
    +
    +
    + + + + + + + +
    +
    + +
    +
    +
    + +
    + +
    +
    + + +
    +
    +
    +
    +
    +
    Loading...
    +
    Searching...
    +
    No Matches
    +
    +
    +
    +
    + +
    +
    linalg::mult_rz Member List
    +
    +
    + +

    This is the complete list of members for linalg::mult_rz, including all inherited members.

    +
    +
    + + + + diff --git a/doc/html/interfacelinalg_1_1mult__rz.html b/doc/html/interfacelinalg_1_1mult__rz.html new file mode 100644 index 00000000..9be04921 --- /dev/null +++ b/doc/html/interfacelinalg_1_1mult__rz.html @@ -0,0 +1,167 @@ + + + + + + + +linalg: linalg::mult_rz Interface Reference + + + + + + + + + + + + + + + +
    +
    + + + + + + +
    +
    linalg 1.6.1 +
    +
    A linear algebra library that provides a user-friendly interface to several BLAS and LAPACK routines.
    +
    +
    + + + + + + + +
    +
    + +
    +
    +
    + +
    + +
    +
    + + +
    +
    +
    +
    +
    +
    Loading...
    +
    Searching...
    +
    No Matches
    +
    +
    +
    +
    + +
    + +
    linalg::mult_rz Interface Reference
    +
    +
    + +

    Multiplies a general matrix by the orthogonal matrix Z from an RZ factorization. + More...

    +

    Detailed Description

    +

    Multiplies a general matrix by the orthogonal matrix Z from an RZ factorization.

    +
    Syntax 1
    Multiplies a general matrix by the orthogonal matrix Z from an RZ factorization such that: \( C = op(Z) C \) , or \( C = C op(Z) \).
    subroutine mult_rz(logical lside, logical trans, integer(int32) l, real(real64) a(:,:), real(real64) tau(:), real(real64) c(:,:), optional real(real64) work(:), optional integer(int32) olwork, optional class(errors) err)
    +
    subroutine mult_rz(logical lside, logical trans, integer(int32) l, complex(real64) a(:,:), complex(real64) tau(:), complex(real64) c(:,:), optional complex(real64) work(:), optional integer(int32) olwork, optional class(errors) err)
    +
    +
    Parameters
    + + + + + + + + + + +
    [in]lsideSet to true to apply \( Z \) or \( Z^T \) from the left; else, set to false to apply \( Z \) or \( Z^T \) from the right.
    [in]transSet to true to apply \( Z^T \) ( \( Z^H \) in the complex case); else, set to false.
    [in]lThe number of columns in matrix a containing the meaningful part of the Householder vectors. If lside is true, M >= L >= 0; else, if lside is false, N >= L >= 0.
    [in,out]aOn input the K-by-LTA matrix Z, where LTA = M if lside is true; else, LTA = N if lside is false. The I-th row must contain the Householder vector in the last k rows. Notice, the contents of this matrix are restored on exit.
    [in]tauA K-element array containing the scalar factors of the elementary reflectors, where M >= K >= 0 if lside is true; else, N >= K >= 0 if lside is false.
    [in,out]cOn input, the M-by-N matrix C. On output, the product of the orthogonal matrix Z and the original matrix C.
    [out]workAn optional input, that if provided, prevents any local memory allocation. If not provided, the memory required is allocated within. If provided, the length of the array must be at least olwork.
    [out]olworkAn optional output used to determine workspace size. If supplied, the routine determines the optimal size for work, and returns without performing any actual calculations.
    [in,out]errAn optional errors-based object that if provided can be used to retrieve information relating to any errors encountered during execution. If not provided, a default implementation of the errors class is used internally to provide error handling. Possible errors and warning messages that may be encountered are as follows.
      +
    • LA_ARRAY_SIZE_ERROR: Occurs if any of the input arrays are not sized appropriately.
    • +
    • LA_OUT_OF_MEMORY_ERROR: Occurs if local memory must be allocated, and there is insufficient memory available.
    • +
    +
    +
    +
    +
    Syntax 2
    Multiplies a general matrix by the orthogonal matrix Z from an RZ factorization such that: \( C = op(Z) C \), or \( C = C op(Z) \).
    subroutine mult_rz(logical trans, integer(int32) l, real(real64) a(:,:), real(real64) tau(:), real(real64) c(:), optional real(real64) work(:), optional integer(int32) olwork, optional class(errors) err)
    +
    subroutine mult_rz(logical trans, integer(int32) l, complex(real64) a(:,:), complex(real64) tau(:), complex(real64) c(:), optional complex(real64) work(:), optional integer(int32) olwork, optional class(errors) err)
    +
    +
    Parameters
    + + + + + + + + + +
    [in]transSet to true to apply \( Z^T \) ( \( Z^H \) in the complex case); else, set to false.
    [in]lThe number of columns in matrix a containing the meaningful part of the Householder vectors. If lside is true, M >= L >= 0; else, if lside is false, N >= L >= 0.
    [in,out]aOn input the K-by-LTA matrix Z, where LTA = M if lside is true; else, LTA = N if lside is false. The I-th row must contain the Householder vector in the last k rows. Notice, the contents of this matrix are restored on exit.
    [in]tauA K-element array containing the scalar factors of the elementary reflectors, where M >= K >= 0 if lside is true; else, N >= K >= 0 if lside is false.
    [in,out]cOn input, the M-element array C. On output, the product of the orthogonal matrix Z and the original array C.
    [out]workAn optional input, that if provided, prevents any local memory allocation. If not provided, the memory required is allocated within. If provided, the length of the array must be at least olwork.
    [out]olworkAn optional output used to determine workspace size. If supplied, the routine determines the optimal size for work, and returns without performing any actual calculations.
    [in,out]errAn optional errors-based object that if provided can be used to retrieve information relating to any errors encountered during execution. If not provided, a default implementation of the errors class is used internally to provide error handling. Possible errors and warning messages that may be encountered are as follows.
      +
    • LA_ARRAY_SIZE_ERROR: Occurs if any of the input arrays are not sized appropriately.
    • +
    • LA_OUT_OF_MEMORY_ERROR: Occurs if local memory must be allocated, and there is insufficient memory available.
    • +
    +
    +
    +
    +
    Notes
    This routine utilizes the LAPACK routine DORMRZ (ZUNMRZ in the complex case).
    + +

    Definition at line 1803 of file linalg.f90.

    +

    The documentation for this interface was generated from the following file: +
    +
    + + + + diff --git a/doc/html/interfacelinalg_1_1qr__factor-members.html b/doc/html/interfacelinalg_1_1qr__factor-members.html new file mode 100644 index 00000000..7e4c29ea --- /dev/null +++ b/doc/html/interfacelinalg_1_1qr__factor-members.html @@ -0,0 +1,114 @@ + + + + + + + +linalg: Member List + + + + + + + + + + + + + + + +
    +
    + + + + + + +
    +
    linalg 1.6.1 +
    +
    A linear algebra library that provides a user-friendly interface to several BLAS and LAPACK routines.
    +
    +
    + + + + + + + +
    +
    + +
    +
    +
    + +
    + +
    +
    + + +
    +
    +
    +
    +
    +
    Loading...
    +
    Searching...
    +
    No Matches
    +
    +
    +
    +
    + +
    +
    linalg::qr_factor Member List
    +
    +
    + +

    This is the complete list of members for linalg::qr_factor, including all inherited members.

    +
    +
    + + + + diff --git a/doc/html/interfacelinalg_1_1qr__factor.html b/doc/html/interfacelinalg_1_1qr__factor.html new file mode 100644 index 00000000..62b455ab --- /dev/null +++ b/doc/html/interfacelinalg_1_1qr__factor.html @@ -0,0 +1,218 @@ + + + + + + + +linalg: linalg::qr_factor Interface Reference + + + + + + + + + + + + + + + +
    +
    + + + + + + +
    +
    linalg 1.6.1 +
    +
    A linear algebra library that provides a user-friendly interface to several BLAS and LAPACK routines.
    +
    +
    + + + + + + + +
    +
    + +
    +
    +
    + +
    + +
    +
    + + +
    +
    +
    +
    +
    +
    Loading...
    +
    Searching...
    +
    No Matches
    +
    +
    +
    +
    + +
    + +
    linalg::qr_factor Interface Reference
    +
    +
    + +

    Computes the QR factorization of an M-by-N matrix. + More...

    +

    Detailed Description

    +

    Computes the QR factorization of an M-by-N matrix.

    +
    Syntax 1
    subroutine qr_factor(real(real64) a(:,:), real(real64) tau(:), optional real(real64) work(:), optional integer(int32) olwork, optional class(errors) err)
    +
    subroutine qr_factor(complex(real64) a(:,:), complex(real64) tau(:), optional complex(real64) work(:), optional integer(int32) olwork, optional class(errors) err)
    +
    +
    Parameters
    + + + + + + +
    [in,out]aOn input, the M-by-N matrix to factor. On output, the elements on and above the diagonal contain the MIN(M, N)-by-N upper trapezoidal matrix R (R is upper triangular if M >= N). The elements below the diagonal, along with the array tau, represent the orthogonal matrix Q as a product of elementary reflectors.
    [out]tauA MIN(M, N)-element array used to store the scalar factors of the elementary reflectors.
    [out]workAn optional input, that if provided, prevents any local memory allocation. If not provided, the memory required is allocated within. If provided, the length of the array must be at least olwork.
    [out]olworkAn optional output used to determine workspace size. If supplied, the routine determines the optimal size for work, and returns without performing any actual calculations.
    [in,out]errAn optional errors-based object that if provided can be used to retrieve information relating to any errors encountered during execution. If not provided, a default implementation of the errors class is used internally to provide error handling. Possible errors and warning messages that may be encountered are as follows.
      +
    • LA_ARRAY_SIZE_ERROR: Occurs if tau or work are not sized appropriately.
    • +
    • LA_OUT_OF_MEMORY_ERROR: Occurs if local memory must be allocated, and there is insufficient memory available.
    • +
    +
    +
    +
    +
    Remarks
    QR factorization without pivoting is best suited to solving an overdetermined system in least-squares terms, or to solve a normally defined system. To solve an underdetermined system, it is recommended to use either LQ factorization, or a column-pivoting based QR factorization.
    +
    Notes
    This routine utilizes the LAPACK routine DGEQRF (ZGEQRF for the complex case).
    +
    Syntax 2
    Computes the QR factorization of an M-by-N matrix with column pivoting such that \( A P = Q R \).
    subroutine qr_factor(real(real64) a(:,:), real(real64) tau(:), integer(int32) jpvt(:), optional real(real64) work(:), optional integer(int32) olwork, optional class(errors) err)
    +
    subroutine qr_factor(complex(real64) a(:,:), complex(real64) tau(:), integer(int32) jpvt(:), optional complex(real64) work(:), optional integer(int32) olwork, optional real(real64) rwork(:), optional class(errors) err)
    +
    +
    Parameters
    + + + + + + + + +
    [in,out]aOn input, the M-by-N matrix to factor. On output, the elements on and above the diagonal contain the MIN(M, N)-by-N upper trapezoidal matrix R (R is upper triangular if M >= N). The elements below the diagonal, along with the array tau, represent the orthogonal matrix Q as a product of elementary reflectors.
    [out]tauA MIN(M, N)-element array used to store the scalar factors of the elementary reflectors.
    [in,out]jpvtOn input, an N-element array that if JPVT(I) .ne. 0, the I-th column of A is permuted to the front of A * P; if JPVT(I) = 0, the I-th column of A is a free column. On output, if JPVT(I) = K, then the I-th column of A * P was the K-th column of A.
    [out]workAn optional input, that if provided, prevents any local memory allocation. If not provided, the memory required is allocated within. If provided, the length of the array must be at least olwork.
    [out]olworkAn optional output used to determine workspace size. If supplied, the routine determines the optimal size for work, and returns without performing any actual calculations.
    [out]rworkAn optional input, that if provided, prevents any local allocate of real-valued memory. If not provided, the memory required is allocated within. If provided, the length of the array must be at least 2*N.
    [in,out]errAn optional errors-based object that if provided can be used to retrieve information relating to any errors encountered during execution. If not provided, a default implementation of the errors class is used internally to provide error handling. Possible errors and warning messages that may be encountered are as follows.
      +
    • LA_ARRAY_SIZE_ERROR: Occurs if any of the input arrays are not sized appropriately.
    • +
    • LA_OUT_OF_MEMORY_ERROR: Occurs if local memory must be allocated, and there is insufficient memory available.
    • +
    +
    +
    +
    +
    Notes
    This routine utilizes the LAPACK routine DGEQP3 (ZGEQP3 for the complex case).
    +
    Usage
    The following example illustrates the solution of a system of equations using QR factorization.
    program example
    +
    use iso_fortran_env, only : real64, int32
    +
    use linalg_core
    +
    implicit none
    +
    +
    ! Local Variables
    +
    real(real64) :: a(3,3), tau(3), b(3)
    +
    integer(int32) :: i, pvt(3)
    +
    +
    ! Build the 3-by-3 matrix A.
    +
    ! | 1 2 3 |
    +
    ! A = | 4 5 6 |
    +
    ! | 7 8 0 |
    +
    a = reshape( &
    +
    [1.0d0, 4.0d0, 7.0d0, 2.0d0, 5.0d0, 8.0d0, 3.0d0, 6.0d0, 0.0d0], &
    +
    [3, 3])
    +
    +
    ! Build the right-hand-side vector B.
    +
    ! | -1 |
    +
    ! b = | -2 |
    +
    ! | -3 |
    +
    b = [-1.0d0, -2.0d0, -3.0d0]
    +
    +
    ! The solution is:
    +
    ! | 1/3 |
    +
    ! x = | -2/3 |
    +
    ! | 0 |
    +
    +
    ! Compute the QR factorization, using pivoting
    +
    pvt = 0 ! Zero every entry in order not to lock any column in place
    +
    call qr_factor(a, tau, pvt)
    +
    +
    ! Compute the solution. The results overwrite b.
    +
    call solve_qr(a, tau, pvt, b)
    +
    +
    ! Display the results.
    +
    print '(A)', "QR Solution: X = "
    +
    print '(F8.4)', (b(i), i = 1, size(b))
    +
    +
    ! Notice, QR factorization without pivoting could be accomplished in the
    +
    ! same manner. The only difference is to omit the PVT array (column pivot
    +
    ! tracking array).
    +
    end program
    +
    The above program produces the following output.
    QR Solution: X =
    +
    0.3333
    +
    -0.6667
    +
    0.0000
    +
    +
    See Also
    +
    + +

    Definition at line 871 of file linalg.f90.

    +

    The documentation for this interface was generated from the following file: +
    +
    + + + + diff --git a/doc/html/interfacelinalg_1_1qr__rank1__update-members.html b/doc/html/interfacelinalg_1_1qr__rank1__update-members.html new file mode 100644 index 00000000..8a79e9e0 --- /dev/null +++ b/doc/html/interfacelinalg_1_1qr__rank1__update-members.html @@ -0,0 +1,114 @@ + + + + + + + +linalg: Member List + + + + + + + + + + + + + + + +
    +
    + + + + + + +
    +
    linalg 1.6.1 +
    +
    A linear algebra library that provides a user-friendly interface to several BLAS and LAPACK routines.
    +
    +
    + + + + + + + +
    +
    + +
    +
    +
    + +
    + +
    +
    + + +
    +
    +
    +
    +
    +
    Loading...
    +
    Searching...
    +
    No Matches
    +
    +
    +
    +
    + +
    +
    linalg::qr_rank1_update Member List
    +
    +
    + +

    This is the complete list of members for linalg::qr_rank1_update, including all inherited members.

    +
    +
    + + + + diff --git a/doc/html/interfacelinalg_1_1qr__rank1__update.html b/doc/html/interfacelinalg_1_1qr__rank1__update.html new file mode 100644 index 00000000..df972f9c --- /dev/null +++ b/doc/html/interfacelinalg_1_1qr__rank1__update.html @@ -0,0 +1,231 @@ + + + + + + + +linalg: linalg::qr_rank1_update Interface Reference + + + + + + + + + + + + + + + +
    +
    + + + + + + +
    +
    linalg 1.6.1 +
    +
    A linear algebra library that provides a user-friendly interface to several BLAS and LAPACK routines.
    +
    +
    + + + + + + + +
    +
    + +
    +
    +
    + +
    + +
    +
    + + +
    +
    +
    +
    +
    +
    Loading...
    +
    Searching...
    +
    No Matches
    +
    +
    +
    +
    + +
    + +
    linalg::qr_rank1_update Interface Reference
    +
    +
    + +

    Computes the rank 1 update to an M-by-N QR factored matrix A (M >= N) where \( A = Q R \), and \( A1 = A + U V^T \) such that \( A1 = Q1 R1 \). + More...

    +

    Detailed Description

    +

    Computes the rank 1 update to an M-by-N QR factored matrix A (M >= N) where \( A = Q R \), and \( A1 = A + U V^T \) such that \( A1 = Q1 R1 \).

    +
    Syntax
    subroutine qr_rank1_update(real(real64) q(:,:), real(real64) r(:,:), real(real64) u(:), real(real64) v(:), optional real(real64) work(:), optional class(errors) err)
    +
    subroutine qr_rank1_update(complex(real64) q(:,:), complex(real64) r(:,:), complex(real64) u(:), complex(real64) v(:), optional complex(real64) work(:), optional real(real64) rwork(:), optional class(errors) err)
    +
    +
    Parameters
    + + + + + + + + +
    [in,out]qOn input, the original M-by-K orthogonal matrix Q. On output, the updated matrix Q1.
    [in,out]rOn input, the M-by-N matrix R. On output, the updated matrix R1.
    [in,out]uOn input, the M-element U update vector. On output, the original content of the array is overwritten.
    [in,out]vOn input, the N-element V update vector. On output, the original content of the array is overwritten.
    [out]workAn optional argument that if supplied prevents local memory allocation. If provided, the array must have at least K elements.
    [out]rworkAn optional argument that if supplied prevents local memory allocation. If provided, the array must have at least K elements.
    [in,out]errAn optional errors-based object that if provided can be used to retrieve information relating to any errors encountered during execution. If not provided, a default implementation of the errors class is used internally to provide error handling. Possible errors and warning messages that may be encountered are as follows.
      +
    • LA_ARRAY_SIZE_ERROR: Occurs if any of the input arrays are not sized appropriately.
    • +
    • LA_OUT_OF_MEMORY_ERROR: Occurs if local memory must be allocated, and there is insufficient memory available.
    • +
    +
    +
    +
    +
    Remarks
    Notice, K must either be equal to M, or equal to N. In the event that K = N, only the submatrix Qa is updated. This is appropriate as the QR factorization for an overdetermined system can be written as follows:
      A = Q * R = [Qa, Qb] * [Ra]
    +                         [0 ]
    Note: Ra is upper triangular of dimension N-by-N.
    +
    Notes
    This routine utilizes the QRUPDATE routine ZQR1UP.
    +
    See Also
    Source
    +
    Usage
    The following example illustrates a rank 1 update to a QR factored system. The results are compared to updating the original matrix, and then performing the factorization.
    program example
    +
    use iso_fortran_env
    +
    use linalg_core
    +
    implicit none
    +
    +
    ! Variables
    +
    real(real64) :: a(3,3), u(3), v(3), r(3,3), tau(3), q(3,3), qu(3,3)
    +
    integer(int32) :: i
    +
    +
    ! Build the 3-by-3 matrix A.
    +
    ! | 1 2 3 |
    +
    ! A = | 4 5 6 |
    +
    ! | 7 8 0 |
    +
    a = reshape( &
    +
    [1.0d0, 4.0d0, 7.0d0, 2.0d0, 5.0d0, 8.0d0, 3.0d0, 6.0d0, 0.0d0], &
    +
    [3, 3])
    +
    +
    ! Build the update vectors
    +
    ! | 1/2 | | 1 |
    +
    ! u = | 3/2 |, v = | 5 |
    +
    ! | 3 | | 2 |
    +
    u = [0.5d0, 1.5d0, 3.0d0]
    +
    v = [1.0d0, 5.0d0, 2.0d0]
    +
    +
    ! Compute the QR factorization of the original matrix
    +
    r = a ! Making a copy as the matrix will be overwritten by qr_factor
    +
    call qr_factor(r, tau)
    +
    +
    ! Form Q & R
    +
    call form_qr(r, tau, q)
    +
    +
    ! Compute the rank 1 update to the original matrix such that:
    +
    ! A = A + u * v**T
    +
    call rank1_update(1.0d0, u, v, a)
    +
    +
    ! Compute the rank 1 update to the factorization. Notice, the contents
    +
    ! of U & V are destroyed as part of this process.
    +
    call qr_rank1_update(q, r, u, v)
    +
    +
    ! As comparison, compute the QR factorization of the rank 1 updated matrix
    +
    call qr_factor(a, tau)
    +
    call form_qr(a, tau, qu)
    +
    +
    ! Display the matrices
    +
    print '(A)', "Updating the Factored Form:"
    +
    print '(A)', "Q = "
    +
    do i = 1, size(q, 1)
    +
    print *, q(i,:)
    +
    end do
    +
    print '(A)', "R = "
    +
    do i = 1, size(r, 1)
    +
    print *, r(i,:)
    +
    end do
    +
    +
    print '(A)', "Updating A Directly:"
    +
    print '(A)', "Q = "
    +
    do i = 1, size(qu, 1)
    +
    print *, qu(i,:)
    +
    end do
    +
    print '(A)', "R = "
    +
    do i = 1, size(a, 1)
    +
    print *, a(i,:)
    +
    end do
    +
    end program
    +
    The above program produces the following output.
    Updating the Factored Form:
    +
    Q =
    +
    -0.13031167282892092 0.98380249683206911 -0.12309149097933236
    +
    -0.47780946703937632 -0.17109608640557677 -0.86164043685532932
    +
    -0.86874448552613881 -5.3467527001743037E-002 0.49236596391733078
    +
    R =
    +
    -11.510864433221338 -26.540144032823541 -10.033998807826904
    +
    0.0000000000000000 1.0586570346345126 2.0745400476676279
    +
    0.0000000000000000 0.0000000000000000 -5.2929341121113067
    +
    Updating A Directly:
    +
    Q =
    +
    -0.13031167282892087 0.98380249683206955 -0.12309149097933178
    +
    -0.47780946703937643 -0.17109608640557616 -0.86164043685532943
    +
    -0.86874448552613903 -5.3467527001742954E-002 0.49236596391733084
    +
    R =
    +
    -11.510864433221336 -26.540144032823545 -10.033998807826906
    +
    0.0000000000000000 1.0586570346345205 2.0745400476676350
    +
    0.0000000000000000 0.0000000000000000 -5.2929341121113058
    +
    + +

    Definition at line 1334 of file linalg.f90.

    +

    The documentation for this interface was generated from the following file: +
    +
    + + + + diff --git a/doc/html/interfacelinalg_1_1rank1__update-members.html b/doc/html/interfacelinalg_1_1rank1__update-members.html new file mode 100644 index 00000000..89892878 --- /dev/null +++ b/doc/html/interfacelinalg_1_1rank1__update-members.html @@ -0,0 +1,114 @@ + + + + + + + +linalg: Member List + + + + + + + + + + + + + + + +
    +
    + + + + + + +
    +
    linalg 1.6.1 +
    +
    A linear algebra library that provides a user-friendly interface to several BLAS and LAPACK routines.
    +
    +
    + + + + + + + +
    +
    + +
    +
    +
    + +
    + +
    +
    + + +
    +
    +
    +
    +
    +
    Loading...
    +
    Searching...
    +
    No Matches
    +
    +
    +
    +
    + +
    +
    linalg::rank1_update Member List
    +
    +
    + +

    This is the complete list of members for linalg::rank1_update, including all inherited members.

    +
    +
    + + + + diff --git a/doc/html/interfacelinalg_1_1rank1__update.html b/doc/html/interfacelinalg_1_1rank1__update.html new file mode 100644 index 00000000..549919ef --- /dev/null +++ b/doc/html/interfacelinalg_1_1rank1__update.html @@ -0,0 +1,142 @@ + + + + + + + +linalg: linalg::rank1_update Interface Reference + + + + + + + + + + + + + + + +
    +
    + + + + + + +
    +
    linalg 1.6.1 +
    +
    A linear algebra library that provides a user-friendly interface to several BLAS and LAPACK routines.
    +
    +
    + + + + + + + +
    +
    + +
    +
    +
    + +
    + +
    +
    + + +
    +
    +
    +
    +
    +
    Loading...
    +
    Searching...
    +
    No Matches
    +
    +
    +
    +
    + +
    + +
    linalg::rank1_update Interface Reference
    +
    +
    + +

    Performs the rank-1 update to matrix A such that: \( A = \alpha X Y^T + A \), where \( A \) is an M-by-N matrix, \( \alpha \)is a scalar, \( X \) is an M-element array, and \( Y \) is an N-element array. In the event that \( Y \) is complex, \( Y^H \) is used instead of \( Y^T \). + More...

    +

    Detailed Description

    +

    Performs the rank-1 update to matrix A such that: \( A = \alpha X Y^T + A \), where \( A \) is an M-by-N matrix, \( \alpha \)is a scalar, \( X \) is an M-element array, and \( Y \) is an N-element array. In the event that \( Y \) is complex, \( Y^H \) is used instead of \( Y^T \).

    +
    Syntax
    subroutine rank1_update(real(real64) alpha, real(real64) x(:), real(real64) y(:), real(real64) a(:,:), class(errors) err)
    +
    subroutine rank1_update(complex(real64) alpha, complex(real64) x(:), complex(real64) y(:), complex(real64) a(:,:), class(errors) err)
    +
    +
    Parameters
    + + + + + + +
    [in]alphaThe scalar multiplier.
    [in]xAn M-element array.
    [in]yAn N-element array.
    [in,out]aOn input, the M-by-N matrix to update. On output, the updated M-by-N matrix.
    [in,out]errAn optional errors-based object that if provided can be used to retrieve information relating to any errors encountered during execution. If not provided, a default implementation of the errors class is used internally to provide error handling. Possible errors and warning messages that may be encountered are as follows.
      +
    • LA_ARRAY_SIZE_ERROR: Occurs if the size of a does not match with x and y.
    • +
    +
    +
    +
    +
    Notes
    This routine is based upon the BLAS routine DGER or ZGER.
    + +

    Definition at line 194 of file linalg.f90.

    +

    The documentation for this interface was generated from the following file: +
    +
    + + + + diff --git a/doc/html/interfacelinalg_1_1recip__mult__array-members.html b/doc/html/interfacelinalg_1_1recip__mult__array-members.html new file mode 100644 index 00000000..87396e08 --- /dev/null +++ b/doc/html/interfacelinalg_1_1recip__mult__array-members.html @@ -0,0 +1,114 @@ + + + + + + + +linalg: Member List + + + + + + + + + + + + + + + +
    +
    + + + + + + +
    +
    linalg 1.6.1 +
    +
    A linear algebra library that provides a user-friendly interface to several BLAS and LAPACK routines.
    +
    +
    + + + + + + + +
    +
    + +
    +
    +
    + +
    + +
    +
    + + +
    +
    +
    +
    +
    +
    Loading...
    +
    Searching...
    +
    No Matches
    +
    +
    +
    +
    + +
    +
    linalg::recip_mult_array Member List
    +
    +
    + +

    This is the complete list of members for linalg::recip_mult_array, including all inherited members.

    +
    +
    + + + + diff --git a/doc/html/interfacelinalg_1_1recip__mult__array.html b/doc/html/interfacelinalg_1_1recip__mult__array.html new file mode 100644 index 00000000..6d553588 --- /dev/null +++ b/doc/html/interfacelinalg_1_1recip__mult__array.html @@ -0,0 +1,135 @@ + + + + + + + +linalg: linalg::recip_mult_array Interface Reference + + + + + + + + + + + + + + + +
    +
    + + + + + + +
    +
    linalg 1.6.1 +
    +
    A linear algebra library that provides a user-friendly interface to several BLAS and LAPACK routines.
    +
    +
    + + + + + + + +
    +
    + +
    +
    +
    + +
    + +
    +
    + + +
    +
    +
    +
    +
    +
    Loading...
    +
    Searching...
    +
    No Matches
    +
    +
    +
    +
    + +
    + +
    linalg::recip_mult_array Interface Reference
    +
    +
    + +

    Multiplies a vector by the reciprocal of a real scalar. + More...

    +

    Detailed Description

    +

    Multiplies a vector by the reciprocal of a real scalar.

    +
    Syntax
    subroutine recip_mult_array(real(real64) a, real(real64) x(:))
    +
    +
    Parameters
    + + + +
    [in]aThe scalar which is used to divide each component of X. The value must be >= 0, or the subroutine will divide by zero.
    [in,out]xThe vector.
    +
    +
    +
    Notes
    This routine is based upon the LAPACK routine DRSCL.
    + +

    Definition at line 475 of file linalg.f90.

    +

    The documentation for this interface was generated from the following file: +
    +
    + + + + diff --git a/doc/html/interfacelinalg_1_1rz__factor-members.html b/doc/html/interfacelinalg_1_1rz__factor-members.html new file mode 100644 index 00000000..20837f53 --- /dev/null +++ b/doc/html/interfacelinalg_1_1rz__factor-members.html @@ -0,0 +1,114 @@ + + + + + + + +linalg: Member List + + + + + + + + + + + + + + + +
    +
    + + + + + + +
    +
    linalg 1.6.1 +
    +
    A linear algebra library that provides a user-friendly interface to several BLAS and LAPACK routines.
    +
    +
    + + + + + + + +
    +
    + +
    +
    +
    + +
    + +
    +
    + + +
    +
    +
    +
    +
    +
    Loading...
    +
    Searching...
    +
    No Matches
    +
    +
    +
    +
    + +
    +
    linalg::rz_factor Member List
    +
    +
    + +

    This is the complete list of members for linalg::rz_factor, including all inherited members.

    +
    +
    + + + + diff --git a/doc/html/interfacelinalg_1_1rz__factor.html b/doc/html/interfacelinalg_1_1rz__factor.html new file mode 100644 index 00000000..ca79b4a2 --- /dev/null +++ b/doc/html/interfacelinalg_1_1rz__factor.html @@ -0,0 +1,152 @@ + + + + + + + +linalg: linalg::rz_factor Interface Reference + + + + + + + + + + + + + + + +
    +
    + + + + + + +
    +
    linalg 1.6.1 +
    +
    A linear algebra library that provides a user-friendly interface to several BLAS and LAPACK routines.
    +
    +
    + + + + + + + +
    +
    + +
    +
    +
    + +
    + +
    +
    + + +
    +
    +
    +
    +
    +
    Loading...
    +
    Searching...
    +
    No Matches
    +
    +
    +
    +
    + +
    + +
    linalg::rz_factor Interface Reference
    +
    +
    + +

    Factors an upper trapezoidal matrix by means of orthogonal transformations such that \( A = R Z = (R 0) Z \). Z is an orthogonal matrix of dimension N-by-N, and R is an M-by-M upper triangular matrix. + More...

    +

    Detailed Description

    +

    Factors an upper trapezoidal matrix by means of orthogonal transformations such that \( A = R Z = (R 0) Z \). Z is an orthogonal matrix of dimension N-by-N, and R is an M-by-M upper triangular matrix.

    +
    Syntax
    subroutine rz_factor(real(real64) a(:,:), real(real64) tau(:), optional real(real64) work(:), optional integer(int32) olwork, optional class(errors) err)
    +
    subroutine rz_factor(complex(real64) a(:,:), complex(real64) tau(:), optional complex(real64) work(:), optional integer(int32) olwork, optional class(errors) err)
    +
    +
    Parameters
    + + + + + + +
    [in,out]aOn input, the M-by-N upper trapezoidal matrix to factor. On output, the leading M-by-M upper triangular part of the matrix contains the upper triangular matrix R, and elements N-L+1 to N of the first M rows of A, with the array tau, represent the orthogonal matrix Z as a product of M elementary reflectors.
    [out]tauAn M-element array used to store the scalar factors of the elementary reflectors.
    [out]workAn optional input, that if provided, prevents any local memory allocation. If not provided, the memory required is allocated within. If provided, the length of the array must be at least olwork.
    [out]olworkAn optional output used to determine workspace size. If supplied, the routine determines the optimal size for work, and returns without performing any actual calculations.
    [in,out]errAn optional errors-based object that if provided can be used to retrieve information relating to any errors encountered during execution. If not provided, a default implementation of the errors class is used internally to provide error handling. Possible errors and warning messages that may be encountered are as follows.
      +
    • LA_ARRAY_SIZE_ERROR: Occurs if any of the input arrays are not sized appropriately.
    • +
    • LA_OUT_OF_MEMORY_ERROR: Occurs if local memory must be allocated, and there is insufficient memory available.
    • +
    +
    +
    +
    +
    Further Details
    The factorization is obtained by Householder's method. The kth transformation matrix, Z( k ), which is used to introduce zeros into the ( m - k + 1 )th row of A, is given in the form
         Z( k ) = ( I     0   ),
    +              ( 0  T( k ) )
    where
         T( k ) = I - tau*u( k )*u( k )**T,   u( k ) = (   1    ),
    +                                                   (   0    )
    +                                                   ( z( k ) )
    tau is a scalar and z( k ) is an l element vector. tau and z( k ) are chosen to annihilate the elements of the kth row of A2.
    +

    The scalar tau is returned in the kth element of TAU and the vector u( k ) in the kth row of A2, such that the elements of z( k ) are in a( k, l + 1 ), ..., a( k, n ). The elements of R are returned in the upper triangular part of A1.

    +

    Z is given by

         Z =  Z( 1 ) * Z( 2 ) * ... * Z( m ).
    Notes
    This routine is based upon the LAPACK routine DTZRZF.
    +
    See Also
    +
    + +

    Definition at line 1712 of file linalg.f90.

    +

    The documentation for this interface was generated from the following file: +
    +
    + + + + diff --git a/doc/html/interfacelinalg_1_1solve__cholesky-members.html b/doc/html/interfacelinalg_1_1solve__cholesky-members.html new file mode 100644 index 00000000..5148566c --- /dev/null +++ b/doc/html/interfacelinalg_1_1solve__cholesky-members.html @@ -0,0 +1,114 @@ + + + + + + + +linalg: Member List + + + + + + + + + + + + + + + +
    +
    + + + + + + +
    +
    linalg 1.6.1 +
    +
    A linear algebra library that provides a user-friendly interface to several BLAS and LAPACK routines.
    +
    +
    + + + + + + + +
    +
    + +
    +
    +
    + +
    + +
    +
    + + +
    +
    +
    +
    +
    +
    Loading...
    +
    Searching...
    +
    No Matches
    +
    +
    +
    +
    + +
    +
    linalg::solve_cholesky Member List
    +
    +
    + +

    This is the complete list of members for linalg::solve_cholesky, including all inherited members.

    +
    +
    + + + + diff --git a/doc/html/interfacelinalg_1_1solve__cholesky.html b/doc/html/interfacelinalg_1_1solve__cholesky.html new file mode 100644 index 00000000..dab536e0 --- /dev/null +++ b/doc/html/interfacelinalg_1_1solve__cholesky.html @@ -0,0 +1,202 @@ + + + + + + + +linalg: linalg::solve_cholesky Interface Reference + + + + + + + + + + + + + + + +
    +
    + + + + + + +
    +
    linalg 1.6.1 +
    +
    A linear algebra library that provides a user-friendly interface to several BLAS and LAPACK routines.
    +
    +
    + + + + + + + +
    +
    + +
    +
    +
    + +
    + +
    +
    + + +
    +
    +
    +
    +
    +
    Loading...
    +
    Searching...
    +
    No Matches
    +
    +
    +
    +
    + +
    + +
    linalg::solve_cholesky Interface Reference
    +
    +
    + +

    Solves a system of Cholesky factored equations. + More...

    +

    Detailed Description

    +

    Solves a system of Cholesky factored equations.

    +
    Syntax
    subroutine solve_cholesky(logical upper, real(real64) a(:,:), real(real64) b(:,:), optional class(errors) err)
    +
    subroutine solve_cholesky(logical upper, complex(real64) a(:,:), complex(real64) b(:,:), optional class(errors) err)
    +
    subroutine solve_cholesky(logical upper, real(real64) a(:,:), real(real64) b(:), optional class(errors) err)
    +
    subroutine solve_cholesky(logical upper, complex(real64) a(:,:), complex(real64) b(:), optional class(errors) err)
    +
    +
    Parameters
    + + + + + +
    [in]upperSet to true if the original matrix \( A \) was factored such that \( A = U^T U \); else, set to false if the factorization of \( A \) was \( A = L L^T \).
    [in]aThe N-by-N Cholesky factored matrix as returned by cholesky_factor.
    [in,out]bOn input, the N-by-NRHS right-hand-side matrix B. On output, the solution matrix X.
    [in,out]errAn optional errors-based object that if provided can be used to retrieve information relating to any errors encountered during execution. If not provided, a default implementation of the errors class is used internally to provide error handling. Possible errors and warning messages that may be encountered are as follows.
      +
    • LA_ARRAY_SIZE_ERROR: Occurs if any of the input array sizes are incorrect.
    • +
    +
    +
    +
    +
    Notes
    This routine utilizes the LAPACK routine DPOTRS (ZPOTRS in the complex case).
    +
    Usage
    The following example illustrates the solution of a positive-definite system of equations via Cholesky factorization.
    program example
    +
    use iso_fortran_env, only : real64, int32
    +
    use linalg_core
    +
    implicit none
    +
    +
    ! Variables
    +
    real(real64) :: a(3, 3), b(3), bu(3)
    +
    integer(int32) :: i
    +
    +
    ! Build the 3-by-3 positive-definite matrix A.
    +
    ! | 4 12 -16 |
    +
    ! A = | 12 37 -43 |
    +
    ! |-16 -43 98 |
    +
    a = reshape([4.0d0, 12.0d0, -16.0d0, 12.0d0, 37.0d0, -43.0d0, -16.0d0, &
    +
    -43.0d0, 98.0d0], [3, 3])
    +
    +
    ! Build the 3-element array B
    +
    ! | 5 |
    +
    ! b = | 1 |
    +
    ! | 3 |
    +
    b = [5.0d0, 1.0d0, 3.0d0]
    +
    +
    ! Make a copy of B for later use - not necessary, but just for example to
    +
    ! illustrate the long or manual method of solving a Cholesky factored system
    +
    bu = b
    +
    +
    ! Compute the Cholesky factorization of A considering only the upper
    +
    ! triangular portion of A (the default configuration).
    +
    call cholesky_factor(a)
    +
    +
    ! Compute the solution
    +
    call solve_cholesky(.true., a, b)
    +
    +
    ! Display the results
    +
    print '(A)', "Cholesky Solution: X = "
    +
    print '(F8.4)', (b(i), i = 1, size(b))
    +
    +
    ! The solution could also be computed manually noting the Cholesky
    +
    ! factorization causes A = U**T * U. Then U**T * U * X = B.
    +
    +
    ! Step 1 would then be to solve the problem U**T * Y = B, for Y.
    +
    call solve_triangular_system(.true., .true., .true., a, bu)
    +
    +
    ! Now, solve the problem U * X = Y, for X
    +
    call solve_triangular_system(.true., .false., .true., a, bu)
    +
    +
    ! Display the results
    +
    print '(A)', "Cholesky Solution (Manual Approach): X = "
    +
    print '(F8.4)', (bu(i), i = 1, size(bu))
    +
    end program
    +
    The above program produces the following output.
    Cholesky Solution: X =
    +
    239.5833
    +
    -65.6667
    +
    10.3333
    +
    Cholesky Solution (Manual Approach): X =
    +
    239.5833
    +
    -65.6667
    +
    10.3333
    +
    + +

    Definition at line 2390 of file linalg.f90.

    +

    The documentation for this interface was generated from the following file: +
    +
    + + + + diff --git a/doc/html/interfacelinalg_1_1solve__least__squares-members.html b/doc/html/interfacelinalg_1_1solve__least__squares-members.html new file mode 100644 index 00000000..8837baf7 --- /dev/null +++ b/doc/html/interfacelinalg_1_1solve__least__squares-members.html @@ -0,0 +1,114 @@ + + + + + + + +linalg: Member List + + + + + + + + + + + + + + + +
    +
    + + + + + + +
    +
    linalg 1.6.1 +
    +
    A linear algebra library that provides a user-friendly interface to several BLAS and LAPACK routines.
    +
    +
    + + + + + + + +
    +
    + +
    +
    +
    + +
    + +
    +
    + + +
    +
    +
    +
    +
    +
    Loading...
    +
    Searching...
    +
    No Matches
    +
    +
    +
    +
    + +
    +
    linalg::solve_least_squares Member List
    +
    +
    + +

    This is the complete list of members for linalg::solve_least_squares, including all inherited members.

    +
    +
    + + + + diff --git a/doc/html/interfacelinalg_1_1solve__least__squares.html b/doc/html/interfacelinalg_1_1solve__least__squares.html new file mode 100644 index 00000000..cb6f85b1 --- /dev/null +++ b/doc/html/interfacelinalg_1_1solve__least__squares.html @@ -0,0 +1,182 @@ + + + + + + + +linalg: linalg::solve_least_squares Interface Reference + + + + + + + + + + + + + + + +
    +
    + + + + + + +
    +
    linalg 1.6.1 +
    +
    A linear algebra library that provides a user-friendly interface to several BLAS and LAPACK routines.
    +
    +
    + + + + + + + +
    +
    + +
    +
    +
    + +
    + +
    +
    + + +
    +
    +
    +
    +
    +
    Loading...
    +
    Searching...
    +
    No Matches
    +
    +
    +
    +
    + +
    + +
    linalg::solve_least_squares Interface Reference
    +
    +
    + +

    Solves the overdetermined or underdetermined system \( A X = B \) of M equations of N unknowns. Notice, it is assumed that matrix A has full rank. + More...

    +

    Detailed Description

    +

    Solves the overdetermined or underdetermined system \( A X = B \) of M equations of N unknowns. Notice, it is assumed that matrix A has full rank.

    +
    Syntax
    subroutine solve_least_squares(real(real64) a(:,:), real(real64) b(:,:), optional real(real64) work(:), optional integer(int32) olwork, optional class(errors) err)
    +
    subroutine solve_least_squares(complex(real64) a(:,:), complex(real64) b(:,:), optional complex(real64) work(:), optional integer(int32) olwork, optional class(errors) err)
    +
    subroutine solve_least_squares(real(real64) a(:,:), real(real64) b(:), optional real(real64) work(:), optional integer(int32) olwork, optional class(errors) err)
    +
    subroutine solve_least_squares(complex(real64) a(:,:), complex(real64) b(:), optional complex(real64) work(:), optional integer(int32) olwork, optional class(errors) err)
    +
    +
    Parameters
    + + + + + + +
    [in,out]aOn input, the M-by-N matrix A. On output, if M >= N, the QR factorization of A in the form as output by qr_factor; else, if M < N, the LQ factorization of A.
    [in,out]bIf M >= N, the M-by-NRHS matrix B. On output, the first N rows contain the N-by-NRHS solution matrix X. If M < N, an N-by-NRHS matrix with the first M rows containing the matrix B. On output, the N-by-NRHS solution matrix X.
    [out]workAn optional input, that if provided, prevents any local memory allocation. If not provided, the memory required is allocated within. If provided, the length of the array must be at least olwork.
    [out]olworkAn optional output used to determine workspace size. If supplied, the routine determines the optimal size for work, and returns without performing any actual calculations.
    [in,out]errAn optional errors-based object that if provided can be used to retrieve information relating to any errors encountered during execution. If not provided, a default implementation of the errors class is used internally to provide error handling. Possible errors and warning messages that may be encountered are as follows.
      +
    • LA_ARRAY_SIZE_ERROR: Occurs if any of the input arrays are not sized appropriately.
    • +
    • LA_OUT_OF_MEMORY_ERROR: Occurs if local memory must be allocated, and there is insufficient memory available.
    • +
    • LA_INVALID_OPERATION_ERROR: Occurs if a is not of full rank.
    • +
    +
    +
    +
    +
    Notes
    This routine utilizes the LAPACK routine DGELS (ZGELS in the complex case).
    +
    Usage
    The following example illustrates the least squares solution of an overdetermined system of linear equations.
    program example
    +
    use iso_fortran_env, only : real64, int32
    +
    use linalg_core
    +
    implicit none
    +
    +
    ! Local Variables
    +
    real(real64) :: a(3,2), b(3)
    +
    integer(int32) :: i
    +
    +
    ! Build the 3-by-2 matrix A
    +
    ! | 2 1 |
    +
    ! A = |-3 1 |
    +
    ! |-1 1 |
    +
    a = reshape([2.0d0, -3.0d0, -1.0d0, 1.0d0, 1.0d0, 1.0d0], [3, 2])
    +
    +
    ! Build the right-hand-side vector B.
    +
    ! |-1 |
    +
    ! b = |-2 |
    +
    ! | 1 |
    +
    b = [-1.0d0, -2.0d0, 1.0d0]
    +
    +
    ! The solution is:
    +
    ! x = [0.13158, -0.57895]**T
    +
    +
    ! Compute the solution via a least-squares approach. The results overwrite
    +
    ! the first 2 elements in b.
    +
    call solve_least_squares(a, b)
    +
    +
    ! Display the results
    +
    print '(A)', "Least Squares Solution: X = "
    +
    print '(F9.5)', (b(i), i = 1, size(a, 2))
    +
    end program
    +
    The above program produces the following output.
    Least Squares Solution: X =
    +
    0.13158
    +
    -0.57895
    +
    + +

    Definition at line 2480 of file linalg.f90.

    +

    The documentation for this interface was generated from the following file: +
    +
    + + + + diff --git a/doc/html/interfacelinalg_1_1solve__least__squares__full-members.html b/doc/html/interfacelinalg_1_1solve__least__squares__full-members.html new file mode 100644 index 00000000..542aa680 --- /dev/null +++ b/doc/html/interfacelinalg_1_1solve__least__squares__full-members.html @@ -0,0 +1,114 @@ + + + + + + + +linalg: Member List + + + + + + + + + + + + + + + +
    +
    + + + + + + +
    +
    linalg 1.6.1 +
    +
    A linear algebra library that provides a user-friendly interface to several BLAS and LAPACK routines.
    +
    +
    + + + + + + + +
    +
    + +
    +
    +
    + +
    + +
    +
    + + +
    +
    +
    +
    +
    +
    Loading...
    +
    Searching...
    +
    No Matches
    +
    +
    +
    +
    + +
    +
    linalg::solve_least_squares_full Member List
    +
    +
    + +

    This is the complete list of members for linalg::solve_least_squares_full, including all inherited members.

    +
    +
    + + + + diff --git a/doc/html/interfacelinalg_1_1solve__least__squares__full.html b/doc/html/interfacelinalg_1_1solve__least__squares__full.html new file mode 100644 index 00000000..a05d17d3 --- /dev/null +++ b/doc/html/interfacelinalg_1_1solve__least__squares__full.html @@ -0,0 +1,184 @@ + + + + + + + +linalg: linalg::solve_least_squares_full Interface Reference + + + + + + + + + + + + + + + +
    +
    + + + + + + +
    +
    linalg 1.6.1 +
    +
    A linear algebra library that provides a user-friendly interface to several BLAS and LAPACK routines.
    +
    +
    + + + + + + + +
    +
    + +
    +
    +
    + +
    + +
    +
    + + +
    +
    +
    +
    +
    +
    Loading...
    +
    Searching...
    +
    No Matches
    +
    +
    +
    +
    + +
    + +
    linalg::solve_least_squares_full Interface Reference
    +
    +
    + +

    Solves the overdetermined or underdetermined system \( A X = B \) of M equations of N unknowns, but uses a full orthogonal factorization of the system. + More...

    +

    Detailed Description

    +

    Solves the overdetermined or underdetermined system \( A X = B \) of M equations of N unknowns, but uses a full orthogonal factorization of the system.

    +
    Syntax
    subroutine solve_least_squares_full(real(real64) a(:,:), real(real64) b(:,:), optional integer(int32) ipvt(:), optional integer(int32) arnk, optional real(real64) work(:), optional integer(int32) olwork, optional class(errors) err)
    +
    subroutine solve_least_squares_full(complex(real64) a(:,:), complex(real64) b(:,:), optional integer(int32) ipvt(:), optional integer(int32) arnk, optional complex(real64) work(:), optional integer(int32) olwork, optional real(real64) rwork(:), optional class(errors) err)
    +
    subroutine solve_least_squares_full(real(real64) a(:,:), real(real64) b(:), optional integer(int32) ipvt(:), optional integer(int32) arnk, optional real(real64) work(:), optional integer(int32) olwork, optional class(errors) err)
    +
    subroutine solve_least_squares_full(complex(real64) a(:,:), complex(real64) b(:), optional integer(int32) ipvt(:), optional integer(int32) arnk, optional complex(real64) work(:), optional integer(int32) olwork, optional real(real64) rwork(:), optional class(errors) err)
    +
    +
    Parameters
    + + + + + + + + + +
    [in,out]aOn input, the M-by-N matrix A. On output, the matrix is overwritten by the details of its complete orthogonal factorization.
    [in,out]bIf M >= N, the M-by-NRHS matrix B. On output, the first N rows contain the N-by-NRHS solution matrix X. If M < N, an N-by-NRHS matrix with the first M rows containing the matrix B. On output, the N-by-NRHS solution matrix X.
    [out]ipvtAn optional input that on input, an N-element array that if IPVT(I) .ne. 0, the I-th column of A is permuted to the front of A * P; if IPVT(I) = 0, the I-th column of A is a free column. On output, if IPVT(I) = K, then the I-th column of A * P was the K-th column of A. If not supplied, memory is allocated internally, and IPVT is set to all zeros such that all columns are treated as free.
    [out]arnkAn optional output, that if provided, will return the rank of a.
    [out]workAn optional input, that if provided, prevents any local memory allocation. If not provided, the memory required is allocated within. If provided, the length of the array must be at least olwork.
    [out]olworkAn optional output used to determine workspace size. If supplied, the routine determines the optimal size for work, and returns without performing any actual calculations.
    [out]rworkAn optional input, that if provided, prevents any local memory allocation for real-valued workspaces. If not provided, the memory required is allocated within. If provided, the length of the array must be at least 2 * N.
    [in,out]errAn optional errors-based object that if provided can be used to retrieve information relating to any errors encountered during execution. If not provided, a default implementation of the errors class is used internally to provide error handling. Possible errors and warning messages that may be encountered are as follows.
      +
    • LA_ARRAY_SIZE_ERROR: Occurs if any of the input arrays are not sized appropriately.
    • +
    • LA_OUT_OF_MEMORY_ERROR: Occurs if local memory must be allocated, and there is insufficient memory available.
    • +
    +
    +
    +
    +
    Notes
    This routine utilizes the LAPACK routine DGELSY (ZGELSY in the complex case).
    +
    Usage
    The following example illustrates the least squares solution of an overdetermined system of linear equations.
    program example
    +
    use iso_fortran_env, only : real64, int32
    +
    use linalg_core
    +
    implicit none
    +
    +
    ! Local Variables
    +
    real(real64) :: a(3,2), b(3)
    +
    integer(int32) :: i
    +
    +
    ! Build the 3-by-2 matrix A
    +
    ! | 2 1 |
    +
    ! A = |-3 1 |
    +
    ! |-1 1 |
    +
    a = reshape([2.0d0, -3.0d0, -1.0d0, 1.0d0, 1.0d0, 1.0d0], [3, 2])
    +
    +
    ! Build the right-hand-side vector B.
    +
    ! |-1 |
    +
    ! b = |-2 |
    +
    ! | 1 |
    +
    b = [-1.0d0, -2.0d0, 1.0d0]
    +
    +
    ! The solution is:
    +
    ! x = [0.13158, -0.57895]**T
    +
    +
    ! Compute the solution via a least-squares approach. The results overwrite
    +
    ! the first 2 elements in b.
    +
    call solve_least_squares_full(a, b)
    +
    +
    ! Display the results
    +
    print '(A)', "Least Squares Solution: X = "
    +
    print '(F9.5)', (b(i), i = 1, size(a, 2))
    +
    end program
    +
    The above program produces the following output.
    Least Squares Solution: X =
    +
    0.13158
    +
    -0.57895
    +
    + +

    Definition at line 2581 of file linalg.f90.

    +

    The documentation for this interface was generated from the following file: +
    +
    + + + + diff --git a/doc/html/interfacelinalg_1_1solve__least__squares__svd-members.html b/doc/html/interfacelinalg_1_1solve__least__squares__svd-members.html new file mode 100644 index 00000000..a9d9812a --- /dev/null +++ b/doc/html/interfacelinalg_1_1solve__least__squares__svd-members.html @@ -0,0 +1,114 @@ + + + + + + + +linalg: Member List + + + + + + + + + + + + + + + +
    +
    + + + + + + +
    +
    linalg 1.6.1 +
    +
    A linear algebra library that provides a user-friendly interface to several BLAS and LAPACK routines.
    +
    +
    + + + + + + + +
    +
    + +
    +
    +
    + +
    + +
    +
    + + +
    +
    +
    +
    +
    +
    Loading...
    +
    Searching...
    +
    No Matches
    +
    +
    +
    +
    + +
    +
    linalg::solve_least_squares_svd Member List
    +
    +
    + +

    This is the complete list of members for linalg::solve_least_squares_svd, including all inherited members.

    +
    +
    + + + + diff --git a/doc/html/interfacelinalg_1_1solve__least__squares__svd.html b/doc/html/interfacelinalg_1_1solve__least__squares__svd.html new file mode 100644 index 00000000..119485b6 --- /dev/null +++ b/doc/html/interfacelinalg_1_1solve__least__squares__svd.html @@ -0,0 +1,186 @@ + + + + + + + +linalg: linalg::solve_least_squares_svd Interface Reference + + + + + + + + + + + + + + + +
    +
    + + + + + + +
    +
    linalg 1.6.1 +
    +
    A linear algebra library that provides a user-friendly interface to several BLAS and LAPACK routines.
    +
    +
    + + + + + + + +
    +
    + +
    +
    +
    + +
    + +
    +
    + + +
    +
    +
    +
    +
    +
    Loading...
    +
    Searching...
    +
    No Matches
    +
    +
    +
    +
    + +
    + +
    linalg::solve_least_squares_svd Interface Reference
    +
    +
    + +

    Solves the overdetermined or underdetermined system \( A X = B \) of M equations of N unknowns using a singular value decomposition of matrix A. + More...

    +

    Detailed Description

    +

    Solves the overdetermined or underdetermined system \( A X = B \) of M equations of N unknowns using a singular value decomposition of matrix A.

    +
    Syntax
    subroutine solve_least_squares_svd(real(real64) a(:,:), real(real64) b(:,:), optional real(real64) s(:), optional integer(int32) arnk, optional real(real64) work(:), optional integer(int32) olwork, optional class(errors) err)
    +
    subroutine solve_least_squares_svd(complex(real64) a(:,:), complex(real64) b(:,:), optional real(real64) s(:), optional integer(int32) arnk, optional complex(real64) work(:), optional integer(int32) olwork, optional real(real64) rwork(:), optional class(errors) err)
    +
    subroutine solve_least_squares_svd(real(real64) a(:,:), real(real64) b(:), optional real(real64) s(:), optional integer(int32) arnk, optional real(real64) work(:), optional integer(int32) olwork, optional class(errors) err)
    +
    subroutine solve_least_squares_svd(complex(real64) a(:,:), complex(real64) b(:), optional real(real64) s(:), optional integer(int32) arnk, optional complex(real64) work(:), optional integer(int32) olwork, optional real(real64) rwork(:), optional class(errors) err)
    +
    +
    Parameters
    + + + + + + + + + + +
    [in,out]aOn input, the M-by-N matrix A. On output, the matrix is overwritten by the details of its complete orthogonal factorization.
    [in,out]bIf M >= N, the M-by-NRHS matrix B. On output, the first N rows contain the N-by-NRHS solution matrix X. If M < N, an N-by-NRHS matrix with the first M rows containing the matrix B. On output, the N-by-NRHS solution matrix X.
    [out]arnkAn optional output, that if provided, will return the rank of a.
    [out]sAn optional MIN(M, N)-element array that on output contains the singular values of a in descending order. Notice, the condition number of a can be determined by S(1) / S(MIN(M, N)).
    [out]arnkAn optional output, that if provided, will return the rank of a.
    [out]workAn optional input, that if provided, prevents any local memory allocation for complex-valued workspaces. If not provided, the memory required is allocated within. If provided, the length of the array must be at least olwork.
    [out]olworkAn optional output used to determine workspace size. If supplied, the routine determines the optimal size for work, and returns without performing any actual calculations.
    [out]rworkAn optional input, that if provided, prevents any local memory allocation for real-valued workspaces. If not provided, the memory required is allocated within. If provided, the length of the array must be at least 5 * MIN(M, N).
    [in,out]errAn optional errors-based object that if provided can be used to retrieve information relating to any errors encountered during execution. If not provided, a default implementation of the errors class is used internally to provide error handling. Possible errors and warning messages that may be encountered are as follows.
      +
    • LA_ARRAY_SIZE_ERROR: Occurs if any of the input arrays are not sized appropriately.
    • +
    • LA_OUT_OF_MEMORY_ERROR: Occurs if local memory must be allocated, and there is insufficient memory available.
    • +
    • LA_CONVERGENCE_ERROR: Occurs as a warning if the QR iteration process could not converge to a zero value.
    • +
    +
    +
    +
    +
    Notes
    This routine utilizes the LAPACK routine DGELSS (ZGELSS in the complex case).
    +
    Usage
    The following example illustrates the least squares solution of an overdetermined system of linear equations.
    program example
    +
    use iso_fortran_env, only : real64, int32
    +
    use linalg_core
    +
    implicit none
    +
    +
    ! Local Variables
    +
    real(real64) :: a(3,2), b(3)
    +
    integer(int32) :: i
    +
    +
    ! Build the 3-by-2 matrix A
    +
    ! | 2 1 |
    +
    ! A = |-3 1 |
    +
    ! |-1 1 |
    +
    a = reshape([2.0d0, -3.0d0, -1.0d0, 1.0d0, 1.0d0, 1.0d0], [3, 2])
    +
    +
    ! Build the right-hand-side vector B.
    +
    ! |-1 |
    +
    ! b = |-2 |
    +
    ! | 1 |
    +
    b = [-1.0d0, -2.0d0, 1.0d0]
    +
    +
    ! The solution is:
    +
    ! x = [0.13158, -0.57895]**T
    +
    +
    ! Compute the solution via a least-squares approach. The results overwrite
    +
    ! the first 2 elements in b.
    +
    call solve_least_squares_svd(a, b)
    +
    +
    ! Display the results
    +
    print '(A)', "Least Squares Solution: X = "
    +
    print '(F9.5)', (b(i), i = 1, size(a, 2))
    +
    end program
    +
    The above program produces the following output.
    Least Squares Solution: X =
    +
    0.13158
    +
    -0.57895
    +
    + +

    Definition at line 2683 of file linalg.f90.

    +

    The documentation for this interface was generated from the following file: +
    +
    + + + + diff --git a/doc/html/interfacelinalg_1_1solve__lu-members.html b/doc/html/interfacelinalg_1_1solve__lu-members.html new file mode 100644 index 00000000..6da94e66 --- /dev/null +++ b/doc/html/interfacelinalg_1_1solve__lu-members.html @@ -0,0 +1,114 @@ + + + + + + + +linalg: Member List + + + + + + + + + + + + + + + +
    +
    + + + + + + +
    +
    linalg 1.6.1 +
    +
    A linear algebra library that provides a user-friendly interface to several BLAS and LAPACK routines.
    +
    +
    + + + + + + + +
    +
    + +
    +
    +
    + +
    + +
    +
    + + +
    +
    +
    +
    +
    +
    Loading...
    +
    Searching...
    +
    No Matches
    +
    +
    +
    +
    + +
    +
    linalg::solve_lu Member List
    +
    +
    + +

    This is the complete list of members for linalg::solve_lu, including all inherited members.

    +
    +
    + + + + diff --git a/doc/html/interfacelinalg_1_1solve__lu.html b/doc/html/interfacelinalg_1_1solve__lu.html new file mode 100644 index 00000000..e66d92b6 --- /dev/null +++ b/doc/html/interfacelinalg_1_1solve__lu.html @@ -0,0 +1,191 @@ + + + + + + + +linalg: linalg::solve_lu Interface Reference + + + + + + + + + + + + + + + +
    +
    + + + + + + +
    +
    linalg 1.6.1 +
    +
    A linear algebra library that provides a user-friendly interface to several BLAS and LAPACK routines.
    +
    +
    + + + + + + + +
    +
    + +
    +
    +
    + +
    + +
    +
    + + +
    +
    +
    +
    +
    +
    Loading...
    +
    Searching...
    +
    No Matches
    +
    +
    +
    +
    + +
    + +
    linalg::solve_lu Interface Reference
    +
    +
    + +

    Solves a system of LU-factored equations. + More...

    +

    Detailed Description

    +

    Solves a system of LU-factored equations.

    +
    Syntax
    subroutine solve_lu(real(real64) a(:,:), integer(int32) ipvt(:), real(real64) b(:,:), optional class(errors) err)
    +
    subroutine solve_lu(complex(real64) a(:,:), integer(int32) ipvt(:), complex(real64) b(:,:), optional class(errors) err)
    +
    subroutine solve_lu(real(real64) a(:,:), integer(int32) ipvt(:), real(real64) b(:), optional class(errors) err)
    +
    subroutine solve_lu(complex(real64) a(:,:), integer(int32) ipvt(:), complex(real64) b(:), optional class(errors) err)
    +
    +
    Parameters
    + + + + + +
    [in]aThe N-by-N LU factored matrix as output by lu_factor.
    [in]ipvtThe N-element pivot array as output by lu_factor.
    [in,out]bOn input, the N-by-NRHS right-hand-side matrix. On output, the N-by-NRHS solution matrix.
    [in,out]errAn optional errors-based object that if provided can be used to retrieve information relating to any errors encountered during execution. If not provided, a default implementation of the errors class is used internally to provide error handling. Possible errors and warning messages that may be encountered are as follows.
      +
    • LA_ARRAY_SIZE_ERROR: Occurs if any of the input array sizes are incorrect.
    • +
    +
    +
    +
    +
    Notes
    The routine is based upon the LAPACK routine DGETRS (ZGETRS in the complex case).
    +
    Usage
    To solve a system of 3 equations of 3 unknowns using LU factorization, the following code will suffice.
    program example
    +
    use iso_fortran_env
    +
    use linalg_core
    +
    implicit none
    +
    +
    ! Local Variables
    +
    real(real64) :: a(3,3), b(3)
    +
    integer(int32) :: i, pvt(3)
    +
    +
    ! Build the 3-by-3 matrix A.
    +
    ! | 1 2 3 |
    +
    ! A = | 4 5 6 |
    +
    ! | 7 8 0 |
    +
    a = reshape( &
    +
    [1.0d0, 4.0d0, 7.0d0, 2.0d0, 5.0d0, 8.0d0, 3.0d0, 6.0d0, 0.0d0], &
    +
    [3, 3])
    +
    +
    ! Build the right-hand-side vector B.
    +
    ! | -1 |
    +
    ! b = | -2 |
    +
    ! | -3 |
    +
    b = [-1.0d0, -2.0d0, -3.0d0]
    +
    +
    ! The solution is:
    +
    ! | 1/3 |
    +
    ! x = | -2/3 |
    +
    ! | 0 |
    +
    +
    ! Compute the LU factorization
    +
    call lu_factor(a, pvt)
    +
    +
    ! Compute the solution. The results overwrite b.
    +
    call solve_lu(a, pvt, b)
    +
    +
    ! Display the results.
    +
    print '(A)', "LU Solution: X = "
    +
    print '(F8.4)', (b(i), i = 1, size(b))
    +
    end program
    +
    The program generates the following output.
    LU Solution: X =
    +
    0.3333
    +
    -0.6667
    +
    0.0000
    +
    +
    See Also
    +
    + +

    Definition at line 2149 of file linalg.f90.

    +

    The documentation for this interface was generated from the following file: +
    +
    + + + + diff --git a/doc/html/interfacelinalg_1_1solve__qr-members.html b/doc/html/interfacelinalg_1_1solve__qr-members.html new file mode 100644 index 00000000..d0432978 --- /dev/null +++ b/doc/html/interfacelinalg_1_1solve__qr-members.html @@ -0,0 +1,114 @@ + + + + + + + +linalg: Member List + + + + + + + + + + + + + + + +
    +
    + + + + + + +
    +
    linalg 1.6.1 +
    +
    A linear algebra library that provides a user-friendly interface to several BLAS and LAPACK routines.
    +
    +
    + + + + + + + +
    +
    + +
    +
    +
    + +
    + +
    +
    + + +
    +
    +
    +
    +
    +
    Loading...
    +
    Searching...
    +
    No Matches
    +
    +
    +
    +
    + +
    +
    linalg::solve_qr Member List
    +
    +
    + +

    This is the complete list of members for linalg::solve_qr, including all inherited members.

    +
    +
    + + + + diff --git a/doc/html/interfacelinalg_1_1solve__qr.html b/doc/html/interfacelinalg_1_1solve__qr.html new file mode 100644 index 00000000..ee023a5e --- /dev/null +++ b/doc/html/interfacelinalg_1_1solve__qr.html @@ -0,0 +1,219 @@ + + + + + + + +linalg: linalg::solve_qr Interface Reference + + + + + + + + + + + + + + + +
    +
    + + + + + + +
    +
    linalg 1.6.1 +
    +
    A linear algebra library that provides a user-friendly interface to several BLAS and LAPACK routines.
    +
    +
    + + + + + + + +
    +
    + +
    +
    +
    + +
    + +
    +
    + + +
    +
    +
    +
    +
    +
    Loading...
    +
    Searching...
    +
    No Matches
    +
    +
    +
    +
    + +
    + +
    linalg::solve_qr Interface Reference
    +
    +
    + +

    Solves a system of M QR-factored equations of N unknowns. + More...

    +

    Detailed Description

    +

    Solves a system of M QR-factored equations of N unknowns.

    +
    Syntax 1 (No Pivoting)
    subroutine solve_qr(real(real64) a(:,:), real(real64) tau(:), real(real64) b(:,:), optional real(real64) work(:), optional integer(int32) olwork, optional class(errors) err)
    +
    subroutine solve_qr(complex(real64) a(:,:), complex(real64) tau(:), complex(real64) b(:,:), optional complex(real64) work(:), optional integer(int32) olwork, optional class(errors) err)
    +
    subroutine solve_qr(real(real64) a(:,:), real(real64) tau(:), real(real64) b(:), optional real(real64) work(:), optional integer(int32) olwork, optional class(errors) err)
    +
    subroutine solve_qr(complex(real64) a(:,:), complex(real64) tau(:), complex(real64) b(:), optional complex(real64) work(:), optional integer(int32) olwork, optional class(errors) err)
    +
    +
    Parameters
    + + + + + + + +
    [in]aOn input, the M-by-N QR factored matrix as returned by qr_factor. On output, the contents of this matrix are restored. Notice, M must be greater than or equal to N.
    [in]tauA MIN(M, N)-element array containing the scalar factors of the elementary reflectors as returned by qr_factor.
    [in]bOn input, the M-by-NRHS right-hand-side matrix. On output, the first N rows are overwritten by the solution matrix X.
    [out]workAn optional input, that if provided, prevents any local memory allocation. If not provided, the memory required is allocated within. If provided, the length of the array must be at least olwork.
    [out]olworkAn optional output used to determine workspace size. If supplied, the routine determines the optimal size for work, and returns without performing any actual calculations.
    [in,out]errAn optional errors-based object that if provided can be used to retrieve information relating to any errors encountered during execution. If not provided, a default implementation of the errors class is used internally to provide error handling. Possible errors and warning messages that may be encountered are as follows.
      +
    • LA_ARRAY_SIZE_ERROR: Occurs if any of the input arrays are not sized appropriately.
    • +
    • LA_OUT_OF_MEMORY_ERROR: Occurs if local memory must be allocated, and there is insufficient memory available.
    • +
    +
    +
    +
    +
    Syntax 2 (With Pivoting)
    subroutine solve_qr(real(real64) a(:,:), real(real64) tau(:), integer(int32) jpvt(:), real(real64) b(:,:), optional real(real64) work(:), optional integer(int32) olwork, optional class(errors) err)
    +
    subroutine solve_qr(complex(real64) a(:,:), complex(real64) tau(:), integer(int32) jpvt(:), complex(real64) b(:,:), optional complex(real64) work(:), optional integer(int32) olwork, optional class(errors) err)
    +
    subroutine solve_qr(real(real64) a(:,:), real(real64) tau(:), integer(int32) jpvt(:), real(real64) b(:), optional real(real64) work(:), optional integer(int32) olwork, optional class(errors) err)
    +
    subroutine solve_qr(complex(real64) a(:,:), complex(real64) tau(:), integer(int32) jpvt(:), complex(real64) b(:), optional complex(real64) work(:), optional integer(int32) olwork, optional class(errors) err)
    +
    +
    Parameters
    + + + + + + + + +
    [in]aOn input, the M-by-N QR factored matrix as returned by qr_factor. On output, the contents of this matrix are altered.
    [in]tauA MIN(M, N)-element array containing the scalar factors of the elementary reflectors as returned by qr_factor.
    [in]jpvtAn N-element array, as output by qr_factor, used to track the column pivots.
    [in]bOn input, the MAX(M, N)-by-NRHS matrix where the first M rows contain the right-hand-side matrix B. On output, the first N rows are overwritten by the solution matrix X.
    [out]workAn optional input, that if provided, prevents any local memory allocation. If not provided, the memory required is allocated within. If provided, the length of the array must be at least olwork.
    [out]olworkAn optional output used to determine workspace size. If supplied, the routine determines the optimal size for work, and returns without performing any actual calculations.
    [in,out]errAn optional errors-based object that if provided can be used to retrieve information relating to any errors encountered during execution. If not provided, a default implementation of the errors class is used internally to provide error handling. Possible errors and warning messages that may be encountered are as follows.
      +
    • LA_ARRAY_SIZE_ERROR: Occurs if any of the input arrays are not sized appropriately.
    • +
    • LA_OUT_OF_MEMORY_ERROR: Occurs if local memory must be allocated, and there is insufficient memory available.
    • +
    +
    +
    +
    +
    Usage
    The following example illustrates the solution of a system of equations using QR factorization.
    program example
    +
    use iso_fortran_env, only : real64, int32
    +
    use linalg_core
    +
    implicit none
    +
    +
    ! Local Variables
    +
    real(real64) :: a(3,3), tau(3), b(3)
    +
    integer(int32) :: i, pvt(3)
    +
    +
    ! Build the 3-by-3 matrix A.
    +
    ! | 1 2 3 |
    +
    ! A = | 4 5 6 |
    +
    ! | 7 8 0 |
    +
    a = reshape( &
    +
    [1.0d0, 4.0d0, 7.0d0, 2.0d0, 5.0d0, 8.0d0, 3.0d0, 6.0d0, 0.0d0], &
    +
    [3, 3])
    +
    +
    ! Build the right-hand-side vector B.
    +
    ! | -1 |
    +
    ! b = | -2 |
    +
    ! | -3 |
    +
    b = [-1.0d0, -2.0d0, -3.0d0]
    +
    +
    ! The solution is:
    +
    ! | 1/3 |
    +
    ! x = | -2/3 |
    +
    ! | 0 |
    +
    +
    ! Compute the QR factorization, using pivoting
    +
    pvt = 0 ! Zero every entry in order not to lock any column in place
    +
    call qr_factor(a, tau, pvt)
    +
    +
    ! Compute the solution. The results overwrite b.
    +
    call solve_qr(a, tau, pvt, b)
    +
    +
    ! Display the results.
    +
    print '(A)', "QR Solution: X = "
    +
    print '(F8.4)', (b(i), i = 1, size(b))
    +
    +
    ! Notice, QR factorization without pivoting could be accomplished in the
    +
    ! same manner. The only difference is to omit the PVT array (column pivot
    +
    ! tracking array).
    +
    end program
    +
    The above program produces the following output.
    QR Solution: X =
    +
    0.3333
    +
    -0.6667
    +
    0.0000
    +
    +
    See Also
    +
    + +

    Definition at line 2284 of file linalg.f90.

    +

    The documentation for this interface was generated from the following file: +
    +
    + + + + diff --git a/doc/html/interfacelinalg_1_1solve__triangular__system-members.html b/doc/html/interfacelinalg_1_1solve__triangular__system-members.html new file mode 100644 index 00000000..1e7b9f02 --- /dev/null +++ b/doc/html/interfacelinalg_1_1solve__triangular__system-members.html @@ -0,0 +1,114 @@ + + + + + + + +linalg: Member List + + + + + + + + + + + + + + + +
    +
    + + + + + + +
    +
    linalg 1.6.1 +
    +
    A linear algebra library that provides a user-friendly interface to several BLAS and LAPACK routines.
    +
    +
    + + + + + + + +
    +
    + +
    +
    +
    + +
    + +
    +
    + + +
    +
    +
    +
    +
    +
    Loading...
    +
    Searching...
    +
    No Matches
    +
    +
    +
    +
    + +
    +
    linalg::solve_triangular_system Member List
    +
    +
    + +

    This is the complete list of members for linalg::solve_triangular_system, including all inherited members.

    +
    +
    + + + + diff --git a/doc/html/interfacelinalg_1_1solve__triangular__system.html b/doc/html/interfacelinalg_1_1solve__triangular__system.html new file mode 100644 index 00000000..c8d3cf84 --- /dev/null +++ b/doc/html/interfacelinalg_1_1solve__triangular__system.html @@ -0,0 +1,217 @@ + + + + + + + +linalg: linalg::solve_triangular_system Interface Reference + + + + + + + + + + + + + + + +
    +
    + + + + + + +
    +
    linalg 1.6.1 +
    +
    A linear algebra library that provides a user-friendly interface to several BLAS and LAPACK routines.
    +
    +
    + + + + + + + +
    +
    + +
    +
    +
    + +
    + +
    +
    + + +
    +
    +
    +
    +
    +
    Loading...
    +
    Searching...
    +
    No Matches
    +
    +
    +
    +
    + +
    + +
    linalg::solve_triangular_system Interface Reference
    +
    +
    + +

    Solves a triangular system of equations. + More...

    +

    Detailed Description

    +

    Solves a triangular system of equations.

    +
    Syntax 1
    Solves one of the matrix equations: \( op(A) X = \alpha B \), or \( X op(A) = \alpha B \), where \( A \) is a triangular matrix.
    subroutine solve_triangular_system(logical lside, logical upper, logical trans, logical nounit, real(real64) alpha, real(real64) a(:,:), real(real64) b(:,:), optional class(errors) err)
    +
    subroutine solve_triangular_system(logical lside, logical upper, logical trans, logical nounit, complex(real64) alpha, complex(real64) a(:,:), complex(real64) b(:,:), optional class(errors) err)
    +
    +
    Parameters
    + + + + + + + + + +
    [in]lsideSet to true to solve \( op(A) X = \alpha B \); else, set to false to solve \( X op(A) = \alpha B \).
    [in]upperSet to true if A is an upper triangular matrix; else, set to false if A is a lower triangular matrix.
    [in]transSet to true if \( op(A) = A^T \) ( \( op(A) = A^H \) in the complex case); else, set to false if \( op(A) = A \).
    [in]nounitSet to true if A is not a unit-diagonal matrix (ones on every diagonal element); else, set to false if A is a unit-diagonal matrix.
    [in]alphaThe scalar multiplier to B.
    [in]aIf lside is true, the M-by-M triangular matrix on which to operate; else, if lside is false, the N-by-N triangular matrix on which to operate.
    [in,out]bOn input, the M-by-N right-hand-side. On output, the M-by-N solution.
    [in,out]errAn optional errors-based object that if provided can be used to retrieve information relating to any errors encountered during execution. If not provided, a default implementation of the errors class is used internally to provide error handling. Possible errors and warning messages that may be encountered are as follows.
      +
    • LA_ARRAY_SIZE_ERROR: Occurs if a is not square, or if the sizes of a and b are not compatible.
    • +
    +
    +
    +
    +
    Notes
    This routine is based upon the BLAS routine DTRSM (ZTRSM in the complex case).
    +
    Syntax 2
    Solves the system of equations: \( op(A) X = B \), where \( A \) is a triangular matrix.
    subroutine solve_triangular_system(logical upper, logical trans, logical nounit, real(real64) a(:,:), real(real64) x(:), optional class(errors) err)
    +
    subroutine solve_triangular_system(logical upper, logical trans, logical nounit, complex(real64) a(:,:), complex(real64) x(:), optional class(errors) err)
    +
    +
    Parameters
    + + + + + + + +
    [in]upperSet to true if A is an upper triangular matrix; else, set to false if A is a lower triangular matrix.
    [in]transSet to true if \( op(A) = A^T \) ( \( op(A) = A^H \) in the complex case); else, set to false if \( op(A) = A \).
    [in]nounitSet to true if A is not a unit-diagonal matrix (ones on every diagonal element); else, set to false if A is a unit-diagonal matrix.
    [in]aThe N-by-N triangular matrix.
    [in,out]xOn input, the N-element right-hand-side array. On output, the N-element solution array.
    [out]errAn optional errors-based object that if provided can be used to retrieve information relating to any errors encountered during execution. If not provided, a default implementation of the errors class is used internally to provide error handling. Possible errors and warning messages that may be encountered are as follows.
      +
    • LA_ARRAY_SIZE_ERROR: Occurs if a is not square, or if the sizes of a and b are not compatible.
    • +
    +
    +
    +
    +
    Notes
    This routine is based upon the BLAS routine DTRSV (ZTRSV in the complex case).
    +
    Usage
    The following example illustrates the solution of two triangular systems to solve a system of LU factored equations.
    program example
    +
    use iso_fortran_env, only : real64, int32
    +
    use linalg_core
    +
    implicit none
    +
    +
    ! Variables
    +
    real(real64) :: a(3,3), b(3), u(3,3), p(3,3)
    +
    integer(int32) :: i, pvt(3)
    +
    +
    ! Build the 3-by-3 matrix A.
    +
    ! | 1 2 3 |
    +
    ! A = | 4 5 6 |
    +
    ! | 7 8 0 |
    +
    a = reshape( &
    +
    [1.0d0, 4.0d0, 7.0d0, 2.0d0, 5.0d0, 8.0d0, 3.0d0, 6.0d0, 0.0d0], &
    +
    [3, 3])
    +
    +
    ! Build the right-hand-side vector B.
    +
    ! | -1 |
    +
    ! b = | -2 |
    +
    ! | -3 |
    +
    b = [-1.0d0, -2.0d0, -3.0d0]
    +
    +
    ! The solution is:
    +
    ! | 1/3 |
    +
    ! x = | -2/3 |
    +
    ! | 0 |
    +
    +
    ! Compute the LU factorization
    +
    call lu_factor(a, pvt)
    +
    +
    ! Extract the L and U matrices. A is overwritten with L.
    +
    call form_lu(a, pvt, u, p)
    +
    +
    ! Solve the lower triangular system L * Y = P * B for Y, but first compute
    +
    ! P * B, and store the results in B
    +
    b = matmul(p, b)
    +
    +
    ! Now, compute the solution to the lower triangular system. Store the
    +
    ! result in B. Remember, L is unit diagonal (ones on its diagonal)
    +
    call solve_triangular_system(.false., .false., .false., a, b)
    +
    +
    ! Solve the upper triangular system U * X = Y for X.
    +
    call solve_triangular_system(.true., .false., .true., u, b)
    +
    +
    ! Display the results.
    +
    print '(A)', "LU Solution: X = "
    +
    print '(F8.4)', (b(i), i = 1, size(b))
    +
    end program
    +
    The above program produces the following output.
    LU Solution: X =
    +
    0.3333
    +
    -0.6667
    +
    0.0000
    +
    + +

    Definition at line 2061 of file linalg.f90.

    +

    The documentation for this interface was generated from the following file: +
    +
    + + + + diff --git a/doc/html/interfacelinalg_1_1sort-members.html b/doc/html/interfacelinalg_1_1sort-members.html new file mode 100644 index 00000000..ca21a437 --- /dev/null +++ b/doc/html/interfacelinalg_1_1sort-members.html @@ -0,0 +1,114 @@ + + + + + + + +linalg: Member List + + + + + + + + + + + + + + + +
    +
    + + + + + + +
    +
    linalg 1.6.1 +
    +
    A linear algebra library that provides a user-friendly interface to several BLAS and LAPACK routines.
    +
    +
    + + + + + + + +
    +
    + +
    +
    +
    + +
    + +
    +
    + + +
    +
    +
    +
    +
    +
    Loading...
    +
    Searching...
    +
    No Matches
    +
    +
    +
    +
    + +
    +
    linalg::sort Member List
    +
    +
    + +

    This is the complete list of members for linalg::sort, including all inherited members.

    +
    +
    + + + + diff --git a/doc/html/interfacelinalg_1_1sort.html b/doc/html/interfacelinalg_1_1sort.html new file mode 100644 index 00000000..d039497d --- /dev/null +++ b/doc/html/interfacelinalg_1_1sort.html @@ -0,0 +1,169 @@ + + + + + + + +linalg: linalg::sort Interface Reference + + + + + + + + + + + + + + + +
    +
    + + + + + + +
    +
    linalg 1.6.1 +
    +
    A linear algebra library that provides a user-friendly interface to several BLAS and LAPACK routines.
    +
    +
    + + + + + + + +
    +
    + +
    +
    +
    + +
    + +
    +
    + + +
    +
    +
    +
    +
    +
    Loading...
    +
    Searching...
    +
    No Matches
    +
    +
    +
    +
    + +
    + +
    linalg::sort Interface Reference
    +
    +
    + +

    Sorts an array. + More...

    +

    Detailed Description

    +

    Sorts an array.

    +
    Syntax 1
    subroutine sort(real(real64) x(:), optional logical ascend)
    +
    subroutine sort(complex(real64) x(:), optional logical ascend)
    +
    +
    Parameters
    + + + +
    [in,out]xOn input, the array to sort. On output, the sorted array.
    [in]ascendAn optional input that, if specified, controls if the the array is sorted in an ascending order (default), or a descending order.
    +
    +
    +
    Remarks
    The routine utilizes a quick sort algorithm unless the size of the array is less than or equal to 20. For such small arrays an insertion sort algorithm is utilized.
    +
    Notes
    This routine utilizes the LAPACK routine DLASRT.
    +
    Syntax 2
    subroutine sort(real(real64) x(:), integer(int32) ind(:), optional logical ascend, optional class(errors) err)
    +
    subroutine sort(complex(real64) x(:), integer(int32) ind(:), optional logical ascend, optional class(errors) err)
    +
    +
    Parameters
    + + + + + +
    [in,out]xOn input, the array to sort. On output, the sorted array.
    [in,out]indOn input, an integer array. On output, the contents of this array are shifted in the same order as that of x as a means of tracking the sorting operation. It is often useful to set this array to an ascending group of values (1, 2, ... n) such that this array tracks the original positions of the sorted array. Such an array can then be used to align other arrays. This array must be the same size as x.
    [in]ascendAn optional input that, if specified, controls if the the array is sorted in an ascending order (default), or a descending order.
    [in,out]errAn optional errors-based object that if provided can be used to retrieve information relating to any errors encountered during execution. If not provided, a default implementation of the errors class is used internally to provide error handling. Possible errors and warning messages that may be encountered are as follows.
      +
    • LA_ARRAY_SIZE_ERROR: Occurs if ind is not sized to match x.
    • +
    +
    +
    +
    +
    Remarks
    This routine utilizes a quick sort algorithm explained at http://www.fortran.com/qsort_c.f95.
    +
    Syntax 3 (Eigen sorting)
    A sorting routine specifically tailored for sorting of eigenvalues and their associated eigenvectors using a quick-sort approach.
    subroutine sort(real(real64) vals(:), real(real64) vecs(:,:), optional logical ascend, optional class(errors) err)
    +
    subroutine sort(complex(real64) vals(:), complex(real64) vecs(:,:), optional logical ascend, optional class(errors) err)
    +
    +
    Parameters
    + + + + + +
    [in,out]valsOn input, an N-element array containing the eigenvalues. On output, the sorted eigenvalues.
    [in,out]vecsOn input, an N-by-N matrix containing the eigenvectors associated with vals (one vector per column). On output, the sorted eigenvector matrix.
    [in]ascendAn optional input that, if specified, controls if the the array is sorted in an ascending order (default), or a descending order.
    [in,out]errAn optional errors-based object that if provided can be used to retrieve information relating to any errors encountered during execution. If not provided, a default implementation of the errors class is used internally to provide error handling. Possible errors and warning messages that may be encountered are as follows.
      +
    • LA_ARRAY_SIZE_ERROR: Occurs if vecs is not sized to match vals.
    • +
    • LA_OUT_OF_MEMORY_ERROR: Occurs if there is insufficient memory available to comoplete this operation.
    • +
    +
    +
    +
    + +

    Definition at line 3181 of file linalg.f90.

    +

    The documentation for this interface was generated from the following file: +
    +
    + + + + diff --git a/doc/html/interfacelinalg_1_1svd-members.html b/doc/html/interfacelinalg_1_1svd-members.html new file mode 100644 index 00000000..0e1e3453 --- /dev/null +++ b/doc/html/interfacelinalg_1_1svd-members.html @@ -0,0 +1,114 @@ + + + + + + + +linalg: Member List + + + + + + + + + + + + + + + +
    +
    + + + + + + +
    +
    linalg 1.6.1 +
    +
    A linear algebra library that provides a user-friendly interface to several BLAS and LAPACK routines.
    +
    +
    + + + + + + + +
    +
    + +
    +
    +
    + +
    + +
    +
    + + +
    +
    +
    +
    +
    +
    Loading...
    +
    Searching...
    +
    No Matches
    +
    +
    +
    +
    + +
    +
    linalg::svd Member List
    +
    +
    + +

    This is the complete list of members for linalg::svd, including all inherited members.

    +
    +
    + + + + diff --git a/doc/html/interfacelinalg_1_1svd.html b/doc/html/interfacelinalg_1_1svd.html new file mode 100644 index 00000000..4e3b80cd --- /dev/null +++ b/doc/html/interfacelinalg_1_1svd.html @@ -0,0 +1,208 @@ + + + + + + + +linalg: linalg::svd Interface Reference + + + + + + + + + + + + + + + +
    +
    + + + + + + +
    +
    linalg 1.6.1 +
    +
    A linear algebra library that provides a user-friendly interface to several BLAS and LAPACK routines.
    +
    +
    + + + + + + + +
    +
    + +
    +
    +
    + +
    + +
    +
    + + +
    +
    +
    +
    +
    +
    Loading...
    +
    Searching...
    +
    No Matches
    +
    +
    +
    +
    + +
    + +
    linalg::svd Interface Reference
    +
    +
    + +

    Computes the singular value decomposition of a matrix A. The SVD is defined as: \( A = U S V^T \), where \( U \) is an M-by-M orthogonal matrix, \( S \) is an M-by-N diagonal matrix, and \( V \) is an N-by-N orthogonal matrix. + More...

    +

    Detailed Description

    +

    Computes the singular value decomposition of a matrix A. The SVD is defined as: \( A = U S V^T \), where \( U \) is an M-by-M orthogonal matrix, \( S \) is an M-by-N diagonal matrix, and \( V \) is an N-by-N orthogonal matrix.

    +
    Syntax
    subroutine svd(real(real64) a(:,:), real(real64) s(:), optional real(real64) u(:,:), optional real(real64) vt(:,:), optional real(real64) work(:), optional integer(int32) olwork, optional class(errors) err)
    +
    subroutine svd(complex(real64) a(:,:), real(real64) s(:), optional complex(real64) u(:,:), optional complex(real64) vt(:,:), optional complex(real64) work(:), optional integer(int32) olwork, optional real(real64) rwork(:), optional class(errors) err)
    +
    +
    Parameters
    + + + + + + + + + +
    [in,out]aOn input, the M-by-N matrix to factor. The matrix is overwritten on output.
    [out]sA MIN(M, N)-element array containing the singular values of a sorted in descending order.
    [out]uAn optional argument, that if supplied, is used to contain the orthogonal matrix U from the decomposition. The matrix U contains the left singular vectors, and can be either M-by-M (all left singular vectors are computed), or M-by-MIN(M,N) (only the first MIN(M, N) left singular vectors are computed).
    [out]vtAn optional argument, that if supplied, is used to contain the conjugate transpose of the N-by-N orthogonal matrix V. The matrix V contains the right singular vectors.
    [out]workAn optional input, that if provided, prevents any local memory allocation for complex-valued workspaces. If not provided, the memory required is allocated within. If provided, the length of the array must be at least olwork.
    [out]olworkAn optional output used to determine workspace size. If supplied, the routine determines the optimal size for work, and returns without performing any actual calculations.
    [out]rworkAn optional input, that if provided, prevents any local memory allocation for real-valued workspaces. If not provided, the memory required is allocated within. If provided, the length of the array must be at least 5 * MIN(M, N).
    [in,out]errAn optional errors-based object that if provided can be used to retrieve information relating to any errors encountered during execution. If not provided, a default implementation of the errors class is used internally to provide error handling. Possible errors and warning messages that may be encountered are as follows.
      +
    • LA_ARRAY_SIZE_ERROR: Occurs if any of the input arrays are not sized appropriately.
    • +
    • LA_OUT_OF_MEMORY_ERROR: Occurs if local memory must be allocated, and there is insufficient memory available.
    • +
    • LA_CONVERGENCE_ERROR: Occurs as a warning if the QR iteration process could not converge to a zero value.
    • +
    +
    +
    +
    +
    Notes
    This routine utilizes the LAPACK routine DGESVD (ZGESVD in the complex case).
    +
    See Also
    +
    +
    Usage
    The following example illustrates the calculation of the singular value decomposition of an overdetermined system.
    program example
    +
    use iso_fortran_env, only : int32, real64
    +
    use linalg_core
    +
    implicit none
    +
    +
    ! Variables
    +
    real(real64) :: a(3,2), s(2), u(3,3), vt(2,2), ac(3,2)
    +
    integer(int32) :: i
    +
    +
    ! Initialize the 3-by-2 matrix A
    +
    ! | 2 1 |
    +
    ! A = |-3 1 |
    +
    ! |-1 1 |
    +
    a = reshape([2.0d0, -3.0d0, -1.0d0, 1.0d0, 1.0d0, 1.0d0], [3, 2])
    +
    +
    ! Compute the singular value decomposition of A. Notice, V**T is returned
    +
    ! instead of V. Also note, A is overwritten.
    +
    call svd(a, s, u, vt)
    +
    +
    ! Display the results
    +
    print '(A)', "U ="
    +
    do i = 1, size(u, 1)
    +
    print *, u(i,:)
    +
    end do
    +
    +
    print '(A)', "S ="
    +
    print '(F9.5)', (s(i), i = 1, size(a, 2))
    +
    +
    print '(A)', "V**T ="
    +
    do i = 1, size(vt, 1)
    +
    print *, vt(i,:)
    +
    end do
    +
    +
    ! Compute U * S * V**T
    +
    call diag_mtx_mult(.true., 1.0d0, s, vt) ! Compute: VT = S * V**T
    +
    ac = matmul(u(:,1:2), vt)
    +
    print '(A)', "U * S * V**T ="
    +
    do i = 1, size(ac, 1)
    +
    print *, ac(i,:)
    +
    end do
    +
    end program
    +
    The above program produces the following output.
    U =
    +
    -0.47411577501825380 -0.81850539032073777 -0.32444284226152509
    +
    0.82566838523833064 -0.28535874325972488 -0.48666426339228758
    +
    0.30575472113569685 -0.49861740208412991 0.81110710565381272
    +
    S =
    +
    3.78845
    +
    1.62716
    +
    V**T =
    +
    -0.98483334211643059 0.17350299206578967
    +
    -0.17350299206578967 -0.98483334211643059
    +
    U * S * V**T =
    +
    1.9999999999999993 0.99999999999999956
    +
    -3.0000000000000000 1.0000000000000000
    +
    -1.0000000000000000 0.99999999999999967
    +
    + +

    Definition at line 1927 of file linalg.f90.

    +

    The documentation for this interface was generated from the following file: +
    +
    + + + + diff --git a/doc/html/interfacelinalg_1_1swap-members.html b/doc/html/interfacelinalg_1_1swap-members.html new file mode 100644 index 00000000..25b1697d --- /dev/null +++ b/doc/html/interfacelinalg_1_1swap-members.html @@ -0,0 +1,114 @@ + + + + + + + +linalg: Member List + + + + + + + + + + + + + + + +
    +
    + + + + + + +
    +
    linalg 1.6.1 +
    +
    A linear algebra library that provides a user-friendly interface to several BLAS and LAPACK routines.
    +
    +
    + + + + + + + +
    +
    + +
    +
    +
    + +
    + +
    +
    + + +
    +
    +
    +
    +
    +
    Loading...
    +
    Searching...
    +
    No Matches
    +
    +
    +
    +
    + +
    +
    linalg::swap Member List
    +
    +
    + +

    This is the complete list of members for linalg::swap, including all inherited members.

    +
    +
    + + + + diff --git a/doc/html/interfacelinalg_1_1swap.html b/doc/html/interfacelinalg_1_1swap.html new file mode 100644 index 00000000..eea75e7e --- /dev/null +++ b/doc/html/interfacelinalg_1_1swap.html @@ -0,0 +1,139 @@ + + + + + + + +linalg: linalg::swap Interface Reference + + + + + + + + + + + + + + + +
    +
    + + + + + + +
    +
    linalg 1.6.1 +
    +
    A linear algebra library that provides a user-friendly interface to several BLAS and LAPACK routines.
    +
    +
    + + + + + + + +
    +
    + +
    +
    +
    + +
    + +
    +
    + + +
    +
    +
    +
    +
    +
    Loading...
    +
    Searching...
    +
    No Matches
    +
    +
    +
    +
    + +
    + +
    linalg::swap Interface Reference
    +
    +
    + +

    Swaps the contents of two arrays. + More...

    +

    Detailed Description

    +

    Swaps the contents of two arrays.

    +
    Syntax
    subroutine swap(real(real64) x(:), real(real64) y(:), optional class(errors) err)
    +
    subroutine swap(complex(real64) x(:), complex(real64) y(:), optional class(errors) err)
    +
    +
    Parameters
    + + + + +
    [in,out]xOne of the N-element arrays.
    [in,out]yThe other N-element array.
    [in,out]errAn optional errors-based object that if provided can be used to retrieve information relating to any errors encountered during execution. If not provided, a default implementation of the errors class is used internally to provide error handling. Possible errors and warning messages that may be encountered are as follows.
      +
    • LA_ARRAY_SIZE_ERROR: Occurs if x and y are not the same size.
    • +
    +
    +
    +
    + +

    Definition at line 456 of file linalg.f90.

    +

    The documentation for this interface was generated from the following file: +
    +
    + + + + diff --git a/doc/html/interfacelinalg_1_1trace-members.html b/doc/html/interfacelinalg_1_1trace-members.html new file mode 100644 index 00000000..53866cf7 --- /dev/null +++ b/doc/html/interfacelinalg_1_1trace-members.html @@ -0,0 +1,114 @@ + + + + + + + +linalg: Member List + + + + + + + + + + + + + + + +
    +
    + + + + + + +
    +
    linalg 1.6.1 +
    +
    A linear algebra library that provides a user-friendly interface to several BLAS and LAPACK routines.
    +
    +
    + + + + + + + +
    +
    + +
    +
    +
    + +
    + +
    +
    + + +
    +
    +
    +
    +
    +
    Loading...
    +
    Searching...
    +
    No Matches
    +
    +
    +
    +
    + +
    +
    linalg::trace Member List
    +
    +
    + +

    This is the complete list of members for linalg::trace, including all inherited members.

    +
    +
    + + + + diff --git a/doc/html/interfacelinalg_1_1trace.html b/doc/html/interfacelinalg_1_1trace.html new file mode 100644 index 00000000..42a90a77 --- /dev/null +++ b/doc/html/interfacelinalg_1_1trace.html @@ -0,0 +1,135 @@ + + + + + + + +linalg: linalg::trace Interface Reference + + + + + + + + + + + + + + + +
    +
    + + + + + + +
    +
    linalg 1.6.1 +
    +
    A linear algebra library that provides a user-friendly interface to several BLAS and LAPACK routines.
    +
    +
    + + + + + + + +
    +
    + +
    +
    +
    + +
    + +
    +
    + + +
    +
    +
    +
    +
    +
    Loading...
    +
    Searching...
    +
    No Matches
    +
    +
    +
    +
    + +
    + +
    linalg::trace Interface Reference
    +
    +
    + +

    Computes the trace of a matrix (the sum of the main diagonal elements). + More...

    +

    Detailed Description

    +

    Computes the trace of a matrix (the sum of the main diagonal elements).

    +
    Syntax
    real(real64) function trace(real(real64) x(:,:))
    +
    complex(real64) function trace(complex(real64) x(:,:))
    +
    +
    Parameters
    + + +
    [in]xThe matrix on which to operate.
    +
    +
    +
    Returns
    The trace of x.
    + +

    Definition at line 353 of file linalg.f90.

    +

    The documentation for this interface was generated from the following file: +
    +
    + + + + diff --git a/doc/html/interfacelinalg_1_1tri__mtx__mult-members.html b/doc/html/interfacelinalg_1_1tri__mtx__mult-members.html new file mode 100644 index 00000000..664d8295 --- /dev/null +++ b/doc/html/interfacelinalg_1_1tri__mtx__mult-members.html @@ -0,0 +1,114 @@ + + + + + + + +linalg: Member List + + + + + + + + + + + + + + + +
    +
    + + + + + + +
    +
    linalg 1.6.1 +
    +
    A linear algebra library that provides a user-friendly interface to several BLAS and LAPACK routines.
    +
    +
    + + + + + + + +
    +
    + +
    +
    +
    + +
    + +
    +
    + + +
    +
    +
    +
    +
    +
    Loading...
    +
    Searching...
    +
    No Matches
    +
    +
    +
    +
    + +
    +
    linalg::tri_mtx_mult Member List
    +
    +
    + +

    This is the complete list of members for linalg::tri_mtx_mult, including all inherited members.

    +
    +
    + + + + diff --git a/doc/html/interfacelinalg_1_1tri__mtx__mult.html b/doc/html/interfacelinalg_1_1tri__mtx__mult.html new file mode 100644 index 00000000..059df584 --- /dev/null +++ b/doc/html/interfacelinalg_1_1tri__mtx__mult.html @@ -0,0 +1,142 @@ + + + + + + + +linalg: linalg::tri_mtx_mult Interface Reference + + + + + + + + + + + + + + + +
    +
    + + + + + + +
    +
    linalg 1.6.1 +
    +
    A linear algebra library that provides a user-friendly interface to several BLAS and LAPACK routines.
    +
    +
    + + + + + + + +
    +
    + +
    +
    +
    + +
    + +
    +
    + + +
    +
    +
    +
    +
    +
    Loading...
    +
    Searching...
    +
    No Matches
    +
    +
    +
    +
    + +
    + +
    linalg::tri_mtx_mult Interface Reference
    +
    +
    + +

    Computes the triangular matrix operation: \( B = \alpha A^T A + \beta B \), or \( B = \alpha A A^T + \beta B \), where A is a triangular matrix. + More...

    +

    Detailed Description

    +

    Computes the triangular matrix operation: \( B = \alpha A^T A + \beta B \), or \( B = \alpha A A^T + \beta B \), where A is a triangular matrix.

    +
    Syntax
    subroutine tri_mtx_mult(logical upper, real(real64) alpha, real(real64) a(:,:), real(real64) beta, real(real64) b(:,:), optional class(errors) err)
    +
    subroutine tri_mtx_mult(logical upper, complex(real64) alpha, complex(real64) a(:,:), complex(real64) beta, complex(real64) b(:,:), optional class(errors) err)
    +
    +
    Parameters
    + + + + + + + +
    [in]upperSet to true if matrix A is upper triangular, and \( B = \alpha A^T A + \beta B \) is to be calculated; else, set to false if A is lower triangular, and \( B = \alpha A A^T + \beta B \) is to be computed.
    [in]alphaA scalar multiplier.
    [in]aThe N-by-N triangular matrix. Notice, if upper is true only the upper triangular portion of this matrix is referenced; else, if upper is false, only the lower triangular portion of this matrix is referenced.
    [in]betaA scalar multiplier.
    [in,out]bOn input, the N-by-N matrix B. On output, the N-by-N solution matrix.
    [in,out]errAn optional errors-based object that if provided can be used to retrieve information relating to any errors encountered during execution. If not provided, a default implementation of the errors class is used internally to provide error handling. Possible errors and warning messages that may be encountered are as follows.
      +
    • LA_ARRAY_SIZE_ERROR: Occurs if any of the input arrays are not sized appropriately.
    • +
    +
    +
    +
    + +

    Definition at line 509 of file linalg.f90.

    +

    The documentation for this interface was generated from the following file: +
    +
    + + + + diff --git a/doc/html/interfacelinalg__immutable_1_1mat__eigen.html b/doc/html/interfacelinalg__immutable_1_1mat__eigen.html index 83e9898a..e800ad2a 100644 --- a/doc/html/interfacelinalg__immutable_1_1mat__eigen.html +++ b/doc/html/interfacelinalg__immutable_1_1mat__eigen.html @@ -108,7 +108,7 @@

    Detailed Description

    Computes the eigenvalues and eigenvectors (right) of a general N-by-N matrix.

    -

    Definition at line 109 of file linalg_immutable.f90.

    +

    Definition at line 108 of file linalg_immutable.f90.


    The documentation for this interface was generated from the following file: diff --git a/doc/html/interfacelinalg__immutable_1_1mat__lu.html b/doc/html/interfacelinalg__immutable_1_1mat__lu.html index 4a24d75e..709bbfa7 100644 --- a/doc/html/interfacelinalg__immutable_1_1mat__lu.html +++ b/doc/html/interfacelinalg__immutable_1_1mat__lu.html @@ -108,7 +108,7 @@

    Detailed Description

    Computes the LU factorization of a square matrix. Notice, partial row pivoting is utilized.

    -

    Definition at line 101 of file linalg_immutable.f90.

    +

    Definition at line 100 of file linalg_immutable.f90.


    The documentation for this interface was generated from the following file: diff --git a/doc/html/interfacelinalg__immutable_1_1mat__mult__diag.html b/doc/html/interfacelinalg__immutable_1_1mat__mult__diag.html index da25cc0c..c14a3f99 100644 --- a/doc/html/interfacelinalg__immutable_1_1mat__mult__diag.html +++ b/doc/html/interfacelinalg__immutable_1_1mat__mult__diag.html @@ -108,7 +108,7 @@

    Detailed Description

    Computes the matrix operation: C = A * B, where A is a diagonal matrix.

    -

    Definition at line 49 of file linalg_immutable.f90.

    +

    Definition at line 48 of file linalg_immutable.f90.


    The documentation for this interface was generated from the following file: diff --git a/doc/html/interfacelinalg__immutable_1_1mat__mult__lower__tri.html b/doc/html/interfacelinalg__immutable_1_1mat__mult__lower__tri.html index c0c567ac..c81b8145 100644 --- a/doc/html/interfacelinalg__immutable_1_1mat__mult__lower__tri.html +++ b/doc/html/interfacelinalg__immutable_1_1mat__mult__lower__tri.html @@ -108,7 +108,7 @@

    Detailed Description

    Computes the matrix operation C = A * B, where A is a lower triangular matrix.

    -

    Definition at line 71 of file linalg_immutable.f90.

    +

    Definition at line 70 of file linalg_immutable.f90.


    The documentation for this interface was generated from the following file: diff --git a/doc/html/interfacelinalg__immutable_1_1mat__mult__upper__tri.html b/doc/html/interfacelinalg__immutable_1_1mat__mult__upper__tri.html index 3331637c..b877f079 100644 --- a/doc/html/interfacelinalg__immutable_1_1mat__mult__upper__tri.html +++ b/doc/html/interfacelinalg__immutable_1_1mat__mult__upper__tri.html @@ -108,7 +108,7 @@

    Detailed Description

    Computes the matrix operation C = A * B, where A is an upper triangular matrix.

    -

    Definition at line 61 of file linalg_immutable.f90.

    +

    Definition at line 60 of file linalg_immutable.f90.


    The documentation for this interface was generated from the following file: diff --git a/doc/html/interfacelinalg__immutable_1_1mat__solve__lower__tri.html b/doc/html/interfacelinalg__immutable_1_1mat__solve__lower__tri.html index d746efa7..32a6331c 100644 --- a/doc/html/interfacelinalg__immutable_1_1mat__solve__lower__tri.html +++ b/doc/html/interfacelinalg__immutable_1_1mat__solve__lower__tri.html @@ -108,7 +108,7 @@

    Detailed Description

    Solves the lower triangular system A X = B, where A is a lower triangular matrix.

    -

    Definition at line 91 of file linalg_immutable.f90.

    +

    Definition at line 90 of file linalg_immutable.f90.


    The documentation for this interface was generated from the following file: diff --git a/doc/html/interfacelinalg__immutable_1_1mat__solve__upper__tri.html b/doc/html/interfacelinalg__immutable_1_1mat__solve__upper__tri.html index c4defbc1..ebebff24 100644 --- a/doc/html/interfacelinalg__immutable_1_1mat__solve__upper__tri.html +++ b/doc/html/interfacelinalg__immutable_1_1mat__solve__upper__tri.html @@ -108,7 +108,7 @@

    Detailed Description

    Solves the upper triangular system A X = B, where A is an upper triangular matrix.

    -

    Definition at line 81 of file linalg_immutable.f90.

    +

    Definition at line 80 of file linalg_immutable.f90.


    The documentation for this interface was generated from the following file: diff --git a/doc/html/linalg_8f90_source.html b/doc/html/linalg_8f90_source.html new file mode 100644 index 00000000..ae9ae262 --- /dev/null +++ b/doc/html/linalg_8f90_source.html @@ -0,0 +1,1340 @@ + + + + + + + +linalg: D:/Code/linalg/src/linalg.f90 Source File + + + + + + + + + + + + + + + +
    +
    + + + + + + +
    +
    linalg 1.6.1 +
    +
    A linear algebra library that provides a user-friendly interface to several BLAS and LAPACK routines.
    +
    +
    + + + + + + + +
    +
    + +
    +
    +
    + +
    + +
    +
    + + +
    +
    +
    +
    +
    +
    Loading...
    +
    Searching...
    +
    No Matches
    +
    +
    +
    +
    + +
    +
    linalg.f90
    +
    +
    +
    1! linalg.f90
    +
    2
    +
    3
    +
    12
    +
    13
    +
    15module linalg
    +
    16 use, intrinsic :: iso_fortran_env, only : int32, real64
    +
    17 use ferror, only : errors
    +
    18 implicit none
    +
    19
    +
    20 private
    +
    21 public :: mtx_mult
    +
    22 public :: rank1_update
    +
    23 public :: diag_mtx_mult
    +
    24 public :: trace
    +
    25 public :: mtx_rank
    +
    26 public :: det
    +
    27 public :: swap
    +
    28 public :: recip_mult_array
    +
    29 public :: tri_mtx_mult
    +
    30 public :: lu_factor
    +
    31 public :: form_lu
    +
    32 public :: qr_factor
    +
    33 public :: form_qr
    +
    34 public :: mult_qr
    +
    35 public :: qr_rank1_update
    +
    36 public :: cholesky_factor
    +
    37 public :: cholesky_rank1_update
    + +
    39 public :: rz_factor
    +
    40 public :: mult_rz
    +
    41 public :: svd
    + +
    43 public :: solve_lu
    +
    44 public :: solve_qr
    +
    45 public :: solve_cholesky
    +
    46 public :: mtx_inverse
    +
    47 public :: mtx_pinverse
    +
    48 public :: solve_least_squares
    + + +
    51 public :: eigen
    +
    52 public :: sort
    +
    53 public :: la_no_operation
    +
    54 public :: la_transpose
    +
    55 public :: la_hermitian_transpose
    +
    56 public :: la_no_error
    +
    57 public :: la_invalid_input_error
    +
    58 public :: la_array_size_error
    +
    59 public :: la_singular_matrix_error
    +
    60 public :: la_matrix_format_error
    +
    61 public :: la_out_of_memory_error
    +
    62 public :: la_convergence_error
    +
    63 public :: la_invalid_operation_error
    +
    64
    +
    65! ******************************************************************************
    +
    66! CONSTANTS
    +
    67! ------------------------------------------------------------------------------
    +
    69 integer(int32), parameter :: la_no_operation = 0
    +
    71 integer(int32), parameter :: la_transpose = 1
    +
    73 integer(int32), parameter :: la_hermitian_transpose = 2
    +
    74
    +
    75! ******************************************************************************
    +
    76! ERROR FLAGS
    +
    77! ------------------------------------------------------------------------------
    +
    79 integer(int32), parameter :: la_no_error = 0
    +
    81 integer(int32), parameter :: la_invalid_input_error = 101
    +
    83 integer(int32), parameter :: la_array_size_error = 102
    +
    85 integer(int32), parameter :: la_singular_matrix_error = 103
    +
    87 integer(int32), parameter :: la_matrix_format_error = 104
    +
    89 integer(int32), parameter :: la_out_of_memory_error = 105
    +
    91 integer(int32), parameter :: la_convergence_error = 106
    +
    93 integer(int32), parameter :: la_invalid_operation_error = 107
    +
    94
    +
    95! ******************************************************************************
    +
    96! INTERFACES
    +
    97! ------------------------------------------------------------------------------
    +
    159interface mtx_mult
    +
    160 module procedure :: mtx_mult_mtx
    +
    161 module procedure :: mtx_mult_vec
    +
    162 module procedure :: cmtx_mult_mtx
    +
    163 module procedure :: cmtx_mult_vec
    +
    164end interface
    +
    165
    +
    166! ------------------------------------------------------------------------------
    + +
    195 module procedure :: rank1_update_dbl
    +
    196 module procedure :: rank1_update_cmplx
    +
    197end interface
    +
    198
    +
    199! ------------------------------------------------------------------------------
    + +
    330 module procedure :: diag_mtx_mult_mtx
    +
    331 module procedure :: diag_mtx_mult_mtx2
    +
    332 module procedure :: diag_mtx_mult_mtx3
    +
    333 module procedure :: diag_mtx_mult_mtx4
    +
    334 module procedure :: diag_mtx_mult_mtx_cmplx
    +
    335 module procedure :: diag_mtx_mult_mtx2_cmplx
    +
    336 module procedure :: diag_mtx_mult_mtx_mix
    +
    337 module procedure :: diag_mtx_mult_mtx2_mix
    +
    338end interface
    +
    339
    +
    340! ------------------------------------------------------------------------------
    +
    353interface trace
    +
    354 module procedure :: trace_dbl
    +
    355 module procedure :: trace_cmplx
    +
    356end interface
    +
    357
    +
    358! ------------------------------------------------------------------------------
    +
    401interface mtx_rank
    +
    402 module procedure :: mtx_rank_dbl
    +
    403 module procedure :: mtx_rank_cmplx
    +
    404end interface
    +
    405
    +
    406! ------------------------------------------------------------------------------
    +
    434interface det
    +
    435 module procedure :: det_dbl
    +
    436 module procedure :: det_cmplx
    +
    437end interface
    +
    438
    +
    439! ------------------------------------------------------------------------------
    +
    456interface swap
    +
    457 module procedure :: swap_dbl
    +
    458 module procedure :: swap_cmplx
    +
    459end interface
    +
    460
    +
    461! ------------------------------------------------------------------------------
    + +
    476 module procedure :: recip_mult_array_dbl
    +
    477end interface
    +
    478
    +
    479! ------------------------------------------------------------------------------
    + +
    510 module procedure :: tri_mtx_mult_dbl
    +
    511 module procedure :: tri_mtx_mult_cmplx
    +
    512end interface
    +
    513
    +
    514! ------------------------------------------------------------------------------
    +
    595interface lu_factor
    +
    596 module procedure :: lu_factor_dbl
    +
    597 module procedure :: lu_factor_cmplx
    +
    598end interface
    +
    599
    +
    717interface form_lu
    +
    718 module procedure :: form_lu_all
    +
    719 module procedure :: form_lu_all_cmplx
    +
    720 module procedure :: form_lu_only
    +
    721 module procedure :: form_lu_only_cmplx
    +
    722end interface
    +
    723
    +
    724! ------------------------------------------------------------------------------
    +
    871interface qr_factor
    +
    872 module procedure :: qr_factor_no_pivot
    +
    873 module procedure :: qr_factor_no_pivot_cmplx
    +
    874 module procedure :: qr_factor_pivot
    +
    875 module procedure :: qr_factor_pivot_cmplx
    +
    876end interface
    +
    877
    +
    878! ------------------------------------------------------------------------------
    +
    1031interface form_qr
    +
    1032 module procedure :: form_qr_no_pivot
    +
    1033 module procedure :: form_qr_no_pivot_cmplx
    +
    1034 module procedure :: form_qr_pivot
    +
    1035 module procedure :: form_qr_pivot_cmplx
    +
    1036end interface
    +
    1037
    +
    1038! ------------------------------------------------------------------------------
    +
    1185interface mult_qr
    +
    1186 module procedure :: mult_qr_mtx
    +
    1187 module procedure :: mult_qr_mtx_cmplx
    +
    1188 module procedure :: mult_qr_vec
    +
    1189 module procedure :: mult_qr_vec_cmplx
    +
    1190end interface
    +
    1191
    +
    1192! ------------------------------------------------------------------------------
    + +
    1335 module procedure :: qr_rank1_update_dbl
    +
    1336 module procedure :: qr_rank1_update_cmplx
    +
    1337end interface
    +
    1338
    +
    1339! ------------------------------------------------------------------------------
    + +
    1434 module procedure :: cholesky_factor_dbl
    +
    1435 module procedure :: cholesky_factor_cmplx
    +
    1436end interface
    +
    1437
    +
    1438! ------------------------------------------------------------------------------
    + +
    1533 module procedure :: cholesky_rank1_update_dbl
    +
    1534 module procedure :: cholesky_rank1_update_cmplx
    +
    1535end interface
    +
    1536
    +
    1537! ------------------------------------------------------------------------------
    + +
    1640 module procedure :: cholesky_rank1_downdate_dbl
    +
    1641 module procedure :: cholesky_rank1_downdate_cmplx
    +
    1642end interface
    +
    1643
    +
    1644! ------------------------------------------------------------------------------
    +
    1712interface rz_factor
    +
    1713 module procedure :: rz_factor_dbl
    +
    1714 module procedure :: rz_factor_cmplx
    +
    1715end interface
    +
    1716
    +
    1717! ------------------------------------------------------------------------------
    +
    1803interface mult_rz
    +
    1804 module procedure :: mult_rz_mtx
    +
    1805 module procedure :: mult_rz_mtx_cmplx
    +
    1806 module procedure :: mult_rz_vec
    +
    1807 module procedure :: mult_rz_vec_cmplx
    +
    1808end interface
    +
    1809
    +
    1810! ------------------------------------------------------------------------------
    +
    1927interface svd
    +
    1928 module procedure :: svd_dbl
    +
    1929 module procedure :: svd_cmplx
    +
    1930end interface
    +
    1931
    +
    1932! ------------------------------------------------------------------------------
    + +
    2062 module procedure :: solve_tri_mtx
    +
    2063 module procedure :: solve_tri_mtx_cmplx
    +
    2064 module procedure :: solve_tri_vec
    +
    2065 module procedure :: solve_tri_vec_cmplx
    +
    2066end interface
    +
    2067
    +
    2068! ------------------------------------------------------------------------------
    +
    2149interface solve_lu
    +
    2150 module procedure :: solve_lu_mtx
    +
    2151 module procedure :: solve_lu_mtx_cmplx
    +
    2152 module procedure :: solve_lu_vec
    +
    2153 module procedure :: solve_lu_vec_cmplx
    +
    2154end interface
    +
    2155
    +
    2156! ------------------------------------------------------------------------------
    +
    2284interface solve_qr
    +
    2285 module procedure :: solve_qr_no_pivot_mtx
    +
    2286 module procedure :: solve_qr_no_pivot_mtx_cmplx
    +
    2287 module procedure :: solve_qr_no_pivot_vec
    +
    2288 module procedure :: solve_qr_no_pivot_vec_cmplx
    +
    2289 module procedure :: solve_qr_pivot_mtx
    +
    2290 module procedure :: solve_qr_pivot_mtx_cmplx
    +
    2291 module procedure :: solve_qr_pivot_vec
    +
    2292 module procedure :: solve_qr_pivot_vec_cmplx
    +
    2293end interface
    +
    2294
    +
    2295! ------------------------------------------------------------------------------
    + +
    2391 module procedure :: solve_cholesky_mtx
    +
    2392 module procedure :: solve_cholesky_mtx_cmplx
    +
    2393 module procedure :: solve_cholesky_vec
    +
    2394 module procedure :: solve_cholesky_vec_cmplx
    +
    2395end interface
    +
    2396
    +
    2397! ------------------------------------------------------------------------------
    + +
    2481 module procedure :: solve_least_squares_mtx
    +
    2482 module procedure :: solve_least_squares_mtx_cmplx
    +
    2483 module procedure :: solve_least_squares_vec
    +
    2484 module procedure :: solve_least_squares_vec_cmplx
    +
    2485end interface
    +
    2486
    +
    2487! ------------------------------------------------------------------------------
    + +
    2582 module procedure :: solve_least_squares_mtx_pvt
    +
    2583 module procedure :: solve_least_squares_mtx_pvt_cmplx
    +
    2584 module procedure :: solve_least_squares_vec_pvt
    +
    2585 module procedure :: solve_least_squares_vec_pvt_cmplx
    +
    2586end interface
    +
    2587
    +
    2588! ------------------------------------------------------------------------------
    + +
    2684 module procedure :: solve_least_squares_mtx_svd
    +
    2685 module procedure :: solve_least_squares_vec_svd
    +
    2686end interface
    +
    2687
    +
    2688! ------------------------------------------------------------------------------
    + +
    2779 module procedure :: mtx_inverse_dbl
    +
    2780 module procedure :: mtx_inverse_cmplx
    +
    2781end interface
    +
    2782
    +
    2783! ------------------------------------------------------------------------------
    + +
    2885 module procedure :: mtx_pinverse_dbl
    +
    2886 module procedure :: mtx_pinverse_cmplx
    +
    2887end interface
    +
    2888
    +
    2889! ------------------------------------------------------------------------------
    +
    3098interface eigen
    +
    3099 module procedure :: eigen_symm
    +
    3100 module procedure :: eigen_asymm
    +
    3101 module procedure :: eigen_gen
    +
    3102 module procedure :: eigen_cmplx
    +
    3103end interface
    +
    3104
    +
    3105! ------------------------------------------------------------------------------
    +
    3181interface sort
    +
    3182 module procedure :: sort_dbl_array
    +
    3183 module procedure :: sort_dbl_array_ind
    +
    3184 module procedure :: sort_cmplx_array
    +
    3185 module procedure :: sort_cmplx_array_ind
    +
    3186 module procedure :: sort_eigen_cmplx
    +
    3187 module procedure :: sort_eigen_dbl
    +
    3188end interface
    +
    3189
    +
    3190
    +
    3191! ******************************************************************************
    +
    3192! LINALG_BASIC.F90
    +
    3193! ------------------------------------------------------------------------------
    +
    3194interface
    +
    3195 module subroutine mtx_mult_mtx(transa, transb, alpha, a, b, beta, c, err)
    +
    3196 logical, intent(in) :: transa, transb
    +
    3197 real(real64), intent(in) :: alpha, beta
    +
    3198 real(real64), intent(in), dimension(:,:) :: a, b
    +
    3199 real(real64), intent(inout), dimension(:,:) :: c
    +
    3200 class(errors), intent(inout), optional, target :: err
    +
    3201 end subroutine
    +
    3202
    +
    3203 module subroutine mtx_mult_vec(trans, alpha, a, b, beta, c, err)
    +
    3204 logical, intent(in) :: trans
    +
    3205 real(real64), intent(in) :: alpha, beta
    +
    3206 real(real64), intent(in), dimension(:,:) :: a
    +
    3207 real(real64), intent(in), dimension(:) :: b
    +
    3208 real(real64), intent(inout), dimension(:) :: c
    +
    3209 class(errors), intent(inout), optional, target :: err
    +
    3210 end subroutine
    +
    3211
    +
    3212 module subroutine cmtx_mult_mtx(opa, opb, alpha, a, b, beta, c, err)
    +
    3213 integer(int32), intent(in) :: opa, opb
    +
    3214 complex(real64), intent(in) :: alpha, beta
    +
    3215 complex(real64), intent(in), dimension(:,:) :: a, b
    +
    3216 complex(real64), intent(inout), dimension(:,:) :: c
    +
    3217 class(errors), intent(inout), optional, target :: err
    +
    3218 end subroutine
    +
    3219
    +
    3220 module subroutine cmtx_mult_vec(opa, alpha, a, b, beta, c, err)
    +
    3221 integer(int32), intent(in) :: opa
    +
    3222 complex(real64), intent(in) :: alpha, beta
    +
    3223 complex(real64), intent(in), dimension(:,:) :: a
    +
    3224 complex(real64), intent(in), dimension(:) :: b
    +
    3225 complex(real64), intent(inout), dimension(:) :: c
    +
    3226 class(errors), intent(inout), optional, target :: err
    +
    3227 end subroutine
    +
    3228
    +
    3229 module subroutine rank1_update_dbl(alpha, x, y, a, err)
    +
    3230 real(real64), intent(in) :: alpha
    +
    3231 real(real64), intent(in), dimension(:) :: x, y
    +
    3232 real(real64), intent(inout), dimension(:,:) :: a
    +
    3233 class(errors), intent(inout), optional, target :: err
    +
    3234 end subroutine
    +
    3235
    +
    3236 module subroutine rank1_update_cmplx(alpha, x, y, a, err)
    +
    3237 complex(real64), intent(in) :: alpha
    +
    3238 complex(real64), intent(in), dimension(:) :: x, y
    +
    3239 complex(real64), intent(inout), dimension(:,:) :: a
    +
    3240 class(errors), intent(inout), optional, target :: err
    +
    3241 end subroutine
    +
    3242
    +
    3243 module subroutine diag_mtx_mult_mtx(lside, trans, alpha, a, b, beta, c, err)
    +
    3244 logical, intent(in) :: lside, trans
    +
    3245 real(real64) :: alpha, beta
    +
    3246 real(real64), intent(in), dimension(:) :: a
    +
    3247 real(real64), intent(in), dimension(:,:) :: b
    +
    3248 real(real64), intent(inout), dimension(:,:) :: c
    +
    3249 class(errors), intent(inout), optional, target :: err
    +
    3250 end subroutine
    +
    3251
    +
    3252 module subroutine diag_mtx_mult_mtx2(lside, alpha, a, b, err)
    +
    3253 logical, intent(in) :: lside
    +
    3254 real(real64), intent(in) :: alpha
    +
    3255 real(real64), intent(in), dimension(:) :: a
    +
    3256 real(real64), intent(inout), dimension(:,:) :: b
    +
    3257 class(errors), intent(inout), optional, target :: err
    +
    3258 end subroutine
    +
    3259
    +
    3260 module subroutine diag_mtx_mult_mtx3(lside, trans, alpha, a, b, beta, c, err)
    +
    3261 logical, intent(in) :: lside, trans
    +
    3262 real(real64) :: alpha, beta
    +
    3263 complex(real64), intent(in), dimension(:) :: a
    +
    3264 real(real64), intent(in), dimension(:,:) :: b
    +
    3265 complex(real64), intent(inout), dimension(:,:) :: c
    +
    3266 class(errors), intent(inout), optional, target :: err
    +
    3267 end subroutine
    +
    3268
    +
    3269 module subroutine diag_mtx_mult_mtx4(lside, opb, alpha, a, b, beta, c, err)
    +
    3270 logical, intent(in) :: lside
    +
    3271 integer(int32), intent(in) :: opb
    +
    3272 real(real64) :: alpha, beta
    +
    3273 complex(real64), intent(in), dimension(:) :: a
    +
    3274 complex(real64), intent(in), dimension(:,:) :: b
    +
    3275 complex(real64), intent(inout), dimension(:,:) :: c
    +
    3276 class(errors), intent(inout), optional, target :: err
    +
    3277 end subroutine
    +
    3278
    +
    3279 module subroutine diag_mtx_mult_mtx_cmplx(lside, opb, alpha, a, b, beta, c, err)
    +
    3280 logical, intent(in) :: lside
    +
    3281 integer(int32), intent(in) :: opb
    +
    3282 complex(real64) :: alpha, beta
    +
    3283 complex(real64), intent(in), dimension(:) :: a
    +
    3284 complex(real64), intent(in), dimension(:,:) :: b
    +
    3285 complex(real64), intent(inout), dimension(:,:) :: c
    +
    3286 class(errors), intent(inout), optional, target :: err
    +
    3287 end subroutine
    +
    3288
    +
    3289 module subroutine diag_mtx_mult_mtx2_cmplx(lside, alpha, a, b, err)
    +
    3290 logical, intent(in) :: lside
    +
    3291 complex(real64), intent(in) :: alpha
    +
    3292 complex(real64), intent(in), dimension(:) :: a
    +
    3293 complex(real64), intent(inout), dimension(:,:) :: b
    +
    3294 class(errors), intent(inout), optional, target :: err
    +
    3295 end subroutine
    +
    3296
    +
    3297 module subroutine diag_mtx_mult_mtx_mix(lside, opb, alpha, a, b, beta, c, err)
    +
    3298 logical, intent(in) :: lside
    +
    3299 integer(int32), intent(in) :: opb
    +
    3300 complex(real64) :: alpha, beta
    +
    3301 real(real64), intent(in), dimension(:) :: a
    +
    3302 complex(real64), intent(in), dimension(:,:) :: b
    +
    3303 complex(real64), intent(inout), dimension(:,:) :: c
    +
    3304 class(errors), intent(inout), optional, target :: err
    +
    3305 end subroutine
    +
    3306
    +
    3307 module subroutine diag_mtx_mult_mtx2_mix(lside, alpha, a, b, err)
    +
    3308 logical, intent(in) :: lside
    +
    3309 complex(real64), intent(in) :: alpha
    +
    3310 real(real64), intent(in), dimension(:) :: a
    +
    3311 complex(real64), intent(inout), dimension(:,:) :: b
    +
    3312 class(errors), intent(inout), optional, target :: err
    +
    3313 end subroutine
    +
    3314
    +
    3315 pure module function trace_dbl(x) result(y)
    +
    3316 real(real64), intent(in), dimension(:,:) :: x
    +
    3317 real(real64) :: y
    +
    3318 end function
    +
    3319
    +
    3320 pure module function trace_cmplx(x) result(y)
    +
    3321 complex(real64), intent(in), dimension(:,:) :: x
    +
    3322 complex(real64) :: y
    +
    3323 end function
    +
    3324
    +
    3325 module function mtx_rank_dbl(a, tol, work, olwork, err) result(rnk)
    +
    3326 real(real64), intent(inout), dimension(:,:) :: a
    +
    3327 real(real64), intent(in), optional :: tol
    +
    3328 real(real64), intent(out), target, optional, dimension(:) :: work
    +
    3329 integer(int32), intent(out), optional :: olwork
    +
    3330 class(errors), intent(inout), optional, target :: err
    +
    3331 integer(int32) :: rnk
    +
    3332 end function
    +
    3333
    +
    3334 module function mtx_rank_cmplx(a, tol, work, olwork, rwork, err) result(rnk)
    +
    3335 complex(real64), intent(inout), dimension(:,:) :: a
    +
    3336 real(real64), intent(in), optional :: tol
    +
    3337 complex(real64), intent(out), target, optional, dimension(:) :: work
    +
    3338 integer(int32), intent(out), optional :: olwork
    +
    3339 real(real64), intent(out), target, optional, dimension(:) :: rwork
    +
    3340 class(errors), intent(inout), optional, target :: err
    +
    3341 integer(int32) :: rnk
    +
    3342 end function
    +
    3343
    +
    3344 module function det_dbl(a, iwork, err) result(x)
    +
    3345 real(real64), intent(inout), dimension(:,:) :: a
    +
    3346 integer(int32), intent(out), target, optional, dimension(:) :: iwork
    +
    3347 class(errors), intent(inout), optional, target :: err
    +
    3348 real(real64) :: x
    +
    3349 end function
    +
    3350
    +
    3351 module function det_cmplx(a, iwork, err) result(x)
    +
    3352 complex(real64), intent(inout), dimension(:,:) :: a
    +
    3353 integer(int32), intent(out), target, optional, dimension(:) :: iwork
    +
    3354 class(errors), intent(inout), optional, target :: err
    +
    3355 complex(real64) :: x
    +
    3356 end function
    +
    3357
    +
    3358 module subroutine swap_dbl(x, y, err)
    +
    3359 real(real64), intent(inout), dimension(:) :: x, y
    +
    3360 class(errors), intent(inout), optional, target :: err
    +
    3361 end subroutine
    +
    3362
    +
    3363 module subroutine swap_cmplx(x, y, err)
    +
    3364 complex(real64), intent(inout), dimension(:) :: x, y
    +
    3365 class(errors), intent(inout), optional, target :: err
    +
    3366 end subroutine
    +
    3367
    +
    3368 module subroutine recip_mult_array_dbl(a, x)
    +
    3369 real(real64), intent(in) :: a
    +
    3370 real(real64), intent(inout), dimension(:) :: x
    +
    3371 end subroutine
    +
    3372
    +
    3373 module subroutine tri_mtx_mult_dbl(upper, alpha, a, beta, b, err)
    +
    3374 logical, intent(in) :: upper
    +
    3375 real(real64), intent(in) :: alpha, beta
    +
    3376 real(real64), intent(in), dimension(:,:) :: a
    +
    3377 real(real64), intent(inout), dimension(:,:) :: b
    +
    3378 class(errors), intent(inout), optional, target :: err
    +
    3379 end subroutine
    +
    3380
    +
    3381 module subroutine tri_mtx_mult_cmplx(upper, alpha, a, beta, b, err)
    +
    3382 logical, intent(in) :: upper
    +
    3383 complex(real64), intent(in) :: alpha, beta
    +
    3384 complex(real64), intent(in), dimension(:,:) :: a
    +
    3385 complex(real64), intent(inout), dimension(:,:) :: b
    +
    3386 class(errors), intent(inout), optional, target :: err
    +
    3387 end subroutine
    +
    3388
    +
    3389end interface
    +
    3390
    +
    3391! ******************************************************************************
    +
    3392! LINALG_FACTOR.F90
    +
    3393! ------------------------------------------------------------------------------
    +
    3394interface
    +
    3395 module subroutine lu_factor_dbl(a, ipvt, err)
    +
    3396 real(real64), intent(inout), dimension(:,:) :: a
    +
    3397 integer(int32), intent(out), dimension(:) :: ipvt
    +
    3398 class(errors), intent(inout), optional, target :: err
    +
    3399 end subroutine
    +
    3400
    +
    3401 module subroutine lu_factor_cmplx(a, ipvt, err)
    +
    3402 complex(real64), intent(inout), dimension(:,:) :: a
    +
    3403 integer(int32), intent(out), dimension(:) :: ipvt
    +
    3404 class(errors), intent(inout), optional, target :: err
    +
    3405 end subroutine
    +
    3406
    +
    3407 module subroutine form_lu_all(lu, ipvt, u, p, err)
    +
    3408 real(real64), intent(inout), dimension(:,:) :: lu
    +
    3409 integer(int32), intent(in), dimension(:) :: ipvt
    +
    3410 real(real64), intent(out), dimension(:,:) :: u, p
    +
    3411 class(errors), intent(inout), optional, target :: err
    +
    3412 end subroutine
    +
    3413
    +
    3414 module subroutine form_lu_all_cmplx(lu, ipvt, u, p, err)
    +
    3415 complex(real64), intent(inout), dimension(:,:) :: lu
    +
    3416 integer(int32), intent(in), dimension(:) :: ipvt
    +
    3417 complex(real64), intent(out), dimension(:,:) :: u
    +
    3418 real(real64), intent(out), dimension(:,:) :: p
    +
    3419 class(errors), intent(inout), optional, target :: err
    +
    3420 end subroutine
    +
    3421
    +
    3422 module subroutine form_lu_only(lu, u, err)
    +
    3423 real(real64), intent(inout), dimension(:,:) :: lu
    +
    3424 real(real64), intent(out), dimension(:,:) :: u
    +
    3425 class(errors), intent(inout), optional, target :: err
    +
    3426 end subroutine
    +
    3427
    +
    3428 module subroutine form_lu_only_cmplx(lu, u, err)
    +
    3429 complex(real64), intent(inout), dimension(:,:) :: lu
    +
    3430 complex(real64), intent(out), dimension(:,:) :: u
    +
    3431 class(errors), intent(inout), optional, target :: err
    +
    3432 end subroutine
    +
    3433
    +
    3434 module subroutine qr_factor_no_pivot(a, tau, work, olwork, err)
    +
    3435 real(real64), intent(inout), dimension(:,:) :: a
    +
    3436 real(real64), intent(out), dimension(:) :: tau
    +
    3437 real(real64), intent(out), target, dimension(:), optional :: work
    +
    3438 integer(int32), intent(out), optional :: olwork
    +
    3439 class(errors), intent(inout), optional, target :: err
    +
    3440 end subroutine
    +
    3441
    +
    3442 module subroutine qr_factor_no_pivot_cmplx(a, tau, work, olwork, err)
    +
    3443 complex(real64), intent(inout), dimension(:,:) :: a
    +
    3444 complex(real64), intent(out), dimension(:) :: tau
    +
    3445 complex(real64), intent(out), target, dimension(:), optional :: work
    +
    3446 integer(int32), intent(out), optional :: olwork
    +
    3447 class(errors), intent(inout), optional, target :: err
    +
    3448 end subroutine
    +
    3449
    +
    3450 module subroutine qr_factor_pivot(a, tau, jpvt, work, olwork, err)
    +
    3451 real(real64), intent(inout), dimension(:,:) :: a
    +
    3452 real(real64), intent(out), dimension(:) :: tau
    +
    3453 integer(int32), intent(inout), dimension(:) :: jpvt
    +
    3454 real(real64), intent(out), target, dimension(:), optional :: work
    +
    3455 integer(int32), intent(out), optional :: olwork
    +
    3456 class(errors), intent(inout), optional, target :: err
    +
    3457 end subroutine
    +
    3458
    +
    3459 module subroutine qr_factor_pivot_cmplx(a, tau, jpvt, work, olwork, rwork, &
    +
    3460 err)
    +
    3461 complex(real64), intent(inout), dimension(:,:) :: a
    +
    3462 complex(real64), intent(out), dimension(:) :: tau
    +
    3463 integer(int32), intent(inout), dimension(:) :: jpvt
    +
    3464 complex(real64), intent(out), target, dimension(:), optional :: work
    +
    3465 integer(int32), intent(out), optional :: olwork
    +
    3466 real(real64), intent(out), target, dimension(:), optional :: rwork
    +
    3467 class(errors), intent(inout), optional, target :: err
    +
    3468 end subroutine
    +
    3469
    +
    3470 module subroutine form_qr_no_pivot(r, tau, q, work, olwork, err)
    +
    3471 real(real64), intent(inout), dimension(:,:) :: r
    +
    3472 real(real64), intent(in), dimension(:) :: tau
    +
    3473 real(real64), intent(out), dimension(:,:) :: q
    +
    3474 real(real64), intent(out), target, dimension(:), optional :: work
    +
    3475 integer(int32), intent(out), optional :: olwork
    +
    3476 class(errors), intent(inout), optional, target :: err
    +
    3477 end subroutine
    +
    3478
    +
    3479 module subroutine form_qr_no_pivot_cmplx(r, tau, q, work, olwork, err)
    +
    3480 complex(real64), intent(inout), dimension(:,:) :: r
    +
    3481 complex(real64), intent(in), dimension(:) :: tau
    +
    3482 complex(real64), intent(out), dimension(:,:) :: q
    +
    3483 complex(real64), intent(out), target, dimension(:), optional :: work
    +
    3484 integer(int32), intent(out), optional :: olwork
    +
    3485 class(errors), intent(inout), optional, target :: err
    +
    3486 end subroutine
    +
    3487
    +
    3488 module subroutine form_qr_pivot(r, tau, pvt, q, p, work, olwork, err)
    +
    3489 real(real64), intent(inout), dimension(:,:) :: r
    +
    3490 real(real64), intent(in), dimension(:) :: tau
    +
    3491 integer(int32), intent(in), dimension(:) :: pvt
    +
    3492 real(real64), intent(out), dimension(:,:) :: q, p
    +
    3493 real(real64), intent(out), target, dimension(:), optional :: work
    +
    3494 integer(int32), intent(out), optional :: olwork
    +
    3495 class(errors), intent(inout), optional, target :: err
    +
    3496 end subroutine
    +
    3497
    +
    3498 module subroutine form_qr_pivot_cmplx(r, tau, pvt, q, p, work, olwork, err)
    +
    3499 complex(real64), intent(inout), dimension(:,:) :: r
    +
    3500 complex(real64), intent(in), dimension(:) :: tau
    +
    3501 integer(int32), intent(in), dimension(:) :: pvt
    +
    3502 complex(real64), intent(out), dimension(:,:) :: q, p
    +
    3503 complex(real64), intent(out), target, dimension(:), optional :: work
    +
    3504 integer(int32), intent(out), optional :: olwork
    +
    3505 class(errors), intent(inout), optional, target :: err
    +
    3506 end subroutine
    +
    3507
    +
    3508 module subroutine mult_qr_mtx(lside, trans, a, tau, c, work, olwork, err)
    +
    3509 logical, intent(in) :: lside, trans
    +
    3510 real(real64), intent(in), dimension(:) :: tau
    +
    3511 real(real64), intent(inout), dimension(:,:) :: a, c
    +
    3512 real(real64), intent(out), target, dimension(:), optional :: work
    +
    3513 integer(int32), intent(out), optional :: olwork
    +
    3514 class(errors), intent(inout), optional, target :: err
    +
    3515 end subroutine
    +
    3516
    +
    3517 module subroutine mult_qr_mtx_cmplx(lside, trans, a, tau, c, work, olwork, err)
    +
    3518 logical, intent(in) :: lside, trans
    +
    3519 complex(real64), intent(in), dimension(:) :: tau
    +
    3520 complex(real64), intent(inout), dimension(:,:) :: a, c
    +
    3521 complex(real64), intent(out), target, dimension(:), optional :: work
    +
    3522 integer(int32), intent(out), optional :: olwork
    +
    3523 class(errors), intent(inout), optional, target :: err
    +
    3524 end subroutine
    +
    3525
    +
    3526 module subroutine mult_qr_vec(trans, a, tau, c, work, olwork, err)
    +
    3527 logical, intent(in) :: trans
    +
    3528 real(real64), intent(inout), dimension(:,:) :: a
    +
    3529 real(real64), intent(in), dimension(:) :: tau
    +
    3530 real(real64), intent(inout), dimension(:) :: c
    +
    3531 real(real64), intent(out), target, dimension(:), optional :: work
    +
    3532 integer(int32), intent(out), optional :: olwork
    +
    3533 class(errors), intent(inout), optional, target :: err
    +
    3534 end subroutine
    +
    3535
    +
    3536 module subroutine mult_qr_vec_cmplx(trans, a, tau, c, work, olwork, err)
    +
    3537 logical, intent(in) :: trans
    +
    3538 complex(real64), intent(inout), dimension(:,:) :: a
    +
    3539 complex(real64), intent(in), dimension(:) :: tau
    +
    3540 complex(real64), intent(inout), dimension(:) :: c
    +
    3541 complex(real64), intent(out), target, dimension(:), optional :: work
    +
    3542 integer(int32), intent(out), optional :: olwork
    +
    3543 class(errors), intent(inout), optional, target :: err
    +
    3544 end subroutine
    +
    3545
    +
    3546 module subroutine qr_rank1_update_dbl(q, r, u, v, work, err)
    +
    3547 real(real64), intent(inout), dimension(:,:) :: q, r
    +
    3548 real(real64), intent(inout), dimension(:) :: u, v
    +
    3549 real(real64), intent(out), target, optional, dimension(:) :: work
    +
    3550 class(errors), intent(inout), optional, target :: err
    +
    3551 end subroutine
    +
    3552
    +
    3553 module subroutine qr_rank1_update_cmplx(q, r, u, v, work, rwork, err)
    +
    3554 complex(real64), intent(inout), dimension(:,:) :: q, r
    +
    3555 complex(real64), intent(inout), dimension(:) :: u, v
    +
    3556 complex(real64), intent(out), target, optional, dimension(:) :: work
    +
    3557 real(real64), intent(out), target, optional, dimension(:) :: rwork
    +
    3558 class(errors), intent(inout), optional, target :: err
    +
    3559 end subroutine
    +
    3560
    +
    3561 module subroutine cholesky_factor_dbl(a, upper, err)
    +
    3562 real(real64), intent(inout), dimension(:,:) :: a
    +
    3563 logical, intent(in), optional :: upper
    +
    3564 class(errors), intent(inout), optional, target :: err
    +
    3565 end subroutine
    +
    3566
    +
    3567 module subroutine cholesky_factor_cmplx(a, upper, err)
    +
    3568 complex(real64), intent(inout), dimension(:,:) :: a
    +
    3569 logical, intent(in), optional :: upper
    +
    3570 class(errors), intent(inout), optional, target :: err
    +
    3571 end subroutine
    +
    3572
    +
    3573 module subroutine cholesky_rank1_update_dbl(r, u, work, err)
    +
    3574 real(real64), intent(inout), dimension(:,:) :: r
    +
    3575 real(real64), intent(inout), dimension(:) :: u
    +
    3576 real(real64), intent(out), target, optional, dimension(:) :: work
    +
    3577 class(errors), intent(inout), optional, target :: err
    +
    3578 end subroutine
    +
    3579
    +
    3580 module subroutine cholesky_rank1_update_cmplx(r, u, work, err)
    +
    3581 complex(real64), intent(inout), dimension(:,:) :: r
    +
    3582 complex(real64), intent(inout), dimension(:) :: u
    +
    3583 real(real64), intent(out), target, optional, dimension(:) :: work
    +
    3584 class(errors), intent(inout), optional, target :: err
    +
    3585 end subroutine
    +
    3586
    +
    3587 module subroutine cholesky_rank1_downdate_dbl(r, u, work, err)
    +
    3588 real(real64), intent(inout), dimension(:,:) :: r
    +
    3589 real(real64), intent(inout), dimension(:) :: u
    +
    3590 real(real64), intent(out), target, optional, dimension(:) :: work
    +
    3591 class(errors), intent(inout), optional, target :: err
    +
    3592 end subroutine
    +
    3593
    +
    3594 module subroutine cholesky_rank1_downdate_cmplx(r, u, work, err)
    +
    3595 complex(real64), intent(inout), dimension(:,:) :: r
    +
    3596 complex(real64), intent(inout), dimension(:) :: u
    +
    3597 real(real64), intent(out), target, optional, dimension(:) :: work
    +
    3598 class(errors), intent(inout), optional, target :: err
    +
    3599 end subroutine
    +
    3600
    +
    3601 module subroutine rz_factor_dbl(a, tau, work, olwork, err)
    +
    3602 real(real64), intent(inout), dimension(:,:) :: a
    +
    3603 real(real64), intent(out), dimension(:) :: tau
    +
    3604 real(real64), intent(out), target, optional, dimension(:) :: work
    +
    3605 integer(int32), intent(out), optional :: olwork
    +
    3606 class(errors), intent(inout), optional, target :: err
    +
    3607 end subroutine
    +
    3608
    +
    3609 module subroutine rz_factor_cmplx(a, tau, work, olwork, err)
    +
    3610 complex(real64), intent(inout), dimension(:,:) :: a
    +
    3611 complex(real64), intent(out), dimension(:) :: tau
    +
    3612 complex(real64), intent(out), target, optional, dimension(:) :: work
    +
    3613 integer(int32), intent(out), optional :: olwork
    +
    3614 class(errors), intent(inout), optional, target :: err
    +
    3615 end subroutine
    +
    3616
    +
    3617 module subroutine mult_rz_mtx(lside, trans, l, a, tau, c, work, olwork, err)
    +
    3618 logical, intent(in) :: lside, trans
    +
    3619 integer(int32), intent(in) :: l
    +
    3620 real(real64), intent(inout), dimension(:,:) :: a, c
    +
    3621 real(real64), intent(in), dimension(:) :: tau
    +
    3622 real(real64), intent(out), target, optional, dimension(:) :: work
    +
    3623 integer(int32), intent(out), optional :: olwork
    +
    3624 class(errors), intent(inout), optional, target :: err
    +
    3625 end subroutine
    +
    3626
    +
    3627 module subroutine mult_rz_mtx_cmplx(lside, trans, l, a, tau, c, work, olwork, err)
    +
    3628 logical, intent(in) :: lside, trans
    +
    3629 integer(int32), intent(in) :: l
    +
    3630 complex(real64), intent(inout), dimension(:,:) :: a, c
    +
    3631 complex(real64), intent(in), dimension(:) :: tau
    +
    3632 complex(real64), intent(out), target, optional, dimension(:) :: work
    +
    3633 integer(int32), intent(out), optional :: olwork
    +
    3634 class(errors), intent(inout), optional, target :: err
    +
    3635 end subroutine
    +
    3636
    +
    3637 module subroutine mult_rz_vec(trans, l, a, tau, c, work, olwork, err)
    +
    3638 logical, intent(in) :: trans
    +
    3639 integer(int32), intent(in) :: l
    +
    3640 real(real64), intent(inout), dimension(:,:) :: a
    +
    3641 real(real64), intent(in), dimension(:) :: tau
    +
    3642 real(real64), intent(inout), dimension(:) :: c
    +
    3643 real(real64), intent(out), target, optional, dimension(:) :: work
    +
    3644 integer(int32), intent(out), optional :: olwork
    +
    3645 class(errors), intent(inout), optional, target :: err
    +
    3646 end subroutine
    +
    3647
    +
    3648 module subroutine mult_rz_vec_cmplx(trans, l, a, tau, c, work, olwork, err)
    +
    3649 logical, intent(in) :: trans
    +
    3650 integer(int32), intent(in) :: l
    +
    3651 complex(real64), intent(inout), dimension(:,:) :: a
    +
    3652 complex(real64), intent(in), dimension(:) :: tau
    +
    3653 complex(real64), intent(inout), dimension(:) :: c
    +
    3654 complex(real64), intent(out), target, optional, dimension(:) :: work
    +
    3655 integer(int32), intent(out), optional :: olwork
    +
    3656 class(errors), intent(inout), optional, target :: err
    +
    3657 end subroutine
    +
    3658
    +
    3659 module subroutine svd_dbl(a, s, u, vt, work, olwork, err)
    +
    3660 real(real64), intent(inout), dimension(:,:) :: a
    +
    3661 real(real64), intent(out), dimension(:) :: s
    +
    3662 real(real64), intent(out), optional, dimension(:,:) :: u, vt
    +
    3663 real(real64), intent(out), target, optional, dimension(:) :: work
    +
    3664 integer(int32), intent(out), optional :: olwork
    +
    3665 class(errors), intent(inout), optional, target :: err
    +
    3666 end subroutine
    +
    3667
    +
    3668 module subroutine svd_cmplx(a, s, u, vt, work, olwork, rwork, err)
    +
    3669 complex(real64), intent(inout), dimension(:,:) :: a
    +
    3670 real(real64), intent(out), dimension(:) :: s
    +
    3671 complex(real64), intent(out), optional, dimension(:,:) :: u, vt
    +
    3672 complex(real64), intent(out), target, optional, dimension(:) :: work
    +
    3673 integer(int32), intent(out), optional :: olwork
    +
    3674 real(real64), intent(out), target, optional, dimension(:) :: rwork
    +
    3675 class(errors), intent(inout), optional, target :: err
    +
    3676 end subroutine
    +
    3677end interface
    +
    3678
    +
    3679! ******************************************************************************
    +
    3680! LINALG_SOLVE.F90
    +
    3681! ------------------------------------------------------------------------------
    +
    3682interface
    +
    3683 module subroutine solve_tri_mtx(lside, upper, trans, nounit, alpha, a, b, err)
    +
    3684 logical, intent(in) :: lside, upper, trans, nounit
    +
    3685 real(real64), intent(in) :: alpha
    +
    3686 real(real64), intent(in), dimension(:,:) :: a
    +
    3687 real(real64), intent(inout), dimension(:,:) :: b
    +
    3688 class(errors), intent(inout), optional, target :: err
    +
    3689 end subroutine
    +
    3690
    +
    3691 module subroutine solve_tri_mtx_cmplx(lside, upper, trans, nounit, alpha, a, b, err)
    +
    3692 logical, intent(in) :: lside, upper, trans, nounit
    +
    3693 complex(real64), intent(in) :: alpha
    +
    3694 complex(real64), intent(in), dimension(:,:) :: a
    +
    3695 complex(real64), intent(inout), dimension(:,:) :: b
    +
    3696 class(errors), intent(inout), optional, target :: err
    +
    3697 end subroutine
    +
    3698
    +
    3699 module subroutine solve_tri_vec(upper, trans, nounit, a, x, err)
    +
    3700 logical, intent(in) :: upper, trans, nounit
    +
    3701 real(real64), intent(in), dimension(:,:) :: a
    +
    3702 real(real64), intent(inout), dimension(:) :: x
    +
    3703 class(errors), intent(inout), optional, target :: err
    +
    3704 end subroutine
    +
    3705
    +
    3706 module subroutine solve_tri_vec_cmplx(upper, trans, nounit, a, x, err)
    +
    3707 logical, intent(in) :: upper, trans, nounit
    +
    3708 complex(real64), intent(in), dimension(:,:) :: a
    +
    3709 complex(real64), intent(inout), dimension(:) :: x
    +
    3710 class(errors), intent(inout), optional, target :: err
    +
    3711 end subroutine
    +
    3712
    +
    3713 module subroutine solve_lu_mtx(a, ipvt, b, err)
    +
    3714 real(real64), intent(in), dimension(:,:) :: a
    +
    3715 integer(int32), intent(in), dimension(:) :: ipvt
    +
    3716 real(real64), intent(inout), dimension(:,:) :: b
    +
    3717 class(errors), intent(inout), optional, target :: err
    +
    3718 end subroutine
    +
    3719
    +
    3720 module subroutine solve_lu_mtx_cmplx(a, ipvt, b, err)
    +
    3721 complex(real64), intent(in), dimension(:,:) :: a
    +
    3722 integer(int32), intent(in), dimension(:) :: ipvt
    +
    3723 complex(real64), intent(inout), dimension(:,:) :: b
    +
    3724 class(errors), intent(inout), optional, target :: err
    +
    3725 end subroutine
    +
    3726
    +
    3727 module subroutine solve_lu_vec(a, ipvt, b, err)
    +
    3728 real(real64), intent(in), dimension(:,:) :: a
    +
    3729 integer(int32), intent(in), dimension(:) :: ipvt
    +
    3730 real(real64), intent(inout), dimension(:) :: b
    +
    3731 class(errors), intent(inout), optional, target :: err
    +
    3732 end subroutine
    +
    3733
    +
    3734 module subroutine solve_lu_vec_cmplx(a, ipvt, b, err)
    +
    3735 complex(real64), intent(in), dimension(:,:) :: a
    +
    3736 integer(int32), intent(in), dimension(:) :: ipvt
    +
    3737 complex(real64), intent(inout), dimension(:) :: b
    +
    3738 class(errors), intent(inout), optional, target :: err
    +
    3739 end subroutine
    +
    3740
    +
    3741 module subroutine solve_qr_no_pivot_mtx(a, tau, b, work, olwork, err)
    +
    3742 real(real64), intent(inout), dimension(:,:) :: a, b
    +
    3743 real(real64), intent(in), dimension(:) :: tau
    +
    3744 real(real64), intent(out), target, optional, dimension(:) :: work
    +
    3745 integer(int32), intent(out), optional :: olwork
    +
    3746 class(errors), intent(inout), optional, target :: err
    +
    3747 end subroutine
    +
    3748
    +
    3749 module subroutine solve_qr_no_pivot_mtx_cmplx(a, tau, b, work, olwork, err)
    +
    3750 complex(real64), intent(inout), dimension(:,:) :: a, b
    +
    3751 complex(real64), intent(in), dimension(:) :: tau
    +
    3752 complex(real64), intent(out), target, optional, dimension(:) :: work
    +
    3753 integer(int32), intent(out), optional :: olwork
    +
    3754 class(errors), intent(inout), optional, target :: err
    +
    3755 end subroutine
    +
    3756
    +
    3757 module subroutine solve_qr_no_pivot_vec(a, tau, b, work, olwork, err)
    +
    3758 real(real64), intent(inout), dimension(:,:) :: a
    +
    3759 real(real64), intent(in), dimension(:) :: tau
    +
    3760 real(real64), intent(inout), dimension(:) :: b
    +
    3761 real(real64), intent(out), target, optional, dimension(:) :: work
    +
    3762 integer(int32), intent(out), optional :: olwork
    +
    3763 class(errors), intent(inout), optional, target :: err
    +
    3764 end subroutine
    +
    3765
    +
    3766 module subroutine solve_qr_no_pivot_vec_cmplx(a, tau, b, work, olwork, err)
    +
    3767 complex(real64), intent(inout), dimension(:,:) :: a
    +
    3768 complex(real64), intent(in), dimension(:) :: tau
    +
    3769 complex(real64), intent(inout), dimension(:) :: b
    +
    3770 complex(real64), intent(out), target, optional, dimension(:) :: work
    +
    3771 integer(int32), intent(out), optional :: olwork
    +
    3772 class(errors), intent(inout), optional, target :: err
    +
    3773 end subroutine
    +
    3774
    +
    3775 module subroutine solve_qr_pivot_mtx(a, tau, jpvt, b, work, olwork, err)
    +
    3776 real(real64), intent(inout), dimension(:,:) :: a
    +
    3777 real(real64), intent(in), dimension(:) :: tau
    +
    3778 integer(int32), intent(in), dimension(:) :: jpvt
    +
    3779 real(real64), intent(inout), dimension(:,:) :: b
    +
    3780 real(real64), intent(out), target, optional, dimension(:) :: work
    +
    3781 integer(int32), intent(out), optional :: olwork
    +
    3782 class(errors), intent(inout), optional, target :: err
    +
    3783 end subroutine
    +
    3784
    +
    3785 module subroutine solve_qr_pivot_mtx_cmplx(a, tau, jpvt, b, work, olwork, err)
    +
    3786 complex(real64), intent(inout), dimension(:,:) :: a
    +
    3787 complex(real64), intent(in), dimension(:) :: tau
    +
    3788 integer(int32), intent(in), dimension(:) :: jpvt
    +
    3789 complex(real64), intent(inout), dimension(:,:) :: b
    +
    3790 complex(real64), intent(out), target, optional, dimension(:) :: work
    +
    3791 integer(int32), intent(out), optional :: olwork
    +
    3792 class(errors), intent(inout), optional, target :: err
    +
    3793 end subroutine
    +
    3794
    +
    3795 module subroutine solve_qr_pivot_vec(a, tau, jpvt, b, work, olwork, err)
    +
    3796 real(real64), intent(inout), dimension(:,:) :: a
    +
    3797 real(real64), intent(in), dimension(:) :: tau
    +
    3798 integer(int32), intent(in), dimension(:) :: jpvt
    +
    3799 real(real64), intent(inout), dimension(:) :: b
    +
    3800 real(real64), intent(out), target, optional, dimension(:) :: work
    +
    3801 integer(int32), intent(out), optional :: olwork
    +
    3802 class(errors), intent(inout), optional, target :: err
    +
    3803 end subroutine
    +
    3804
    +
    3805 module subroutine solve_qr_pivot_vec_cmplx(a, tau, jpvt, b, work, olwork, err)
    +
    3806 complex(real64), intent(inout), dimension(:,:) :: a
    +
    3807 complex(real64), intent(in), dimension(:) :: tau
    +
    3808 integer(int32), intent(in), dimension(:) :: jpvt
    +
    3809 complex(real64), intent(inout), dimension(:) :: b
    +
    3810 complex(real64), intent(out), target, optional, dimension(:) :: work
    +
    3811 integer(int32), intent(out), optional :: olwork
    +
    3812 class(errors), intent(inout), optional, target :: err
    +
    3813 end subroutine
    +
    3814
    +
    3815 module subroutine solve_cholesky_mtx(upper, a, b, err)
    +
    3816 logical, intent(in) :: upper
    +
    3817 real(real64), intent(in), dimension(:,:) :: a
    +
    3818 real(real64), intent(inout), dimension(:,:) :: b
    +
    3819 class(errors), intent(inout), optional, target :: err
    +
    3820 end subroutine
    +
    3821
    +
    3822 module subroutine solve_cholesky_mtx_cmplx(upper, a, b, err)
    +
    3823 logical, intent(in) :: upper
    +
    3824 complex(real64), intent(in), dimension(:,:) :: a
    +
    3825 complex(real64), intent(inout), dimension(:,:) :: b
    +
    3826 class(errors), intent(inout), optional, target :: err
    +
    3827 end subroutine
    +
    3828
    +
    3829 module subroutine solve_cholesky_vec(upper, a, b, err)
    +
    3830 logical, intent(in) :: upper
    +
    3831 real(real64), intent(in), dimension(:,:) :: a
    +
    3832 real(real64), intent(inout), dimension(:) :: b
    +
    3833 class(errors), intent(inout), optional, target :: err
    +
    3834 end subroutine
    +
    3835
    +
    3836 module subroutine solve_cholesky_vec_cmplx(upper, a, b, err)
    +
    3837 logical, intent(in) :: upper
    +
    3838 complex(real64), intent(in), dimension(:,:) :: a
    +
    3839 complex(real64), intent(inout), dimension(:) :: b
    +
    3840 class(errors), intent(inout), optional, target :: err
    +
    3841 end subroutine
    +
    3842
    +
    3843 module subroutine solve_least_squares_mtx(a, b, work, olwork, err)
    +
    3844 real(real64), intent(inout), dimension(:,:) :: a, b
    +
    3845 real(real64), intent(out), target, optional, dimension(:) :: work
    +
    3846 integer(int32), intent(out), optional :: olwork
    +
    3847 class(errors), intent(inout), optional, target :: err
    +
    3848 end subroutine
    +
    3849
    +
    3850 module subroutine solve_least_squares_mtx_cmplx(a, b, work, olwork, err)
    +
    3851 complex(real64), intent(inout), dimension(:,:) :: a, b
    +
    3852 complex(real64), intent(out), target, optional, dimension(:) :: work
    +
    3853 integer(int32), intent(out), optional :: olwork
    +
    3854 class(errors), intent(inout), optional, target :: err
    +
    3855 end subroutine
    +
    3856
    +
    3857 module subroutine solve_least_squares_vec(a, b, work, olwork, err)
    +
    3858 real(real64), intent(inout), dimension(:,:) :: a
    +
    3859 real(real64), intent(inout), dimension(:) :: b
    +
    3860 real(real64), intent(out), target, optional, dimension(:) :: work
    +
    3861 integer(int32), intent(out), optional :: olwork
    +
    3862 class(errors), intent(inout), optional, target :: err
    +
    3863 end subroutine
    +
    3864
    +
    3865 module subroutine solve_least_squares_vec_cmplx(a, b, work, olwork, err)
    +
    3866 complex(real64), intent(inout), dimension(:,:) :: a
    +
    3867 complex(real64), intent(inout), dimension(:) :: b
    +
    3868 complex(real64), intent(out), target, optional, dimension(:) :: work
    +
    3869 integer(int32), intent(out), optional :: olwork
    +
    3870 class(errors), intent(inout), optional, target :: err
    +
    3871 end subroutine
    +
    3872
    +
    3873 module subroutine solve_least_squares_mtx_pvt(a, b, ipvt, arnk, work, olwork, err)
    +
    3874 real(real64), intent(inout), dimension(:,:) :: a, b
    +
    3875 integer(int32), intent(inout), target, optional, dimension(:) :: ipvt
    +
    3876 integer(int32), intent(out), optional :: arnk
    +
    3877 real(real64), intent(out), target, optional, dimension(:) :: work
    +
    3878 integer(int32), intent(out), optional :: olwork
    +
    3879 class(errors), intent(inout), optional, target :: err
    +
    3880 end subroutine
    +
    3881
    +
    3882 module subroutine solve_least_squares_mtx_pvt_cmplx(a, b, ipvt, arnk, &
    +
    3883 work, olwork, rwork, err)
    +
    3884 complex(real64), intent(inout), dimension(:,:) :: a, b
    +
    3885 integer(int32), intent(inout), target, optional, dimension(:) :: ipvt
    +
    3886 integer(int32), intent(out), optional :: arnk
    +
    3887 complex(real64), intent(out), target, optional, dimension(:) :: work
    +
    3888 integer(int32), intent(out), optional :: olwork
    +
    3889 real(real64), intent(out), target, optional, dimension(:) :: rwork
    +
    3890 class(errors), intent(inout), optional, target :: err
    +
    3891 end subroutine
    +
    3892
    +
    3893 module subroutine solve_least_squares_vec_pvt(a, b, ipvt, arnk, work, olwork, err)
    +
    3894 real(real64), intent(inout), dimension(:,:) :: a
    +
    3895 real(real64), intent(inout), dimension(:) :: b
    +
    3896 integer(int32), intent(inout), target, optional, dimension(:) :: ipvt
    +
    3897 integer(int32), intent(out), optional :: arnk
    +
    3898 real(real64), intent(out), target, optional, dimension(:) :: work
    +
    3899 integer(int32), intent(out), optional :: olwork
    +
    3900 class(errors), intent(inout), optional, target :: err
    +
    3901 end subroutine
    +
    3902
    +
    3903 module subroutine solve_least_squares_vec_pvt_cmplx(a, b, ipvt, arnk, &
    +
    3904 work, olwork, rwork, err)
    +
    3905 complex(real64), intent(inout), dimension(:,:) :: a
    +
    3906 complex(real64), intent(inout), dimension(:) :: b
    +
    3907 integer(int32), intent(inout), target, optional, dimension(:) :: ipvt
    +
    3908 integer(int32), intent(out), optional :: arnk
    +
    3909 complex(real64), intent(out), target, optional, dimension(:) :: work
    +
    3910 integer(int32), intent(out), optional :: olwork
    +
    3911 real(real64), intent(out), target, optional, dimension(:) :: rwork
    +
    3912 class(errors), intent(inout), optional, target :: err
    +
    3913 end subroutine
    +
    3914
    +
    3915 module subroutine solve_least_squares_mtx_svd(a, b, s, arnk, work, olwork, err)
    +
    3916 real(real64), intent(inout), dimension(:,:) :: a, b
    +
    3917 integer(int32), intent(out), optional :: arnk
    +
    3918 real(real64), intent(out), target, optional, dimension(:) :: work, s
    +
    3919 integer(int32), intent(out), optional :: olwork
    +
    3920 class(errors), intent(inout), optional, target :: err
    +
    3921 end subroutine
    +
    3922
    +
    3923 module subroutine solve_least_squares_mtx_svd_cmplx(a, b, s, arnk, work, &
    +
    3924 olwork, rwork, err)
    +
    3925 complex(real64), intent(inout), dimension(:,:) :: a, b
    +
    3926 integer(int32), intent(out), optional :: arnk
    +
    3927 complex(real64), intent(out), target, optional, dimension(:) :: work
    +
    3928 real(real64), intent(out), target, optional, dimension(:) :: rwork, s
    +
    3929 integer(int32), intent(out), optional :: olwork
    +
    3930 class(errors), intent(inout), optional, target :: err
    +
    3931 end subroutine
    +
    3932
    +
    3933 module subroutine solve_least_squares_vec_svd(a, b, s, arnk, work, olwork, err)
    +
    3934 real(real64), intent(inout), dimension(:,:) :: a
    +
    3935 real(real64), intent(inout), dimension(:) :: b
    +
    3936 integer(int32), intent(out), optional :: arnk
    +
    3937 real(real64), intent(out), target, optional, dimension(:) :: work, s
    +
    3938 integer(int32), intent(out), optional :: olwork
    +
    3939 class(errors), intent(inout), optional, target :: err
    +
    3940 end subroutine
    +
    3941
    +
    3942 module subroutine solve_least_squares_vec_svd_cmplx(a, b, s, arnk, work, &
    +
    3943 olwork, rwork, err)
    +
    3944 complex(real64), intent(inout), dimension(:,:) :: a
    +
    3945 complex(real64), intent(inout), dimension(:) :: b
    +
    3946 integer(int32), intent(out), optional :: arnk
    +
    3947 complex(real64), intent(out), target, optional, dimension(:) :: work
    +
    3948 real(real64), intent(out), target, optional, dimension(:) :: rwork, s
    +
    3949 integer(int32), intent(out), optional :: olwork
    +
    3950 class(errors), intent(inout), optional, target :: err
    +
    3951 end subroutine
    +
    3952
    +
    3953 module subroutine mtx_inverse_dbl(a, iwork, work, olwork, err)
    +
    3954 real(real64), intent(inout), dimension(:,:) :: a
    +
    3955 integer(int32), intent(out), target, optional, dimension(:) :: iwork
    +
    3956 real(real64), intent(out), target, optional, dimension(:) :: work
    +
    3957 integer(int32), intent(out), optional :: olwork
    +
    3958 class(errors), intent(inout), optional, target :: err
    +
    3959 end subroutine
    +
    3960
    +
    3961 module subroutine mtx_inverse_cmplx(a, iwork, work, olwork, err)
    +
    3962 complex(real64), intent(inout), dimension(:,:) :: a
    +
    3963 integer(int32), intent(out), target, optional, dimension(:) :: iwork
    +
    3964 complex(real64), intent(out), target, optional, dimension(:) :: work
    +
    3965 integer(int32), intent(out), optional :: olwork
    +
    3966 class(errors), intent(inout), optional, target :: err
    +
    3967 end subroutine
    +
    3968
    +
    3969 module subroutine mtx_pinverse_dbl(a, ainv, tol, work, olwork, err)
    +
    3970 real(real64), intent(inout), dimension(:,:) :: a
    +
    3971 real(real64), intent(out), dimension(:,:) :: ainv
    +
    3972 real(real64), intent(in), optional :: tol
    +
    3973 real(real64), intent(out), target, dimension(:), optional :: work
    +
    3974 integer(int32), intent(out), optional :: olwork
    +
    3975 class(errors), intent(inout), optional, target :: err
    +
    3976 end subroutine
    +
    3977
    +
    3978 module subroutine mtx_pinverse_cmplx(a, ainv, tol, work, olwork, rwork, err)
    +
    3979 complex(real64), intent(inout), dimension(:,:) :: a
    +
    3980 complex(real64), intent(out), dimension(:,:) :: ainv
    +
    3981 real(real64), intent(in), optional :: tol
    +
    3982 complex(real64), intent(out), target, dimension(:), optional :: work
    +
    3983 integer(int32), intent(out), optional :: olwork
    +
    3984 real(real64), intent(out), target, dimension(:), optional :: rwork
    +
    3985 class(errors), intent(inout), optional, target :: err
    +
    3986 end subroutine
    +
    3987
    +
    3988end interface
    +
    3989
    +
    3990! ******************************************************************************
    +
    3991! LINALG_EIGEN.F90
    +
    3992! ------------------------------------------------------------------------------
    +
    3993interface
    +
    3994 module subroutine eigen_symm(vecs, a, vals, work, olwork, err)
    +
    3995 logical, intent(in) :: vecs
    +
    3996 real(real64), intent(inout), dimension(:,:) :: a
    +
    3997 real(real64), intent(out), dimension(:) :: vals
    +
    3998 real(real64), intent(out), pointer, optional, dimension(:) :: work
    +
    3999 integer(int32), intent(out), optional :: olwork
    +
    4000 class(errors), intent(inout), optional, target :: err
    +
    4001 end subroutine
    +
    4002
    +
    4003 module subroutine eigen_asymm(a, vals, vecs, work, olwork, err)
    +
    4004 real(real64), intent(inout), dimension(:,:) :: a
    +
    4005 complex(real64), intent(out), dimension(:) :: vals
    +
    4006 complex(real64), intent(out), optional, dimension(:,:) :: vecs
    +
    4007 real(real64), intent(out), pointer, optional, dimension(:) :: work
    +
    4008 integer(int32), intent(out), optional :: olwork
    +
    4009 class(errors), intent(inout), optional, target :: err
    +
    4010 end subroutine
    +
    4011
    +
    4012 module subroutine eigen_gen(a, b, alpha, beta, vecs, work, olwork, err)
    +
    4013 real(real64), intent(inout), dimension(:,:) :: a, b
    +
    4014 complex(real64), intent(out), dimension(:) :: alpha
    +
    4015 real(real64), intent(out), optional, dimension(:) :: beta
    +
    4016 complex(real64), intent(out), optional, dimension(:,:) :: vecs
    +
    4017 real(real64), intent(out), optional, pointer, dimension(:) :: work
    +
    4018 integer(int32), intent(out), optional :: olwork
    +
    4019 class(errors), intent(inout), optional, target :: err
    +
    4020 end subroutine
    +
    4021
    +
    4022 module subroutine eigen_cmplx(a, vals, vecs, work, olwork, rwork, err)
    +
    4023 complex(real64), intent(inout), dimension(:,:) :: a
    +
    4024 complex(real64), intent(out), dimension(:) :: vals
    +
    4025 complex(real64), intent(out), optional, dimension(:,:) :: vecs
    +
    4026 complex(real64), intent(out), target, optional, dimension(:) :: work
    +
    4027 real(real64), intent(out), target, optional, dimension(:) :: rwork
    +
    4028 integer(int32), intent(out), optional :: olwork
    +
    4029 class(errors), intent(inout), optional, target :: err
    +
    4030 end subroutine
    +
    4031end interface
    +
    4032
    +
    4033! ******************************************************************************
    +
    4034! LINALG_SORTING.F90
    +
    4035! ------------------------------------------------------------------------------
    +
    4036interface
    +
    4037 module subroutine sort_dbl_array(x, ascend)
    +
    4038 real(real64), intent(inout), dimension(:) :: x
    +
    4039 logical, intent(in), optional :: ascend
    +
    4040 end subroutine
    +
    4041
    +
    4042 module subroutine sort_dbl_array_ind(x, ind, ascend, err)
    +
    4043 real(real64), intent(inout), dimension(:) :: x
    +
    4044 integer(int32), intent(inout), dimension(:) :: ind
    +
    4045 logical, intent(in), optional :: ascend
    +
    4046 class(errors), intent(inout), optional, target :: err
    +
    4047 end subroutine
    +
    4048
    +
    4049 module subroutine sort_cmplx_array(x, ascend)
    +
    4050 complex(real64), intent(inout), dimension(:) :: x
    +
    4051 logical, intent(in), optional :: ascend
    +
    4052 end subroutine
    +
    4053
    +
    4054 module subroutine sort_cmplx_array_ind(x, ind, ascend, err)
    +
    4055 complex(real64), intent(inout), dimension(:) :: x
    +
    4056 integer(int32), intent(inout), dimension(:) :: ind
    +
    4057 logical, intent(in), optional :: ascend
    +
    4058 class(errors), intent(inout), optional, target :: err
    +
    4059 end subroutine
    +
    4060
    +
    4061 module subroutine sort_eigen_cmplx(vals, vecs, ascend, err)
    +
    4062 complex(real64), intent(inout), dimension(:) :: vals
    +
    4063 complex(real64), intent(inout), dimension(:,:) :: vecs
    +
    4064 logical, intent(in), optional :: ascend
    +
    4065 class(errors), intent(inout), optional, target :: err
    +
    4066 end subroutine
    +
    4067
    +
    4068 module subroutine sort_eigen_dbl(vals, vecs, ascend, err)
    +
    4069 real(real64), intent(inout), dimension(:) :: vals
    +
    4070 real(real64), intent(inout), dimension(:,:) :: vecs
    +
    4071 logical, intent(in), optional :: ascend
    +
    4072 class(errors), intent(inout), optional, target :: err
    +
    4073 end subroutine
    +
    4074
    +
    4075end interface
    +
    4076
    +
    4077end module
    +
    Computes the Cholesky factorization of a symmetric, positive definite matrix.
    Definition: linalg.f90:1433
    +
    Computes the rank 1 downdate to a Cholesky factored matrix (upper triangular).
    Definition: linalg.f90:1639
    +
    Computes the rank 1 update to a Cholesky factored matrix (upper triangular).
    Definition: linalg.f90:1532
    +
    Computes the determinant of a square matrix.
    Definition: linalg.f90:434
    +
    Multiplies a diagonal matrix with another matrix or array.
    Definition: linalg.f90:329
    +
    Computes the eigenvalues, and optionally the eigenvectors, of a matrix.
    Definition: linalg.f90:3098
    +
    Extracts the L and U matrices from the condensed [L\U] storage format used by the lu_factor.
    Definition: linalg.f90:717
    +
    Forms the full M-by-M orthogonal matrix Q from the elementary reflectors returned by the base QR fact...
    Definition: linalg.f90:1031
    +
    Computes the LU factorization of an M-by-N matrix.
    Definition: linalg.f90:595
    +
    Computes the inverse of a square matrix.
    Definition: linalg.f90:2778
    +
    Performs the matrix operation: .
    Definition: linalg.f90:159
    +
    Computes the Moore-Penrose pseudo-inverse of a M-by-N matrix using the singular value decomposition o...
    Definition: linalg.f90:2884
    +
    Computes the rank of a matrix.
    Definition: linalg.f90:401
    +
    Multiplies a general matrix by the orthogonal matrix Q from a QR factorization.
    Definition: linalg.f90:1185
    +
    Multiplies a general matrix by the orthogonal matrix Z from an RZ factorization.
    Definition: linalg.f90:1803
    +
    Computes the QR factorization of an M-by-N matrix.
    Definition: linalg.f90:871
    +
    Computes the rank 1 update to an M-by-N QR factored matrix A (M >= N) where , and such that .
    Definition: linalg.f90:1334
    +
    Performs the rank-1 update to matrix A such that: , where is an M-by-N matrix, is a scalar,...
    Definition: linalg.f90:194
    +
    Multiplies a vector by the reciprocal of a real scalar.
    Definition: linalg.f90:475
    +
    Factors an upper trapezoidal matrix by means of orthogonal transformations such that ....
    Definition: linalg.f90:1712
    +
    Solves a system of Cholesky factored equations.
    Definition: linalg.f90:2390
    +
    Solves the overdetermined or underdetermined system of M equations of N unknowns,...
    Definition: linalg.f90:2581
    +
    Solves the overdetermined or underdetermined system of M equations of N unknowns using a singular va...
    Definition: linalg.f90:2683
    +
    Solves the overdetermined or underdetermined system of M equations of N unknowns....
    Definition: linalg.f90:2480
    +
    Solves a system of LU-factored equations.
    Definition: linalg.f90:2149
    +
    Solves a system of M QR-factored equations of N unknowns.
    Definition: linalg.f90:2284
    +
    Solves a triangular system of equations.
    Definition: linalg.f90:2061
    +
    Sorts an array.
    Definition: linalg.f90:3181
    +
    Computes the singular value decomposition of a matrix A. The SVD is defined as: , where is an M-by-M...
    Definition: linalg.f90:1927
    +
    Swaps the contents of two arrays.
    Definition: linalg.f90:456
    +
    Computes the trace of a matrix (the sum of the main diagonal elements).
    Definition: linalg.f90:353
    +
    Computes the triangular matrix operation: , or , where A is a triangular matrix.
    Definition: linalg.f90:509
    +
    Provides a set of common linear algebra routines.
    Definition: linalg.f90:15
    +
    +
    + + + + diff --git a/doc/html/linalg_8h_source.html b/doc/html/linalg_8h_source.html index f1651410..ed277c34 100644 --- a/doc/html/linalg_8h_source.html +++ b/doc/html/linalg_8h_source.html @@ -122,247 +122,186 @@
    20extern "C" {
    21#endif
    22
    -
    41int la_rank1_update(int m, int n, double alpha, const double *x,
    +
    41int la_rank1_update(int m, int n, double alpha, const double *x,
    42 const double *y, double *a, int lda);
    43
    -
    62int la_rank1_update_cmplx(int m, int n, double complex alpha,
    +
    62int la_rank1_update_cmplx(int m, int n, double complex alpha,
    63 const double complex *x, const double complex *y, double complex *a,
    64 int lda);
    65
    -
    80int la_trace(int m, int n, const double *a, int lda, double *rst);
    +
    80int la_trace(int m, int n, const double *a, int lda, double *rst);
    81
    -
    96int la_trace_cmplx(int m, int n, const double complex *a, int lda,
    +
    96int la_trace_cmplx(int m, int n, const double complex *a, int lda,
    97 double complex *rst);
    98
    -
    125int la_mtx_mult(bool transa, bool transb, int m, int n, int k, double alpha,
    +
    125int la_mtx_mult(bool transa, bool transb, int m, int n, int k, double alpha,
    126 const double *a, int lda, const double *b, int ldb, double beta,
    127 double *c, int ldc);
    128
    -
    157int la_mtx_mult_cmplx(int opa, int opb, int m, int n, int k,
    +
    157int la_mtx_mult_cmplx(int opa, int opb, int m, int n, int k,
    158 double complex alpha, const double complex *a, int lda,
    159 const double complex *b, int ldb, double complex beta, double complex *c,
    160 int ldc);
    161
    -
    195int la_diag_mtx_mult(bool lside, bool transb, int m, int n, int k,
    +
    195int la_diag_mtx_mult(bool lside, bool transb, int m, int n, int k,
    196 double alpha, const double *a, const double *b, int ldb, double beta,
    197 double *c, int ldc);
    198
    -
    233int la_diag_mtx_mult_cmplx(bool lside, int opb, int m, int n, int k,
    +
    233int la_diag_mtx_mult_cmplx(bool lside, int opb, int m, int n, int k,
    234 double complex alpha, const double complex *a, const double complex *b,
    235 int ldb, double complex beta, double complex *c, int ldc);
    236
    -
    271int la_diag_mtx_mult_mixed(bool lside, int opb, int m, int n, int k,
    +
    271int la_diag_mtx_mult_mixed(bool lside, int opb, int m, int n, int k,
    272 double complex alpha, const double *a, const double complex *b,
    273 int ldb, double complex beta, double complex *c, int ldc);
    274
    -
    293int la_rank(int m, int n, double *a, int lda, int *rnk);
    +
    293int la_rank(int m, int n, double *a, int lda, int *rnk);
    294
    -
    313int la_rank_cmplx(int m, int n, double complex *a, int lda, int *rnk);
    +
    313int la_rank_cmplx(int m, int n, double complex *a, int lda, int *rnk);
    314
    -
    330int la_det(int n, double *a, int lda, double *d);
    +
    330int la_det(int n, double *a, int lda, double *d);
    331
    -
    347int la_det_cmplx(int n, double complex *a, int lda, double complex *d);
    +
    347int la_det_cmplx(int n, double complex *a, int lda, double complex *d);
    348
    -
    374int la_tri_mtx_mult(bool upper, double alpha, int n, const double *a, int lda,
    +
    374int la_tri_mtx_mult(bool upper, double alpha, int n, const double *a, int lda,
    375 double beta, double *b, int ldb);
    376
    -
    402int la_tri_mtx_mult_cmplx(bool upper, double complex alpha, int n,
    +
    402int la_tri_mtx_mult_cmplx(bool upper, double complex alpha, int n,
    403 const double complex *a, int lda, double complex beta,
    404 double complex *b, int ldb);
    405
    -
    425int la_lu_factor(int m, int n, double *a, int lda, int *ipvt);
    +
    425int la_lu_factor(int m, int n, double *a, int lda, int *ipvt);
    426
    -
    446int la_lu_factor_cmplx(int m, int n, double complex *a, int lda, int *ipvt);
    +
    446int la_lu_factor_cmplx(int m, int n, double complex *a, int lda, int *ipvt);
    447
    -
    469int la_form_lu(int n, double *a, int lda, int *ipvt, double *u, int ldu,
    +
    469int la_form_lu(int n, double *a, int lda, int *ipvt, double *u, int ldu,
    470 double *p, int ldp);
    471
    -
    493int la_form_lu_cmplx(int n, double complex *a, int lda, int *ipvt,
    +
    493int la_form_lu_cmplx(int n, double complex *a, int lda, int *ipvt,
    494 double complex *u, int ldu, double *p, int ldp);
    495
    -
    517int la_qr_factor(int m, int n, double *a, int lda, double *tau);
    +
    517int la_qr_factor(int m, int n, double *a, int lda, double *tau);
    518
    -
    540int la_qr_factor_cmplx(int m, int n, double complex *a, int lda,
    +
    540int la_qr_factor_cmplx(int m, int n, double complex *a, int lda,
    541 double complex *tau);
    542
    -
    567int la_qr_factor_pvt(int m, int n, double *a, int lda, double *tau, int *jpvt);
    +
    567int la_qr_factor_pvt(int m, int n, double *a, int lda, double *tau, int *jpvt);
    568
    -
    593int la_qr_factor_cmplx_pvt(int m, int n, double complex *a, int lda,
    +
    593int la_qr_factor_cmplx_pvt(int m, int n, double complex *a, int lda,
    594 double complex *tau, int *jpvt);
    595
    -
    622int la_form_qr(bool fullq, int m, int n, double *r, int ldr, const double *tau,
    +
    622int la_form_qr(bool fullq, int m, int n, double *r, int ldr, const double *tau,
    623 double *q, int ldq);
    624
    -
    651int la_form_qr_cmplx(bool fullq, int m, int n, double complex *r, int ldr,
    +
    651int la_form_qr_cmplx(bool fullq, int m, int n, double complex *r, int ldr,
    652 const double complex *tau, double complex *q, int ldq);
    653
    -
    686int la_form_qr_pvt(bool fullq, int m, int n, double *r, int ldr,
    +
    686int la_form_qr_pvt(bool fullq, int m, int n, double *r, int ldr,
    687 const double *tau, const int *pvt, double *q, int ldq, double *p, int ldp);
    688
    -
    721int la_form_qr_cmplx_pvt(bool fullq, int m, int n, double complex *r, int ldr,
    +
    721int la_form_qr_cmplx_pvt(bool fullq, int m, int n, double complex *r, int ldr,
    722 const double complex *tau, const int *pvt, double complex *q, int ldq,
    723 double complex *p, int ldp);
    724
    -
    754int la_mult_qr(bool lside, bool trans, int m, int n, int k, double *a, int lda,
    +
    754int la_mult_qr(bool lside, bool trans, int m, int n, int k, double *a, int lda,
    755 const double *tau, double *c, int ldc);
    756
    -
    786int la_mult_qr_cmplx(bool lside, bool trans, int m, int n, int k,
    +
    786int la_mult_qr_cmplx(bool lside, bool trans, int m, int n, int k,
    787 double complex *a, int lda, const double complex *tau, double complex *c,
    788 int ldc);
    789
    -
    813int la_qr_rank1_update(int m, int n, double *q, int ldq, double *r, int ldr,
    +
    813int la_qr_rank1_update(int m, int n, double *q, int ldq, double *r, int ldr,
    814 double *u, double *v);
    815
    -
    839int la_qr_rank1_update_cmplx(int m, int n, double complex *q, int ldq,
    +
    839int la_qr_rank1_update_cmplx(int m, int n, double complex *q, int ldq,
    840 double complex *r, int ldr, double complex *u, double complex *v);
    841
    -
    860int la_cholesky_factor(bool upper, int n, double *a, int lda);
    +
    860int la_cholesky_factor(bool upper, int n, double *a, int lda);
    861
    -
    880int la_cholesky_factor_cmplx(bool upper, int n, double complex *a, int lda);
    +
    880int la_cholesky_factor_cmplx(bool upper, int n, double complex *a, int lda);
    881
    -
    899int la_cholesky_rank1_update(int n, double *r, int ldr, double *u);
    +
    899int la_cholesky_rank1_update(int n, double *r, int ldr, double *u);
    900
    -
    918int la_cholesky_rank1_update_cmplx(int n, double complex *r, int ldr,
    +
    918int la_cholesky_rank1_update_cmplx(int n, double complex *r, int ldr,
    919 double complex *u);
    920
    -
    940int la_cholesky_rank1_downdate(int n, double *r, int ldr, double *u);
    +
    940int la_cholesky_rank1_downdate(int n, double *r, int ldr, double *u);
    941
    -
    961int la_cholesky_rank1_downdate_cmplx(int n, double complex *r, int ldr,
    +
    961int la_cholesky_rank1_downdate_cmplx(int n, double complex *r, int ldr,
    962 double complex *u);
    963
    -
    993int la_svd(int m, int n, double *a, int lda, double *s, double *u, int ldu,
    +
    993int la_svd(int m, int n, double *a, int lda, double *s, double *u, int ldu,
    994 double *vt, int ldv);
    995
    -
    1025int la_svd_cmplx(int m, int n, double complex *a, int lda, double *s,
    +
    1025int la_svd_cmplx(int m, int n, double complex *a, int lda, double *s,
    1026 double complex *u, int ldu, double complex *vt, int ldv);
    1027
    -
    1056int la_solve_tri_mtx(bool lside, bool upper, bool trans, bool nounit, int m,
    +
    1056int la_solve_tri_mtx(bool lside, bool upper, bool trans, bool nounit, int m,
    1057 int n, double alpha, const double *a, int lda, double *b, int ldb);
    1058
    -
    1087int la_solve_tri_mtx_cmplx(bool lside, bool upper, bool trans, bool nounit,
    +
    1087int la_solve_tri_mtx_cmplx(bool lside, bool upper, bool trans, bool nounit,
    1088 int m, int n, double complex alpha, const double complex *a, int lda,
    1089 double complex *b, int ldb);
    1090
    -
    1107int la_solve_lu(int m, int n, const double *a, int lda, const int *ipvt,
    +
    1107int la_solve_lu(int m, int n, const double *a, int lda, const int *ipvt,
    1108 double *b, int ldb);
    1109
    -
    1126int la_solve_lu_cmplx(int m, int n, const double complex *a, int lda,
    +
    1126int la_solve_lu_cmplx(int m, int n, const double complex *a, int lda,
    1127 const int *ipvt, double complex *b, int ldb);
    1128
    -
    1152int la_solve_qr(int m, int n, int k, double *a, int lda, const double *tau,
    +
    1152int la_solve_qr(int m, int n, int k, double *a, int lda, const double *tau,
    1153 double *b, int ldb);
    1154
    -
    1178int la_solve_qr_cmplx(int m, int n, int k, double complex *a, int lda,
    +
    1178int la_solve_qr_cmplx(int m, int n, int k, double complex *a, int lda,
    1179 const double complex *tau, double complex *b, int ldb);
    1180
    -
    1204int la_solve_qr_pvt(int m, int n, int k, double *a, int lda, const double *tau,
    +
    1204int la_solve_qr_pvt(int m, int n, int k, double *a, int lda, const double *tau,
    1205 const int *jpvt, double *b, int ldb);
    1206
    -
    1230int la_solve_qr_cmplx_pvt(int m, int n, int k, double complex *a, int lda,
    +
    1230int la_solve_qr_cmplx_pvt(int m, int n, int k, double complex *a, int lda,
    1231 const double complex *tau, const int *jpvt, double complex *b, int ldb);
    1232
    -
    1251int la_solve_cholesky(bool upper, int m, int n, const double *a, int lda,
    +
    1251int la_solve_cholesky(bool upper, int m, int n, const double *a, int lda,
    1252 double *b, int ldb);
    1253
    -
    1272int la_solve_cholesky_cmplx(bool upper, int m, int n, const double complex *a,
    +
    1272int la_solve_cholesky_cmplx(bool upper, int m, int n, const double complex *a,
    1273 int lda, double complex *b, int ldb);
    1274
    -
    1300int la_solve_least_squares(int m, int n, int k, double *a, int lda, double *b,
    +
    1300int la_solve_least_squares(int m, int n, int k, double *a, int lda, double *b,
    1301 int ldb);
    1302
    -
    1328int la_solve_least_squares_cmplx(int m, int n, int k, double complex *a,
    +
    1328int la_solve_least_squares_cmplx(int m, int n, int k, double complex *a,
    1329 int lda, double complex *b, int ldb);
    1330
    -
    1344int la_inverse(int n, double *a, int lda);
    +
    1344int la_inverse(int n, double *a, int lda);
    1345
    -
    1359int la_inverse_cmplx(int n, double complex *a, int lda);
    +
    1359int la_inverse_cmplx(int n, double complex *a, int lda);
    1360
    -
    1378int la_pinverse(int m, int n, double *a, int lda, double *ainv, int ldai);
    +
    1378int la_pinverse(int m, int n, double *a, int lda, double *ainv, int ldai);
    1379
    -
    1397int la_pinverse_cmplx(int m, int n, double complex *a, int lda,
    +
    1397int la_pinverse_cmplx(int m, int n, double complex *a, int lda,
    1398 double complex *ainv, int ldai);
    1399
    -
    1423int la_eigen_symm(bool vecs, int n, double *a, int lda, double *vals);
    +
    1423int la_eigen_symm(bool vecs, int n, double *a, int lda, double *vals);
    1424
    -
    1447int la_eigen_asymm(bool vecs, int n, double *a, int lda,
    +
    1447int la_eigen_asymm(bool vecs, int n, double *a, int lda,
    1448 double complex *vals, double complex *v, int ldv);
    1449
    -
    1482int la_eigen_gen(bool vecs, int n, double *a, int lda, double *b, int ldb,
    +
    1482int la_eigen_gen(bool vecs, int n, double *a, int lda, double *b, int ldb,
    1483 double complex *alpha, double *beta, double complex *v, int ldv);
    1484
    -
    1507int la_eigen_cmplx(bool vecs, int n, double complex *a, int lda,
    +
    1507int la_eigen_cmplx(bool vecs, int n, double complex *a, int lda,
    1508 double complex *vals, double complex *v, int ldv);
    1509
    -
    1529int la_sort_eigen(bool ascend, int n, double *vals, double *vecs, int ldv);
    +
    1529int la_sort_eigen(bool ascend, int n, double *vals, double *vecs, int ldv);
    1530
    -
    1550int la_sort_eigen_cmplx(bool ascend, int n, double complex *vals,
    +
    1550int la_sort_eigen_cmplx(bool ascend, int n, double complex *vals,
    1551 double complex *vecs, int ldv);
    1552
    1553#ifdef __cplusplus
    1554}
    1555#endif // __cplusplus
    1556#endif // LINALG_H_
    -
    integer(c_int) function la_qr_rank1_update_cmplx(m, n, q, ldq, r, ldr, u, v)
    Computes the rank 1 update to an M-by-N QR factored matrix A (M >= N) where A = Q * R,...
    -
    integer(c_int) function la_qr_rank1_update(m, n, q, ldq, r, ldr, u, v)
    Computes the rank 1 update to an M-by-N QR factored matrix A (M >= N) where A = Q * R,...
    -
    integer(c_int) function la_solve_qr_pvt(m, n, k, a, lda, tau, jpvt, b, ldb)
    Solves a system of M QR-factored equations of N unknowns.
    -
    integer(c_int) function la_qr_factor_cmplx(m, n, a, lda, tau)
    Computes the QR factorization of an M-by-N matrix without pivoting.
    -
    integer(c_int) function la_solve_qr(m, n, k, a, lda, tau, b, ldb)
    Solves a system of M QR-factored equations of N unknowns where M >= N.
    -
    integer(c_int) function la_lu_factor_cmplx(m, n, a, lda, ipvt)
    Computes the LU factorization of an M-by-N matrix.
    -
    integer(c_int) function la_solve_qr_cmplx_pvt(m, n, k, a, lda, tau, jpvt, b, ldb)
    Solves a system of M QR-factored equations of N unknowns.
    -
    integer(c_int) function la_diag_mtx_mult_cmplx(lside, opb, m, n, k, alpha, a, b, ldb, beta, c, ldc)
    Computes the matrix operation: C = alpha * A * op(B) + beta * C, or C = alpha * op(B) * A + beta * C.
    -
    integer(c_int) function la_mult_qr(lside, trans, m, n, k, a, lda, tau, c, ldc)
    Multiplies a general matrix by the orthogonal matrix Q from a QR factorization such that: C = op(Q) *...
    -
    integer(c_int) function la_sort_eigen_cmplx(ascend, n, vals, vecs, ldv)
    A sorting routine specifically tailored for sorting of eigenvalues and their associated eigenvectors ...
    -
    integer(c_int) function la_solve_least_squares_cmplx(m, n, k, a, lda, b, ldb)
    Solves the overdetermined or underdetermined system (A*X = B) of M equations of N unknowns using a QR...
    -
    integer(c_int) function la_qr_factor(m, n, a, lda, tau)
    Computes the QR factorization of an M-by-N matrix without pivoting.
    -
    integer(c_int) function la_inverse(n, a, lda)
    Computes the inverse of a square matrix.
    -
    integer(c_int) function la_trace_cmplx(m, n, a, lda, rst)
    Computes the trace of a matrix (the sum of the main diagonal elements).
    -
    integer(c_int) function la_cholesky_rank1_downdate_cmplx(n, r, ldr, u)
    Computes the rank 1 downdate to a Cholesky factored matrix (upper triangular).
    -
    integer(c_int) function la_rank(m, n, a, lda, rnk)
    Computes the rank of a matrix.
    -
    integer(c_int) function la_pinverse(m, n, a, lda, ainv, ldai)
    Computes the Moore-Penrose pseudo-inverse of an M-by-N matrix by means of singular value decompositio...
    -
    integer(c_int) function la_lu_factor(m, n, a, lda, ipvt)
    Computes the LU factorization of an M-by-N matrix.
    -
    integer(c_int) function la_mtx_mult(transa, transb, m, n, k, alpha, a, lda, b, ldb, beta, c, ldc)
    Computes the matrix operation C = alpha * op(A) * op(B) + beta * C.
    -
    integer(c_int) function la_svd(m, n, a, lda, s, u, ldu, vt, ldv)
    Computes the singular value decomposition of a matrix A. The SVD is defined as: A = U * S * V**T,...
    -
    integer(c_int) function la_svd_cmplx(m, n, a, lda, s, u, ldu, vt, ldv)
    Computes the singular value decomposition of a matrix A. The SVD is defined as: A = U * S * V**T,...
    -
    integer(c_int) function la_mult_qr_cmplx(lside, trans, m, n, k, a, lda, tau, c, ldc)
    Multiplies a general matrix by the orthogonal matrix Q from a QR factorization such that: C = op(Q) *...
    -
    integer(c_int) function la_form_qr_cmplx_pvt(fullq, m, n, r, ldr, tau, pvt, q, ldq, p, ldp)
    Forms the full M-by-M orthogonal matrix Q from the elementary reflectors returned by the base QR fact...
    -
    integer(c_int) function la_cholesky_rank1_update_cmplx(n, r, ldr, u)
    Computes the rank 1 update to a Cholesky factored matrix (upper triangular).
    -
    integer(c_int) function la_cholesky_rank1_downdate(n, r, ldr, u)
    Computes the rank 1 downdate to a Cholesky factored matrix (upper triangular).
    -
    integer(c_int) function la_rank_cmplx(m, n, a, lda, rnk)
    Computes the rank of a matrix.
    -
    integer(c_int) function la_eigen_symm(vecs, n, a, lda, vals)
    Computes the eigenvalues, and optionally the eigenvectors of a real, symmetric matrix.
    -
    integer(c_int) function la_form_qr_pvt(fullq, m, n, r, ldr, tau, pvt, q, ldq, p, ldp)
    Forms the full M-by-M orthogonal matrix Q from the elementary reflectors returned by the base QR fact...
    -
    integer(c_int) function la_rank1_update(m, n, alpha, x, y, a, lda)
    Performs the rank-1 update to matrix A such that: A = alpha * X * Y**T + A, where A is an M-by-N matr...
    -
    integer(c_int) function la_inverse_cmplx(n, a, lda)
    Computes the inverse of a square matrix.
    -
    integer(c_int) function la_tri_mtx_mult(upper, alpha, n, a, lda, beta, b, ldb)
    Computes the triangular matrix operation: B = alpha * A**T * A + beta * B, or B = alpha * A * A**T + ...
    -
    integer(c_int) function la_solve_tri_mtx(lside, upper, trans, nounit, m, n, alpha, a, lda, b, ldb)
    Solves one of the matrix equations: op(A) * X = alpha * B, or X * op(A) = alpha * B,...
    -
    integer(c_int) function la_solve_tri_mtx_cmplx(lside, upper, trans, nounit, m, n, alpha, a, lda, b, ldb)
    Solves one of the matrix equations: op(A) * X = alpha * B, or X * op(A) = alpha * B,...
    -
    integer(c_int) function la_cholesky_factor_cmplx(upper, n, a, lda)
    Computes the Cholesky factorization of a symmetric, positive definite matrix.
    -
    integer(c_int) function la_det_cmplx(n, a, lda, d)
    Computes the determinant of a square matrix.
    -
    integer(c_int) function la_solve_cholesky_cmplx(upper, m, n, a, lda, b, ldb)
    Solves a system of Cholesky factored equations.
    -
    integer(c_int) function la_solve_lu(m, n, a, lda, ipvt, b, ldb)
    Solves a system of LU-factored equations.
    -
    integer(c_int) function la_eigen_gen(vecs, n, a, lda, b, ldb, alpha, beta, v, ldv)
    Computes the eigenvalues, and optionally the right eigenvectors of a square matrix assuming the struc...
    -
    integer(c_int) function la_form_qr(fullq, m, n, r, ldr, tau, q, ldq)
    Forms the full M-by-M orthogonal matrix Q from the elementary reflectors returned by the base QR fact...
    -
    integer(c_int) function la_qr_factor_pvt(m, n, a, lda, tau, jpvt)
    Computes the QR factorization of an M-by-N matrix with column pivoting.
    -
    integer(c_int) function la_cholesky_factor(upper, n, a, lda)
    Computes the Cholesky factorization of a symmetric, positive definite matrix.
    -
    integer(c_int) function la_form_qr_cmplx(fullq, m, n, r, ldr, tau, q, ldq)
    Forms the full M-by-M orthogonal matrix Q from the elementary reflectors returned by the base QR fact...
    -
    integer(c_int) function la_qr_factor_cmplx_pvt(m, n, a, lda, tau, jpvt)
    Computes the QR factorization of an M-by-N matrix with column pivoting.
    -
    integer(c_int) function la_solve_lu_cmplx(m, n, a, lda, ipvt, b, ldb)
    Solves a system of LU-factored equations.
    -
    integer(c_int) function la_eigen_cmplx(vecs, n, a, lda, vals, v, ldv)
    Computes the eigenvalues, and optionally the right eigenvectors of a square matrix.
    -
    integer(c_int) function la_sort_eigen(ascend, n, vals, vecs, ldv)
    A sorting routine specifically tailored for sorting of eigenvalues and their associated eigenvectors ...
    -
    integer(c_int) function la_mtx_mult_cmplx(opa, opb, m, n, k, alpha, a, lda, b, ldb, beta, c, ldc)
    Computes the matrix operation C = alpha * op(A) * op(B) + beta * C.
    -
    integer(c_int) function la_solve_cholesky(upper, m, n, a, lda, b, ldb)
    Solves a system of Cholesky factored equations.
    -
    integer(c_int) function la_rank1_update_cmplx(m, n, alpha, x, y, a, lda)
    Performs the rank-1 update to matrix A such that: A = alpha * X * Y**T + A, where A is an M-by-N matr...
    -
    integer(c_int) function la_solve_qr_cmplx(m, n, k, a, lda, tau, b, ldb)
    Solves a system of M QR-factored equations of N unknowns where M >= N.
    -
    integer(c_int) function la_pinverse_cmplx(m, n, a, lda, ainv, ldai)
    Computes the Moore-Penrose pseudo-inverse of an M-by-N matrix by means of singular value decompositio...
    -
    integer(c_int) function la_diag_mtx_mult_mixed(lside, opb, m, n, k, alpha, a, b, ldb, beta, c, ldc)
    Computes the matrix operation: C = alpha * A * op(B) + beta * C, or C = alpha * op(B) * A + beta * C.
    -
    integer(c_int) function la_cholesky_rank1_update(n, r, ldr, u)
    Computes the rank 1 update to a Cholesky factored matrix (upper triangular).
    -
    integer(c_int) function la_diag_mtx_mult(lside, transb, m, n, k, alpha, a, b, ldb, beta, c, ldc)
    Computes the matrix operation: C = alpha * A * op(B) + beta * C, or C = alpha * op(B) * A + beta * C.
    -
    integer(c_int) function la_form_lu_cmplx(n, a, lda, ipvt, u, ldu, p, ldp)
    Extracts the L, U, and P matrices from the LU factorization output from la_lu_factor.
    -
    integer(c_int) function la_form_lu(n, a, lda, ipvt, u, ldu, p, ldp)
    Extracts the L, U, and P matrices from the LU factorization output from la_lu_factor.
    -
    integer(c_int) function la_tri_mtx_mult_cmplx(upper, alpha, n, a, lda, beta, b, ldb)
    Computes the triangular matrix operation: B = alpha * A**T * A + beta * B, or B = alpha * A * A**T + ...
    -
    integer(c_int) function la_solve_least_squares(m, n, k, a, lda, b, ldb)
    Solves the overdetermined or underdetermined system (A*X = B) of M equations of N unknowns using a QR...
    -
    integer(c_int) function la_eigen_asymm(vecs, n, a, lda, vals, v, ldv)
    Computes the eigenvalues, and optionally the right eigenvectors of a square matrix.
    -
    integer(c_int) function la_trace(m, n, a, lda, rst)
    Computes the trace of a matrix (the sum of the main diagonal elements).
    -
    integer(c_int) function la_det(n, a, lda, d)
    Computes the determinant of a square matrix.
    diff --git a/doc/html/linalg__basic_8f90_source.html b/doc/html/linalg__basic_8f90_source.html index dd2ba0be..710e7651 100644 --- a/doc/html/linalg__basic_8f90_source.html +++ b/doc/html/linalg__basic_8f90_source.html @@ -102,7 +102,7 @@
    1! linalg_basic.f90
    2
    -
    3submodule(linalg_core) linalg_basic
    +
    3submodule(linalg) linalg_basic
    4contains
    5! ******************************************************************************
    6! MATRIX MULTIPLICATION ROUTINES
    @@ -259,11 +259,11 @@
    157 ! Initialization
    158 m = size(c, 1)
    159 n = size(c, 2)
    -
    160 if (opa == transpose) then ! K = # of columns in op(A) (# of rows in op(B))
    +
    160 if (opa == la_transpose) then ! K = # of columns in op(A) (# of rows in op(B))
    161 k = size(a, 1)
    162 ta = 'T'
    163 lda = k
    -
    164 else if (opa == hermitian_transpose) then
    +
    164 else if (opa == la_hermitian_transpose) then
    165 k = size(a, 1)
    166 ta = 'H'
    167 lda = k
    @@ -272,10 +272,10 @@
    170 ta = 'N'
    171 lda = m
    172 end if
    -
    173 if (opb == transpose) then
    +
    173 if (opb == la_transpose) then
    174 tb = 'T'
    175 ldb = n
    -
    176 else if (opb == hermitian_transpose) then
    +
    176 else if (opb == la_hermitian_transpose) then
    177 tb = 'H'
    178 ldb = n
    179 else
    @@ -290,12 +290,12 @@
    188
    189 ! Input Check
    190 flag = 0
    -
    191 if (opa == transpose .or. opa == hermitian_transpose) then
    +
    191 if (opa == la_transpose .or. opa == la_hermitian_transpose) then
    192 if (size(a, 2) /= m) flag = 4
    193 else
    194 if (size(a, 1) /= m) flag = 4
    195 end if
    -
    196 if (opb == transpose .or. opb == hermitian_transpose) then
    +
    196 if (opb == la_transpose .or. opb == la_hermitian_transpose) then
    197 if (size(b, 2) /= k .or. size(b, 1) /= n) flag = 5
    198 else
    199 if (size(b, 1) /= k .or. size(b, 2) /= n) flag = 5
    @@ -334,9 +334,9 @@
    232 ! Initialization
    233 m = size(a, 1)
    234 n = size(a, 2)
    -
    235 if (opa == transpose) then
    +
    235 if (opa == la_transpose) then
    236 t = 'T'
    -
    237 else if (opa == hermitian_transpose) then
    +
    237 else if (opa == la_hermitian_transpose) then
    238 t = 'H'
    239 else
    240 t = 'N'
    @@ -349,7 +349,7 @@
    247
    248 ! Input Check
    249 flag = 0
    -
    250 if (opa == transpose .or. opa == hermitian_transpose) then
    +
    250 if (opa == la_transpose .or. opa == la_hermitian_transpose) then
    251 if (size(b) /= m) then
    252 flag = 4
    253 else if (size(c) /= n) then
    @@ -862,7 +862,7 @@
    760 if (k > m) then
    761 flag = 4
    762 else
    -
    763 if (opb == transpose .or. opb == hermitian_transpose) then
    +
    763 if (opb == la_transpose .or. opb == la_hermitian_transpose) then
    764 ! Compute C = alpha * A * B**T + beta * C
    765 if (nrowb /= n .or. ncolb < k) flag = 5
    766 else
    @@ -874,7 +874,7 @@
    772 if (k > n) then
    773 flag = 4
    774 else
    -
    775 if (opb == transpose .or. opb == hermitian_transpose) then
    +
    775 if (opb == la_transpose .or. opb == la_hermitian_transpose) then
    776 ! Compute C = alpha * B**T * A + beta * C
    777 if (ncolb /= m .or. nrowb < k) flag = 5
    778 else
    @@ -904,7 +904,7 @@
    802
    803 ! Process
    804 if (lside) then
    -
    805 if (opb == transpose) then
    +
    805 if (opb == la_transpose) then
    806 ! Compute C = alpha * A * B**T + beta * C
    807 do i = 1, k
    808 if (beta == zero) then
    @@ -915,7 +915,7 @@
    813 temp = alpha * a(i)
    814 if (temp /= one) c(i,:) = c(i,:) + temp * b(:,i)
    815 end do
    -
    816 else if (opb == hermitian_transpose) then
    +
    816 else if (opb == la_hermitian_transpose) then
    817 ! Compute C = alpha * A * B**H + beta * C
    818 do i = 1, k
    819 if (beta == zero) then
    @@ -948,7 +948,7 @@
    846 end if
    847 end if
    848 else
    -
    849 if (opb == transpose) then
    +
    849 if (opb == la_transpose) then
    850 ! Compute C = alpha * B**T * A + beta * C
    851 do i = 1, k
    852 if (beta == zero) then
    @@ -959,7 +959,7 @@
    857 temp = alpha * a(i)
    858 if (temp /= one) c(:,i) = c(:,i) + temp * b(i,:)
    859 end do
    -
    860 else if (opb == hermitian_transpose) then
    +
    860 else if (opb == la_hermitian_transpose) then
    861 ! Compute C = alpha * B**H * A + beta * C
    862 do i = 1, k
    863 if (beta == zero) then
    @@ -1034,7 +1034,7 @@
    932 if (k > m) then
    933 flag = 4
    934 else
    -
    935 if (opb == transpose .or. opb == hermitian_transpose) then
    +
    935 if (opb == la_transpose .or. opb == la_hermitian_transpose) then
    936 ! Compute C = alpha * A * B**T + beta * C
    937 if (nrowb /= n .or. ncolb < k) flag = 5
    938 else
    @@ -1046,7 +1046,7 @@
    944 if (k > n) then
    945 flag = 4
    946 else
    -
    947 if (opb == transpose .or. opb == hermitian_transpose) then
    +
    947 if (opb == la_transpose .or. opb == la_hermitian_transpose) then
    948 ! Compute C = alpha * B**T * A + beta * C
    949 if (ncolb /= m .or. nrowb < k) flag = 5
    950 else
    @@ -1076,7 +1076,7 @@
    974
    975 ! Process
    976 if (lside) then
    -
    977 if (opb == transpose) then
    +
    977 if (opb == la_transpose) then
    978 ! Compute C = alpha * A * B**T + beta * C
    979 do i = 1, k
    980 if (beta == zero) then
    @@ -1087,7 +1087,7 @@
    985 temp = alpha * a(i)
    986 if (temp /= one) c(i,:) = c(i,:) + temp * b(:,i)
    987 end do
    -
    988 else if (opb == hermitian_transpose) then
    +
    988 else if (opb == la_hermitian_transpose) then
    989 ! Compute C = alpha * A * B**H + beta * C
    990 do i = 1, k
    991 if (beta == zero) then
    @@ -1120,7 +1120,7 @@
    1018 end if
    1019 end if
    1020 else
    -
    1021 if (opb == transpose) then
    +
    1021 if (opb == la_transpose) then
    1022 ! Compute C = alpha * B**T * A + beta * C
    1023 do i = 1, k
    1024 if (beta == zero) then
    @@ -1131,7 +1131,7 @@
    1029 temp = alpha * a(i)
    1030 if (temp /= one) c(:,i) = c(:,i) + temp * b(i,:)
    1031 end do
    -
    1032 else if (opb == hermitian_transpose) then
    +
    1032 else if (opb == la_hermitian_transpose) then
    1033 ! Compute C = alpha * B**H * A + beta * C
    1034 do i = 1, k
    1035 if (beta == zero) then
    @@ -1262,7 +1262,7 @@
    1160 if (k > m) then
    1161 flag = 4
    1162 else
    -
    1163 if (opb == transpose .or. opb == hermitian_transpose) then
    +
    1163 if (opb == la_transpose .or. opb == la_hermitian_transpose) then
    1164 ! Compute C = alpha * A * B**T + beta * C
    1165 if (nrowb /= n .or. ncolb < k) flag = 5
    1166 else
    @@ -1274,7 +1274,7 @@
    1172 if (k > n) then
    1173 flag = 4
    1174 else
    -
    1175 if (opb == transpose .or. opb == hermitian_transpose) then
    +
    1175 if (opb == la_transpose .or. opb == la_hermitian_transpose) then
    1176 ! Compute C = alpha * B**T * A + beta * C
    1177 if (ncolb /= m .or. nrowb < k) flag = 5
    1178 else
    @@ -1304,7 +1304,7 @@
    1202
    1203 ! Process
    1204 if (lside) then
    -
    1205 if (opb == transpose) then
    +
    1205 if (opb == la_transpose) then
    1206 ! Compute C = alpha * A * B**T + beta * C
    1207 do i = 1, k
    1208 if (beta == zero) then
    @@ -1315,7 +1315,7 @@
    1213 temp = alpha * a(i)
    1214 if (temp /= one) c(i,:) = c(i,:) + temp * b(:,i)
    1215 end do
    -
    1216 else if (opb == hermitian_transpose) then
    +
    1216 else if (opb == la_hermitian_transpose) then
    1217 ! Compute C = alpha * A * B**H + beta * C
    1218 do i = 1, k
    1219 if (beta == zero) then
    @@ -1348,7 +1348,7 @@
    1246 end if
    1247 end if
    1248 else
    -
    1249 if (opb == transpose) then
    +
    1249 if (opb == la_transpose) then
    1250 ! Compute C = alpha * B**T * A + beta * C
    1251 do i = 1, k
    1252 if (beta == zero) then
    @@ -1359,7 +1359,7 @@
    1257 temp = alpha * a(i)
    1258 if (temp /= one) c(:,i) = c(:,i) + temp * b(i,:)
    1259 end do
    -
    1260 else if (opb == hermitian_transpose) then
    +
    1260 else if (opb == la_hermitian_transpose) then
    1261 ! Compute C = alpha * B**H * A + beta * C
    1262 do i = 1, k
    1263 if (beta == zero) then
    @@ -2281,7 +2281,7 @@
    2179
    2180! ------------------------------------------------------------------------------
    2181end submodule
    -
    Provides a set of common linear algebra routines.
    Definition: linalg_core.f90:15
    +
    Provides a set of common linear algebra routines.
    Definition: linalg.f90:15
    diff --git a/doc/html/linalg__c__api_8f90_source.html b/doc/html/linalg__c__api_8f90_source.html index 44e6604f..86f7aa77 100644 --- a/doc/html/linalg__c__api_8f90_source.html +++ b/doc/html/linalg__c__api_8f90_source.html @@ -104,1952 +104,1950 @@
    2
    6 use iso_c_binding
    - - -
    9 use ferror
    -
    10 implicit none
    -
    11
    -
    12contains
    -
    13! ------------------------------------------------------------------------------
    -
    30 function la_rank1_update(m, n, alpha, x, y, a, lda) &
    -
    31 bind(C, name = "la_rank1_update") result(flag)
    -
    32 ! Arguments
    -
    33 integer(c_int), intent(in), value :: m, n, lda
    -
    34 real(c_double), intent(in), value :: alpha
    -
    35 real(c_double), intent(in) :: x(*), y(*)
    -
    36 real(c_double), intent(inout) :: a(lda,*)
    -
    37 integer(c_int) :: flag
    -
    38
    -
    39 ! Initialization
    -
    40 flag = la_no_error
    -
    41
    -
    42 ! Input Checking
    -
    43 if (lda < m) then
    -
    44 flag = la_invalid_input_error
    -
    45 return
    -
    46 end if
    -
    47
    -
    48 ! Process
    -
    49 call rank1_update(alpha, x(1:m), y(1:n), a(1:m,1:n))
    -
    50 end function
    -
    51
    -
    52! ------------------------------------------------------------------------------
    -
    69 function la_rank1_update_cmplx(m, n, alpha, x, y, a, lda) &
    -
    70 bind(C, name = "la_rank1_update_cmplx") result(flag)
    -
    71 ! Arguments
    -
    72 integer(c_int), intent(in), value :: m, n, lda
    -
    73 complex(c_double), intent(in), value :: alpha
    -
    74 complex(c_double), intent(in) :: x(*), y(*)
    -
    75 complex(c_double), intent(inout) :: a(lda,*)
    -
    76 integer(c_int) :: flag
    -
    77
    -
    78 ! Initialization
    -
    79 flag = la_no_error
    -
    80
    -
    81 ! Input Checking
    -
    82 if (lda < m) then
    -
    83 flag = la_invalid_input_error
    -
    84 return
    -
    85 end if
    -
    86
    -
    87 ! Process
    -
    88 call rank1_update(alpha, x(1:m), y(1:n), a(1:m,1:n))
    -
    89 end function
    -
    90
    -
    91! ------------------------------------------------------------------------------
    -
    104 function la_trace(m, n, a, lda, rst) bind(C, name = "la_trace") &
    -
    105 result(flag)
    -
    106 ! Arguments
    -
    107 integer(c_int), intent(in), value :: m, n, lda
    -
    108 real(c_double), intent(in) :: a(lda,*)
    -
    109 real(c_double), intent(out) :: rst
    -
    110 integer(c_int) :: flag
    -
    111
    -
    112 ! Initialization
    -
    113 flag = la_no_error
    -
    114
    -
    115 ! Input Checking
    -
    116 if (lda < m) then
    -
    117 flag = la_invalid_input_error
    -
    118 return
    -
    119 end if
    -
    120
    -
    121 ! Process
    -
    122 rst = trace(a(1:m,1:n))
    -
    123 end function
    -
    124
    -
    125! ------------------------------------------------------------------------------
    -
    138 function la_trace_cmplx(m, n, a, lda, rst) &
    -
    139 bind(C, name = "la_trace_cmplx") result(flag)
    -
    140 ! Arguments
    -
    141 integer(c_int), intent(in), value :: m, n, lda
    -
    142 complex(c_double), intent(in) :: a(lda,*)
    -
    143 complex(c_double), intent(out) :: rst
    -
    144 integer(c_int) :: flag
    -
    145
    -
    146 ! Initialization
    -
    147 flag = la_no_error
    -
    148
    -
    149 ! Input Checking
    -
    150 if (lda < m) then
    -
    151 flag = la_invalid_input_error
    -
    152 return
    -
    153 end if
    -
    154
    -
    155 ! Process
    -
    156 rst = trace(a(1:m,1:n))
    -
    157 end function
    -
    158
    -
    159! ------------------------------------------------------------------------------
    -
    184 function la_mtx_mult(transa, transb, m, n, k, alpha, a, lda, b, ldb, &
    -
    185 beta, c, ldc) bind(C, name="la_mtx_mult") result(flag)
    -
    186 ! Arugments
    -
    187 logical(c_bool), intent(in), value :: transa, transb
    -
    188 integer(c_int), intent(in), value :: m, n, k, lda, ldb, ldc
    -
    189 real(c_double), intent(in), value :: alpha, beta
    -
    190 real(c_double), intent(in) :: a(lda,*), b(ldb,*)
    -
    191 real(c_double), intent(inout) :: c(ldc,*)
    -
    192 integer(c_int) :: flag
    -
    193
    -
    194 ! Local Variables
    -
    195 character :: ta, tb
    -
    196 integer(c_int) :: nrowa, nrowb
    -
    197
    -
    198 ! Initialization
    -
    199 flag = la_no_error
    -
    200 ta = "N"
    -
    201 if (transa) ta = "T"
    -
    202
    -
    203 tb = "N"
    -
    204 if (transb) tb = "T"
    -
    205
    -
    206 if (transa) then
    -
    207 nrowa = k
    -
    208 else
    -
    209 nrowa = m
    -
    210 end if
    -
    211
    -
    212 if (transb) then
    -
    213 nrowb = n
    -
    214 else
    -
    215 nrowb = k
    -
    216 end if
    -
    217
    -
    218 ! Input Checking
    -
    219 if (lda < nrowa .or. ldb < nrowb .or. ldc < m) then
    -
    220 flag = la_invalid_input_error
    -
    221 return
    -
    222 end if
    -
    223
    -
    224 ! Call DGEMM directly
    -
    225 call dgemm(ta, tb, m, n, k, alpha, a, lda, b, ldb, beta, c, ldc)
    -
    226 end function
    -
    227
    -
    228! ------------------------------------------------------------------------------
    -
    255 function la_mtx_mult_cmplx(opa, opb, m, n, k, alpha, a, lda, b, ldb, &
    -
    256 beta, c, ldc) bind(C, name="la_mtx_mult_cmplx") result(flag)
    -
    257 ! Arguments
    -
    258 integer(c_int), intent(in), value :: opa, opb, m, n, k, lda, ldb, ldc
    -
    259 complex(c_double), intent(in), value :: alpha, beta
    -
    260 complex(c_double), intent(in) :: a(lda,*), b(ldb,*)
    -
    261 complex(c_double), intent(inout) :: c(ldc,*)
    -
    262 integer(c_int) :: flag
    -
    263
    -
    264 ! Local Variables
    -
    265 character :: ta, tb
    -
    266 integer(c_int) :: nrowa, nrowb
    -
    267
    -
    268 ! Initialization
    -
    269 flag = la_no_error
    -
    270 if (opa == transpose) then
    -
    271 ta = "T"
    -
    272 else if (opa == hermitian_transpose) then
    -
    273 ta = "H"
    -
    274 else
    -
    275 ta = "N"
    -
    276 end if
    -
    277
    -
    278 if (opb == transpose) then
    -
    279 tb = "T"
    -
    280 else if (opb == hermitian_transpose) then
    -
    281 tb = "H"
    -
    282 else
    -
    283 tb = "N"
    -
    284 end if
    -
    285
    -
    286 if (opa == transpose .or. opa == hermitian_transpose) then
    -
    287 nrowa = k
    -
    288 else
    -
    289 nrowa = m
    -
    290 end if
    -
    291
    -
    292 if (opb == transpose .or. opb == hermitian_transpose) then
    -
    293 nrowb = n
    -
    294 else
    -
    295 nrowb = k
    -
    296 end if
    -
    297
    -
    298 ! Input Checking
    -
    299 if (lda < nrowa .or. ldb < nrowb .or. ldc < m) then
    -
    300 flag = la_invalid_input_error
    -
    301 return
    -
    302 end if
    -
    303
    -
    304 ! Call ZGEMM directly
    -
    305 call zgemm(ta, tb, m, n, k, alpha, a, lda, b, ldb, beta, c, ldc)
    -
    306 end function
    -
    307
    -
    308! ------------------------------------------------------------------------------
    -
    340 function la_diag_mtx_mult(lside, transb, m, n, k, alpha, a, b, ldb, &
    -
    341 beta, c, ldc) bind(C, name="la_diag_mtx_mult") result(flag)
    -
    342 ! Arguments
    -
    343 logical(c_bool), intent(in), value :: lside, transb
    -
    344 integer(c_int), intent(in), value :: m, n, k, ldb, ldc
    -
    345 real(c_double), intent(in), value :: alpha, beta
    -
    346 real(c_double), intent(in) :: a(*), b(ldb,*)
    -
    347 real(c_double), intent(inout) :: c(ldc,*)
    -
    348 integer(c_int) :: flag
    -
    349
    -
    350 ! Local Variabes
    -
    351 integer(c_int) :: nrows, ncols, p
    -
    352 logical :: ls, tb
    -
    353 type(errors) :: err
    -
    354
    -
    355 ! Initialization
    -
    356 call err%set_exit_on_error(.false.)
    -
    357 flag = la_no_error
    -
    358 if (lside .and. transb) then
    -
    359 nrows = n
    -
    360 ncols = k
    -
    361 p = min(k, m)
    -
    362 ls = .true.
    -
    363 tb = .true.
    -
    364 else if (lside .and. .not. transb) then
    -
    365 nrows = k
    -
    366 ncols = n
    -
    367 p = min(k, m)
    -
    368 ls = .true.
    -
    369 tb = .false.
    -
    370 else if (.not. lside .and. transb) then
    -
    371 nrows = k
    -
    372 ncols = m
    -
    373 p = min(k, n)
    -
    374 ls = .false.
    -
    375 tb = .true.
    -
    376 else
    -
    377 nrows = m
    -
    378 ncols = k
    -
    379 p = min(k, n)
    -
    380 ls = .false.
    -
    381 tb = .false.
    -
    382 end if
    -
    383
    -
    384 ! Error Checking
    -
    385 if (ldb < nrows .or. ldc < m) then
    -
    386 flag = la_invalid_input_error
    -
    387 return
    -
    388 end if
    -
    389
    -
    390 ! Process
    -
    391 call diag_mtx_mult(ls, tb, alpha, a(1:p), b(1:nrows,1:ncols), &
    -
    392 beta, c(1:m,1:n), err)
    -
    393 if (err%has_error_occurred()) flag = err%get_error_flag()
    -
    394 end function
    -
    395
    -
    396! ------------------------------------------------------------------------------
    -
    429 function la_diag_mtx_mult_mixed(lside, opb, m, n, k, alpha, a, b, ldb, &
    -
    430 beta, c, ldc) bind(C, name = "la_diag_mtx_mult_mixed") result(flag)
    -
    431 ! Arguments
    -
    432 logical(c_bool), intent(in), value :: lside
    -
    433 integer(c_int), intent(in), value :: opb, m, n, k, ldb, ldc
    -
    434 complex(c_double), intent(in), value :: alpha, beta
    -
    435 real(c_double), intent(in) :: a(*)
    -
    436 complex(c_double), intent(in) :: b(ldb,*)
    -
    437 complex(c_double), intent(inout) :: c(ldc,*)
    -
    438 integer(c_int) :: flag
    -
    439
    -
    440 ! Local Variabes
    -
    441 integer(c_int) :: nrows, ncols, p
    -
    442 logical :: ls, tb
    -
    443 type(errors) :: err
    -
    444
    -
    445 ! Initialization
    -
    446 call err%set_exit_on_error(.false.)
    -
    447 flag = la_no_error
    -
    448 tb = .false.
    -
    449 if (opb == transpose .or. opb == hermitian_transpose) tb = .true.
    -
    450 if (lside .and. tb) then
    -
    451 nrows = n
    -
    452 ncols = k
    -
    453 p = min(k, m)
    -
    454 ls = .true.
    -
    455 else if (lside .and. .not. tb) then
    -
    456 nrows = k
    -
    457 ncols = n
    -
    458 p = min(k, m)
    -
    459 ls = .true.
    -
    460 else if (.not. lside .and. tb) then
    -
    461 nrows = k
    -
    462 ncols = m
    -
    463 p = min(k, n)
    -
    464 ls = .false.
    -
    465 else
    -
    466 nrows = m
    -
    467 ncols = k
    -
    468 p = min(k, n)
    -
    469 ls = .false.
    -
    470 end if
    -
    471
    -
    472 ! Error Checking
    -
    473 if (ldb < nrows .or. ldc < m) then
    -
    474 flag = la_invalid_input_error
    -
    475 return
    -
    476 end if
    -
    477
    -
    478 ! Process
    -
    479 call diag_mtx_mult(ls, opb, alpha, a(1:p), b(1:nrows,1:ncols), &
    -
    480 beta, c(1:m,1:n))
    -
    481 if (err%has_error_occurred()) flag = err%get_error_flag()
    -
    482 end function
    -
    483
    -
    484! ------------------------------------------------------------------------------
    -
    517 function la_diag_mtx_mult_cmplx(lside, opb, m, n, k, alpha, a, b, &
    -
    518 ldb, beta, c, ldc) bind(C, name="la_diag_mtx_mult_cmplx") &
    -
    519 result(flag)
    -
    520 ! Arguments
    -
    521 logical(c_bool), intent(in), value :: lside
    -
    522 integer(c_int), intent(in), value :: opb, m, n, k, ldb, ldc
    -
    523 complex(c_double), intent(in), value :: alpha, beta
    -
    524 complex(c_double), intent(in) :: a(*), b(ldb,*)
    -
    525 complex(c_double), intent(inout) :: c(ldc,*)
    -
    526 integer(c_int) :: flag
    -
    527
    -
    528 ! Local Variabes
    -
    529 integer(c_int) :: nrows, ncols, p
    -
    530 logical :: ls, tb
    -
    531 type(errors) :: err
    -
    532
    -
    533 ! Initialization
    -
    534 call err%set_exit_on_error(.false.)
    -
    535 flag = la_no_error
    -
    536 tb = .false.
    -
    537 if (opb == transpose .or. opb == hermitian_transpose) tb = .true.
    -
    538 if (lside .and. tb) then
    -
    539 nrows = n
    -
    540 ncols = k
    -
    541 p = min(k, m)
    -
    542 ls = .true.
    -
    543 else if (lside .and. .not. tb) then
    -
    544 nrows = k
    -
    545 ncols = n
    -
    546 p = min(k, m)
    -
    547 ls = .true.
    -
    548 else if (.not. lside .and. tb) then
    -
    549 nrows = k
    -
    550 ncols = m
    -
    551 p = min(k, n)
    -
    552 ls = .false.
    -
    553 else
    -
    554 nrows = m
    -
    555 ncols = k
    -
    556 p = min(k, n)
    -
    557 ls = .false.
    -
    558 end if
    -
    559
    -
    560 ! Error Checking
    -
    561 if (ldb < nrows .or. ldc < m) then
    -
    562 flag = la_invalid_input_error
    -
    563 return
    -
    564 end if
    -
    565
    -
    566 ! Process
    -
    567 call diag_mtx_mult(ls, opb, alpha, a(1:p), b(1:nrows,1:ncols), &
    -
    568 beta, c(1:m,1:n))
    -
    569 if (err%has_error_occurred()) flag = err%get_error_flag()
    -
    570 end function
    -
    571
    -
    572! ------------------------------------------------------------------------------
    -
    589 function la_rank(m, n, a, lda, rnk) bind(C, name="la_rank") result(flag)
    -
    590 ! Arguments
    -
    591 integer(c_int), intent(in), value :: m, n, lda
    -
    592 real(c_double), intent(inout) :: a(lda,*)
    -
    593 integer(c_int), intent(out) :: rnk
    -
    594 integer(c_int) :: flag
    -
    595
    -
    596 ! Local Variables
    -
    597 type(errors) :: err
    -
    598
    -
    599 ! Input Check
    -
    600 call err%set_exit_on_error(.false.)
    -
    601 flag = la_no_error
    -
    602 if (lda < m) then
    -
    603 flag = la_invalid_input_error
    -
    604 return
    -
    605 end if
    -
    606
    -
    607 ! Process
    -
    608 rnk = mtx_rank(a(1:m,1:n), err =err)
    -
    609 if (err%has_error_occurred()) flag = err%get_error_flag()
    -
    610 end function
    -
    611
    -
    612! ------------------------------------------------------------------------------
    -
    629 function la_rank_cmplx(m, n, a, lda, rnk) bind(C, name="la_rank_cmplx") &
    -
    630 result(flag)
    -
    631 ! Arguments
    -
    632 integer(c_int), intent(in), value :: m, n, lda
    -
    633 complex(c_double), intent(inout) :: a(lda,*)
    -
    634 integer(c_int), intent(out) :: rnk
    -
    635 integer(c_int) :: flag
    -
    636
    -
    637 ! Local Variables
    -
    638 type(errors) :: err
    -
    639
    -
    640 ! Input Check
    -
    641 call err%set_exit_on_error(.false.)
    -
    642 flag = la_no_error
    -
    643 if (lda < m) then
    -
    644 flag = la_invalid_input_error
    -
    645 return
    -
    646 end if
    -
    647
    -
    648 ! Process
    -
    649 rnk = mtx_rank(a(1:m,1:n), err = err)
    -
    650 if (err%has_error_occurred()) flag = err%get_error_flag()
    -
    651 end function
    -
    652
    -
    653! ------------------------------------------------------------------------------
    -
    667 function la_det(n, a, lda, d) bind(C, name="la_det") result(flag)
    -
    668 ! Arguments
    -
    669 integer(c_int), intent(in), value :: n, lda
    -
    670 real(c_double), intent(inout) :: a(lda,*)
    -
    671 real(c_double), intent(out) :: d
    -
    672 integer(c_int) :: flag
    -
    673
    -
    674 ! Local Variables
    -
    675 type(errors) :: err
    -
    676
    -
    677 ! Error Checking
    -
    678 call err%set_exit_on_error(.false.)
    -
    679 flag = la_no_error
    -
    680 if (lda < n) then
    -
    681 flag = la_invalid_input_error
    -
    682 return
    -
    683 end if
    -
    684
    -
    685 ! Process
    -
    686 d = det(a(1:n,1:n), err = err)
    -
    687 if (err%has_error_occurred()) flag = err%get_error_flag()
    -
    688 end function
    -
    689
    -
    690! ------------------------------------------------------------------------------
    -
    704 function la_det_cmplx(n, a, lda, d) bind(C, name="la_det_cmplx") result(flag)
    -
    705 ! Arguments
    -
    706 integer(c_int), intent(in), value :: n, lda
    -
    707 complex(c_double), intent(inout) :: a(lda,*)
    -
    708 complex(c_double), intent(out) :: d
    -
    709 integer(c_int) :: flag
    -
    710
    -
    711 ! Local Variables
    -
    712 type(errors) :: err
    -
    713
    -
    714 ! Error Checking
    -
    715 call err%set_exit_on_error(.false.)
    -
    716 flag = la_no_error
    -
    717 if (lda < n) then
    -
    718 flag = la_invalid_input_error
    -
    719 return
    -
    720 end if
    -
    721
    -
    722 ! Process
    -
    723 d = det(a(1:n,1:n), err = err)
    -
    724 if (err%has_error_occurred()) flag = err%get_error_flag()
    -
    725 end function
    -
    726
    -
    727! ------------------------------------------------------------------------------
    -
    751 function la_tri_mtx_mult(upper, alpha, n, a, lda, beta, b, ldb) &
    -
    752 bind(C, name = "la_tri_mtx_mult") result(flag)
    -
    753 ! Arguments
    -
    754 logical(c_bool), intent(in), value :: upper
    -
    755 integer(c_int), intent(in), value :: n, lda, ldb
    -
    756 real(c_double), intent(in), value :: alpha, beta
    -
    757 real(c_double), intent(in) :: a(lda,*)
    -
    758 real(c_double), intent(inout) :: b(ldb,*)
    -
    759 integer(c_int) :: flag
    -
    760
    -
    761 ! Error Checking
    -
    762 flag = la_no_error
    -
    763 if (lda < n .or. ldb < n) then
    -
    764 flag = la_invalid_input_error
    -
    765 return
    -
    766 end if
    -
    767
    -
    768 ! Process
    -
    769 call tri_mtx_mult(logical(upper), alpha, a(1:n,1:n), beta, b(1:n,1:n))
    -
    770 end function
    -
    771
    -
    772! ------------------------------------------------------------------------------
    -
    796 function la_tri_mtx_mult_cmplx(upper, alpha, n, a, lda, beta, b, ldb) &
    -
    797 bind(C, name = "la_tri_mtx_mult_cmplx") result(flag)
    -
    798 ! Arguments
    -
    799 logical(c_bool), intent(in), value :: upper
    -
    800 integer(c_int), intent(in), value :: n, lda, ldb
    -
    801 complex(c_double), intent(in), value :: alpha, beta
    -
    802 complex(c_double), intent(in) :: a(lda,*)
    -
    803 complex(c_double), intent(inout) :: b(ldb,*)
    -
    804 integer(c_int) :: flag
    -
    805
    -
    806 ! Error Checking
    -
    807 flag = la_no_error
    -
    808 if (lda < n .or. ldb < n) then
    -
    809 flag = la_invalid_input_error
    -
    810 return
    -
    811 end if
    -
    812
    -
    813 ! Process
    -
    814 call tri_mtx_mult(logical(upper), alpha, a(1:n,1:n), beta, b(1:n,1:n))
    -
    815 end function
    -
    816
    -
    817! ------------------------------------------------------------------------------
    -
    835 function la_lu_factor(m, n, a, lda, ipvt) bind(C, name = "la_lu_factor") &
    -
    836 result(flag)
    -
    837 ! Arguments
    -
    838 integer(c_int), intent(in), value :: m, n, lda
    -
    839 real(c_double), intent(inout) :: a(lda,*)
    -
    840 integer(c_int), intent(out) :: ipvt(*)
    -
    841 integer(c_int) :: flag
    -
    842
    -
    843 ! Local Variables
    -
    844 type(errors) :: err
    -
    845 integer(c_int) :: mn
    -
    846
    -
    847 ! Error Checking
    -
    848 call err%set_exit_on_error(.false.)
    -
    849 flag = la_no_error
    -
    850 if (lda < m) then
    -
    851 flag = la_invalid_input_error
    -
    852 return
    -
    853 end if
    -
    854
    -
    855 ! Process
    -
    856 mn = min(m, n)
    -
    857 call lu_factor(a(1:m,1:n), ipvt(1:mn), err)
    -
    858 if (err%has_error_occurred()) then
    -
    859 flag = err%get_error_flag()
    -
    860 return
    -
    861 end if
    -
    862 end function
    -
    863
    -
    864! ------------------------------------------------------------------------------
    -
    882 function la_lu_factor_cmplx(m, n, a, lda, ipvt) &
    -
    883 bind(C, name = "la_lu_factor_cmplx") result(flag)
    -
    884 ! Arguments
    -
    885 integer(c_int), intent(in), value :: m, n, lda
    -
    886 complex(c_double), intent(inout) :: a(lda,*)
    -
    887 integer(c_int), intent(out) :: ipvt(*)
    -
    888 integer(c_int) :: flag
    -
    889
    -
    890 ! Local Variables
    -
    891 type(errors) :: err
    -
    892 integer(c_int) :: mn
    -
    893
    -
    894 ! Error Checking
    -
    895 call err%set_exit_on_error(.false.)
    -
    896 flag = la_no_error
    -
    897 if (lda < m) then
    -
    898 flag = la_invalid_input_error
    -
    899 return
    -
    900 end if
    -
    901
    -
    902 ! Process
    -
    903 mn = min(m, n)
    -
    904 call lu_factor(a(1:m,1:n), ipvt(1:mn), err)
    -
    905 if (err%has_error_occurred()) then
    -
    906 flag = err%get_error_flag()
    -
    907 return
    -
    908 end if
    -
    909 end function
    -
    910
    -
    911! ------------------------------------------------------------------------------
    -
    931 function la_form_lu(n, a, lda, ipvt, u, ldu, p, ldp) &
    -
    932 bind(C, name = "la_form_lu") result(flag)
    -
    933 ! Arguments
    -
    934 integer(c_int), intent(in), value :: n, lda, ldu, ldp
    -
    935 real(c_double), intent(inout) :: a(lda,*)
    -
    936 real(c_double), intent(out) :: u(ldu,*), p(ldp,*)
    -
    937 integer(c_int), intent(in) :: ipvt(*)
    -
    938 integer(c_int) :: flag
    -
    939
    -
    940 ! Input Checking
    -
    941 flag = la_no_error
    -
    942 if (lda < n .or. ldu < n .or. ldp < n) then
    -
    943 flag = la_invalid_input_error
    -
    944 return
    -
    945 end if
    -
    946
    -
    947 ! Process
    -
    948 call form_lu(a(1:n,1:n), ipvt(1:n), u(1:n,1:n), p(1:n,1:n))
    -
    949 end function
    -
    950
    -
    951! ------------------------------------------------------------------------------
    -
    971 function la_form_lu_cmplx(n, a, lda, ipvt, u, ldu, p, ldp) &
    -
    972 bind(C, name = "la_form_lu_cmplx") result(flag)
    -
    973 ! Arguments
    -
    974 integer(c_int), intent(in), value :: n, lda, ldu, ldp
    -
    975 complex(c_double), intent(inout) :: a(lda,*)
    -
    976 complex(c_double), intent(out) :: u(ldu,*)
    -
    977 real(c_double), intent(out) :: p(ldp,*)
    -
    978 integer(c_int), intent(in) :: ipvt(*)
    -
    979 integer(c_int) :: flag
    -
    980
    -
    981 ! Input Checking
    -
    982 flag = la_no_error
    -
    983 if (lda < n .or. ldu < n .or. ldp < n) then
    -
    984 flag = la_invalid_input_error
    -
    985 return
    -
    986 end if
    -
    987
    -
    988 ! Process
    -
    989 call form_lu(a(1:n,1:n), ipvt(1:n), u(1:n,1:n), p(1:n,1:n))
    -
    990 end function
    -
    991
    -
    992! ------------------------------------------------------------------------------
    -
    1012 function la_qr_factor(m, n, a, lda, tau) bind(C, name = "la_qr_factor") &
    -
    1013 result(flag)
    -
    1014 ! Arguments
    -
    1015 integer(c_int), intent(in), value :: m, n, lda
    -
    1016 real(c_double), intent(inout) :: a(lda,*)
    -
    1017 real(c_double), intent(out) :: tau(*)
    -
    1018 integer(c_int) :: flag
    -
    1019
    -
    1020 ! Local Variables
    -
    1021 type(errors) :: err
    -
    1022 integer(c_int) :: mn
    -
    1023
    -
    1024 ! Error Checking
    -
    1025 call err%set_exit_on_error(.false.)
    -
    1026 flag = la_no_error
    -
    1027 if (lda < m) then
    -
    1028 flag = la_invalid_input_error
    -
    1029 return
    -
    1030 end if
    -
    1031
    -
    1032 ! Process
    -
    1033 mn = min(m, n)
    -
    1034 call qr_factor(a(1:m,1:n), tau(1:mn), err = err)
    -
    1035 if (err%has_error_occurred()) then
    -
    1036 flag = err%get_error_flag()
    -
    1037 return
    -
    1038 end if
    -
    1039 end function
    -
    1040
    -
    1041! ------------------------------------------------------------------------------
    -
    1061 function la_qr_factor_cmplx(m, n, a, lda, tau) &
    -
    1062 bind(C, name = "la_qr_factor_cmplx") result(flag)
    -
    1063 ! Arguments
    -
    1064 integer(c_int), intent(in), value :: m, n, lda
    -
    1065 complex(c_double), intent(inout) :: a(lda,*)
    -
    1066 complex(c_double), intent(out) :: tau(*)
    -
    1067 integer(c_int) :: flag
    -
    1068
    -
    1069 ! Local Variables
    -
    1070 type(errors) :: err
    -
    1071 integer(c_int) :: mn
    -
    1072
    -
    1073 ! Error Checking
    -
    1074 call err%set_exit_on_error(.false.)
    -
    1075 flag = la_no_error
    -
    1076 if (lda < m) then
    -
    1077 flag = la_invalid_input_error
    -
    1078 return
    -
    1079 end if
    -
    1080
    -
    1081 ! Process
    -
    1082 mn = min(m, n)
    -
    1083 call qr_factor(a(1:m,1:n), tau(1:mn), err = err)
    -
    1084 if (err%has_error_occurred()) then
    -
    1085 flag = err%get_error_flag()
    -
    1086 return
    -
    1087 end if
    -
    1088 end function
    -
    1089
    -
    1090! ------------------------------------------------------------------------------
    -
    1114 function la_qr_factor_pvt(m, n, a, lda, tau, jpvt) &
    -
    1115 bind(C, name = "la_qr_factor_pvt") result(flag)
    -
    1116 ! Arguments
    -
    1117 integer(c_int), intent(in), value :: m, n, lda
    -
    1118 real(c_double), intent(inout) :: a(lda,*)
    -
    1119 real(c_double), intent(out) :: tau(*)
    -
    1120 integer(c_int), intent(inout) :: jpvt(*)
    -
    1121 integer(c_int) :: flag
    -
    1122
    -
    1123 ! Local Variables
    -
    1124 type(errors) :: err
    -
    1125 integer(c_int) :: mn
    -
    1126
    -
    1127 ! Error Checking
    -
    1128 call err%set_exit_on_error(.false.)
    -
    1129 flag = la_no_error
    -
    1130 if (lda < m) then
    -
    1131 flag = la_invalid_input_error
    -
    1132 return
    -
    1133 end if
    -
    1134
    -
    1135 ! Process
    -
    1136 mn = min(m, n)
    -
    1137 call qr_factor(a(1:m,1:n), tau(1:mn), jpvt(1:n), err = err)
    -
    1138 if (err%has_error_occurred()) then
    -
    1139 flag = err%get_error_flag()
    -
    1140 return
    -
    1141 end if
    -
    1142 end function
    -
    1143
    -
    1144! ------------------------------------------------------------------------------
    -
    1168 function la_qr_factor_cmplx_pvt(m, n, a, lda, tau, jpvt) &
    -
    1169 bind(C, name = "la_qr_factor_cmplx_pvt") result(flag)
    -
    1170 ! Arguments
    -
    1171 integer(c_int), intent(in), value :: m, n, lda
    -
    1172 complex(c_double), intent(inout) :: a(lda,*)
    -
    1173 complex(c_double), intent(out) :: tau(*)
    -
    1174 integer(c_int), intent(inout) :: jpvt(*)
    -
    1175 integer(c_int) :: flag
    -
    1176
    -
    1177 ! Local Variables
    -
    1178 type(errors) :: err
    -
    1179 integer(c_int) :: mn
    -
    1180
    -
    1181 ! Error Checking
    -
    1182 call err%set_exit_on_error(.false.)
    -
    1183 flag = la_no_error
    -
    1184 if (lda < m) then
    -
    1185 flag = la_invalid_input_error
    -
    1186 return
    -
    1187 end if
    -
    1188
    -
    1189 ! Process
    -
    1190 mn = min(m, n)
    -
    1191 call qr_factor(a(1:m,1:n), tau(1:mn), jpvt(1:n), err = err)
    -
    1192 if (err%has_error_occurred()) then
    -
    1193 flag = err%get_error_flag()
    -
    1194 return
    -
    1195 end if
    -
    1196 end function
    -
    1197
    -
    1198! ------------------------------------------------------------------------------
    -
    1223 function la_form_qr(fullq, m, n, r, ldr, tau, q, ldq) &
    -
    1224 bind(C, name = "la_form_qr") result(flag)
    -
    1225 ! Arguments
    -
    1226 logical(c_bool), intent(in), value :: fullq
    -
    1227 integer(c_int), intent(in), value :: m, n, ldr, ldq
    -
    1228 real(c_double), intent(inout) :: r(ldr,*)
    -
    1229 real(c_double), intent(in) :: tau(*)
    -
    1230 real(c_double), intent(out) :: q(ldq,*)
    -
    1231 integer(c_int) :: flag
    -
    1232
    -
    1233 ! Local Variables
    -
    1234 type(errors) :: err
    -
    1235 integer(c_int) :: mn, nq
    -
    1236
    -
    1237 ! Error Checking
    -
    1238 call err%set_exit_on_error(.false.)
    -
    1239 flag = la_no_error
    -
    1240 if (ldr < m .or. ldq < m) then
    -
    1241 flag = la_invalid_input_error
    -
    1242 return
    -
    1243 end if
    -
    1244
    -
    1245 ! Process
    -
    1246 mn = min(m, n)
    -
    1247 nq = m
    -
    1248 if (.not.fullq) nq = n
    -
    1249 call form_qr(r(1:m,1:n), tau(1:mn), q(1:m,1:nq), err = err)
    -
    1250 if (err%has_error_occurred()) then
    -
    1251 flag = err%get_error_flag()
    -
    1252 return
    -
    1253 end if
    -
    1254 end function
    -
    1255
    -
    1256! ------------------------------------------------------------------------------
    -
    1281 function la_form_qr_cmplx(fullq, m, n, r, ldr, tau, q, ldq) &
    -
    1282 bind(C, name = "la_form_qr_cmplx") result(flag)
    -
    1283 ! Arguments
    -
    1284 logical(c_bool), intent(in), value :: fullq
    -
    1285 integer(c_int), intent(in), value :: m, n, ldr, ldq
    -
    1286 complex(c_double), intent(inout) :: r(ldr,*)
    -
    1287 complex(c_double), intent(in) :: tau(*)
    -
    1288 complex(c_double), intent(out) :: q(ldq,*)
    -
    1289 integer(c_int) :: flag
    -
    1290
    -
    1291 ! Local Variables
    -
    1292 type(errors) :: err
    -
    1293 integer(c_int) :: mn, nq
    -
    1294
    -
    1295 ! Error Checking
    -
    1296 call err%set_exit_on_error(.false.)
    -
    1297 flag = la_no_error
    -
    1298 if (ldr < m .or. ldq < m) then
    -
    1299 flag = la_invalid_input_error
    -
    1300 return
    -
    1301 end if
    -
    1302
    -
    1303 ! Process
    -
    1304 mn = min(m, n)
    -
    1305 nq = m
    -
    1306 if (.not.fullq) nq = n
    -
    1307 call form_qr(r(1:m,1:n), tau(1:mn), q(1:m,1:nq), err = err)
    -
    1308 if (err%has_error_occurred()) then
    -
    1309 flag = err%get_error_flag()
    -
    1310 return
    -
    1311 end if
    -
    1312 end function
    -
    1313
    -
    1314! ------------------------------------------------------------------------------
    -
    1345 function la_form_qr_pvt(fullq, m, n, r, ldr, tau, pvt, q, ldq, p, ldp) &
    -
    1346 bind(C, name = "la_form_qr_pvt") result(flag)
    -
    1347 ! Arguments
    -
    1348 logical(c_bool), intent(in), value :: fullq
    -
    1349 integer(c_int), intent(in), value :: m, n, ldr, ldq, ldp
    -
    1350 real(c_double), intent(inout) :: r(ldr,*)
    -
    1351 real(c_double), intent(in) :: tau(*)
    -
    1352 integer(c_int), intent(in) :: pvt(*)
    -
    1353 real(c_double), intent(out) :: q(ldq,*), p(ldp,*)
    -
    1354 integer(c_int) :: flag
    -
    1355
    -
    1356 ! Local Variables
    -
    1357 type(errors) :: err
    -
    1358 integer(c_int) :: mn, nq
    -
    1359
    -
    1360 ! Error Checking
    -
    1361 call err%set_exit_on_error(.false.)
    -
    1362 flag = la_no_error
    -
    1363 if (ldr < m .or. ldq < m .or. ldp < n) then
    -
    1364 flag = la_invalid_input_error
    -
    1365 return
    -
    1366 end if
    -
    1367
    -
    1368 ! Process
    -
    1369 mn = min(m, n)
    -
    1370 nq = m
    -
    1371 if (.not.fullq) nq = n
    -
    1372 call form_qr(r(1:m,1:n), tau(1:mn), pvt(1:n), q(1:m,1:nq), p(1:n,1:n), &
    -
    1373 err = err)
    -
    1374 if (err%has_error_occurred()) then
    -
    1375 flag = err%get_error_flag()
    -
    1376 return
    -
    1377 end if
    -
    1378 end function
    -
    1379
    -
    1380! ------------------------------------------------------------------------------
    -
    1411 function la_form_qr_cmplx_pvt(fullq, m, n, r, ldr, tau, pvt, q, ldq, p, &
    -
    1412 ldp) bind(C, name = "la_form_qr_cmplx_pvt") result(flag)
    -
    1413 ! Arguments
    -
    1414 logical(c_bool), intent(in), value :: fullq
    -
    1415 integer(c_int), intent(in), value :: m, n, ldr, ldq, ldp
    -
    1416 complex(c_double), intent(inout) :: r(ldr,*)
    -
    1417 complex(c_double), intent(in) :: tau(*)
    -
    1418 integer(c_int), intent(in) :: pvt(*)
    -
    1419 complex(c_double), intent(out) :: q(ldq,*), p(ldp,*)
    -
    1420 integer(c_int) :: flag
    -
    1421
    -
    1422 ! Local Variables
    -
    1423 type(errors) :: err
    -
    1424 integer(c_int) :: mn, nq
    -
    1425
    -
    1426 ! Error Checking
    -
    1427 call err%set_exit_on_error(.false.)
    -
    1428 flag = la_no_error
    -
    1429 if (ldr < m .or. ldq < m .or. ldp < n) then
    -
    1430 flag = la_invalid_input_error
    -
    1431 return
    -
    1432 end if
    -
    1433
    -
    1434 ! Process
    -
    1435 mn = min(m, n)
    -
    1436 nq = m
    -
    1437 if (.not.fullq) nq = n
    -
    1438 call form_qr(r(1:m,1:n), tau(1:mn), pvt(1:n), q(1:m,1:nq), p(1:n,1:n), &
    -
    1439 err = err)
    -
    1440 if (err%has_error_occurred()) then
    -
    1441 flag = err%get_error_flag()
    -
    1442 return
    -
    1443 end if
    -
    1444 end function
    -
    1445
    -
    1446! ------------------------------------------------------------------------------
    -
    1474 function la_mult_qr(lside, trans, m, n, k, a, lda, tau, c, ldc) &
    -
    1475 bind(C, name = "la_mult_qr") result(flag)
    -
    1476 ! Local Variables
    -
    1477 logical(c_bool), intent(in), value :: lside, trans
    -
    1478 integer(c_int), intent(in), value :: m, n, k, lda, ldc
    -
    1479 real(c_double), intent(inout) :: a(lda,*), c(ldc,*)
    -
    1480 real(c_double), intent(in) :: tau(*)
    -
    1481 integer(c_int) :: flag
    -
    1482
    -
    1483 ! Local Variables
    -
    1484 type(errors) :: err
    -
    1485 integer(c_int) :: ma, na
    -
    1486
    -
    1487 ! Initialization
    -
    1488 if (lside) then
    -
    1489 ma = m
    -
    1490 na = m
    -
    1491 else
    -
    1492 ma = n
    -
    1493 na = n
    -
    1494 end if
    -
    1495
    -
    1496 ! Error Checking
    -
    1497 call err%set_exit_on_error(.false.)
    -
    1498 flag = la_no_error
    -
    1499 if (lda < ma .or. ldc < m) then
    -
    1500 flag = la_invalid_input_error
    -
    1501 return
    -
    1502 end if
    -
    1503 if (k > na .or. k < 0) then
    -
    1504 flag = la_invalid_input_error
    -
    1505 return
    -
    1506 end if
    -
    1507
    -
    1508 ! Process
    -
    1509 call mult_qr(logical(lside), logical(trans), a(1:ma,1:k), tau(1:k), &
    -
    1510 c(1:m,1:n), err = err)
    -
    1511 if (err%has_error_occurred()) then
    -
    1512 flag = err%get_error_flag()
    -
    1513 return
    -
    1514 end if
    -
    1515 end function
    -
    1516
    -
    1517! ------------------------------------------------------------------------------
    -
    1545 function la_mult_qr_cmplx(lside, trans, m, n, k, a, lda, tau, c, ldc) &
    -
    1546 bind(C, name = "la_mult_qr_cmplx") result(flag)
    -
    1547 ! Local Variables
    -
    1548 logical(c_bool), intent(in), value :: lside, trans
    -
    1549 integer(c_int), intent(in), value :: m, n, k, lda, ldc
    -
    1550 complex(c_double), intent(inout) :: a(lda,*), c(ldc,*)
    -
    1551 complex(c_double), intent(in) :: tau(*)
    -
    1552 integer(c_int) :: flag
    -
    1553
    -
    1554 ! Local Variables
    -
    1555 type(errors) :: err
    -
    1556 integer(c_int) :: ma, na
    -
    1557
    -
    1558 ! Initialization
    -
    1559 if (lside) then
    -
    1560 ma = m
    -
    1561 na = m
    -
    1562 else
    -
    1563 ma = n
    -
    1564 na = n
    -
    1565 end if
    -
    1566
    -
    1567 ! Error Checking
    -
    1568 call err%set_exit_on_error(.false.)
    -
    1569 flag = la_no_error
    -
    1570 if (lda < ma .or. ldc < m) then
    -
    1571 flag = la_invalid_input_error
    -
    1572 return
    -
    1573 end if
    -
    1574 if (k > na .or. k < 0) then
    -
    1575 flag = la_invalid_input_error
    -
    1576 return
    -
    1577 end if
    -
    1578
    -
    1579 ! Process
    -
    1580 call mult_qr(logical(lside), logical(trans), a(1:ma,1:k), tau(1:k), &
    -
    1581 c(1:m,1:n), err = err)
    -
    1582 if (err%has_error_occurred()) then
    -
    1583 flag = err%get_error_flag()
    -
    1584 return
    -
    1585 end if
    -
    1586 end function
    -
    1587
    -
    1588! ------------------------------------------------------------------------------
    -
    1610 function la_qr_rank1_update(m, n, q, ldq, r, ldr, u, v) &
    -
    1611 bind(C, name = "la_qr_rank1_update") result(flag)
    -
    1612 ! Arguments
    -
    1613 integer(c_int), intent(in), value :: m, n, ldq, ldr
    -
    1614 real(c_double), intent(inout) :: q(ldq,*), r(ldr,*), u(*), v(*)
    -
    1615 integer(c_int) :: flag
    -
    1616
    -
    1617 ! Local Variables
    -
    1618 type(errors) :: err
    -
    1619 integer(c_int) :: mn
    -
    1620
    -
    1621 ! Error Checking
    -
    1622 call err%set_exit_on_error(.false.)
    -
    1623 flag = la_no_error
    -
    1624 if (ldq < m .or. ldr < m) then
    -
    1625 flag = la_invalid_input_error
    -
    1626 return
    -
    1627 end if
    -
    1628
    -
    1629 ! Process
    -
    1630 mn = min(m, n)
    -
    1631 call qr_rank1_update(q(1:m,1:mn), r(1:m,1:n), u(1:m), v(1:n), err = err)
    -
    1632 if (err%has_error_occurred()) then
    -
    1633 flag = err%get_error_flag()
    -
    1634 return
    -
    1635 end if
    -
    1636 end function
    -
    1637
    -
    1638! ------------------------------------------------------------------------------
    -
    1660 function la_qr_rank1_update_cmplx(m, n, q, ldq, r, ldr, u, v) &
    -
    1661 bind(C, name = "la_qr_rank1_update_cmplx") result(flag)
    -
    1662 ! Arguments
    -
    1663 integer(c_int), intent(in), value :: m, n, ldq, ldr
    -
    1664 complex(c_double), intent(inout) :: q(ldq,*), r(ldr,*), u(*), v(*)
    -
    1665 integer(c_int) :: flag
    -
    1666
    -
    1667 ! Local Variables
    -
    1668 type(errors) :: err
    -
    1669 integer(c_int) :: mn
    -
    1670
    -
    1671 ! Error Checking
    -
    1672 call err%set_exit_on_error(.false.)
    -
    1673 flag = la_no_error
    -
    1674 if (ldq < m .or. ldr < m) then
    -
    1675 flag = la_invalid_input_error
    -
    1676 return
    -
    1677 end if
    -
    1678
    -
    1679 ! Process
    -
    1680 mn = min(m, n)
    -
    1681 call qr_rank1_update(q(1:m,1:mn), r(1:m,1:n), u(1:m), v(1:n), err = err)
    -
    1682 if (err%has_error_occurred()) then
    -
    1683 flag = err%get_error_flag()
    -
    1684 return
    -
    1685 end if
    -
    1686 end function
    -
    1687
    -
    1688! ------------------------------------------------------------------------------
    -
    1705 function la_cholesky_factor(upper, n, a, lda) &
    -
    1706 bind(C, name = "la_cholesky_factor") result(flag)
    -
    1707 ! Arguments
    -
    1708 logical(c_bool), intent(in), value :: upper
    -
    1709 integer(c_int), intent(in), value :: n, lda
    -
    1710 real(c_double), intent(inout) :: a(lda,*)
    -
    1711 integer(c_int) :: flag
    -
    1712
    -
    1713 ! Local Variables
    -
    1714 type(errors) :: err
    -
    1715
    -
    1716 ! Error Checking
    -
    1717 call err%set_exit_on_error(.false.)
    -
    1718 flag = la_no_error
    -
    1719 if (lda < n) then
    -
    1720 flag = la_invalid_input_error
    -
    1721 return
    -
    1722 end if
    -
    1723
    -
    1724 ! Process
    -
    1725 call cholesky_factor(a(1:n,1:n), logical(upper), err = err)
    -
    1726 if (err%has_error_occurred()) then
    -
    1727 flag = err%get_error_flag()
    -
    1728 return
    -
    1729 end if
    -
    1730 end function
    -
    1731
    -
    1732! ------------------------------------------------------------------------------
    -
    1749 function la_cholesky_factor_cmplx(upper, n, a, lda) &
    -
    1750 bind(C, name = "la_cholesky_factor_cmplx") result(flag)
    -
    1751 ! Arguments
    -
    1752 logical(c_bool), intent(in), value :: upper
    -
    1753 integer(c_int), intent(in), value :: n, lda
    -
    1754 complex(c_double), intent(inout) :: a(lda,*)
    -
    1755 integer(c_int) :: flag
    -
    1756
    -
    1757 ! Local Variables
    -
    1758 type(errors) :: err
    -
    1759
    -
    1760 ! Error Checking
    -
    1761 call err%set_exit_on_error(.false.)
    -
    1762 flag = la_no_error
    -
    1763 if (lda < n) then
    -
    1764 flag = la_invalid_input_error
    -
    1765 return
    -
    1766 end if
    -
    1767
    -
    1768 ! Process
    -
    1769 call cholesky_factor(a(1:n,1:n), logical(upper), err = err)
    -
    1770 if (err%has_error_occurred()) then
    -
    1771 flag = err%get_error_flag()
    -
    1772 return
    -
    1773 end if
    -
    1774 end function
    -
    1775
    -
    1776! ------------------------------------------------------------------------------
    -
    1792 function la_cholesky_rank1_update(n, r, ldr, u) &
    -
    1793 bind(C, name = "la_cholesky_rank1_update") result(flag)
    -
    1794 ! Arguments
    -
    1795 integer(c_int), intent(in), value :: n, ldr
    -
    1796 real(c_double), intent(inout) :: r(ldr,*), u(*)
    -
    1797 integer(c_int) :: flag
    -
    1798
    -
    1799 ! Local Variables
    -
    1800 type(errors) :: err
    -
    1801
    -
    1802 ! Error Checking
    -
    1803 call err%set_exit_on_error(.false.)
    -
    1804 flag = la_no_error
    -
    1805 if (ldr < n) then
    -
    1806 flag = la_invalid_input_error
    -
    1807 return
    -
    1808 end if
    -
    1809
    -
    1810 ! Process
    -
    1811 call cholesky_rank1_update(r(1:n,1:n), u(1:n), err = err)
    -
    1812 if (err%has_error_occurred()) then
    -
    1813 flag = err%get_error_flag()
    -
    1814 return
    -
    1815 end if
    -
    1816 end function
    -
    1817
    -
    1818! ------------------------------------------------------------------------------
    -
    1834 function la_cholesky_rank1_update_cmplx(n, r, ldr, u) &
    -
    1835 bind(C, name = "la_cholesky_rank1_update_cmplx") result(flag)
    -
    1836 ! Arguments
    -
    1837 integer(c_int), intent(in), value :: n, ldr
    -
    1838 complex(c_double), intent(inout) :: r(ldr,*), u(*)
    -
    1839 integer(c_int) :: flag
    -
    1840
    -
    1841 ! Local Variables
    -
    1842 type(errors) :: err
    -
    1843
    -
    1844 ! Error Checking
    -
    1845 call err%set_exit_on_error(.false.)
    -
    1846 flag = la_no_error
    -
    1847 if (ldr < n) then
    -
    1848 flag = la_invalid_input_error
    -
    1849 return
    -
    1850 end if
    -
    1851
    -
    1852 ! Process
    -
    1853 call cholesky_rank1_update(r(1:n,1:n), u(1:n), err = err)
    -
    1854 if (err%has_error_occurred()) then
    -
    1855 flag = err%get_error_flag()
    -
    1856 return
    -
    1857 end if
    -
    1858 end function
    -
    1859
    -
    1860! ------------------------------------------------------------------------------
    -
    1878 function la_cholesky_rank1_downdate(n, r, ldr, u) &
    -
    1879 bind(C, name = "la_cholesky_rank1_downdate") result(flag)
    -
    1880 ! Arguments
    -
    1881 integer(c_int), intent(in), value :: n, ldr
    -
    1882 real(c_double), intent(inout) :: r(ldr,*), u(*)
    -
    1883 integer(c_int) :: flag
    -
    1884
    -
    1885 ! Local Variables
    -
    1886 type(errors) :: err
    -
    1887
    -
    1888 ! Error Checking
    -
    1889 call err%set_exit_on_error(.false.)
    -
    1890 flag = la_no_error
    -
    1891 if (ldr < n) then
    -
    1892 flag = la_invalid_input_error
    -
    1893 return
    -
    1894 end if
    -
    1895
    -
    1896 ! Process
    -
    1897 call cholesky_rank1_downdate(r(1:n,1:n), u(1:n), err = err)
    -
    1898 if (err%has_error_occurred()) then
    -
    1899 flag = err%get_error_flag()
    -
    1900 return
    -
    1901 end if
    -
    1902 end function
    -
    1903
    -
    1904! ------------------------------------------------------------------------------
    -
    1922 function la_cholesky_rank1_downdate_cmplx(n, r, ldr, u) &
    -
    1923 bind(C, name = "la_cholesky_rank1_downdate_cmplx") result(flag)
    -
    1924 ! Arguments
    -
    1925 integer(c_int), intent(in), value :: n, ldr
    -
    1926 complex(c_double), intent(inout) :: r(ldr,*), u(*)
    -
    1927 integer(c_int) :: flag
    -
    1928
    -
    1929 ! Local Variables
    -
    1930 type(errors) :: err
    -
    1931
    -
    1932 ! Error Checking
    -
    1933 call err%set_exit_on_error(.false.)
    -
    1934 flag = la_no_error
    -
    1935 if (ldr < n) then
    -
    1936 flag = la_invalid_input_error
    -
    1937 return
    -
    1938 end if
    -
    1939
    -
    1940 ! Process
    -
    1941 call cholesky_rank1_downdate(r(1:n,1:n), u(1:n), err = err)
    -
    1942 if (err%has_error_occurred()) then
    -
    1943 flag = err%get_error_flag()
    -
    1944 return
    -
    1945 end if
    -
    1946 end function
    -
    1947
    -
    1948! ------------------------------------------------------------------------------
    -
    1976 function la_svd(m, n, a, lda, s, u, ldu, vt, ldv) &
    -
    1977 bind(C, name = "la_svd") result(flag)
    -
    1978 ! Arguments
    -
    1979 integer(c_int), intent(in), value :: m, n, lda, ldu, ldv
    -
    1980 real(c_double), intent(inout) :: a(lda,*)
    -
    1981 real(c_double), intent(out) :: s(*), u(ldu,*), vt(ldv,*)
    -
    1982 integer(c_int) :: flag
    -
    1983
    -
    1984 ! Local Variables
    -
    1985 type(errors) :: err
    -
    1986 integer(c_int) :: mn
    -
    1987
    -
    1988 ! Error Checking
    -
    1989 call err%set_exit_on_error(.false.)
    -
    1990 flag = la_no_error
    -
    1991 if (lda < m .or. ldu < m .or. ldv < n) then
    -
    1992 flag = la_invalid_input_error
    -
    1993 return
    -
    1994 end if
    -
    1995
    -
    1996 ! Process
    -
    1997 mn = min(m, n)
    -
    1998 call svd(a(1:m,1:n), s(1:mn), u(1:m,1:m), vt(1:n,1:n), err = err)
    -
    1999 if (err%has_error_occurred()) then
    -
    2000 flag = err%get_error_flag()
    -
    2001 return
    -
    2002 end if
    -
    2003 end function
    -
    2004
    -
    2005! ------------------------------------------------------------------------------
    -
    2033 function la_svd_cmplx(m, n, a, lda, s, u, ldu, vt, ldv) &
    -
    2034 bind(C, name = "la_svd_cmplx") result(flag)
    -
    2035 ! Arguments
    -
    2036 integer(c_int), intent(in), value :: m, n, lda, ldu, ldv
    -
    2037 complex(c_double), intent(inout) :: a(lda,*)
    -
    2038 real(c_double), intent(out) :: s(*)
    -
    2039 complex(c_double), intent(out) :: u(ldu,*), vt(ldv,*)
    -
    2040 integer(c_int) :: flag
    -
    2041
    -
    2042 ! Local Variables
    -
    2043 type(errors) :: err
    -
    2044 integer(c_int) :: mn
    -
    2045
    -
    2046 ! Error Checking
    -
    2047 call err%set_exit_on_error(.false.)
    -
    2048 flag = la_no_error
    -
    2049 if (lda < m .or. ldu < m .or. ldv < n) then
    -
    2050 flag = la_invalid_input_error
    -
    2051 return
    -
    2052 end if
    -
    2053
    -
    2054 ! Process
    -
    2055 mn = min(m, n)
    -
    2056 call svd(a(1:m,1:n), s(1:mn), u(1:m,1:m), vt(1:n,1:n), err = err)
    -
    2057 if (err%has_error_occurred()) then
    -
    2058 flag = err%get_error_flag()
    -
    2059 return
    -
    2060 end if
    -
    2061 end function
    -
    2062
    -
    2063! ------------------------------------------------------------------------------
    -
    2090 function la_solve_tri_mtx(lside, upper, trans, nounit, m, n, alpha, a, &
    -
    2091 lda, b, ldb) bind(C, name = "la_solve_tri_mtx") result(flag)
    -
    2092 ! Arguments
    -
    2093 logical(c_bool), intent(in), value :: lside, upper, trans, nounit
    -
    2094 integer(c_int), intent(in), value :: m, n, lda, ldb
    -
    2095 real(c_double), intent(in), value :: alpha
    -
    2096 real(c_double), intent(in) :: a(lda,*)
    -
    2097 real(c_double), intent(inout) :: b(ldb,*)
    -
    2098 integer(c_int) :: flag
    -
    2099
    -
    2100 ! Local Variables
    -
    2101 type(errors) :: err
    -
    2102 integer(c_int) :: ma
    -
    2103
    -
    2104 ! Initialization
    -
    2105 if (lside) then
    -
    2106 ma = m
    -
    2107 else
    -
    2108 ma = n
    -
    2109 end if
    -
    2110
    -
    2111 ! Error Checking
    -
    2112 call err%set_exit_on_error(.false.)
    -
    2113 flag = la_no_error
    -
    2114 if (lda < ma .or. ldb < m) then
    -
    2115 flag = la_invalid_input_error
    -
    2116 return
    -
    2117 end if
    -
    2118
    -
    2119 ! Process
    -
    2120 call solve_triangular_system(logical(lside), logical(upper), &
    -
    2121 logical(trans), logical(nounit), alpha, a(1:ma,1:ma), b(1:m,1:n))
    -
    2122 end function
    -
    2123
    -
    2124! ------------------------------------------------------------------------------
    -
    2151 function la_solve_tri_mtx_cmplx(lside, upper, trans, nounit, m, n, &
    -
    2152 alpha, a, lda, b, ldb) &
    -
    2153 bind(C, name = "la_solve_tri_mtx_cmplx") result(flag)
    -
    2154 ! Arguments
    -
    2155 logical(c_bool), intent(in), value :: lside, upper, trans, nounit
    -
    2156 integer(c_int), intent(in), value :: m, n, lda, ldb
    -
    2157 complex(c_double), intent(in), value :: alpha
    -
    2158 complex(c_double), intent(in) :: a(lda,*)
    -
    2159 complex(c_double), intent(inout) :: b(ldb,*)
    -
    2160 integer(c_int) :: flag
    -
    2161
    -
    2162 ! Local Variables
    -
    2163 type(errors) :: err
    -
    2164 integer(c_int) :: ma
    -
    2165
    -
    2166 ! Initialization
    -
    2167 if (lside) then
    -
    2168 ma = m
    -
    2169 else
    -
    2170 ma = n
    -
    2171 end if
    -
    2172
    -
    2173 ! Error Checking
    -
    2174 call err%set_exit_on_error(.false.)
    -
    2175 flag = la_no_error
    -
    2176 if (lda < ma .or. ldb < m) then
    -
    2177 flag = la_invalid_input_error
    -
    2178 return
    -
    2179 end if
    -
    2180
    -
    2181 ! Process
    -
    2182 call solve_triangular_system(logical(lside), logical(upper), &
    -
    2183 logical(trans), logical(nounit), alpha, a(1:ma,1:ma), b(1:m,1:n))
    -
    2184 end function
    -
    2185
    -
    2186! ------------------------------------------------------------------------------
    -
    2201 function la_solve_lu(m, n, a, lda, ipvt, b, ldb) &
    -
    2202 bind(C, name = "la_solve_lu") result(flag)
    -
    2203 ! Arguments
    -
    2204 integer(c_int), intent(in), value :: m, n, lda, ldb
    -
    2205 real(c_double), intent(in) :: a(lda,*)
    -
    2206 integer(c_int), intent(in) :: ipvt(*)
    -
    2207 real(c_double), intent(inout) :: b(ldb,*)
    -
    2208 integer(c_int) :: flag
    -
    2209
    -
    2210 ! Local Variables
    -
    2211 type(errors) :: err
    -
    2212
    -
    2213 ! Error Checking
    -
    2214 call err%set_exit_on_error(.false.)
    -
    2215 flag = la_no_error
    -
    2216 if (lda < m .or. ldb < m) then
    -
    2217 flag = la_invalid_input_error
    -
    2218 return
    -
    2219 end if
    -
    2220
    -
    2221 ! Process
    -
    2222 call solve_lu(a(1:m,1:m), ipvt(1:m), b(1:m,1:n))
    -
    2223 end function
    -
    2224
    -
    2225! ------------------------------------------------------------------------------
    -
    2240 function la_solve_lu_cmplx(m, n, a, lda, ipvt, b, ldb) &
    -
    2241 bind(C, name = "la_solve_lu_cmplx") result(flag)
    -
    2242 ! Arguments
    -
    2243 integer(c_int), intent(in), value :: m, n, lda, ldb
    -
    2244 complex(c_double), intent(in) :: a(lda,*)
    -
    2245 integer(c_int), intent(in) :: ipvt(*)
    -
    2246 complex(c_double), intent(inout) :: b(ldb,*)
    -
    2247 integer(c_int) :: flag
    -
    2248
    -
    2249 ! Local Variables
    -
    2250 type(errors) :: err
    -
    2251
    -
    2252 ! Error Checking
    -
    2253 call err%set_exit_on_error(.false.)
    -
    2254 flag = la_no_error
    -
    2255 if (lda < m .or. ldb < m) then
    -
    2256 flag = la_invalid_input_error
    -
    2257 return
    -
    2258 end if
    -
    2259
    -
    2260 ! Process
    -
    2261 call solve_lu(a(1:m,1:m), ipvt(1:m), b(1:m,1:n))
    -
    2262 end function
    -
    2263
    -
    2264! ------------------------------------------------------------------------------
    -
    2286 function la_solve_qr(m, n, k, a, lda, tau, b, ldb) &
    -
    2287 bind(C, name = "la_solve_qr") result(flag)
    -
    2288 ! Arguments
    -
    2289 integer(c_int), intent(in), value :: m, n, k, lda, ldb
    -
    2290 real(c_double), intent(inout) :: a(lda,*), b(ldb,*)
    -
    2291 real(c_double), intent(in) :: tau(*)
    -
    2292 integer(c_int) :: flag
    -
    2293
    -
    2294 ! Local Variables
    -
    2295 type(errors) :: err
    -
    2296 integer(c_int) :: minmn
    -
    2297
    -
    2298 ! Error Checking
    -
    2299 call err%set_exit_on_error(.false.)
    -
    2300 flag = la_no_error
    -
    2301 if (lda < m .or. ldb < m .or. m < n) then
    -
    2302 flag = la_invalid_input_error
    -
    2303 return
    -
    2304 end if
    -
    2305
    -
    2306 ! Process
    -
    2307 minmn = min(m, n)
    -
    2308 call solve_qr(a(1:m,1:n), tau(1:minmn), b(1:m,1:k), err = err)
    -
    2309 if (err%has_error_occurred()) then
    -
    2310 flag = err%get_error_flag()
    -
    2311 return
    -
    2312 end if
    -
    2313 end function
    -
    2314
    -
    2315! ------------------------------------------------------------------------------
    -
    2337 function la_solve_qr_cmplx(m, n, k, a, lda, tau, b, ldb) &
    -
    2338 bind(C, name = "la_solve_qr_cmplx") result(flag)
    -
    2339 ! Arguments
    -
    2340 integer(c_int), intent(in), value :: m, n, k, lda, ldb
    -
    2341 complex(c_double), intent(inout) :: a(lda,*), b(ldb,*)
    -
    2342 complex(c_double), intent(in) :: tau(*)
    -
    2343 integer(c_int) :: flag
    -
    2344
    -
    2345 ! Local Variables
    -
    2346 type(errors) :: err
    -
    2347 integer(c_int) :: minmn
    -
    2348
    -
    2349 ! Error Checking
    -
    2350 call err%set_exit_on_error(.false.)
    -
    2351 flag = la_no_error
    -
    2352 if (lda < m .or. ldb < m .or. m < n) then
    -
    2353 flag = la_invalid_input_error
    -
    2354 return
    -
    2355 end if
    -
    2356
    -
    2357 ! Process
    -
    2358 minmn = min(m, n)
    -
    2359 call solve_qr(a(1:m,1:n), tau(1:minmn), b(1:m,1:k), err = err)
    -
    2360 if (err%has_error_occurred()) then
    -
    2361 flag = err%get_error_flag()
    -
    2362 return
    -
    2363 end if
    -
    2364 end function
    -
    2365
    -
    2366! ------------------------------------------------------------------------------
    -
    2388 function la_solve_qr_pvt(m, n, k, a, lda, tau, jpvt, b, ldb) &
    -
    2389 bind(C, name = "la_solve_qr_pvt") result(flag)
    -
    2390 ! Arguments
    -
    2391 integer(c_int), intent(in), value :: m, n, k, lda, ldb
    -
    2392 real(c_double), intent(inout) :: a(lda,*), b(ldb,*)
    -
    2393 real(c_double), intent(in) :: tau(*)
    -
    2394 integer(c_int), intent(in) :: jpvt(*)
    -
    2395 integer(c_int) :: flag
    -
    2396
    -
    2397 ! Local Variables
    -
    2398 type(errors) :: err
    -
    2399 integer(c_int) :: minmn, maxmn
    -
    2400
    -
    2401 ! Error Checking
    -
    2402 minmn = min(m, n)
    -
    2403 maxmn = max(m, n)
    -
    2404 call err%set_exit_on_error(.false.)
    -
    2405 flag = la_no_error
    -
    2406 if (lda < m .or. ldb < maxmn) then
    -
    2407 flag = la_invalid_input_error
    -
    2408 return
    -
    2409 end if
    -
    2410
    -
    2411 ! Process
    -
    2412 call solve_qr(a(1:m,1:n), tau(1:minmn), jpvt(1:n), b(1:maxmn,1:k), &
    -
    2413 err = err)
    -
    2414 if (err%has_error_occurred()) then
    -
    2415 flag = err%get_error_flag()
    -
    2416 return
    -
    2417 end if
    -
    2418 end function
    -
    2419
    -
    2420! ------------------------------------------------------------------------------
    -
    2442 function la_solve_qr_cmplx_pvt(m, n, k, a, lda, tau, jpvt, b, ldb) &
    -
    2443 bind(C, name = "la_solve_qr_cmplx_pvt") result(flag)
    -
    2444 ! Arguments
    -
    2445 integer(c_int), intent(in), value :: m, n, k, lda, ldb
    -
    2446 complex(c_double), intent(inout) :: a(lda,*), b(ldb,*)
    -
    2447 complex(c_double), intent(in) :: tau(*)
    -
    2448 integer(c_int), intent(in) :: jpvt(*)
    -
    2449 integer(c_int) :: flag
    -
    2450
    -
    2451 ! Local Variables
    -
    2452 type(errors) :: err
    -
    2453 integer(c_int) :: minmn, maxmn
    -
    2454
    -
    2455 ! Error Checking
    -
    2456 minmn = min(m, n)
    -
    2457 maxmn = max(m, n)
    -
    2458 call err%set_exit_on_error(.false.)
    -
    2459 flag = la_no_error
    -
    2460 if (lda < m .or. ldb < maxmn) then
    -
    2461 flag = la_invalid_input_error
    -
    2462 return
    -
    2463 end if
    -
    2464
    -
    2465 ! Process
    -
    2466 call solve_qr(a(1:m,1:n), tau(1:minmn), jpvt(1:n), b(1:maxmn,1:k), &
    -
    2467 err = err)
    -
    2468 if (err%has_error_occurred()) then
    -
    2469 flag = err%get_error_flag()
    -
    2470 return
    -
    2471 end if
    -
    2472 end function
    -
    2473
    -
    2474! ------------------------------------------------------------------------------
    -
    2491 function la_solve_cholesky(upper, m, n, a, lda, b, ldb) &
    -
    2492 bind(C, name = "la_solve_cholesky") result(flag)
    -
    2493 ! Arguments
    -
    2494 logical(c_bool), intent(in), value :: upper
    -
    2495 integer(c_int), intent(in), value :: m, n, lda, ldb
    -
    2496 real(c_double), intent(in) :: a(lda,*)
    -
    2497 real(c_double), intent(inout) :: b(ldb,*)
    -
    2498 integer(c_int) :: flag
    -
    2499
    -
    2500 ! Local Variables
    -
    2501 type(errors) :: err
    -
    2502
    -
    2503 ! Error Checking
    -
    2504 call err%set_exit_on_error(.false.)
    -
    2505 flag = la_no_error
    -
    2506 if (lda < m .or. ldb < m) then
    -
    2507 flag = la_invalid_input_error
    -
    2508 return
    -
    2509 end if
    -
    2510
    -
    2511 ! Process
    -
    2512 call solve_cholesky(logical(upper), a(1:m,1:m), b(1:m,1:n))
    -
    2513 end function
    -
    2514
    -
    2515! ------------------------------------------------------------------------------
    -
    2532 function la_solve_cholesky_cmplx(upper, m, n, a, lda, b, ldb) &
    -
    2533 bind(C, name = "la_solve_cholesky_cmplx") result(flag)
    -
    2534 ! Arguments
    -
    2535 logical(c_bool), intent(in), value :: upper
    -
    2536 integer(c_int), intent(in), value :: m, n, lda, ldb
    -
    2537 complex(c_double), intent(in) :: a(lda,*)
    -
    2538 complex(c_double), intent(inout) :: b(ldb,*)
    -
    2539 integer(c_int) :: flag
    -
    2540
    -
    2541 ! Local Variables
    -
    2542 type(errors) :: err
    -
    2543
    -
    2544 ! Error Checking
    -
    2545 call err%set_exit_on_error(.false.)
    -
    2546 flag = la_no_error
    -
    2547 if (lda < m .or. ldb < m) then
    -
    2548 flag = la_invalid_input_error
    -
    2549 return
    -
    2550 end if
    -
    2551
    -
    2552 ! Process
    -
    2553 call solve_cholesky(logical(upper), a(1:m,1:m), b(1:m,1:n))
    -
    2554 end function
    -
    2555
    -
    2556! ------------------------------------------------------------------------------
    -
    2580 function la_solve_least_squares(m, n, k, a, lda, b, ldb) &
    -
    2581 bind(C, name = "la_solve_least_squares") result(flag)
    -
    2582 ! Arguments
    -
    2583 integer(c_int), intent(in), value :: m, n, k, lda, ldb
    -
    2584 real(c_double), intent(inout) :: a(lda,*), b(ldb,*)
    -
    2585 integer(c_int) :: flag
    -
    2586
    -
    2587 ! Local Variables
    -
    2588 type(errors) :: err
    -
    2589 integer(c_int) :: maxmn
    -
    2590
    -
    2591 ! Error Checking
    -
    2592 maxmn = max(m, n)
    -
    2593 call err%set_exit_on_error(.false.)
    -
    2594 flag = la_no_error
    -
    2595 if (lda < m .or. ldb < maxmn) then
    -
    2596 flag = la_invalid_input_error
    -
    2597 return
    -
    2598 end if
    -
    2599
    -
    2600 ! Process
    -
    2601 call solve_least_squares(a(1:m,1:n), b(1:maxmn,1:k), err = err)
    -
    2602 if (err%has_error_occurred()) then
    -
    2603 flag = err%get_error_flag()
    -
    2604 return
    -
    2605 end if
    -
    2606 end function
    -
    2607
    -
    2608! ------------------------------------------------------------------------------
    -
    2632 function la_solve_least_squares_cmplx(m, n, k, a, lda, b, ldb) &
    -
    2633 bind(C, name = "la_solve_least_squares_cmplx") result(flag)
    -
    2634 ! Arguments
    -
    2635 integer(c_int), intent(in), value :: m, n, k, lda, ldb
    -
    2636 complex(c_double), intent(inout) :: a(lda,*), b(ldb,*)
    -
    2637 integer(c_int) :: flag
    -
    2638
    -
    2639 ! Local Variables
    -
    2640 type(errors) :: err
    -
    2641 integer(c_int) :: maxmn
    -
    2642
    -
    2643 ! Error Checking
    -
    2644 maxmn = max(m, n)
    -
    2645 call err%set_exit_on_error(.false.)
    -
    2646 flag = la_no_error
    -
    2647 if (lda < m .or. ldb < maxmn) then
    -
    2648 flag = la_invalid_input_error
    -
    2649 return
    -
    2650 end if
    -
    2651
    -
    2652 ! Process
    -
    2653 call solve_least_squares(a(1:m,1:n), b(1:maxmn,1:k), err = err)
    -
    2654 if (err%has_error_occurred()) then
    -
    2655 flag = err%get_error_flag()
    -
    2656 return
    -
    2657 end if
    -
    2658 end function
    -
    2659
    -
    2660! ------------------------------------------------------------------------------
    -
    2672 function la_inverse(n, a, lda) bind(C, name = "la_inverse") result(flag)
    -
    2673 ! Arguments
    -
    2674 integer(c_int), intent(in), value :: n, lda
    -
    2675 real(c_double), intent(inout) :: a(lda,*)
    -
    2676 integer(c_int) :: flag
    -
    2677
    -
    2678 ! Local Variables
    -
    2679 type(errors) :: err
    -
    2680
    -
    2681 ! Error Checking
    -
    2682 call err%set_exit_on_error(.false.)
    -
    2683 flag = la_no_error
    -
    2684 if (lda < n) then
    -
    2685 flag = la_invalid_input_error
    -
    2686 return
    -
    2687 end if
    -
    2688
    -
    2689 ! Process
    -
    2690 call mtx_inverse(a(1:n,1:n), err = err)
    -
    2691 if (err%has_error_occurred()) then
    -
    2692 flag = err%get_error_flag()
    -
    2693 return
    -
    2694 end if
    -
    2695 end function
    -
    2696
    -
    2697! ------------------------------------------------------------------------------
    -
    2709 function la_inverse_cmplx(n, a, lda) bind(C, name = "la_inverse_cmplx") &
    -
    2710 result(flag)
    -
    2711 ! Arguments
    -
    2712 integer(c_int), intent(in), value :: n, lda
    -
    2713 complex(c_double), intent(inout) :: a(lda,*)
    -
    2714 integer(c_int) :: flag
    -
    2715
    -
    2716 ! Local Variables
    -
    2717 type(errors) :: err
    -
    2718
    -
    2719 ! Error Checking
    -
    2720 call err%set_exit_on_error(.false.)
    -
    2721 flag = la_no_error
    -
    2722 if (lda < n) then
    -
    2723 flag = la_invalid_input_error
    -
    2724 return
    -
    2725 end if
    -
    2726
    -
    2727 ! Process
    -
    2728 call mtx_inverse(a(1:n,1:n), err = err)
    -
    2729 if (err%has_error_occurred()) then
    -
    2730 flag = err%get_error_flag()
    -
    2731 return
    -
    2732 end if
    -
    2733 end function
    -
    2734
    -
    2735! ------------------------------------------------------------------------------
    -
    2751 function la_pinverse(m, n, a, lda, ainv, ldai) &
    -
    2752 bind(C, name = "la_pinverse") result(flag)
    -
    2753 ! Arguments
    -
    2754 integer(c_int), intent(in), value :: m, n, lda, ldai
    -
    2755 real(c_double), intent(inout) :: a(lda,*)
    -
    2756 real(c_double), intent(out) :: ainv(ldai,*)
    -
    2757 integer(c_int) :: flag
    -
    2758
    -
    2759 ! Local Variables
    -
    2760 type(errors) :: err
    -
    2761
    -
    2762 ! Error Checking
    -
    2763 call err%set_exit_on_error(.false.)
    -
    2764 flag = la_no_error
    -
    2765 if (lda < m .or. ldai < n) then
    -
    2766 flag = la_invalid_input_error
    -
    2767 return
    -
    2768 end if
    -
    2769
    -
    2770 ! Process
    -
    2771 call mtx_pinverse(a(1:m,1:n), ainv(1:n,1:m), err = err)
    -
    2772 if (err%has_error_occurred()) then
    -
    2773 flag = err%get_error_flag()
    -
    2774 return
    -
    2775 end if
    -
    2776 end function
    -
    2777
    -
    2778! ------------------------------------------------------------------------------
    -
    2794 function la_pinverse_cmplx(m, n, a, lda, ainv, ldai) &
    -
    2795 bind(C, name = "la_pinverse_cmplx") result(flag)
    -
    2796 ! Arguments
    -
    2797 integer(c_int), intent(in), value :: m, n, lda, ldai
    -
    2798 complex(c_double), intent(inout) :: a(lda,*)
    -
    2799 complex(c_double), intent(out) :: ainv(ldai,*)
    -
    2800 integer(c_int) :: flag
    -
    2801
    -
    2802 ! Local Variables
    -
    2803 type(errors) :: err
    -
    2804
    -
    2805 ! Error Checking
    -
    2806 call err%set_exit_on_error(.false.)
    -
    2807 flag = la_no_error
    -
    2808 if (lda < m .or. ldai < n) then
    -
    2809 flag = la_invalid_input_error
    -
    2810 return
    -
    2811 end if
    -
    2812
    -
    2813 ! Process
    -
    2814 call mtx_pinverse(a(1:m,1:n), ainv(1:n,1:m), err = err)
    -
    2815 if (err%has_error_occurred()) then
    -
    2816 flag = err%get_error_flag()
    -
    2817 return
    -
    2818 end if
    -
    2819 end function
    -
    2820
    -
    2821! ------------------------------------------------------------------------------
    -
    2843 function la_eigen_symm(vecs, n, a, lda, vals) &
    -
    2844 bind(C, name = "la_eigen_symm") result(flag)
    -
    2845 ! Arguments
    -
    2846 logical(c_bool), intent(in), value :: vecs
    -
    2847 integer(c_int), intent(in), value :: n, lda
    -
    2848 real(c_double), intent(inout) :: a(lda,*)
    -
    2849 real(c_double), intent(out) :: vals(*)
    -
    2850 integer(c_int) :: flag
    -
    2851
    -
    2852 ! Local Variables
    -
    2853 type(errors) :: err
    -
    2854
    -
    2855 ! Error Checking
    -
    2856 call err%set_exit_on_error(.false.)
    -
    2857 flag = la_no_error
    -
    2858 if (lda < n) then
    -
    2859 flag = la_invalid_input_error
    -
    2860 return
    -
    2861 end if
    -
    2862
    -
    2863 ! Process
    -
    2864 call eigen(logical(vecs), a(1:n,1:n), vals(1:n), err = err)
    -
    2865 if (err%has_error_occurred()) then
    -
    2866 flag = err%get_error_flag()
    -
    2867 return
    -
    2868 end if
    -
    2869 end function
    -
    2870
    -
    2871! ------------------------------------------------------------------------------
    -
    2892 function la_eigen_asymm(vecs, n, a, lda, vals, v, ldv) &
    -
    2893 bind(C, name = "la_eigen_asymm") result(flag)
    -
    2894 ! Arguments
    -
    2895 logical(c_bool), intent(in), value :: vecs
    -
    2896 integer(c_int), intent(in), value :: n, lda, ldv
    -
    2897 real(c_double), intent(inout) :: a(lda,*)
    -
    2898 complex(c_double), intent(out) :: vals(*), v(ldv,*)
    -
    2899 integer(c_int) :: flag
    -
    2900
    -
    2901 ! Local Variables
    -
    2902 type(errors) :: err
    -
    2903
    -
    2904 ! Error Checking
    -
    2905 call err%set_exit_on_error(.false.)
    -
    2906 flag = la_no_error
    -
    2907 if (vecs) then
    -
    2908 if (lda < n .or. ldv < n) then
    -
    2909 flag = la_invalid_input_error
    -
    2910 return
    -
    2911 end if
    -
    2912 else
    -
    2913 if (lda < n) then
    -
    2914 flag = la_invalid_input_error
    -
    2915 return
    -
    2916 end if
    -
    2917 end if
    -
    2918
    -
    2919 ! Process
    -
    2920 if (vecs) then
    -
    2921 call eigen(a(1:n,1:n), vals(1:n), v(1:n,1:n), err = err)
    -
    2922 else
    -
    2923 call eigen(a(1:n,1:n), vals(1:n))
    -
    2924 end if
    -
    2925 if (err%has_error_occurred()) then
    -
    2926 flag = err%get_error_flag()
    -
    2927 return
    -
    2928 end if
    -
    2929 end function
    -
    2930
    -
    2931! ------------------------------------------------------------------------------
    -
    2965 function la_eigen_gen(vecs, n, a, lda, b, ldb, alpha, beta, v, ldv) &
    -
    2966 bind(C, name = "la_eigen_gen") result(flag)
    -
    2967 ! Arguments
    -
    2968 logical(c_bool), intent(in), value :: vecs
    -
    2969 integer(c_int), intent(in), value :: n, lda, ldb, ldv
    -
    2970 real(c_double), intent(inout) :: a(lda,*), b(ldb,*)
    -
    2971 real(c_double), intent(out) :: beta(*)
    -
    2972 complex(c_double), intent(out) :: alpha(*), v(ldv,*)
    -
    2973 integer(c_int) :: flag
    -
    2974
    -
    2975 ! Local Variables
    -
    2976 type(errors) :: err
    -
    2977
    -
    2978 ! Error Checking
    -
    2979 call err%set_exit_on_error(.false.)
    -
    2980 flag = la_no_error
    -
    2981 if (vecs) then
    -
    2982 if (lda < n .or. ldb < n .or. ldv < n) then
    -
    2983 flag = la_invalid_input_error
    -
    2984 return
    -
    2985 end if
    -
    2986 else
    -
    2987 if (lda < n .or. ldb < n) then
    -
    2988 flag = la_invalid_input_error
    -
    2989 return
    -
    2990 end if
    -
    2991 end if
    -
    2992
    -
    2993 ! Process
    -
    2994 if (vecs) then
    -
    2995 call eigen(a(1:n,1:n), b(1:n,1:n), alpha(1:n), beta(1:n), &
    -
    2996 v(1:n,1:n), err = err)
    -
    2997 else
    -
    2998 call eigen(a(1:n,1:n), b(1:n,1:n), alpha(1:n), beta(1:n), err = err)
    -
    2999 end if
    -
    3000 if (err%has_error_occurred()) then
    -
    3001 flag = err%get_error_flag()
    -
    3002 return
    -
    3003 end if
    -
    3004 end function
    -
    3005
    -
    3006! ------------------------------------------------------------------------------
    -
    3027 function la_eigen_cmplx(vecs, n, a, lda, vals, v, ldv) &
    -
    3028 bind(C, name = "la_eigen_cmplx") result(flag)
    -
    3029 ! Arguments
    -
    3030 logical(c_bool), intent(in), value :: vecs
    -
    3031 integer(c_int), intent(in), value :: n, lda, ldv
    -
    3032 complex(c_double), intent(inout) :: a(lda,*)
    -
    3033 complex(c_double), intent(out) :: vals(*), v(ldv,*)
    -
    3034 integer(c_int) :: flag
    -
    3035
    -
    3036 ! Local Variables
    -
    3037 type(errors) :: err
    -
    3038
    -
    3039 ! Error Checking
    -
    3040 call err%set_exit_on_error(.false.)
    -
    3041 flag = la_no_error
    -
    3042 if (vecs) then
    -
    3043 if (lda < n .or. ldv < n) then
    -
    3044 flag = la_invalid_input_error
    -
    3045 return
    -
    3046 end if
    -
    3047 else
    -
    3048 if (lda < n) then
    -
    3049 flag = la_invalid_input_error
    -
    3050 return
    -
    3051 end if
    -
    3052 end if
    -
    3053
    -
    3054 ! Process
    -
    3055 if (vecs) then
    -
    3056 call eigen(a(1:n,1:n), vals(1:n), v(1:n,1:n), err = err)
    -
    3057 else
    -
    3058 call eigen(a(1:n,1:n), vals(1:n))
    -
    3059 end if
    -
    3060 if (err%has_error_occurred()) then
    -
    3061 flag = err%get_error_flag()
    -
    3062 return
    -
    3063 end if
    -
    3064 end function
    -
    3065
    -
    3066! ------------------------------------------------------------------------------
    -
    3084 function la_sort_eigen(ascend, n, vals, vecs, ldv) &
    -
    3085 bind(C, name = "la_sort_eigen") result(flag)
    -
    3086 ! Arguments
    -
    3087 logical(c_bool), intent(in), value :: ascend
    -
    3088 integer(c_int), intent(in), value :: n, ldv
    -
    3089 real(c_double), intent(inout) :: vals(*), vecs(ldv,*)
    -
    3090 integer(c_int) :: flag
    -
    3091
    -
    3092 ! Local Variables
    -
    3093 type(errors) :: err
    -
    3094
    -
    3095 ! Error Checking
    -
    3096 call err%set_exit_on_error(.false.)
    -
    3097 flag = la_no_error
    -
    3098 if (ldv < n) then
    -
    3099 flag = la_invalid_input_error
    -
    3100 return
    -
    3101 end if
    -
    3102
    -
    3103 ! Process
    -
    3104 call sort(vals(1:n), vecs(1:n,1:n), logical(ascend), err = err)
    -
    3105 if (err%has_error_occurred()) then
    -
    3106 flag = err%get_error_flag()
    -
    3107 return
    -
    3108 end if
    -
    3109 end function
    -
    3110
    -
    3111! ------------------------------------------------------------------------------
    -
    3129 function la_sort_eigen_cmplx(ascend, n, vals, vecs, ldv) &
    -
    3130 bind(C, name = "la_sort_eigen_cmplx") result(flag)
    -
    3131 ! Arguments
    -
    3132 logical(c_bool), intent(in), value :: ascend
    -
    3133 integer(c_int), intent(in), value :: n, ldv
    -
    3134 complex(c_double), intent(inout) :: vals(*), vecs(ldv,*)
    -
    3135 integer(c_int) :: flag
    -
    3136
    -
    3137 ! Local Variables
    -
    3138 type(errors) :: err
    -
    3139
    -
    3140 ! Error Checking
    -
    3141 call err%set_exit_on_error(.false.)
    -
    3142 flag = la_no_error
    -
    3143 if (ldv < n) then
    -
    3144 flag = la_invalid_input_error
    -
    3145 return
    -
    3146 end if
    -
    3147
    -
    3148 ! Process
    -
    3149 call sort(vals(1:n), vecs(1:n,1:n), logical(ascend), err = err)
    -
    3150 if (err%has_error_occurred()) then
    -
    3151 flag = err%get_error_flag()
    -
    3152 return
    -
    3153 end if
    -
    3154 end function
    -
    3155
    -
    3156! ------------------------------------------------------------------------------
    -
    3157
    -
    3158! ------------------------------------------------------------------------------
    -
    3159
    -
    3160! ------------------------------------------------------------------------------
    -
    3161end module
    -
    Computes the Cholesky factorization of a symmetric, positive definite matrix.
    -
    Computes the rank 1 downdate to a Cholesky factored matrix (upper triangular).
    -
    Computes the rank 1 update to a Cholesky factored matrix (upper triangular).
    -
    Computes the determinant of a square matrix.
    -
    Multiplies a diagonal matrix with another matrix or array.
    -
    Computes the eigenvalues, and optionally the eigenvectors, of a matrix.
    -
    Extracts the L and U matrices from the condensed [L\U] storage format used by the lu_factor.
    -
    Forms the full M-by-M orthogonal matrix Q from the elementary reflectors returned by the base QR fact...
    -
    Computes the LU factorization of an M-by-N matrix.
    -
    Computes the inverse of a square matrix.
    -
    Computes the Moore-Penrose pseudo-inverse of a M-by-N matrix using the singular value decomposition o...
    -
    Computes the rank of a matrix.
    -
    Multiplies a general matrix by the orthogonal matrix Q from a QR factorization.
    -
    Computes the QR factorization of an M-by-N matrix.
    -
    Computes the rank 1 update to an M-by-N QR factored matrix A (M >= N) where , and such that .
    -
    Performs the rank-1 update to matrix A such that: , where is an M-by-N matrix, is a scalar,...
    -
    Solves a system of Cholesky factored equations.
    -
    Solves the overdetermined or underdetermined system of M equations of N unknowns....
    -
    Solves a system of LU-factored equations.
    -
    Solves a system of M QR-factored equations of N unknowns.
    -
    Solves a triangular system of equations.
    -
    Sorts an array.
    -
    Computes the singular value decomposition of a matrix A. The SVD is defined as: , where is an M-by-M...
    -
    Computes the trace of a matrix (the sum of the main diagonal elements).
    -
    Computes the triangular matrix operation: , or , where A is a triangular matrix.
    +
    7 use linalg
    +
    8 use ferror
    +
    9 implicit none
    +
    10
    +
    11contains
    +
    12! ------------------------------------------------------------------------------
    +
    29 function la_rank1_update(m, n, alpha, x, y, a, lda) &
    +
    30 bind(C, name = "la_rank1_update") result(flag)
    +
    31 ! Arguments
    +
    32 integer(c_int), intent(in), value :: m, n, lda
    +
    33 real(c_double), intent(in), value :: alpha
    +
    34 real(c_double), intent(in) :: x(*), y(*)
    +
    35 real(c_double), intent(inout) :: a(lda,*)
    +
    36 integer(c_int) :: flag
    +
    37
    +
    38 ! Initialization
    +
    39 flag = la_no_error
    +
    40
    +
    41 ! Input Checking
    +
    42 if (lda < m) then
    +
    43 flag = la_invalid_input_error
    +
    44 return
    +
    45 end if
    +
    46
    +
    47 ! Process
    +
    48 call rank1_update(alpha, x(1:m), y(1:n), a(1:m,1:n))
    +
    49 end function
    +
    50
    +
    51! ------------------------------------------------------------------------------
    +
    68 function la_rank1_update_cmplx(m, n, alpha, x, y, a, lda) &
    +
    69 bind(C, name = "la_rank1_update_cmplx") result(flag)
    +
    70 ! Arguments
    +
    71 integer(c_int), intent(in), value :: m, n, lda
    +
    72 complex(c_double), intent(in), value :: alpha
    +
    73 complex(c_double), intent(in) :: x(*), y(*)
    +
    74 complex(c_double), intent(inout) :: a(lda,*)
    +
    75 integer(c_int) :: flag
    +
    76
    +
    77 ! Initialization
    +
    78 flag = la_no_error
    +
    79
    +
    80 ! Input Checking
    +
    81 if (lda < m) then
    +
    82 flag = la_invalid_input_error
    +
    83 return
    +
    84 end if
    +
    85
    +
    86 ! Process
    +
    87 call rank1_update(alpha, x(1:m), y(1:n), a(1:m,1:n))
    +
    88 end function
    +
    89
    +
    90! ------------------------------------------------------------------------------
    +
    103 function la_trace(m, n, a, lda, rst) bind(C, name = "la_trace") &
    +
    104 result(flag)
    +
    105 ! Arguments
    +
    106 integer(c_int), intent(in), value :: m, n, lda
    +
    107 real(c_double), intent(in) :: a(lda,*)
    +
    108 real(c_double), intent(out) :: rst
    +
    109 integer(c_int) :: flag
    +
    110
    +
    111 ! Initialization
    +
    112 flag = la_no_error
    +
    113
    +
    114 ! Input Checking
    +
    115 if (lda < m) then
    +
    116 flag = la_invalid_input_error
    +
    117 return
    +
    118 end if
    +
    119
    +
    120 ! Process
    +
    121 rst = trace(a(1:m,1:n))
    +
    122 end function
    +
    123
    +
    124! ------------------------------------------------------------------------------
    +
    137 function la_trace_cmplx(m, n, a, lda, rst) &
    +
    138 bind(C, name = "la_trace_cmplx") result(flag)
    +
    139 ! Arguments
    +
    140 integer(c_int), intent(in), value :: m, n, lda
    +
    141 complex(c_double), intent(in) :: a(lda,*)
    +
    142 complex(c_double), intent(out) :: rst
    +
    143 integer(c_int) :: flag
    +
    144
    +
    145 ! Initialization
    +
    146 flag = la_no_error
    +
    147
    +
    148 ! Input Checking
    +
    149 if (lda < m) then
    +
    150 flag = la_invalid_input_error
    +
    151 return
    +
    152 end if
    +
    153
    +
    154 ! Process
    +
    155 rst = trace(a(1:m,1:n))
    +
    156 end function
    +
    157
    +
    158! ------------------------------------------------------------------------------
    +
    183 function la_mtx_mult(transa, transb, m, n, k, alpha, a, lda, b, ldb, &
    +
    184 beta, c, ldc) bind(C, name="la_mtx_mult") result(flag)
    +
    185 ! Arugments
    +
    186 logical(c_bool), intent(in), value :: transa, transb
    +
    187 integer(c_int), intent(in), value :: m, n, k, lda, ldb, ldc
    +
    188 real(c_double), intent(in), value :: alpha, beta
    +
    189 real(c_double), intent(in) :: a(lda,*), b(ldb,*)
    +
    190 real(c_double), intent(inout) :: c(ldc,*)
    +
    191 integer(c_int) :: flag
    +
    192
    +
    193 ! Local Variables
    +
    194 character :: ta, tb
    +
    195 integer(c_int) :: nrowa, nrowb
    +
    196
    +
    197 ! Initialization
    +
    198 flag = la_no_error
    +
    199 ta = "N"
    +
    200 if (transa) ta = "T"
    +
    201
    +
    202 tb = "N"
    +
    203 if (transb) tb = "T"
    +
    204
    +
    205 if (transa) then
    +
    206 nrowa = k
    +
    207 else
    +
    208 nrowa = m
    +
    209 end if
    +
    210
    +
    211 if (transb) then
    +
    212 nrowb = n
    +
    213 else
    +
    214 nrowb = k
    +
    215 end if
    +
    216
    +
    217 ! Input Checking
    +
    218 if (lda < nrowa .or. ldb < nrowb .or. ldc < m) then
    +
    219 flag = la_invalid_input_error
    +
    220 return
    +
    221 end if
    +
    222
    +
    223 ! Call DGEMM directly
    +
    224 call dgemm(ta, tb, m, n, k, alpha, a, lda, b, ldb, beta, c, ldc)
    +
    225 end function
    +
    226
    +
    227! ------------------------------------------------------------------------------
    +
    254 function la_mtx_mult_cmplx(opa, opb, m, n, k, alpha, a, lda, b, ldb, &
    +
    255 beta, c, ldc) bind(C, name="la_mtx_mult_cmplx") result(flag)
    +
    256 ! Arguments
    +
    257 integer(c_int), intent(in), value :: opa, opb, m, n, k, lda, ldb, ldc
    +
    258 complex(c_double), intent(in), value :: alpha, beta
    +
    259 complex(c_double), intent(in) :: a(lda,*), b(ldb,*)
    +
    260 complex(c_double), intent(inout) :: c(ldc,*)
    +
    261 integer(c_int) :: flag
    +
    262
    +
    263 ! Local Variables
    +
    264 character :: ta, tb
    +
    265 integer(c_int) :: nrowa, nrowb
    +
    266
    +
    267 ! Initialization
    +
    268 flag = la_no_error
    +
    269 if (opa == la_transpose) then
    +
    270 ta = "T"
    +
    271 else if (opa == la_hermitian_transpose) then
    +
    272 ta = "H"
    +
    273 else
    +
    274 ta = "N"
    +
    275 end if
    +
    276
    +
    277 if (opb == la_transpose) then
    +
    278 tb = "T"
    +
    279 else if (opb == la_hermitian_transpose) then
    +
    280 tb = "H"
    +
    281 else
    +
    282 tb = "N"
    +
    283 end if
    +
    284
    +
    285 if (opa == la_transpose .or. opa == la_hermitian_transpose) then
    +
    286 nrowa = k
    +
    287 else
    +
    288 nrowa = m
    +
    289 end if
    +
    290
    +
    291 if (opb == la_transpose .or. opb == la_hermitian_transpose) then
    +
    292 nrowb = n
    +
    293 else
    +
    294 nrowb = k
    +
    295 end if
    +
    296
    +
    297 ! Input Checking
    +
    298 if (lda < nrowa .or. ldb < nrowb .or. ldc < m) then
    +
    299 flag = la_invalid_input_error
    +
    300 return
    +
    301 end if
    +
    302
    +
    303 ! Call ZGEMM directly
    +
    304 call zgemm(ta, tb, m, n, k, alpha, a, lda, b, ldb, beta, c, ldc)
    +
    305 end function
    +
    306
    +
    307! ------------------------------------------------------------------------------
    +
    339 function la_diag_mtx_mult(lside, transb, m, n, k, alpha, a, b, ldb, &
    +
    340 beta, c, ldc) bind(C, name="la_diag_mtx_mult") result(flag)
    +
    341 ! Arguments
    +
    342 logical(c_bool), intent(in), value :: lside, transb
    +
    343 integer(c_int), intent(in), value :: m, n, k, ldb, ldc
    +
    344 real(c_double), intent(in), value :: alpha, beta
    +
    345 real(c_double), intent(in) :: a(*), b(ldb,*)
    +
    346 real(c_double), intent(inout) :: c(ldc,*)
    +
    347 integer(c_int) :: flag
    +
    348
    +
    349 ! Local Variabes
    +
    350 integer(c_int) :: nrows, ncols, p
    +
    351 logical :: ls, tb
    +
    352 type(errors) :: err
    +
    353
    +
    354 ! Initialization
    +
    355 call err%set_exit_on_error(.false.)
    +
    356 flag = la_no_error
    +
    357 if (lside .and. transb) then
    +
    358 nrows = n
    +
    359 ncols = k
    +
    360 p = min(k, m)
    +
    361 ls = .true.
    +
    362 tb = .true.
    +
    363 else if (lside .and. .not. transb) then
    +
    364 nrows = k
    +
    365 ncols = n
    +
    366 p = min(k, m)
    +
    367 ls = .true.
    +
    368 tb = .false.
    +
    369 else if (.not. lside .and. transb) then
    +
    370 nrows = k
    +
    371 ncols = m
    +
    372 p = min(k, n)
    +
    373 ls = .false.
    +
    374 tb = .true.
    +
    375 else
    +
    376 nrows = m
    +
    377 ncols = k
    +
    378 p = min(k, n)
    +
    379 ls = .false.
    +
    380 tb = .false.
    +
    381 end if
    +
    382
    +
    383 ! Error Checking
    +
    384 if (ldb < nrows .or. ldc < m) then
    +
    385 flag = la_invalid_input_error
    +
    386 return
    +
    387 end if
    +
    388
    +
    389 ! Process
    +
    390 call diag_mtx_mult(ls, tb, alpha, a(1:p), b(1:nrows,1:ncols), &
    +
    391 beta, c(1:m,1:n), err)
    +
    392 if (err%has_error_occurred()) flag = err%get_error_flag()
    +
    393 end function
    +
    394
    +
    395! ------------------------------------------------------------------------------
    +
    428 function la_diag_mtx_mult_mixed(lside, opb, m, n, k, alpha, a, b, ldb, &
    +
    429 beta, c, ldc) bind(C, name = "la_diag_mtx_mult_mixed") result(flag)
    +
    430 ! Arguments
    +
    431 logical(c_bool), intent(in), value :: lside
    +
    432 integer(c_int), intent(in), value :: opb, m, n, k, ldb, ldc
    +
    433 complex(c_double), intent(in), value :: alpha, beta
    +
    434 real(c_double), intent(in) :: a(*)
    +
    435 complex(c_double), intent(in) :: b(ldb,*)
    +
    436 complex(c_double), intent(inout) :: c(ldc,*)
    +
    437 integer(c_int) :: flag
    +
    438
    +
    439 ! Local Variabes
    +
    440 integer(c_int) :: nrows, ncols, p
    +
    441 logical :: ls, tb
    +
    442 type(errors) :: err
    +
    443
    +
    444 ! Initialization
    +
    445 call err%set_exit_on_error(.false.)
    +
    446 flag = la_no_error
    +
    447 tb = .false.
    +
    448 if (opb == la_transpose .or. opb == la_hermitian_transpose) tb = .true.
    +
    449 if (lside .and. tb) then
    +
    450 nrows = n
    +
    451 ncols = k
    +
    452 p = min(k, m)
    +
    453 ls = .true.
    +
    454 else if (lside .and. .not. tb) then
    +
    455 nrows = k
    +
    456 ncols = n
    +
    457 p = min(k, m)
    +
    458 ls = .true.
    +
    459 else if (.not. lside .and. tb) then
    +
    460 nrows = k
    +
    461 ncols = m
    +
    462 p = min(k, n)
    +
    463 ls = .false.
    +
    464 else
    +
    465 nrows = m
    +
    466 ncols = k
    +
    467 p = min(k, n)
    +
    468 ls = .false.
    +
    469 end if
    +
    470
    +
    471 ! Error Checking
    +
    472 if (ldb < nrows .or. ldc < m) then
    +
    473 flag = la_invalid_input_error
    +
    474 return
    +
    475 end if
    +
    476
    +
    477 ! Process
    +
    478 call diag_mtx_mult(ls, opb, alpha, a(1:p), b(1:nrows,1:ncols), &
    +
    479 beta, c(1:m,1:n))
    +
    480 if (err%has_error_occurred()) flag = err%get_error_flag()
    +
    481 end function
    +
    482
    +
    483! ------------------------------------------------------------------------------
    +
    516 function la_diag_mtx_mult_cmplx(lside, opb, m, n, k, alpha, a, b, &
    +
    517 ldb, beta, c, ldc) bind(C, name="la_diag_mtx_mult_cmplx") &
    +
    518 result(flag)
    +
    519 ! Arguments
    +
    520 logical(c_bool), intent(in), value :: lside
    +
    521 integer(c_int), intent(in), value :: opb, m, n, k, ldb, ldc
    +
    522 complex(c_double), intent(in), value :: alpha, beta
    +
    523 complex(c_double), intent(in) :: a(*), b(ldb,*)
    +
    524 complex(c_double), intent(inout) :: c(ldc,*)
    +
    525 integer(c_int) :: flag
    +
    526
    +
    527 ! Local Variabes
    +
    528 integer(c_int) :: nrows, ncols, p
    +
    529 logical :: ls, tb
    +
    530 type(errors) :: err
    +
    531
    +
    532 ! Initialization
    +
    533 call err%set_exit_on_error(.false.)
    +
    534 flag = la_no_error
    +
    535 tb = .false.
    +
    536 if (opb == la_transpose .or. opb == la_hermitian_transpose) tb = .true.
    +
    537 if (lside .and. tb) then
    +
    538 nrows = n
    +
    539 ncols = k
    +
    540 p = min(k, m)
    +
    541 ls = .true.
    +
    542 else if (lside .and. .not. tb) then
    +
    543 nrows = k
    +
    544 ncols = n
    +
    545 p = min(k, m)
    +
    546 ls = .true.
    +
    547 else if (.not. lside .and. tb) then
    +
    548 nrows = k
    +
    549 ncols = m
    +
    550 p = min(k, n)
    +
    551 ls = .false.
    +
    552 else
    +
    553 nrows = m
    +
    554 ncols = k
    +
    555 p = min(k, n)
    +
    556 ls = .false.
    +
    557 end if
    +
    558
    +
    559 ! Error Checking
    +
    560 if (ldb < nrows .or. ldc < m) then
    +
    561 flag = la_invalid_input_error
    +
    562 return
    +
    563 end if
    +
    564
    +
    565 ! Process
    +
    566 call diag_mtx_mult(ls, opb, alpha, a(1:p), b(1:nrows,1:ncols), &
    +
    567 beta, c(1:m,1:n))
    +
    568 if (err%has_error_occurred()) flag = err%get_error_flag()
    +
    569 end function
    +
    570
    +
    571! ------------------------------------------------------------------------------
    +
    588 function la_rank(m, n, a, lda, rnk) bind(C, name="la_rank") result(flag)
    +
    589 ! Arguments
    +
    590 integer(c_int), intent(in), value :: m, n, lda
    +
    591 real(c_double), intent(inout) :: a(lda,*)
    +
    592 integer(c_int), intent(out) :: rnk
    +
    593 integer(c_int) :: flag
    +
    594
    +
    595 ! Local Variables
    +
    596 type(errors) :: err
    +
    597
    +
    598 ! Input Check
    +
    599 call err%set_exit_on_error(.false.)
    +
    600 flag = la_no_error
    +
    601 if (lda < m) then
    +
    602 flag = la_invalid_input_error
    +
    603 return
    +
    604 end if
    +
    605
    +
    606 ! Process
    +
    607 rnk = mtx_rank(a(1:m,1:n), err =err)
    +
    608 if (err%has_error_occurred()) flag = err%get_error_flag()
    +
    609 end function
    +
    610
    +
    611! ------------------------------------------------------------------------------
    +
    628 function la_rank_cmplx(m, n, a, lda, rnk) bind(C, name="la_rank_cmplx") &
    +
    629 result(flag)
    +
    630 ! Arguments
    +
    631 integer(c_int), intent(in), value :: m, n, lda
    +
    632 complex(c_double), intent(inout) :: a(lda,*)
    +
    633 integer(c_int), intent(out) :: rnk
    +
    634 integer(c_int) :: flag
    +
    635
    +
    636 ! Local Variables
    +
    637 type(errors) :: err
    +
    638
    +
    639 ! Input Check
    +
    640 call err%set_exit_on_error(.false.)
    +
    641 flag = la_no_error
    +
    642 if (lda < m) then
    +
    643 flag = la_invalid_input_error
    +
    644 return
    +
    645 end if
    +
    646
    +
    647 ! Process
    +
    648 rnk = mtx_rank(a(1:m,1:n), err = err)
    +
    649 if (err%has_error_occurred()) flag = err%get_error_flag()
    +
    650 end function
    +
    651
    +
    652! ------------------------------------------------------------------------------
    +
    666 function la_det(n, a, lda, d) bind(C, name="la_det") result(flag)
    +
    667 ! Arguments
    +
    668 integer(c_int), intent(in), value :: n, lda
    +
    669 real(c_double), intent(inout) :: a(lda,*)
    +
    670 real(c_double), intent(out) :: d
    +
    671 integer(c_int) :: flag
    +
    672
    +
    673 ! Local Variables
    +
    674 type(errors) :: err
    +
    675
    +
    676 ! Error Checking
    +
    677 call err%set_exit_on_error(.false.)
    +
    678 flag = la_no_error
    +
    679 if (lda < n) then
    +
    680 flag = la_invalid_input_error
    +
    681 return
    +
    682 end if
    +
    683
    +
    684 ! Process
    +
    685 d = det(a(1:n,1:n), err = err)
    +
    686 if (err%has_error_occurred()) flag = err%get_error_flag()
    +
    687 end function
    +
    688
    +
    689! ------------------------------------------------------------------------------
    +
    703 function la_det_cmplx(n, a, lda, d) bind(C, name="la_det_cmplx") result(flag)
    +
    704 ! Arguments
    +
    705 integer(c_int), intent(in), value :: n, lda
    +
    706 complex(c_double), intent(inout) :: a(lda,*)
    +
    707 complex(c_double), intent(out) :: d
    +
    708 integer(c_int) :: flag
    +
    709
    +
    710 ! Local Variables
    +
    711 type(errors) :: err
    +
    712
    +
    713 ! Error Checking
    +
    714 call err%set_exit_on_error(.false.)
    +
    715 flag = la_no_error
    +
    716 if (lda < n) then
    +
    717 flag = la_invalid_input_error
    +
    718 return
    +
    719 end if
    +
    720
    +
    721 ! Process
    +
    722 d = det(a(1:n,1:n), err = err)
    +
    723 if (err%has_error_occurred()) flag = err%get_error_flag()
    +
    724 end function
    +
    725
    +
    726! ------------------------------------------------------------------------------
    +
    750 function la_tri_mtx_mult(upper, alpha, n, a, lda, beta, b, ldb) &
    +
    751 bind(C, name = "la_tri_mtx_mult") result(flag)
    +
    752 ! Arguments
    +
    753 logical(c_bool), intent(in), value :: upper
    +
    754 integer(c_int), intent(in), value :: n, lda, ldb
    +
    755 real(c_double), intent(in), value :: alpha, beta
    +
    756 real(c_double), intent(in) :: a(lda,*)
    +
    757 real(c_double), intent(inout) :: b(ldb,*)
    +
    758 integer(c_int) :: flag
    +
    759
    +
    760 ! Error Checking
    +
    761 flag = la_no_error
    +
    762 if (lda < n .or. ldb < n) then
    +
    763 flag = la_invalid_input_error
    +
    764 return
    +
    765 end if
    +
    766
    +
    767 ! Process
    +
    768 call tri_mtx_mult(logical(upper), alpha, a(1:n,1:n), beta, b(1:n,1:n))
    +
    769 end function
    +
    770
    +
    771! ------------------------------------------------------------------------------
    +
    795 function la_tri_mtx_mult_cmplx(upper, alpha, n, a, lda, beta, b, ldb) &
    +
    796 bind(C, name = "la_tri_mtx_mult_cmplx") result(flag)
    +
    797 ! Arguments
    +
    798 logical(c_bool), intent(in), value :: upper
    +
    799 integer(c_int), intent(in), value :: n, lda, ldb
    +
    800 complex(c_double), intent(in), value :: alpha, beta
    +
    801 complex(c_double), intent(in) :: a(lda,*)
    +
    802 complex(c_double), intent(inout) :: b(ldb,*)
    +
    803 integer(c_int) :: flag
    +
    804
    +
    805 ! Error Checking
    +
    806 flag = la_no_error
    +
    807 if (lda < n .or. ldb < n) then
    +
    808 flag = la_invalid_input_error
    +
    809 return
    +
    810 end if
    +
    811
    +
    812 ! Process
    +
    813 call tri_mtx_mult(logical(upper), alpha, a(1:n,1:n), beta, b(1:n,1:n))
    +
    814 end function
    +
    815
    +
    816! ------------------------------------------------------------------------------
    +
    834 function la_lu_factor(m, n, a, lda, ipvt) bind(C, name = "la_lu_factor") &
    +
    835 result(flag)
    +
    836 ! Arguments
    +
    837 integer(c_int), intent(in), value :: m, n, lda
    +
    838 real(c_double), intent(inout) :: a(lda,*)
    +
    839 integer(c_int), intent(out) :: ipvt(*)
    +
    840 integer(c_int) :: flag
    +
    841
    +
    842 ! Local Variables
    +
    843 type(errors) :: err
    +
    844 integer(c_int) :: mn
    +
    845
    +
    846 ! Error Checking
    +
    847 call err%set_exit_on_error(.false.)
    +
    848 flag = la_no_error
    +
    849 if (lda < m) then
    +
    850 flag = la_invalid_input_error
    +
    851 return
    +
    852 end if
    +
    853
    +
    854 ! Process
    +
    855 mn = min(m, n)
    +
    856 call lu_factor(a(1:m,1:n), ipvt(1:mn), err)
    +
    857 if (err%has_error_occurred()) then
    +
    858 flag = err%get_error_flag()
    +
    859 return
    +
    860 end if
    +
    861 end function
    +
    862
    +
    863! ------------------------------------------------------------------------------
    +
    881 function la_lu_factor_cmplx(m, n, a, lda, ipvt) &
    +
    882 bind(C, name = "la_lu_factor_cmplx") result(flag)
    +
    883 ! Arguments
    +
    884 integer(c_int), intent(in), value :: m, n, lda
    +
    885 complex(c_double), intent(inout) :: a(lda,*)
    +
    886 integer(c_int), intent(out) :: ipvt(*)
    +
    887 integer(c_int) :: flag
    +
    888
    +
    889 ! Local Variables
    +
    890 type(errors) :: err
    +
    891 integer(c_int) :: mn
    +
    892
    +
    893 ! Error Checking
    +
    894 call err%set_exit_on_error(.false.)
    +
    895 flag = la_no_error
    +
    896 if (lda < m) then
    +
    897 flag = la_invalid_input_error
    +
    898 return
    +
    899 end if
    +
    900
    +
    901 ! Process
    +
    902 mn = min(m, n)
    +
    903 call lu_factor(a(1:m,1:n), ipvt(1:mn), err)
    +
    904 if (err%has_error_occurred()) then
    +
    905 flag = err%get_error_flag()
    +
    906 return
    +
    907 end if
    +
    908 end function
    +
    909
    +
    910! ------------------------------------------------------------------------------
    +
    930 function la_form_lu(n, a, lda, ipvt, u, ldu, p, ldp) &
    +
    931 bind(C, name = "la_form_lu") result(flag)
    +
    932 ! Arguments
    +
    933 integer(c_int), intent(in), value :: n, lda, ldu, ldp
    +
    934 real(c_double), intent(inout) :: a(lda,*)
    +
    935 real(c_double), intent(out) :: u(ldu,*), p(ldp,*)
    +
    936 integer(c_int), intent(in) :: ipvt(*)
    +
    937 integer(c_int) :: flag
    +
    938
    +
    939 ! Input Checking
    +
    940 flag = la_no_error
    +
    941 if (lda < n .or. ldu < n .or. ldp < n) then
    +
    942 flag = la_invalid_input_error
    +
    943 return
    +
    944 end if
    +
    945
    +
    946 ! Process
    +
    947 call form_lu(a(1:n,1:n), ipvt(1:n), u(1:n,1:n), p(1:n,1:n))
    +
    948 end function
    +
    949
    +
    950! ------------------------------------------------------------------------------
    +
    970 function la_form_lu_cmplx(n, a, lda, ipvt, u, ldu, p, ldp) &
    +
    971 bind(C, name = "la_form_lu_cmplx") result(flag)
    +
    972 ! Arguments
    +
    973 integer(c_int), intent(in), value :: n, lda, ldu, ldp
    +
    974 complex(c_double), intent(inout) :: a(lda,*)
    +
    975 complex(c_double), intent(out) :: u(ldu,*)
    +
    976 real(c_double), intent(out) :: p(ldp,*)
    +
    977 integer(c_int), intent(in) :: ipvt(*)
    +
    978 integer(c_int) :: flag
    +
    979
    +
    980 ! Input Checking
    +
    981 flag = la_no_error
    +
    982 if (lda < n .or. ldu < n .or. ldp < n) then
    +
    983 flag = la_invalid_input_error
    +
    984 return
    +
    985 end if
    +
    986
    +
    987 ! Process
    +
    988 call form_lu(a(1:n,1:n), ipvt(1:n), u(1:n,1:n), p(1:n,1:n))
    +
    989 end function
    +
    990
    +
    991! ------------------------------------------------------------------------------
    +
    1011 function la_qr_factor(m, n, a, lda, tau) bind(C, name = "la_qr_factor") &
    +
    1012 result(flag)
    +
    1013 ! Arguments
    +
    1014 integer(c_int), intent(in), value :: m, n, lda
    +
    1015 real(c_double), intent(inout) :: a(lda,*)
    +
    1016 real(c_double), intent(out) :: tau(*)
    +
    1017 integer(c_int) :: flag
    +
    1018
    +
    1019 ! Local Variables
    +
    1020 type(errors) :: err
    +
    1021 integer(c_int) :: mn
    +
    1022
    +
    1023 ! Error Checking
    +
    1024 call err%set_exit_on_error(.false.)
    +
    1025 flag = la_no_error
    +
    1026 if (lda < m) then
    +
    1027 flag = la_invalid_input_error
    +
    1028 return
    +
    1029 end if
    +
    1030
    +
    1031 ! Process
    +
    1032 mn = min(m, n)
    +
    1033 call qr_factor(a(1:m,1:n), tau(1:mn), err = err)
    +
    1034 if (err%has_error_occurred()) then
    +
    1035 flag = err%get_error_flag()
    +
    1036 return
    +
    1037 end if
    +
    1038 end function
    +
    1039
    +
    1040! ------------------------------------------------------------------------------
    +
    1060 function la_qr_factor_cmplx(m, n, a, lda, tau) &
    +
    1061 bind(C, name = "la_qr_factor_cmplx") result(flag)
    +
    1062 ! Arguments
    +
    1063 integer(c_int), intent(in), value :: m, n, lda
    +
    1064 complex(c_double), intent(inout) :: a(lda,*)
    +
    1065 complex(c_double), intent(out) :: tau(*)
    +
    1066 integer(c_int) :: flag
    +
    1067
    +
    1068 ! Local Variables
    +
    1069 type(errors) :: err
    +
    1070 integer(c_int) :: mn
    +
    1071
    +
    1072 ! Error Checking
    +
    1073 call err%set_exit_on_error(.false.)
    +
    1074 flag = la_no_error
    +
    1075 if (lda < m) then
    +
    1076 flag = la_invalid_input_error
    +
    1077 return
    +
    1078 end if
    +
    1079
    +
    1080 ! Process
    +
    1081 mn = min(m, n)
    +
    1082 call qr_factor(a(1:m,1:n), tau(1:mn), err = err)
    +
    1083 if (err%has_error_occurred()) then
    +
    1084 flag = err%get_error_flag()
    +
    1085 return
    +
    1086 end if
    +
    1087 end function
    +
    1088
    +
    1089! ------------------------------------------------------------------------------
    +
    1113 function la_qr_factor_pvt(m, n, a, lda, tau, jpvt) &
    +
    1114 bind(C, name = "la_qr_factor_pvt") result(flag)
    +
    1115 ! Arguments
    +
    1116 integer(c_int), intent(in), value :: m, n, lda
    +
    1117 real(c_double), intent(inout) :: a(lda,*)
    +
    1118 real(c_double), intent(out) :: tau(*)
    +
    1119 integer(c_int), intent(inout) :: jpvt(*)
    +
    1120 integer(c_int) :: flag
    +
    1121
    +
    1122 ! Local Variables
    +
    1123 type(errors) :: err
    +
    1124 integer(c_int) :: mn
    +
    1125
    +
    1126 ! Error Checking
    +
    1127 call err%set_exit_on_error(.false.)
    +
    1128 flag = la_no_error
    +
    1129 if (lda < m) then
    +
    1130 flag = la_invalid_input_error
    +
    1131 return
    +
    1132 end if
    +
    1133
    +
    1134 ! Process
    +
    1135 mn = min(m, n)
    +
    1136 call qr_factor(a(1:m,1:n), tau(1:mn), jpvt(1:n), err = err)
    +
    1137 if (err%has_error_occurred()) then
    +
    1138 flag = err%get_error_flag()
    +
    1139 return
    +
    1140 end if
    +
    1141 end function
    +
    1142
    +
    1143! ------------------------------------------------------------------------------
    +
    1167 function la_qr_factor_cmplx_pvt(m, n, a, lda, tau, jpvt) &
    +
    1168 bind(C, name = "la_qr_factor_cmplx_pvt") result(flag)
    +
    1169 ! Arguments
    +
    1170 integer(c_int), intent(in), value :: m, n, lda
    +
    1171 complex(c_double), intent(inout) :: a(lda,*)
    +
    1172 complex(c_double), intent(out) :: tau(*)
    +
    1173 integer(c_int), intent(inout) :: jpvt(*)
    +
    1174 integer(c_int) :: flag
    +
    1175
    +
    1176 ! Local Variables
    +
    1177 type(errors) :: err
    +
    1178 integer(c_int) :: mn
    +
    1179
    +
    1180 ! Error Checking
    +
    1181 call err%set_exit_on_error(.false.)
    +
    1182 flag = la_no_error
    +
    1183 if (lda < m) then
    +
    1184 flag = la_invalid_input_error
    +
    1185 return
    +
    1186 end if
    +
    1187
    +
    1188 ! Process
    +
    1189 mn = min(m, n)
    +
    1190 call qr_factor(a(1:m,1:n), tau(1:mn), jpvt(1:n), err = err)
    +
    1191 if (err%has_error_occurred()) then
    +
    1192 flag = err%get_error_flag()
    +
    1193 return
    +
    1194 end if
    +
    1195 end function
    +
    1196
    +
    1197! ------------------------------------------------------------------------------
    +
    1222 function la_form_qr(fullq, m, n, r, ldr, tau, q, ldq) &
    +
    1223 bind(C, name = "la_form_qr") result(flag)
    +
    1224 ! Arguments
    +
    1225 logical(c_bool), intent(in), value :: fullq
    +
    1226 integer(c_int), intent(in), value :: m, n, ldr, ldq
    +
    1227 real(c_double), intent(inout) :: r(ldr,*)
    +
    1228 real(c_double), intent(in) :: tau(*)
    +
    1229 real(c_double), intent(out) :: q(ldq,*)
    +
    1230 integer(c_int) :: flag
    +
    1231
    +
    1232 ! Local Variables
    +
    1233 type(errors) :: err
    +
    1234 integer(c_int) :: mn, nq
    +
    1235
    +
    1236 ! Error Checking
    +
    1237 call err%set_exit_on_error(.false.)
    +
    1238 flag = la_no_error
    +
    1239 if (ldr < m .or. ldq < m) then
    +
    1240 flag = la_invalid_input_error
    +
    1241 return
    +
    1242 end if
    +
    1243
    +
    1244 ! Process
    +
    1245 mn = min(m, n)
    +
    1246 nq = m
    +
    1247 if (.not.fullq) nq = n
    +
    1248 call form_qr(r(1:m,1:n), tau(1:mn), q(1:m,1:nq), err = err)
    +
    1249 if (err%has_error_occurred()) then
    +
    1250 flag = err%get_error_flag()
    +
    1251 return
    +
    1252 end if
    +
    1253 end function
    +
    1254
    +
    1255! ------------------------------------------------------------------------------
    +
    1280 function la_form_qr_cmplx(fullq, m, n, r, ldr, tau, q, ldq) &
    +
    1281 bind(C, name = "la_form_qr_cmplx") result(flag)
    +
    1282 ! Arguments
    +
    1283 logical(c_bool), intent(in), value :: fullq
    +
    1284 integer(c_int), intent(in), value :: m, n, ldr, ldq
    +
    1285 complex(c_double), intent(inout) :: r(ldr,*)
    +
    1286 complex(c_double), intent(in) :: tau(*)
    +
    1287 complex(c_double), intent(out) :: q(ldq,*)
    +
    1288 integer(c_int) :: flag
    +
    1289
    +
    1290 ! Local Variables
    +
    1291 type(errors) :: err
    +
    1292 integer(c_int) :: mn, nq
    +
    1293
    +
    1294 ! Error Checking
    +
    1295 call err%set_exit_on_error(.false.)
    +
    1296 flag = la_no_error
    +
    1297 if (ldr < m .or. ldq < m) then
    +
    1298 flag = la_invalid_input_error
    +
    1299 return
    +
    1300 end if
    +
    1301
    +
    1302 ! Process
    +
    1303 mn = min(m, n)
    +
    1304 nq = m
    +
    1305 if (.not.fullq) nq = n
    +
    1306 call form_qr(r(1:m,1:n), tau(1:mn), q(1:m,1:nq), err = err)
    +
    1307 if (err%has_error_occurred()) then
    +
    1308 flag = err%get_error_flag()
    +
    1309 return
    +
    1310 end if
    +
    1311 end function
    +
    1312
    +
    1313! ------------------------------------------------------------------------------
    +
    1344 function la_form_qr_pvt(fullq, m, n, r, ldr, tau, pvt, q, ldq, p, ldp) &
    +
    1345 bind(C, name = "la_form_qr_pvt") result(flag)
    +
    1346 ! Arguments
    +
    1347 logical(c_bool), intent(in), value :: fullq
    +
    1348 integer(c_int), intent(in), value :: m, n, ldr, ldq, ldp
    +
    1349 real(c_double), intent(inout) :: r(ldr,*)
    +
    1350 real(c_double), intent(in) :: tau(*)
    +
    1351 integer(c_int), intent(in) :: pvt(*)
    +
    1352 real(c_double), intent(out) :: q(ldq,*), p(ldp,*)
    +
    1353 integer(c_int) :: flag
    +
    1354
    +
    1355 ! Local Variables
    +
    1356 type(errors) :: err
    +
    1357 integer(c_int) :: mn, nq
    +
    1358
    +
    1359 ! Error Checking
    +
    1360 call err%set_exit_on_error(.false.)
    +
    1361 flag = la_no_error
    +
    1362 if (ldr < m .or. ldq < m .or. ldp < n) then
    +
    1363 flag = la_invalid_input_error
    +
    1364 return
    +
    1365 end if
    +
    1366
    +
    1367 ! Process
    +
    1368 mn = min(m, n)
    +
    1369 nq = m
    +
    1370 if (.not.fullq) nq = n
    +
    1371 call form_qr(r(1:m,1:n), tau(1:mn), pvt(1:n), q(1:m,1:nq), p(1:n,1:n), &
    +
    1372 err = err)
    +
    1373 if (err%has_error_occurred()) then
    +
    1374 flag = err%get_error_flag()
    +
    1375 return
    +
    1376 end if
    +
    1377 end function
    +
    1378
    +
    1379! ------------------------------------------------------------------------------
    +
    1410 function la_form_qr_cmplx_pvt(fullq, m, n, r, ldr, tau, pvt, q, ldq, p, &
    +
    1411 ldp) bind(C, name = "la_form_qr_cmplx_pvt") result(flag)
    +
    1412 ! Arguments
    +
    1413 logical(c_bool), intent(in), value :: fullq
    +
    1414 integer(c_int), intent(in), value :: m, n, ldr, ldq, ldp
    +
    1415 complex(c_double), intent(inout) :: r(ldr,*)
    +
    1416 complex(c_double), intent(in) :: tau(*)
    +
    1417 integer(c_int), intent(in) :: pvt(*)
    +
    1418 complex(c_double), intent(out) :: q(ldq,*), p(ldp,*)
    +
    1419 integer(c_int) :: flag
    +
    1420
    +
    1421 ! Local Variables
    +
    1422 type(errors) :: err
    +
    1423 integer(c_int) :: mn, nq
    +
    1424
    +
    1425 ! Error Checking
    +
    1426 call err%set_exit_on_error(.false.)
    +
    1427 flag = la_no_error
    +
    1428 if (ldr < m .or. ldq < m .or. ldp < n) then
    +
    1429 flag = la_invalid_input_error
    +
    1430 return
    +
    1431 end if
    +
    1432
    +
    1433 ! Process
    +
    1434 mn = min(m, n)
    +
    1435 nq = m
    +
    1436 if (.not.fullq) nq = n
    +
    1437 call form_qr(r(1:m,1:n), tau(1:mn), pvt(1:n), q(1:m,1:nq), p(1:n,1:n), &
    +
    1438 err = err)
    +
    1439 if (err%has_error_occurred()) then
    +
    1440 flag = err%get_error_flag()
    +
    1441 return
    +
    1442 end if
    +
    1443 end function
    +
    1444
    +
    1445! ------------------------------------------------------------------------------
    +
    1473 function la_mult_qr(lside, trans, m, n, k, a, lda, tau, c, ldc) &
    +
    1474 bind(C, name = "la_mult_qr") result(flag)
    +
    1475 ! Local Variables
    +
    1476 logical(c_bool), intent(in), value :: lside, trans
    +
    1477 integer(c_int), intent(in), value :: m, n, k, lda, ldc
    +
    1478 real(c_double), intent(inout) :: a(lda,*), c(ldc,*)
    +
    1479 real(c_double), intent(in) :: tau(*)
    +
    1480 integer(c_int) :: flag
    +
    1481
    +
    1482 ! Local Variables
    +
    1483 type(errors) :: err
    +
    1484 integer(c_int) :: ma, na
    +
    1485
    +
    1486 ! Initialization
    +
    1487 if (lside) then
    +
    1488 ma = m
    +
    1489 na = m
    +
    1490 else
    +
    1491 ma = n
    +
    1492 na = n
    +
    1493 end if
    +
    1494
    +
    1495 ! Error Checking
    +
    1496 call err%set_exit_on_error(.false.)
    +
    1497 flag = la_no_error
    +
    1498 if (lda < ma .or. ldc < m) then
    +
    1499 flag = la_invalid_input_error
    +
    1500 return
    +
    1501 end if
    +
    1502 if (k > na .or. k < 0) then
    +
    1503 flag = la_invalid_input_error
    +
    1504 return
    +
    1505 end if
    +
    1506
    +
    1507 ! Process
    +
    1508 call mult_qr(logical(lside), logical(trans), a(1:ma,1:k), tau(1:k), &
    +
    1509 c(1:m,1:n), err = err)
    +
    1510 if (err%has_error_occurred()) then
    +
    1511 flag = err%get_error_flag()
    +
    1512 return
    +
    1513 end if
    +
    1514 end function
    +
    1515
    +
    1516! ------------------------------------------------------------------------------
    +
    1544 function la_mult_qr_cmplx(lside, trans, m, n, k, a, lda, tau, c, ldc) &
    +
    1545 bind(C, name = "la_mult_qr_cmplx") result(flag)
    +
    1546 ! Local Variables
    +
    1547 logical(c_bool), intent(in), value :: lside, trans
    +
    1548 integer(c_int), intent(in), value :: m, n, k, lda, ldc
    +
    1549 complex(c_double), intent(inout) :: a(lda,*), c(ldc,*)
    +
    1550 complex(c_double), intent(in) :: tau(*)
    +
    1551 integer(c_int) :: flag
    +
    1552
    +
    1553 ! Local Variables
    +
    1554 type(errors) :: err
    +
    1555 integer(c_int) :: ma, na
    +
    1556
    +
    1557 ! Initialization
    +
    1558 if (lside) then
    +
    1559 ma = m
    +
    1560 na = m
    +
    1561 else
    +
    1562 ma = n
    +
    1563 na = n
    +
    1564 end if
    +
    1565
    +
    1566 ! Error Checking
    +
    1567 call err%set_exit_on_error(.false.)
    +
    1568 flag = la_no_error
    +
    1569 if (lda < ma .or. ldc < m) then
    +
    1570 flag = la_invalid_input_error
    +
    1571 return
    +
    1572 end if
    +
    1573 if (k > na .or. k < 0) then
    +
    1574 flag = la_invalid_input_error
    +
    1575 return
    +
    1576 end if
    +
    1577
    +
    1578 ! Process
    +
    1579 call mult_qr(logical(lside), logical(trans), a(1:ma,1:k), tau(1:k), &
    +
    1580 c(1:m,1:n), err = err)
    +
    1581 if (err%has_error_occurred()) then
    +
    1582 flag = err%get_error_flag()
    +
    1583 return
    +
    1584 end if
    +
    1585 end function
    +
    1586
    +
    1587! ------------------------------------------------------------------------------
    +
    1609 function la_qr_rank1_update(m, n, q, ldq, r, ldr, u, v) &
    +
    1610 bind(C, name = "la_qr_rank1_update") result(flag)
    +
    1611 ! Arguments
    +
    1612 integer(c_int), intent(in), value :: m, n, ldq, ldr
    +
    1613 real(c_double), intent(inout) :: q(ldq,*), r(ldr,*), u(*), v(*)
    +
    1614 integer(c_int) :: flag
    +
    1615
    +
    1616 ! Local Variables
    +
    1617 type(errors) :: err
    +
    1618 integer(c_int) :: mn
    +
    1619
    +
    1620 ! Error Checking
    +
    1621 call err%set_exit_on_error(.false.)
    +
    1622 flag = la_no_error
    +
    1623 if (ldq < m .or. ldr < m) then
    +
    1624 flag = la_invalid_input_error
    +
    1625 return
    +
    1626 end if
    +
    1627
    +
    1628 ! Process
    +
    1629 mn = min(m, n)
    +
    1630 call qr_rank1_update(q(1:m,1:mn), r(1:m,1:n), u(1:m), v(1:n), err = err)
    +
    1631 if (err%has_error_occurred()) then
    +
    1632 flag = err%get_error_flag()
    +
    1633 return
    +
    1634 end if
    +
    1635 end function
    +
    1636
    +
    1637! ------------------------------------------------------------------------------
    +
    1659 function la_qr_rank1_update_cmplx(m, n, q, ldq, r, ldr, u, v) &
    +
    1660 bind(C, name = "la_qr_rank1_update_cmplx") result(flag)
    +
    1661 ! Arguments
    +
    1662 integer(c_int), intent(in), value :: m, n, ldq, ldr
    +
    1663 complex(c_double), intent(inout) :: q(ldq,*), r(ldr,*), u(*), v(*)
    +
    1664 integer(c_int) :: flag
    +
    1665
    +
    1666 ! Local Variables
    +
    1667 type(errors) :: err
    +
    1668 integer(c_int) :: mn
    +
    1669
    +
    1670 ! Error Checking
    +
    1671 call err%set_exit_on_error(.false.)
    +
    1672 flag = la_no_error
    +
    1673 if (ldq < m .or. ldr < m) then
    +
    1674 flag = la_invalid_input_error
    +
    1675 return
    +
    1676 end if
    +
    1677
    +
    1678 ! Process
    +
    1679 mn = min(m, n)
    +
    1680 call qr_rank1_update(q(1:m,1:mn), r(1:m,1:n), u(1:m), v(1:n), err = err)
    +
    1681 if (err%has_error_occurred()) then
    +
    1682 flag = err%get_error_flag()
    +
    1683 return
    +
    1684 end if
    +
    1685 end function
    +
    1686
    +
    1687! ------------------------------------------------------------------------------
    +
    1704 function la_cholesky_factor(upper, n, a, lda) &
    +
    1705 bind(C, name = "la_cholesky_factor") result(flag)
    +
    1706 ! Arguments
    +
    1707 logical(c_bool), intent(in), value :: upper
    +
    1708 integer(c_int), intent(in), value :: n, lda
    +
    1709 real(c_double), intent(inout) :: a(lda,*)
    +
    1710 integer(c_int) :: flag
    +
    1711
    +
    1712 ! Local Variables
    +
    1713 type(errors) :: err
    +
    1714
    +
    1715 ! Error Checking
    +
    1716 call err%set_exit_on_error(.false.)
    +
    1717 flag = la_no_error
    +
    1718 if (lda < n) then
    +
    1719 flag = la_invalid_input_error
    +
    1720 return
    +
    1721 end if
    +
    1722
    +
    1723 ! Process
    +
    1724 call cholesky_factor(a(1:n,1:n), logical(upper), err = err)
    +
    1725 if (err%has_error_occurred()) then
    +
    1726 flag = err%get_error_flag()
    +
    1727 return
    +
    1728 end if
    +
    1729 end function
    +
    1730
    +
    1731! ------------------------------------------------------------------------------
    +
    1748 function la_cholesky_factor_cmplx(upper, n, a, lda) &
    +
    1749 bind(C, name = "la_cholesky_factor_cmplx") result(flag)
    +
    1750 ! Arguments
    +
    1751 logical(c_bool), intent(in), value :: upper
    +
    1752 integer(c_int), intent(in), value :: n, lda
    +
    1753 complex(c_double), intent(inout) :: a(lda,*)
    +
    1754 integer(c_int) :: flag
    +
    1755
    +
    1756 ! Local Variables
    +
    1757 type(errors) :: err
    +
    1758
    +
    1759 ! Error Checking
    +
    1760 call err%set_exit_on_error(.false.)
    +
    1761 flag = la_no_error
    +
    1762 if (lda < n) then
    +
    1763 flag = la_invalid_input_error
    +
    1764 return
    +
    1765 end if
    +
    1766
    +
    1767 ! Process
    +
    1768 call cholesky_factor(a(1:n,1:n), logical(upper), err = err)
    +
    1769 if (err%has_error_occurred()) then
    +
    1770 flag = err%get_error_flag()
    +
    1771 return
    +
    1772 end if
    +
    1773 end function
    +
    1774
    +
    1775! ------------------------------------------------------------------------------
    +
    1791 function la_cholesky_rank1_update(n, r, ldr, u) &
    +
    1792 bind(C, name = "la_cholesky_rank1_update") result(flag)
    +
    1793 ! Arguments
    +
    1794 integer(c_int), intent(in), value :: n, ldr
    +
    1795 real(c_double), intent(inout) :: r(ldr,*), u(*)
    +
    1796 integer(c_int) :: flag
    +
    1797
    +
    1798 ! Local Variables
    +
    1799 type(errors) :: err
    +
    1800
    +
    1801 ! Error Checking
    +
    1802 call err%set_exit_on_error(.false.)
    +
    1803 flag = la_no_error
    +
    1804 if (ldr < n) then
    +
    1805 flag = la_invalid_input_error
    +
    1806 return
    +
    1807 end if
    +
    1808
    +
    1809 ! Process
    +
    1810 call cholesky_rank1_update(r(1:n,1:n), u(1:n), err = err)
    +
    1811 if (err%has_error_occurred()) then
    +
    1812 flag = err%get_error_flag()
    +
    1813 return
    +
    1814 end if
    +
    1815 end function
    +
    1816
    +
    1817! ------------------------------------------------------------------------------
    +
    1833 function la_cholesky_rank1_update_cmplx(n, r, ldr, u) &
    +
    1834 bind(C, name = "la_cholesky_rank1_update_cmplx") result(flag)
    +
    1835 ! Arguments
    +
    1836 integer(c_int), intent(in), value :: n, ldr
    +
    1837 complex(c_double), intent(inout) :: r(ldr,*), u(*)
    +
    1838 integer(c_int) :: flag
    +
    1839
    +
    1840 ! Local Variables
    +
    1841 type(errors) :: err
    +
    1842
    +
    1843 ! Error Checking
    +
    1844 call err%set_exit_on_error(.false.)
    +
    1845 flag = la_no_error
    +
    1846 if (ldr < n) then
    +
    1847 flag = la_invalid_input_error
    +
    1848 return
    +
    1849 end if
    +
    1850
    +
    1851 ! Process
    +
    1852 call cholesky_rank1_update(r(1:n,1:n), u(1:n), err = err)
    +
    1853 if (err%has_error_occurred()) then
    +
    1854 flag = err%get_error_flag()
    +
    1855 return
    +
    1856 end if
    +
    1857 end function
    +
    1858
    +
    1859! ------------------------------------------------------------------------------
    +
    1877 function la_cholesky_rank1_downdate(n, r, ldr, u) &
    +
    1878 bind(C, name = "la_cholesky_rank1_downdate") result(flag)
    +
    1879 ! Arguments
    +
    1880 integer(c_int), intent(in), value :: n, ldr
    +
    1881 real(c_double), intent(inout) :: r(ldr,*), u(*)
    +
    1882 integer(c_int) :: flag
    +
    1883
    +
    1884 ! Local Variables
    +
    1885 type(errors) :: err
    +
    1886
    +
    1887 ! Error Checking
    +
    1888 call err%set_exit_on_error(.false.)
    +
    1889 flag = la_no_error
    +
    1890 if (ldr < n) then
    +
    1891 flag = la_invalid_input_error
    +
    1892 return
    +
    1893 end if
    +
    1894
    +
    1895 ! Process
    +
    1896 call cholesky_rank1_downdate(r(1:n,1:n), u(1:n), err = err)
    +
    1897 if (err%has_error_occurred()) then
    +
    1898 flag = err%get_error_flag()
    +
    1899 return
    +
    1900 end if
    +
    1901 end function
    +
    1902
    +
    1903! ------------------------------------------------------------------------------
    +
    1921 function la_cholesky_rank1_downdate_cmplx(n, r, ldr, u) &
    +
    1922 bind(C, name = "la_cholesky_rank1_downdate_cmplx") result(flag)
    +
    1923 ! Arguments
    +
    1924 integer(c_int), intent(in), value :: n, ldr
    +
    1925 complex(c_double), intent(inout) :: r(ldr,*), u(*)
    +
    1926 integer(c_int) :: flag
    +
    1927
    +
    1928 ! Local Variables
    +
    1929 type(errors) :: err
    +
    1930
    +
    1931 ! Error Checking
    +
    1932 call err%set_exit_on_error(.false.)
    +
    1933 flag = la_no_error
    +
    1934 if (ldr < n) then
    +
    1935 flag = la_invalid_input_error
    +
    1936 return
    +
    1937 end if
    +
    1938
    +
    1939 ! Process
    +
    1940 call cholesky_rank1_downdate(r(1:n,1:n), u(1:n), err = err)
    +
    1941 if (err%has_error_occurred()) then
    +
    1942 flag = err%get_error_flag()
    +
    1943 return
    +
    1944 end if
    +
    1945 end function
    +
    1946
    +
    1947! ------------------------------------------------------------------------------
    +
    1975 function la_svd(m, n, a, lda, s, u, ldu, vt, ldv) &
    +
    1976 bind(C, name = "la_svd") result(flag)
    +
    1977 ! Arguments
    +
    1978 integer(c_int), intent(in), value :: m, n, lda, ldu, ldv
    +
    1979 real(c_double), intent(inout) :: a(lda,*)
    +
    1980 real(c_double), intent(out) :: s(*), u(ldu,*), vt(ldv,*)
    +
    1981 integer(c_int) :: flag
    +
    1982
    +
    1983 ! Local Variables
    +
    1984 type(errors) :: err
    +
    1985 integer(c_int) :: mn
    +
    1986
    +
    1987 ! Error Checking
    +
    1988 call err%set_exit_on_error(.false.)
    +
    1989 flag = la_no_error
    +
    1990 if (lda < m .or. ldu < m .or. ldv < n) then
    +
    1991 flag = la_invalid_input_error
    +
    1992 return
    +
    1993 end if
    +
    1994
    +
    1995 ! Process
    +
    1996 mn = min(m, n)
    +
    1997 call svd(a(1:m,1:n), s(1:mn), u(1:m,1:m), vt(1:n,1:n), err = err)
    +
    1998 if (err%has_error_occurred()) then
    +
    1999 flag = err%get_error_flag()
    +
    2000 return
    +
    2001 end if
    +
    2002 end function
    +
    2003
    +
    2004! ------------------------------------------------------------------------------
    +
    2032 function la_svd_cmplx(m, n, a, lda, s, u, ldu, vt, ldv) &
    +
    2033 bind(C, name = "la_svd_cmplx") result(flag)
    +
    2034 ! Arguments
    +
    2035 integer(c_int), intent(in), value :: m, n, lda, ldu, ldv
    +
    2036 complex(c_double), intent(inout) :: a(lda,*)
    +
    2037 real(c_double), intent(out) :: s(*)
    +
    2038 complex(c_double), intent(out) :: u(ldu,*), vt(ldv,*)
    +
    2039 integer(c_int) :: flag
    +
    2040
    +
    2041 ! Local Variables
    +
    2042 type(errors) :: err
    +
    2043 integer(c_int) :: mn
    +
    2044
    +
    2045 ! Error Checking
    +
    2046 call err%set_exit_on_error(.false.)
    +
    2047 flag = la_no_error
    +
    2048 if (lda < m .or. ldu < m .or. ldv < n) then
    +
    2049 flag = la_invalid_input_error
    +
    2050 return
    +
    2051 end if
    +
    2052
    +
    2053 ! Process
    +
    2054 mn = min(m, n)
    +
    2055 call svd(a(1:m,1:n), s(1:mn), u(1:m,1:m), vt(1:n,1:n), err = err)
    +
    2056 if (err%has_error_occurred()) then
    +
    2057 flag = err%get_error_flag()
    +
    2058 return
    +
    2059 end if
    +
    2060 end function
    +
    2061
    +
    2062! ------------------------------------------------------------------------------
    +
    2089 function la_solve_tri_mtx(lside, upper, trans, nounit, m, n, alpha, a, &
    +
    2090 lda, b, ldb) bind(C, name = "la_solve_tri_mtx") result(flag)
    +
    2091 ! Arguments
    +
    2092 logical(c_bool), intent(in), value :: lside, upper, trans, nounit
    +
    2093 integer(c_int), intent(in), value :: m, n, lda, ldb
    +
    2094 real(c_double), intent(in), value :: alpha
    +
    2095 real(c_double), intent(in) :: a(lda,*)
    +
    2096 real(c_double), intent(inout) :: b(ldb,*)
    +
    2097 integer(c_int) :: flag
    +
    2098
    +
    2099 ! Local Variables
    +
    2100 type(errors) :: err
    +
    2101 integer(c_int) :: ma
    +
    2102
    +
    2103 ! Initialization
    +
    2104 if (lside) then
    +
    2105 ma = m
    +
    2106 else
    +
    2107 ma = n
    +
    2108 end if
    +
    2109
    +
    2110 ! Error Checking
    +
    2111 call err%set_exit_on_error(.false.)
    +
    2112 flag = la_no_error
    +
    2113 if (lda < ma .or. ldb < m) then
    +
    2114 flag = la_invalid_input_error
    +
    2115 return
    +
    2116 end if
    +
    2117
    +
    2118 ! Process
    +
    2119 call solve_triangular_system(logical(lside), logical(upper), &
    +
    2120 logical(trans), logical(nounit), alpha, a(1:ma,1:ma), b(1:m,1:n))
    +
    2121 end function
    +
    2122
    +
    2123! ------------------------------------------------------------------------------
    +
    2150 function la_solve_tri_mtx_cmplx(lside, upper, trans, nounit, m, n, &
    +
    2151 alpha, a, lda, b, ldb) &
    +
    2152 bind(C, name = "la_solve_tri_mtx_cmplx") result(flag)
    +
    2153 ! Arguments
    +
    2154 logical(c_bool), intent(in), value :: lside, upper, trans, nounit
    +
    2155 integer(c_int), intent(in), value :: m, n, lda, ldb
    +
    2156 complex(c_double), intent(in), value :: alpha
    +
    2157 complex(c_double), intent(in) :: a(lda,*)
    +
    2158 complex(c_double), intent(inout) :: b(ldb,*)
    +
    2159 integer(c_int) :: flag
    +
    2160
    +
    2161 ! Local Variables
    +
    2162 type(errors) :: err
    +
    2163 integer(c_int) :: ma
    +
    2164
    +
    2165 ! Initialization
    +
    2166 if (lside) then
    +
    2167 ma = m
    +
    2168 else
    +
    2169 ma = n
    +
    2170 end if
    +
    2171
    +
    2172 ! Error Checking
    +
    2173 call err%set_exit_on_error(.false.)
    +
    2174 flag = la_no_error
    +
    2175 if (lda < ma .or. ldb < m) then
    +
    2176 flag = la_invalid_input_error
    +
    2177 return
    +
    2178 end if
    +
    2179
    +
    2180 ! Process
    +
    2181 call solve_triangular_system(logical(lside), logical(upper), &
    +
    2182 logical(trans), logical(nounit), alpha, a(1:ma,1:ma), b(1:m,1:n))
    +
    2183 end function
    +
    2184
    +
    2185! ------------------------------------------------------------------------------
    +
    2200 function la_solve_lu(m, n, a, lda, ipvt, b, ldb) &
    +
    2201 bind(C, name = "la_solve_lu") result(flag)
    +
    2202 ! Arguments
    +
    2203 integer(c_int), intent(in), value :: m, n, lda, ldb
    +
    2204 real(c_double), intent(in) :: a(lda,*)
    +
    2205 integer(c_int), intent(in) :: ipvt(*)
    +
    2206 real(c_double), intent(inout) :: b(ldb,*)
    +
    2207 integer(c_int) :: flag
    +
    2208
    +
    2209 ! Local Variables
    +
    2210 type(errors) :: err
    +
    2211
    +
    2212 ! Error Checking
    +
    2213 call err%set_exit_on_error(.false.)
    +
    2214 flag = la_no_error
    +
    2215 if (lda < m .or. ldb < m) then
    +
    2216 flag = la_invalid_input_error
    +
    2217 return
    +
    2218 end if
    +
    2219
    +
    2220 ! Process
    +
    2221 call solve_lu(a(1:m,1:m), ipvt(1:m), b(1:m,1:n))
    +
    2222 end function
    +
    2223
    +
    2224! ------------------------------------------------------------------------------
    +
    2239 function la_solve_lu_cmplx(m, n, a, lda, ipvt, b, ldb) &
    +
    2240 bind(C, name = "la_solve_lu_cmplx") result(flag)
    +
    2241 ! Arguments
    +
    2242 integer(c_int), intent(in), value :: m, n, lda, ldb
    +
    2243 complex(c_double), intent(in) :: a(lda,*)
    +
    2244 integer(c_int), intent(in) :: ipvt(*)
    +
    2245 complex(c_double), intent(inout) :: b(ldb,*)
    +
    2246 integer(c_int) :: flag
    +
    2247
    +
    2248 ! Local Variables
    +
    2249 type(errors) :: err
    +
    2250
    +
    2251 ! Error Checking
    +
    2252 call err%set_exit_on_error(.false.)
    +
    2253 flag = la_no_error
    +
    2254 if (lda < m .or. ldb < m) then
    +
    2255 flag = la_invalid_input_error
    +
    2256 return
    +
    2257 end if
    +
    2258
    +
    2259 ! Process
    +
    2260 call solve_lu(a(1:m,1:m), ipvt(1:m), b(1:m,1:n))
    +
    2261 end function
    +
    2262
    +
    2263! ------------------------------------------------------------------------------
    +
    2285 function la_solve_qr(m, n, k, a, lda, tau, b, ldb) &
    +
    2286 bind(C, name = "la_solve_qr") result(flag)
    +
    2287 ! Arguments
    +
    2288 integer(c_int), intent(in), value :: m, n, k, lda, ldb
    +
    2289 real(c_double), intent(inout) :: a(lda,*), b(ldb,*)
    +
    2290 real(c_double), intent(in) :: tau(*)
    +
    2291 integer(c_int) :: flag
    +
    2292
    +
    2293 ! Local Variables
    +
    2294 type(errors) :: err
    +
    2295 integer(c_int) :: minmn
    +
    2296
    +
    2297 ! Error Checking
    +
    2298 call err%set_exit_on_error(.false.)
    +
    2299 flag = la_no_error
    +
    2300 if (lda < m .or. ldb < m .or. m < n) then
    +
    2301 flag = la_invalid_input_error
    +
    2302 return
    +
    2303 end if
    +
    2304
    +
    2305 ! Process
    +
    2306 minmn = min(m, n)
    +
    2307 call solve_qr(a(1:m,1:n), tau(1:minmn), b(1:m,1:k), err = err)
    +
    2308 if (err%has_error_occurred()) then
    +
    2309 flag = err%get_error_flag()
    +
    2310 return
    +
    2311 end if
    +
    2312 end function
    +
    2313
    +
    2314! ------------------------------------------------------------------------------
    +
    2336 function la_solve_qr_cmplx(m, n, k, a, lda, tau, b, ldb) &
    +
    2337 bind(C, name = "la_solve_qr_cmplx") result(flag)
    +
    2338 ! Arguments
    +
    2339 integer(c_int), intent(in), value :: m, n, k, lda, ldb
    +
    2340 complex(c_double), intent(inout) :: a(lda,*), b(ldb,*)
    +
    2341 complex(c_double), intent(in) :: tau(*)
    +
    2342 integer(c_int) :: flag
    +
    2343
    +
    2344 ! Local Variables
    +
    2345 type(errors) :: err
    +
    2346 integer(c_int) :: minmn
    +
    2347
    +
    2348 ! Error Checking
    +
    2349 call err%set_exit_on_error(.false.)
    +
    2350 flag = la_no_error
    +
    2351 if (lda < m .or. ldb < m .or. m < n) then
    +
    2352 flag = la_invalid_input_error
    +
    2353 return
    +
    2354 end if
    +
    2355
    +
    2356 ! Process
    +
    2357 minmn = min(m, n)
    +
    2358 call solve_qr(a(1:m,1:n), tau(1:minmn), b(1:m,1:k), err = err)
    +
    2359 if (err%has_error_occurred()) then
    +
    2360 flag = err%get_error_flag()
    +
    2361 return
    +
    2362 end if
    +
    2363 end function
    +
    2364
    +
    2365! ------------------------------------------------------------------------------
    +
    2387 function la_solve_qr_pvt(m, n, k, a, lda, tau, jpvt, b, ldb) &
    +
    2388 bind(C, name = "la_solve_qr_pvt") result(flag)
    +
    2389 ! Arguments
    +
    2390 integer(c_int), intent(in), value :: m, n, k, lda, ldb
    +
    2391 real(c_double), intent(inout) :: a(lda,*), b(ldb,*)
    +
    2392 real(c_double), intent(in) :: tau(*)
    +
    2393 integer(c_int), intent(in) :: jpvt(*)
    +
    2394 integer(c_int) :: flag
    +
    2395
    +
    2396 ! Local Variables
    +
    2397 type(errors) :: err
    +
    2398 integer(c_int) :: minmn, maxmn
    +
    2399
    +
    2400 ! Error Checking
    +
    2401 minmn = min(m, n)
    +
    2402 maxmn = max(m, n)
    +
    2403 call err%set_exit_on_error(.false.)
    +
    2404 flag = la_no_error
    +
    2405 if (lda < m .or. ldb < maxmn) then
    +
    2406 flag = la_invalid_input_error
    +
    2407 return
    +
    2408 end if
    +
    2409
    +
    2410 ! Process
    +
    2411 call solve_qr(a(1:m,1:n), tau(1:minmn), jpvt(1:n), b(1:maxmn,1:k), &
    +
    2412 err = err)
    +
    2413 if (err%has_error_occurred()) then
    +
    2414 flag = err%get_error_flag()
    +
    2415 return
    +
    2416 end if
    +
    2417 end function
    +
    2418
    +
    2419! ------------------------------------------------------------------------------
    +
    2441 function la_solve_qr_cmplx_pvt(m, n, k, a, lda, tau, jpvt, b, ldb) &
    +
    2442 bind(C, name = "la_solve_qr_cmplx_pvt") result(flag)
    +
    2443 ! Arguments
    +
    2444 integer(c_int), intent(in), value :: m, n, k, lda, ldb
    +
    2445 complex(c_double), intent(inout) :: a(lda,*), b(ldb,*)
    +
    2446 complex(c_double), intent(in) :: tau(*)
    +
    2447 integer(c_int), intent(in) :: jpvt(*)
    +
    2448 integer(c_int) :: flag
    +
    2449
    +
    2450 ! Local Variables
    +
    2451 type(errors) :: err
    +
    2452 integer(c_int) :: minmn, maxmn
    +
    2453
    +
    2454 ! Error Checking
    +
    2455 minmn = min(m, n)
    +
    2456 maxmn = max(m, n)
    +
    2457 call err%set_exit_on_error(.false.)
    +
    2458 flag = la_no_error
    +
    2459 if (lda < m .or. ldb < maxmn) then
    +
    2460 flag = la_invalid_input_error
    +
    2461 return
    +
    2462 end if
    +
    2463
    +
    2464 ! Process
    +
    2465 call solve_qr(a(1:m,1:n), tau(1:minmn), jpvt(1:n), b(1:maxmn,1:k), &
    +
    2466 err = err)
    +
    2467 if (err%has_error_occurred()) then
    +
    2468 flag = err%get_error_flag()
    +
    2469 return
    +
    2470 end if
    +
    2471 end function
    +
    2472
    +
    2473! ------------------------------------------------------------------------------
    +
    2490 function la_solve_cholesky(upper, m, n, a, lda, b, ldb) &
    +
    2491 bind(C, name = "la_solve_cholesky") result(flag)
    +
    2492 ! Arguments
    +
    2493 logical(c_bool), intent(in), value :: upper
    +
    2494 integer(c_int), intent(in), value :: m, n, lda, ldb
    +
    2495 real(c_double), intent(in) :: a(lda,*)
    +
    2496 real(c_double), intent(inout) :: b(ldb,*)
    +
    2497 integer(c_int) :: flag
    +
    2498
    +
    2499 ! Local Variables
    +
    2500 type(errors) :: err
    +
    2501
    +
    2502 ! Error Checking
    +
    2503 call err%set_exit_on_error(.false.)
    +
    2504 flag = la_no_error
    +
    2505 if (lda < m .or. ldb < m) then
    +
    2506 flag = la_invalid_input_error
    +
    2507 return
    +
    2508 end if
    +
    2509
    +
    2510 ! Process
    +
    2511 call solve_cholesky(logical(upper), a(1:m,1:m), b(1:m,1:n))
    +
    2512 end function
    +
    2513
    +
    2514! ------------------------------------------------------------------------------
    +
    2531 function la_solve_cholesky_cmplx(upper, m, n, a, lda, b, ldb) &
    +
    2532 bind(C, name = "la_solve_cholesky_cmplx") result(flag)
    +
    2533 ! Arguments
    +
    2534 logical(c_bool), intent(in), value :: upper
    +
    2535 integer(c_int), intent(in), value :: m, n, lda, ldb
    +
    2536 complex(c_double), intent(in) :: a(lda,*)
    +
    2537 complex(c_double), intent(inout) :: b(ldb,*)
    +
    2538 integer(c_int) :: flag
    +
    2539
    +
    2540 ! Local Variables
    +
    2541 type(errors) :: err
    +
    2542
    +
    2543 ! Error Checking
    +
    2544 call err%set_exit_on_error(.false.)
    +
    2545 flag = la_no_error
    +
    2546 if (lda < m .or. ldb < m) then
    +
    2547 flag = la_invalid_input_error
    +
    2548 return
    +
    2549 end if
    +
    2550
    +
    2551 ! Process
    +
    2552 call solve_cholesky(logical(upper), a(1:m,1:m), b(1:m,1:n))
    +
    2553 end function
    +
    2554
    +
    2555! ------------------------------------------------------------------------------
    +
    2579 function la_solve_least_squares(m, n, k, a, lda, b, ldb) &
    +
    2580 bind(C, name = "la_solve_least_squares") result(flag)
    +
    2581 ! Arguments
    +
    2582 integer(c_int), intent(in), value :: m, n, k, lda, ldb
    +
    2583 real(c_double), intent(inout) :: a(lda,*), b(ldb,*)
    +
    2584 integer(c_int) :: flag
    +
    2585
    +
    2586 ! Local Variables
    +
    2587 type(errors) :: err
    +
    2588 integer(c_int) :: maxmn
    +
    2589
    +
    2590 ! Error Checking
    +
    2591 maxmn = max(m, n)
    +
    2592 call err%set_exit_on_error(.false.)
    +
    2593 flag = la_no_error
    +
    2594 if (lda < m .or. ldb < maxmn) then
    +
    2595 flag = la_invalid_input_error
    +
    2596 return
    +
    2597 end if
    +
    2598
    +
    2599 ! Process
    +
    2600 call solve_least_squares(a(1:m,1:n), b(1:maxmn,1:k), err = err)
    +
    2601 if (err%has_error_occurred()) then
    +
    2602 flag = err%get_error_flag()
    +
    2603 return
    +
    2604 end if
    +
    2605 end function
    +
    2606
    +
    2607! ------------------------------------------------------------------------------
    +
    2631 function la_solve_least_squares_cmplx(m, n, k, a, lda, b, ldb) &
    +
    2632 bind(C, name = "la_solve_least_squares_cmplx") result(flag)
    +
    2633 ! Arguments
    +
    2634 integer(c_int), intent(in), value :: m, n, k, lda, ldb
    +
    2635 complex(c_double), intent(inout) :: a(lda,*), b(ldb,*)
    +
    2636 integer(c_int) :: flag
    +
    2637
    +
    2638 ! Local Variables
    +
    2639 type(errors) :: err
    +
    2640 integer(c_int) :: maxmn
    +
    2641
    +
    2642 ! Error Checking
    +
    2643 maxmn = max(m, n)
    +
    2644 call err%set_exit_on_error(.false.)
    +
    2645 flag = la_no_error
    +
    2646 if (lda < m .or. ldb < maxmn) then
    +
    2647 flag = la_invalid_input_error
    +
    2648 return
    +
    2649 end if
    +
    2650
    +
    2651 ! Process
    +
    2652 call solve_least_squares(a(1:m,1:n), b(1:maxmn,1:k), err = err)
    +
    2653 if (err%has_error_occurred()) then
    +
    2654 flag = err%get_error_flag()
    +
    2655 return
    +
    2656 end if
    +
    2657 end function
    +
    2658
    +
    2659! ------------------------------------------------------------------------------
    +
    2671 function la_inverse(n, a, lda) bind(C, name = "la_inverse") result(flag)
    +
    2672 ! Arguments
    +
    2673 integer(c_int), intent(in), value :: n, lda
    +
    2674 real(c_double), intent(inout) :: a(lda,*)
    +
    2675 integer(c_int) :: flag
    +
    2676
    +
    2677 ! Local Variables
    +
    2678 type(errors) :: err
    +
    2679
    +
    2680 ! Error Checking
    +
    2681 call err%set_exit_on_error(.false.)
    +
    2682 flag = la_no_error
    +
    2683 if (lda < n) then
    +
    2684 flag = la_invalid_input_error
    +
    2685 return
    +
    2686 end if
    +
    2687
    +
    2688 ! Process
    +
    2689 call mtx_inverse(a(1:n,1:n), err = err)
    +
    2690 if (err%has_error_occurred()) then
    +
    2691 flag = err%get_error_flag()
    +
    2692 return
    +
    2693 end if
    +
    2694 end function
    +
    2695
    +
    2696! ------------------------------------------------------------------------------
    +
    2708 function la_inverse_cmplx(n, a, lda) bind(C, name = "la_inverse_cmplx") &
    +
    2709 result(flag)
    +
    2710 ! Arguments
    +
    2711 integer(c_int), intent(in), value :: n, lda
    +
    2712 complex(c_double), intent(inout) :: a(lda,*)
    +
    2713 integer(c_int) :: flag
    +
    2714
    +
    2715 ! Local Variables
    +
    2716 type(errors) :: err
    +
    2717
    +
    2718 ! Error Checking
    +
    2719 call err%set_exit_on_error(.false.)
    +
    2720 flag = la_no_error
    +
    2721 if (lda < n) then
    +
    2722 flag = la_invalid_input_error
    +
    2723 return
    +
    2724 end if
    +
    2725
    +
    2726 ! Process
    +
    2727 call mtx_inverse(a(1:n,1:n), err = err)
    +
    2728 if (err%has_error_occurred()) then
    +
    2729 flag = err%get_error_flag()
    +
    2730 return
    +
    2731 end if
    +
    2732 end function
    +
    2733
    +
    2734! ------------------------------------------------------------------------------
    +
    2750 function la_pinverse(m, n, a, lda, ainv, ldai) &
    +
    2751 bind(C, name = "la_pinverse") result(flag)
    +
    2752 ! Arguments
    +
    2753 integer(c_int), intent(in), value :: m, n, lda, ldai
    +
    2754 real(c_double), intent(inout) :: a(lda,*)
    +
    2755 real(c_double), intent(out) :: ainv(ldai,*)
    +
    2756 integer(c_int) :: flag
    +
    2757
    +
    2758 ! Local Variables
    +
    2759 type(errors) :: err
    +
    2760
    +
    2761 ! Error Checking
    +
    2762 call err%set_exit_on_error(.false.)
    +
    2763 flag = la_no_error
    +
    2764 if (lda < m .or. ldai < n) then
    +
    2765 flag = la_invalid_input_error
    +
    2766 return
    +
    2767 end if
    +
    2768
    +
    2769 ! Process
    +
    2770 call mtx_pinverse(a(1:m,1:n), ainv(1:n,1:m), err = err)
    +
    2771 if (err%has_error_occurred()) then
    +
    2772 flag = err%get_error_flag()
    +
    2773 return
    +
    2774 end if
    +
    2775 end function
    +
    2776
    +
    2777! ------------------------------------------------------------------------------
    +
    2793 function la_pinverse_cmplx(m, n, a, lda, ainv, ldai) &
    +
    2794 bind(C, name = "la_pinverse_cmplx") result(flag)
    +
    2795 ! Arguments
    +
    2796 integer(c_int), intent(in), value :: m, n, lda, ldai
    +
    2797 complex(c_double), intent(inout) :: a(lda,*)
    +
    2798 complex(c_double), intent(out) :: ainv(ldai,*)
    +
    2799 integer(c_int) :: flag
    +
    2800
    +
    2801 ! Local Variables
    +
    2802 type(errors) :: err
    +
    2803
    +
    2804 ! Error Checking
    +
    2805 call err%set_exit_on_error(.false.)
    +
    2806 flag = la_no_error
    +
    2807 if (lda < m .or. ldai < n) then
    +
    2808 flag = la_invalid_input_error
    +
    2809 return
    +
    2810 end if
    +
    2811
    +
    2812 ! Process
    +
    2813 call mtx_pinverse(a(1:m,1:n), ainv(1:n,1:m), err = err)
    +
    2814 if (err%has_error_occurred()) then
    +
    2815 flag = err%get_error_flag()
    +
    2816 return
    +
    2817 end if
    +
    2818 end function
    +
    2819
    +
    2820! ------------------------------------------------------------------------------
    +
    2842 function la_eigen_symm(vecs, n, a, lda, vals) &
    +
    2843 bind(C, name = "la_eigen_symm") result(flag)
    +
    2844 ! Arguments
    +
    2845 logical(c_bool), intent(in), value :: vecs
    +
    2846 integer(c_int), intent(in), value :: n, lda
    +
    2847 real(c_double), intent(inout) :: a(lda,*)
    +
    2848 real(c_double), intent(out) :: vals(*)
    +
    2849 integer(c_int) :: flag
    +
    2850
    +
    2851 ! Local Variables
    +
    2852 type(errors) :: err
    +
    2853
    +
    2854 ! Error Checking
    +
    2855 call err%set_exit_on_error(.false.)
    +
    2856 flag = la_no_error
    +
    2857 if (lda < n) then
    +
    2858 flag = la_invalid_input_error
    +
    2859 return
    +
    2860 end if
    +
    2861
    +
    2862 ! Process
    +
    2863 call eigen(logical(vecs), a(1:n,1:n), vals(1:n), err = err)
    +
    2864 if (err%has_error_occurred()) then
    +
    2865 flag = err%get_error_flag()
    +
    2866 return
    +
    2867 end if
    +
    2868 end function
    +
    2869
    +
    2870! ------------------------------------------------------------------------------
    +
    2891 function la_eigen_asymm(vecs, n, a, lda, vals, v, ldv) &
    +
    2892 bind(C, name = "la_eigen_asymm") result(flag)
    +
    2893 ! Arguments
    +
    2894 logical(c_bool), intent(in), value :: vecs
    +
    2895 integer(c_int), intent(in), value :: n, lda, ldv
    +
    2896 real(c_double), intent(inout) :: a(lda,*)
    +
    2897 complex(c_double), intent(out) :: vals(*), v(ldv,*)
    +
    2898 integer(c_int) :: flag
    +
    2899
    +
    2900 ! Local Variables
    +
    2901 type(errors) :: err
    +
    2902
    +
    2903 ! Error Checking
    +
    2904 call err%set_exit_on_error(.false.)
    +
    2905 flag = la_no_error
    +
    2906 if (vecs) then
    +
    2907 if (lda < n .or. ldv < n) then
    +
    2908 flag = la_invalid_input_error
    +
    2909 return
    +
    2910 end if
    +
    2911 else
    +
    2912 if (lda < n) then
    +
    2913 flag = la_invalid_input_error
    +
    2914 return
    +
    2915 end if
    +
    2916 end if
    +
    2917
    +
    2918 ! Process
    +
    2919 if (vecs) then
    +
    2920 call eigen(a(1:n,1:n), vals(1:n), v(1:n,1:n), err = err)
    +
    2921 else
    +
    2922 call eigen(a(1:n,1:n), vals(1:n))
    +
    2923 end if
    +
    2924 if (err%has_error_occurred()) then
    +
    2925 flag = err%get_error_flag()
    +
    2926 return
    +
    2927 end if
    +
    2928 end function
    +
    2929
    +
    2930! ------------------------------------------------------------------------------
    +
    2964 function la_eigen_gen(vecs, n, a, lda, b, ldb, alpha, beta, v, ldv) &
    +
    2965 bind(C, name = "la_eigen_gen") result(flag)
    +
    2966 ! Arguments
    +
    2967 logical(c_bool), intent(in), value :: vecs
    +
    2968 integer(c_int), intent(in), value :: n, lda, ldb, ldv
    +
    2969 real(c_double), intent(inout) :: a(lda,*), b(ldb,*)
    +
    2970 real(c_double), intent(out) :: beta(*)
    +
    2971 complex(c_double), intent(out) :: alpha(*), v(ldv,*)
    +
    2972 integer(c_int) :: flag
    +
    2973
    +
    2974 ! Local Variables
    +
    2975 type(errors) :: err
    +
    2976
    +
    2977 ! Error Checking
    +
    2978 call err%set_exit_on_error(.false.)
    +
    2979 flag = la_no_error
    +
    2980 if (vecs) then
    +
    2981 if (lda < n .or. ldb < n .or. ldv < n) then
    +
    2982 flag = la_invalid_input_error
    +
    2983 return
    +
    2984 end if
    +
    2985 else
    +
    2986 if (lda < n .or. ldb < n) then
    +
    2987 flag = la_invalid_input_error
    +
    2988 return
    +
    2989 end if
    +
    2990 end if
    +
    2991
    +
    2992 ! Process
    +
    2993 if (vecs) then
    +
    2994 call eigen(a(1:n,1:n), b(1:n,1:n), alpha(1:n), beta(1:n), &
    +
    2995 v(1:n,1:n), err = err)
    +
    2996 else
    +
    2997 call eigen(a(1:n,1:n), b(1:n,1:n), alpha(1:n), beta(1:n), err = err)
    +
    2998 end if
    +
    2999 if (err%has_error_occurred()) then
    +
    3000 flag = err%get_error_flag()
    +
    3001 return
    +
    3002 end if
    +
    3003 end function
    +
    3004
    +
    3005! ------------------------------------------------------------------------------
    +
    3026 function la_eigen_cmplx(vecs, n, a, lda, vals, v, ldv) &
    +
    3027 bind(C, name = "la_eigen_cmplx") result(flag)
    +
    3028 ! Arguments
    +
    3029 logical(c_bool), intent(in), value :: vecs
    +
    3030 integer(c_int), intent(in), value :: n, lda, ldv
    +
    3031 complex(c_double), intent(inout) :: a(lda,*)
    +
    3032 complex(c_double), intent(out) :: vals(*), v(ldv,*)
    +
    3033 integer(c_int) :: flag
    +
    3034
    +
    3035 ! Local Variables
    +
    3036 type(errors) :: err
    +
    3037
    +
    3038 ! Error Checking
    +
    3039 call err%set_exit_on_error(.false.)
    +
    3040 flag = la_no_error
    +
    3041 if (vecs) then
    +
    3042 if (lda < n .or. ldv < n) then
    +
    3043 flag = la_invalid_input_error
    +
    3044 return
    +
    3045 end if
    +
    3046 else
    +
    3047 if (lda < n) then
    +
    3048 flag = la_invalid_input_error
    +
    3049 return
    +
    3050 end if
    +
    3051 end if
    +
    3052
    +
    3053 ! Process
    +
    3054 if (vecs) then
    +
    3055 call eigen(a(1:n,1:n), vals(1:n), v(1:n,1:n), err = err)
    +
    3056 else
    +
    3057 call eigen(a(1:n,1:n), vals(1:n))
    +
    3058 end if
    +
    3059 if (err%has_error_occurred()) then
    +
    3060 flag = err%get_error_flag()
    +
    3061 return
    +
    3062 end if
    +
    3063 end function
    +
    3064
    +
    3065! ------------------------------------------------------------------------------
    +
    3083 function la_sort_eigen(ascend, n, vals, vecs, ldv) &
    +
    3084 bind(C, name = "la_sort_eigen") result(flag)
    +
    3085 ! Arguments
    +
    3086 logical(c_bool), intent(in), value :: ascend
    +
    3087 integer(c_int), intent(in), value :: n, ldv
    +
    3088 real(c_double), intent(inout) :: vals(*), vecs(ldv,*)
    +
    3089 integer(c_int) :: flag
    +
    3090
    +
    3091 ! Local Variables
    +
    3092 type(errors) :: err
    +
    3093
    +
    3094 ! Error Checking
    +
    3095 call err%set_exit_on_error(.false.)
    +
    3096 flag = la_no_error
    +
    3097 if (ldv < n) then
    +
    3098 flag = la_invalid_input_error
    +
    3099 return
    +
    3100 end if
    +
    3101
    +
    3102 ! Process
    +
    3103 call sort(vals(1:n), vecs(1:n,1:n), logical(ascend), err = err)
    +
    3104 if (err%has_error_occurred()) then
    +
    3105 flag = err%get_error_flag()
    +
    3106 return
    +
    3107 end if
    +
    3108 end function
    +
    3109
    +
    3110! ------------------------------------------------------------------------------
    +
    3128 function la_sort_eigen_cmplx(ascend, n, vals, vecs, ldv) &
    +
    3129 bind(C, name = "la_sort_eigen_cmplx") result(flag)
    +
    3130 ! Arguments
    +
    3131 logical(c_bool), intent(in), value :: ascend
    +
    3132 integer(c_int), intent(in), value :: n, ldv
    +
    3133 complex(c_double), intent(inout) :: vals(*), vecs(ldv,*)
    +
    3134 integer(c_int) :: flag
    +
    3135
    +
    3136 ! Local Variables
    +
    3137 type(errors) :: err
    +
    3138
    +
    3139 ! Error Checking
    +
    3140 call err%set_exit_on_error(.false.)
    +
    3141 flag = la_no_error
    +
    3142 if (ldv < n) then
    +
    3143 flag = la_invalid_input_error
    +
    3144 return
    +
    3145 end if
    +
    3146
    +
    3147 ! Process
    +
    3148 call sort(vals(1:n), vecs(1:n,1:n), logical(ascend), err = err)
    +
    3149 if (err%has_error_occurred()) then
    +
    3150 flag = err%get_error_flag()
    +
    3151 return
    +
    3152 end if
    +
    3153 end function
    +
    3154
    +
    3155! ------------------------------------------------------------------------------
    +
    3156
    +
    3157! ------------------------------------------------------------------------------
    +
    3158
    +
    3159! ------------------------------------------------------------------------------
    +
    3160end module
    +
    Computes the Cholesky factorization of a symmetric, positive definite matrix.
    Definition: linalg.f90:1433
    +
    Computes the rank 1 downdate to a Cholesky factored matrix (upper triangular).
    Definition: linalg.f90:1639
    +
    Computes the rank 1 update to a Cholesky factored matrix (upper triangular).
    Definition: linalg.f90:1532
    +
    Computes the determinant of a square matrix.
    Definition: linalg.f90:434
    +
    Multiplies a diagonal matrix with another matrix or array.
    Definition: linalg.f90:329
    +
    Computes the eigenvalues, and optionally the eigenvectors, of a matrix.
    Definition: linalg.f90:3098
    +
    Extracts the L and U matrices from the condensed [L\U] storage format used by the lu_factor.
    Definition: linalg.f90:717
    +
    Forms the full M-by-M orthogonal matrix Q from the elementary reflectors returned by the base QR fact...
    Definition: linalg.f90:1031
    +
    Computes the LU factorization of an M-by-N matrix.
    Definition: linalg.f90:595
    +
    Computes the inverse of a square matrix.
    Definition: linalg.f90:2778
    +
    Computes the Moore-Penrose pseudo-inverse of a M-by-N matrix using the singular value decomposition o...
    Definition: linalg.f90:2884
    +
    Computes the rank of a matrix.
    Definition: linalg.f90:401
    +
    Multiplies a general matrix by the orthogonal matrix Q from a QR factorization.
    Definition: linalg.f90:1185
    +
    Computes the QR factorization of an M-by-N matrix.
    Definition: linalg.f90:871
    +
    Computes the rank 1 update to an M-by-N QR factored matrix A (M >= N) where , and such that .
    Definition: linalg.f90:1334
    +
    Performs the rank-1 update to matrix A such that: , where is an M-by-N matrix, is a scalar,...
    Definition: linalg.f90:194
    +
    Solves a system of Cholesky factored equations.
    Definition: linalg.f90:2390
    +
    Solves the overdetermined or underdetermined system of M equations of N unknowns....
    Definition: linalg.f90:2480
    +
    Solves a system of LU-factored equations.
    Definition: linalg.f90:2149
    +
    Solves a system of M QR-factored equations of N unknowns.
    Definition: linalg.f90:2284
    +
    Solves a triangular system of equations.
    Definition: linalg.f90:2061
    +
    Sorts an array.
    Definition: linalg.f90:3181
    +
    Computes the singular value decomposition of a matrix A. The SVD is defined as: , where is an M-by-M...
    Definition: linalg.f90:1927
    +
    Computes the trace of a matrix (the sum of the main diagonal elements).
    Definition: linalg.f90:353
    +
    Computes the triangular matrix operation: , or , where A is a triangular matrix.
    Definition: linalg.f90:509
    Provides a C-friendly API to the LINALG library. Notice, all C-API LINALG routines begin with the pre...
    Definition: linalg_c_api.f90:5
    -
    Provides a set of constants and error flags for the library.
    -
    Provides a set of common linear algebra routines.
    Definition: linalg_core.f90:15
    +
    Provides a set of common linear algebra routines.
    Definition: linalg.f90:15
    diff --git a/doc/html/linalg__eigen_8f90_source.html b/doc/html/linalg__eigen_8f90_source.html index 87027855..d2c62cf8 100644 --- a/doc/html/linalg__eigen_8f90_source.html +++ b/doc/html/linalg__eigen_8f90_source.html @@ -102,7 +102,7 @@
    1! linalg_eigen.f90
    2
    -
    7submodule(linalg_core) linalg_eigen
    +
    7submodule(linalg) linalg_eigen
    8contains
    9! ------------------------------------------------------------------------------
    10 module subroutine eigen_symm(vecs, a, vals, work, olwork, err)
    @@ -689,7 +689,7 @@
    591
    592! ------------------------------------------------------------------------------
    593end submodule
    -
    Provides a set of common linear algebra routines.
    Definition: linalg_core.f90:15
    +
    Provides a set of common linear algebra routines.
    Definition: linalg.f90:15
    diff --git a/doc/html/linalg__factor_8f90_source.html b/doc/html/linalg__factor_8f90_source.html index efc07787..cb2549bb 100644 --- a/doc/html/linalg__factor_8f90_source.html +++ b/doc/html/linalg__factor_8f90_source.html @@ -102,7 +102,7 @@
    1! linalg_factor.f90
    2
    -
    7submodule(linalg_core) linalg_factor
    +
    7submodule(linalg) linalg_factor
    8contains
    9! ******************************************************************************
    10! LU FACTORIZATION
    @@ -2861,7 +2861,7 @@
    2763 end subroutine
    2764
    2765end submodule
    -
    Provides a set of common linear algebra routines.
    Definition: linalg_core.f90:15
    +
    Provides a set of common linear algebra routines.
    Definition: linalg.f90:15
    diff --git a/doc/html/linalg__immutable_8f90_source.html b/doc/html/linalg__immutable_8f90_source.html index 4434527e..c1641cf0 100644 --- a/doc/html/linalg__immutable_8f90_source.html +++ b/doc/html/linalg__immutable_8f90_source.html @@ -104,781 +104,779 @@
    2
    15 use, intrinsic :: iso_fortran_env, only : int32, real64
    -
    16 use linalg_core
    - -
    18 implicit none
    -
    19 private
    -
    20 public :: mat_rank1_update
    -
    21 public :: mat_mult_diag
    -
    22 public :: mat_mult_upper_tri
    -
    23 public :: mat_mult_lower_tri
    -
    24 public :: mat_det
    -
    25 public :: mat_lu
    -
    26 public :: mat_qr
    -
    27 public :: mat_qr_rank1_update
    -
    28 public :: mat_svd
    -
    29 public :: mat_cholesky
    -
    30 public :: mat_cholesky_rank1_update
    -
    31 public :: mat_cholesky_rank1_downdate
    -
    32 public :: mat_inverse
    -
    33 public :: mat_pinverse
    -
    34 public :: mat_solve_upper_tri
    -
    35 public :: mat_solve_lower_tri
    -
    36 public :: mat_eigen
    -
    37 public :: lu_results
    -
    38 public :: lu_results_cmplx
    -
    39 public :: qr_results
    -
    40 public :: qr_results_cmplx
    -
    41 public :: svd_results
    -
    42 public :: svd_results_cmplx
    -
    43 public :: eigen_results
    -
    44 public :: identity
    -
    45
    -
    46! ------------------------------------------------------------------------------
    -
    49 interface mat_mult_diag
    -
    50 module procedure :: mat_mult_diag_1
    -
    51 module procedure :: mat_mult_diag_2
    -
    52 module procedure :: mat_mult_diag_3
    -
    53 module procedure :: mat_mult_diag_1_cmplx
    -
    54 module procedure :: mat_mult_diag_2_cmplx
    -
    55 module procedure :: mat_mult_diag_3_cmplx
    -
    56 end interface
    -
    57
    -
    58! ------------------------------------------------------------------------------
    - -
    62 module procedure :: mat_mult_upper_tri_1
    -
    63 module procedure :: mat_mult_upper_tri_2
    -
    64 module procedure :: mat_mult_upper_tri_1_cmplx
    -
    65 module procedure :: mat_mult_upper_tri_2_cmplx
    -
    66 end interface
    -
    67
    -
    68! ------------------------------------------------------------------------------
    - -
    72 module procedure :: mat_mult_lower_tri_1
    -
    73 module procedure :: mat_mult_lower_tri_2
    -
    74 module procedure :: mat_mult_lower_tri_1_cmplx
    -
    75 module procedure :: mat_mult_lower_tri_2_cmplx
    -
    76 end interface
    -
    77
    -
    78! ------------------------------------------------------------------------------
    - -
    82 module procedure :: mat_solve_upper_tri_1
    -
    83 module procedure :: mat_solve_upper_tri_2
    -
    84 module procedure :: mat_solve_upper_tri_1_cmplx
    -
    85 module procedure :: mat_solve_upper_tri_2_cmplx
    -
    86 end interface
    -
    87
    -
    88! ------------------------------------------------------------------------------
    - -
    92 module procedure :: mat_solve_lower_tri_1
    -
    93 module procedure :: mat_solve_lower_tri_2
    -
    94 module procedure :: mat_solve_lower_tri_1_cmplx
    -
    95 module procedure :: mat_solve_lower_tri_2_cmplx
    -
    96 end interface
    -
    97
    -
    98! ------------------------------------------------------------------------------
    -
    101 interface mat_lu
    -
    102 module procedure :: mat_lu_dbl
    -
    103 module procedure :: mat_lu_cmplx
    -
    104 end interface
    -
    105
    -
    106! ------------------------------------------------------------------------------
    -
    109 interface mat_eigen
    -
    110 module procedure :: mat_eigen_1
    -
    111 module procedure :: mat_eigen_2
    -
    112 end interface
    -
    113
    -
    114! ------------------------------------------------------------------------------
    - -
    118 real(real64), allocatable, dimension(:,:) :: l
    -
    120 real(real64), allocatable, dimension(:,:) :: u
    -
    122 real(real64), allocatable, dimension(:,:) :: p
    -
    123 end type
    -
    124
    -
    125! ------------------------------------------------------------------------------
    - -
    129 complex(real64), allocatable, dimension(:,:) :: l
    -
    131 complex(real64), allocatable, dimension(:,:) :: u
    -
    133 real(real64), allocatable, dimension(:,:) :: p
    -
    134 end type
    -
    135
    -
    136! ------------------------------------------------------------------------------
    - -
    140 real(real64), allocatable, dimension(:,:) :: q
    -
    142 real(real64), allocatable, dimension(:,:) :: r
    -
    145 real(real64), allocatable, dimension(:,:) :: p
    -
    146 end type
    -
    147
    -
    148! ------------------------------------------------------------------------------
    - -
    152 complex(real64), allocatable, dimension(:,:) :: q
    -
    154 complex(real64), allocatable, dimension(:,:) :: r
    -
    157 complex(real64), allocatable, dimension(:,:) :: p
    -
    158 end type
    -
    159
    -
    160! ------------------------------------------------------------------------------
    - -
    165 real(real64), allocatable, dimension(:,:) :: u
    -
    167 real(real64), allocatable, dimension(:,:) :: s
    -
    169 real(real64), allocatable, dimension(:,:) :: vt
    -
    170 end type
    -
    171
    -
    172! ------------------------------------------------------------------------------
    - -
    177 complex(real64), allocatable, dimension(:,:) :: u
    -
    179 real(real64), allocatable, dimension(:,:) :: s
    -
    181 complex(real64), allocatable, dimension(:,:) :: vt
    -
    182 end type
    -
    183
    -
    184! ------------------------------------------------------------------------------
    - -
    189 complex(real64), allocatable, dimension(:) :: values
    -
    192 complex(real64), allocatable, dimension(:,:) :: vectors
    -
    193 end type
    -
    194
    -
    195contains
    -
    196! ------------------------------------------------------------------------------
    -
    205 function mat_rank1_update(a, x, y) result(b)
    -
    206 ! Arguments
    -
    207 real(real64), intent(in), dimension(:,:) :: a
    -
    208 real(real64), intent(in), dimension(:) :: x, y
    -
    209 real(real64), dimension(size(a, 1), size(a, 2)) :: b
    -
    210
    -
    211 ! Process
    -
    212 b = a
    -
    213 call rank1_update(1.0d0, x, y, b)
    -
    214 end function
    -
    215
    -
    216! ------------------------------------------------------------------------------
    -
    224 function mat_mult_diag_1(a, b) result(c)
    -
    225 ! Arguments
    -
    226 real(real64), intent(in), dimension(:) :: a
    -
    227 real(real64), intent(in), dimension(:,:) :: b
    -
    228 real(real64), dimension(size(a), size(b, 2)) :: c
    -
    229
    -
    230 ! Process
    -
    231 if (size(b, 1) > size(a)) then
    -
    232 call diag_mtx_mult(.true., .false., 1.0d0, a, b(1:size(a),:), &
    -
    233 0.0d0, c)
    -
    234 else
    -
    235 call diag_mtx_mult(.true., .false., 1.0d0, a, b, 0.0d0, c)
    -
    236 end if
    -
    237 end function
    -
    238
    -
    239! ------------------------------------------------------------------------------
    -
    247 function mat_mult_diag_2(a, b) result(c)
    -
    248 ! Arguments
    -
    249 real(real64), intent(in), dimension(:) :: a, b
    -
    250 real(real64), dimension(size(a)) :: c
    -
    251
    -
    252 ! Local Variables
    -
    253 real(real64), dimension(size(a), 1) :: bc, cc
    -
    254
    -
    255 ! Process
    -
    256 bc(:,1) = b(1:min(size(a), size(b)))
    -
    257 call diag_mtx_mult(.true., .false., 1.0d0, a, bc, 0.0d0, cc)
    -
    258 c = cc(:,1)
    -
    259 end function
    -
    260
    -
    261! ------------------------------------------------------------------------------
    -
    269 function mat_mult_diag_3(a, b) result(c)
    -
    270 ! Arguments
    -
    271 real(real64), intent(in), dimension(:,:) :: a
    -
    272 real(real64), intent(in), dimension(:) :: b
    -
    273 real(real64), dimension(size(a, 1), size(b)) :: c
    -
    274
    -
    275 ! Process
    -
    276 if (size(a, 2) > size(b)) then
    -
    277 call diag_mtx_mult(.false., .false., 1.0d0, b, a(:,1:size(b)), &
    -
    278 0.0d0, c)
    -
    279 else
    -
    280 call diag_mtx_mult(.false., .false., 1.0d0, b, a, 0.0d0, c)
    -
    281 end if
    -
    282 end function
    -
    283
    -
    284! ------------------------------------------------------------------------------
    -
    292 function mat_mult_diag_1_cmplx(a, b) result(c)
    -
    293 ! Arguments
    -
    294 complex(real64), intent(in), dimension(:) :: a
    -
    295 complex(real64), intent(in), dimension(:,:) :: b
    -
    296 complex(real64), dimension(size(a), size(b, 2)) :: c
    -
    297
    -
    298 ! Parameters
    -
    299 complex(real64), parameter :: zero = (0.0d0, 0.0d0)
    -
    300 complex(real64), parameter :: one = (1.0d0, 0.0d0)
    -
    301
    -
    302 ! Process
    -
    303 if (size(b, 1) > size(a)) then
    -
    304 call diag_mtx_mult(.true., no_operation, one, a, b(1:size(a),:), &
    -
    305 zero, c)
    -
    306 else
    -
    307 call diag_mtx_mult(.true., no_operation, one, a, b, zero, c)
    -
    308 end if
    -
    309 end function
    -
    310
    -
    311! ------------------------------------------------------------------------------
    -
    319 function mat_mult_diag_2_cmplx(a, b) result(c)
    -
    320 ! Arguments
    -
    321 complex(real64), intent(in), dimension(:) :: a, b
    -
    322 complex(real64), dimension(size(a)) :: c
    -
    323
    -
    324 ! Parameters
    -
    325 complex(real64), parameter :: zero = (0.0d0, 0.0d0)
    -
    326 complex(real64), parameter :: one = (1.0d0, 0.0d0)
    -
    327
    -
    328 ! Local Variables
    -
    329 complex(real64), dimension(size(a), 1) :: bc, cc
    -
    330
    -
    331 ! Process
    -
    332 bc(:,1) = b(1:min(size(a), size(b)))
    -
    333 call diag_mtx_mult(.true., no_operation, one, a, bc, zero, cc)
    -
    334 c = cc(:,1)
    -
    335 end function
    -
    336
    -
    337! ------------------------------------------------------------------------------
    -
    345 function mat_mult_diag_3_cmplx(a, b) result(c)
    -
    346 ! Arguments
    -
    347 complex(real64), intent(in), dimension(:,:) :: a
    -
    348 complex(real64), intent(in), dimension(:) :: b
    -
    349 complex(real64), dimension(size(a, 1), size(b)) :: c
    -
    350
    -
    351 ! Process
    -
    352 if (size(a, 2) > size(b)) then
    -
    353 call diag_mtx_mult(.false., no_operation, 1.0d0, b, a(:,1:size(b)), &
    -
    354 0.0d0, c)
    -
    355 else
    -
    356 call diag_mtx_mult(.false., no_operation, 1.0d0, b, a, 0.0d0, c)
    -
    357 end if
    -
    358 end function
    -
    359
    -
    360! ------------------------------------------------------------------------------
    -
    367 function mat_mult_upper_tri_1(a, b) result(c)
    -
    368 ! Arguments
    -
    369 real(real64), intent(in), dimension(:,:) :: a, b
    -
    370 real(real64), dimension(size(a, 1), size(b, 2)) :: c
    -
    371
    -
    372 ! Process
    -
    373 c = b
    -
    374 call dtrmm('L', 'U', 'N', 'N', size(b, 1), size(b, 2), 1.0d0, &
    -
    375 a, size(a, 1), c, size(c, 1))
    -
    376 end function
    -
    377
    -
    378! ------------------------------------------------------------------------------
    -
    385 function mat_mult_upper_tri_2(a, b) result(c)
    -
    386 ! Arguments
    -
    387 real(real64), intent(in), dimension(:,:) :: a
    -
    388 real(real64), intent(in), dimension(:) :: b
    -
    389 real(real64), dimension(size(a, 1)) :: c
    -
    390
    -
    391 ! Process
    -
    392 c = b
    -
    393 call dtrmv('U', 'N', 'N', size(a, 1), a, size(a, 1), c, 1)
    -
    394 end function
    -
    395
    -
    396 ! ------------------------------------------------------------------------------
    -
    403 function mat_mult_lower_tri_1(a, b) result(c)
    -
    404 ! Arguments
    -
    405 real(real64), intent(in), dimension(:,:) :: a, b
    -
    406 real(real64), dimension(size(a, 1), size(b, 2)) :: c
    -
    407
    -
    408 ! Process
    -
    409 c = b
    -
    410 call dtrmm('L', 'L', 'N', 'N', size(b, 1), size(b, 2), 1.0d0, &
    -
    411 a, size(a, 1), c, size(c, 1))
    -
    412 end function
    -
    413
    -
    414 ! ------------------------------------------------------------------------------
    -
    421 function mat_mult_lower_tri_2(a, b) result(c)
    -
    422 ! Arguments
    -
    423 real(real64), intent(in), dimension(:,:) :: a
    -
    424 real(real64), intent(in), dimension(:) :: b
    -
    425 real(real64), dimension(size(a, 1)) :: c
    -
    426
    -
    427 ! Process
    -
    428 c = b
    -
    429 call dtrmv('L', 'N', 'N', size(a, 1), a, size(a, 1), c, 1)
    -
    430 end function
    -
    431
    -
    432! ------------------------------------------------------------------------------
    -
    439 function mat_mult_upper_tri_1_cmplx(a, b) result(c)
    -
    440 ! Arguments
    -
    441 complex(real64), intent(in), dimension(:,:) :: a, b
    -
    442 complex(real64), dimension(size(a, 1), size(b, 2)) :: c
    -
    443
    -
    444 ! Process
    -
    445 c = b
    -
    446 call ztrmm('L', 'U', 'N', 'N', size(b, 1), size(b, 2), 1.0d0, &
    -
    447 a, size(a, 1), c, size(c, 1))
    -
    448 end function
    -
    449
    -
    450! ------------------------------------------------------------------------------
    -
    457 function mat_mult_upper_tri_2_cmplx(a, b) result(c)
    -
    458 ! Arguments
    -
    459 complex(real64), intent(in), dimension(:,:) :: a
    -
    460 complex(real64), intent(in), dimension(:) :: b
    -
    461 complex(real64), dimension(size(a, 1)) :: c
    -
    462
    -
    463 ! Process
    -
    464 c = b
    -
    465 call ztrmv('U', 'N', 'N', size(a, 1), a, size(a, 1), c, 1)
    -
    466 end function
    -
    467
    -
    468 ! ------------------------------------------------------------------------------
    -
    475 function mat_mult_lower_tri_1_cmplx(a, b) result(c)
    -
    476 ! Arguments
    -
    477 complex(real64), intent(in), dimension(:,:) :: a, b
    -
    478 complex(real64), dimension(size(a, 1), size(b, 2)) :: c
    -
    479
    -
    480 ! Process
    -
    481 c = b
    -
    482 call ztrmm('L', 'L', 'N', 'N', size(b, 1), size(b, 2), 1.0d0, &
    -
    483 a, size(a, 1), c, size(c, 1))
    -
    484 end function
    -
    485
    -
    486 ! ------------------------------------------------------------------------------
    -
    493 function mat_mult_lower_tri_2_cmplx(a, b) result(c)
    -
    494 ! Arguments
    -
    495 complex(real64), intent(in), dimension(:,:) :: a
    -
    496 complex(real64), intent(in), dimension(:) :: b
    -
    497 complex(real64), dimension(size(a, 1)) :: c
    -
    498
    -
    499 ! Process
    -
    500 c = b
    -
    501 call ztrmv('L', 'N', 'N', size(a, 1), a, size(a, 1), c, 1)
    -
    502 end function
    -
    503
    -
    504! ------------------------------------------------------------------------------
    -
    509 function mat_det(a) result(x)
    -
    510 ! Arguments
    -
    511 real(real64), intent(in), dimension(:,:) :: a
    -
    512 real(real64) :: x
    -
    513
    -
    514 ! Local Variables
    -
    515 real(real64), dimension(size(a, 1), size(a, 2)) :: b
    -
    516
    -
    517 ! Process
    -
    518 b = a
    -
    519 x = det(b)
    -
    520 end function
    -
    521
    -
    522! ------------------------------------------------------------------------------
    -
    528 function mat_lu_dbl(a) result(x)
    -
    529 ! Arguments
    -
    530 real(real64), intent(in), dimension(:,:) :: a
    -
    531 type(lu_results) :: x
    -
    532
    -
    533 ! Local Variables
    -
    534 integer(int32) :: n
    -
    535 integer(int32), allocatable, dimension(:) :: ipvt
    -
    536
    -
    537 ! Memory Allocation
    -
    538 n = size(a, 1)
    -
    539 allocate(ipvt(n))
    -
    540 allocate(x%l(n,n))
    -
    541 allocate(x%u(n,n))
    -
    542 allocate(x%p(n,n))
    -
    543
    -
    544 ! Compute the factorization
    -
    545 x%l = a
    -
    546 call lu_factor(x%l, ipvt)
    -
    547
    -
    548 ! Form L, U, and P
    -
    549 call form_lu(x%l, ipvt, x%u, x%p)
    -
    550 end function
    -
    551
    -
    552! ------------------------------------------------------------------------------
    -
    558 function mat_lu_cmplx(a) result(x)
    -
    559 ! Arguments
    -
    560 complex(real64), intent(in), dimension(:,:) :: a
    -
    561 type(lu_results_cmplx) :: x
    -
    562
    -
    563 ! Local Variables
    -
    564 integer(int32) :: n
    -
    565 integer(int32), allocatable, dimension(:) :: ipvt
    -
    566
    -
    567 ! Memory Allocation
    -
    568 n = size(a, 1)
    -
    569 allocate(ipvt(n))
    -
    570 allocate(x%l(n,n))
    -
    571 allocate(x%u(n,n))
    -
    572 allocate(x%p(n,n))
    -
    573
    -
    574 ! Compute the factorization
    -
    575 x%l = a
    -
    576 call lu_factor(x%l, ipvt)
    -
    577
    -
    578 ! Form L, U, and P
    -
    579 call form_lu(x%l, ipvt, x%u, x%p)
    -
    580 end function
    -
    581
    -
    582! ------------------------------------------------------------------------------
    -
    592 function mat_qr(a, pvt) result(x)
    -
    593 ! Arguments
    -
    594 real(real64), intent(in), dimension(:,:) :: a
    -
    595 logical, intent(in), optional :: pvt
    -
    596 type(qr_results) :: x
    -
    597
    -
    598 ! Local Variables
    -
    599 logical :: use_pivot
    -
    600 integer(int32) :: m, n, mn
    -
    601 integer(int32), allocatable, dimension(:) :: jpvt
    -
    602 real(real64), allocatable, dimension(:) :: tau
    -
    603
    -
    604 ! Memory Allocation
    -
    605 use_pivot = .false.
    -
    606 if (present(pvt)) use_pivot = pvt
    -
    607 m = size(a, 1)
    -
    608 n = size(a, 2)
    -
    609 mn = min(m, n)
    -
    610 allocate(tau(mn))
    -
    611 allocate(x%q(m,m))
    -
    612 allocate(x%r(m,n))
    -
    613
    -
    614 ! Compute the factorization, and then form Q, R, and P
    -
    615 x%r = a
    -
    616 if (use_pivot) then
    -
    617 allocate(x%p(n,n))
    -
    618 allocate(jpvt(n))
    -
    619 jpvt = 0 ! Ensure all columns are free columns
    -
    620 call qr_factor(x%r, tau, jpvt)
    -
    621 call form_qr(x%r, tau, jpvt, x%q, x%p)
    -
    622 else
    -
    623 call qr_factor(x%r, tau)
    -
    624 call form_qr(x%r, tau, x%q)
    -
    625 end if
    -
    626 end function
    -
    627
    -
    628! ------------------------------------------------------------------------------
    -
    638 function mat_qr_rank1_update(q, r, x, y) result(rst)
    -
    639 ! Arguments
    -
    640 real(real64), intent(in), dimension(:,:) :: q, r
    -
    641 real(real64), intent(in), dimension(:) :: x, y
    -
    642 type(qr_results) :: rst
    -
    643
    -
    644 ! Local Variables
    -
    645 integer(int32) :: i, m, n
    -
    646 real(real64), allocatable, dimension(:) :: xc, yc
    -
    647
    -
    648 ! Memory allocation
    -
    649 m = size(q, 1)
    -
    650 n = size(r, 2)
    -
    651 allocate(xc(m))
    -
    652 allocate(yc(n))
    -
    653 allocate(rst%q(m,m))
    -
    654 allocate(rst%r(m,n))
    -
    655
    -
    656 ! Process
    -
    657 do i = 1, m
    -
    658 xc(i) = x(i)
    -
    659 rst%q(:,i) = q(:,i)
    -
    660 end do
    -
    661 do i = 1, n
    -
    662 yc(i) = y(i)
    -
    663 rst%r(:,i) = r(:,i)
    -
    664 end do
    -
    665 call qr_rank1_update(rst%q, rst%r, xc, yc)
    -
    666 end function
    -
    667
    -
    668! ------------------------------------------------------------------------------
    -
    674 function mat_svd(a) result(x)
    -
    675 ! Arguments
    -
    676 real(real64), intent(in), dimension(:,:) :: a
    -
    677 type(svd_results) :: x
    -
    678
    -
    679 ! Local Variables
    -
    680 integer(int32) :: i, m, n, mn
    -
    681 real(real64), allocatable, dimension(:) :: s
    -
    682 real(real64), allocatable, dimension(:,:) :: ac
    -
    683
    -
    684 ! Memory Allocation
    -
    685 m = size(a, 1)
    -
    686 n = size(a, 2)
    -
    687 mn = min(m, n)
    -
    688 allocate(s(mn))
    -
    689 allocate(ac(m,n))
    -
    690 allocate(x%u(m,m))
    -
    691 allocate(x%s(m,n))
    -
    692 allocate(x%vt(n,n))
    -
    693
    -
    694 ! Process
    -
    695 ac = a
    -
    696 call svd(ac, s, x%u, x%vt)
    -
    697
    -
    698 ! Extract the singular values, and populate the results matrix
    -
    699 x%s = 0.0d0
    -
    700 do i = 1, mn
    -
    701 x%s(i,i) = s(i)
    -
    702 end do
    -
    703 end function
    -
    704
    -
    705! ------------------------------------------------------------------------------
    -
    715 function mat_cholesky(a, upper) result(r)
    -
    716 ! Arguments
    -
    717 real(real64), intent(in), dimension(:,:) :: a
    -
    718 logical, intent(in), optional :: upper
    -
    719 real(real64), dimension(size(a, 1), size(a, 2)) :: r
    -
    720
    -
    721 ! Local Variables
    -
    722 logical :: compute_upper
    -
    723
    -
    724 ! Process
    -
    725 compute_upper = .true.
    -
    726 if (present(upper)) compute_upper = upper
    -
    727 r = a
    -
    728 call cholesky_factor(r, compute_upper)
    -
    729 end function
    -
    730
    -
    731! ------------------------------------------------------------------------------
    -
    738 function mat_cholesky_rank1_update(a, x) result(r)
    -
    739 ! Arguments
    -
    740 real(real64), intent(in), dimension(:,:) :: a
    -
    741 real(real64), intent(in), dimension(:) :: x
    -
    742 real(real64), dimension(size(a, 1), size(a, 2)) :: r
    -
    743
    -
    744 ! Local Variables
    -
    745 real(real64), dimension(size(x)) :: xc
    -
    746
    -
    747 ! Process
    -
    748 r = a
    -
    749 xc = x
    -
    750 call cholesky_rank1_update(r, xc)
    -
    751 end function
    -
    752
    -
    753! ------------------------------------------------------------------------------
    -
    760 function mat_cholesky_rank1_downdate(a, x) result(r)
    -
    761 ! Arguments
    -
    762 real(real64), intent(in), dimension(:,:) :: a
    -
    763 real(real64), intent(in), dimension(:) :: x
    -
    764 real(real64), dimension(size(a, 1), size(a, 2)) :: r
    -
    765
    -
    766 ! Local Variables
    -
    767 real(real64), dimension(size(x)) :: xc
    -
    768
    -
    769 ! Process
    -
    770 r = a
    -
    771 xc = x
    -
    772 call cholesky_rank1_downdate(r, xc)
    -
    773 end function
    -
    774
    -
    775! ------------------------------------------------------------------------------
    -
    780 function mat_inverse(a) result(x)
    -
    781 ! Arguments
    -
    782 real(real64), intent(in), dimension(:,:) :: a
    -
    783 real(real64), dimension(size(a, 2), size(a, 1)) :: x
    -
    784
    -
    785 ! Compute the inverse of A
    -
    786 x = a
    -
    787 call mtx_inverse(x)
    -
    788 end function
    -
    789
    -
    790! ------------------------------------------------------------------------------
    -
    795 function mat_pinverse(a) result(x)
    -
    796 ! Arguments
    -
    797 real(real64), intent(in), dimension(:,:) :: a
    -
    798 real(real64), dimension(size(a, 2), size(a, 1)) :: x
    -
    799
    -
    800 ! Local Variables
    -
    801 real(real64), dimension(size(a, 1), size(a, 2)) :: ac
    -
    802
    -
    803 ! Compute the inverse of A
    -
    804 ac = a
    -
    805 call mtx_pinverse(ac, x)
    -
    806 end function
    -
    807
    -
    808! ------------------------------------------------------------------------------
    -
    815 function mat_solve_upper_tri_1(a, b) result(x)
    -
    816 ! Arguments
    -
    817 real(real64), intent(in), dimension(:,:) :: a, b
    -
    818 real(real64), dimension(size(b, 1), size(b, 2)) :: x
    -
    819
    -
    820 ! Process
    -
    821 x = b
    -
    822 call solve_triangular_system(.true., .true., .false., .true., 1.0d0, &
    -
    823 a, x)
    -
    824 end function
    -
    825
    -
    826! ------------------------------------------------------------------------------
    -
    833 function mat_solve_upper_tri_2(a, b) result(x)
    -
    834 ! Arguments
    -
    835 real(real64), intent(in), dimension(:,:) :: a
    -
    836 real(real64), intent(in), dimension(:) :: b
    -
    837 real(real64), dimension(size(b)) :: x
    -
    838
    -
    839 ! Process
    -
    840 x = b
    -
    841 call solve_triangular_system(.true., .false., .true., a, x)
    -
    842 end function
    -
    843
    -
    844! ------------------------------------------------------------------------------
    -
    851 function mat_solve_upper_tri_1_cmplx(a, b) result(x)
    -
    852 ! Arguments
    -
    853 complex(real64), intent(in), dimension(:,:) :: a, b
    -
    854 complex(real64), dimension(size(b, 1), size(b, 2)) :: x
    -
    855
    -
    856 ! Process
    -
    857 x = b
    -
    858 call solve_triangular_system(.true., .true., .false., .true., &
    -
    859 (1.0d0, 0.0d0), a, x)
    -
    860 end function
    -
    861
    -
    862! ------------------------------------------------------------------------------
    -
    869 function mat_solve_upper_tri_2_cmplx(a, b) result(x)
    -
    870 ! Arguments
    -
    871 complex(real64), intent(in), dimension(:,:) :: a
    -
    872 complex(real64), intent(in), dimension(:) :: b
    -
    873 complex(real64), dimension(size(b)) :: x
    -
    874
    -
    875 ! Process
    -
    876 x = b
    -
    877 call solve_triangular_system(.true., .false., .true., a, x)
    -
    878 end function
    -
    879
    -
    880! ------------------------------------------------------------------------------
    -
    887 function mat_solve_lower_tri_1(a, b) result(x)
    -
    888 ! Arguments
    -
    889 real(real64), intent(in), dimension(:,:) :: a, b
    -
    890 real(real64), dimension(size(b, 1), size(b, 2)) :: x
    -
    891
    -
    892 ! Process
    -
    893 x = b
    -
    894 call solve_triangular_system(.true., .false., .false., .true., 1.0d0, &
    -
    895 a, x)
    -
    896 end function
    -
    897
    -
    898! ------------------------------------------------------------------------------
    -
    905 function mat_solve_lower_tri_2(a, b) result(x)
    -
    906 ! Arguments
    -
    907 real(real64), intent(in), dimension(:,:) :: a
    -
    908 real(real64), intent(in), dimension(:) :: b
    -
    909 real(real64), dimension(size(b)) :: x
    -
    910
    -
    911 ! Process
    -
    912 x = b
    -
    913 call solve_triangular_system(.false., .false., .true., a, x)
    -
    914 end function
    -
    915
    -
    916! ------------------------------------------------------------------------------
    -
    923 function mat_solve_lower_tri_1_cmplx(a, b) result(x)
    -
    924 ! Arguments
    -
    925 complex(real64), intent(in), dimension(:,:) :: a, b
    -
    926 complex(real64), dimension(size(b, 1), size(b, 2)) :: x
    -
    927
    -
    928 ! Process
    -
    929 x = b
    -
    930 call solve_triangular_system(.true., .false., .false., .true., &
    -
    931 (1.0d0, 0.0d0), a, x)
    -
    932 end function
    -
    933
    -
    934! ------------------------------------------------------------------------------
    -
    941 function mat_solve_lower_tri_2_cmplx(a, b) result(x)
    -
    942 ! Arguments
    -
    943 complex(real64), intent(in), dimension(:,:) :: a
    -
    944 complex(real64), intent(in), dimension(:) :: b
    -
    945 complex(real64), dimension(size(b)) :: x
    -
    946
    -
    947 ! Process
    -
    948 x = b
    -
    949 call solve_triangular_system(.false., .false., .true., a, x)
    -
    950 end function
    -
    951
    -
    952! ------------------------------------------------------------------------------
    -
    959 function mat_eigen_1(a) result(x)
    -
    960 ! Arguments
    -
    961 real(real64), intent(in), dimension(:,:) :: a
    -
    962 type(eigen_results) :: x
    -
    963
    -
    964 ! Local Variables
    -
    965 integer(int32) :: n
    -
    966 real(real64), dimension(size(a, 1), size(a, 2)) :: ac
    -
    967
    -
    968 ! Memory Allocation
    -
    969 n = size(a, 1)
    -
    970 allocate(x%values(n))
    -
    971 allocate(x%vectors(n,n))
    -
    972
    -
    973 ! Process
    -
    974 ac = a
    -
    975 call eigen(ac, x%values, x%vectors)
    -
    976
    -
    977 ! Sort the eigenvalues and eigenvectors.
    -
    978 call sort(x%values, x%vectors, .true.)
    -
    979 end function
    -
    980
    -
    981! ------------------------------------------------------------------------------
    -
    989 function mat_eigen_2(a, b) result(x)
    -
    990 ! Arguments
    -
    991 real(real64), intent(in), dimension(:,:) :: a, b
    -
    992 type(eigen_results) :: x
    -
    993
    -
    994 ! Local Variables
    -
    995 integer(int32) :: i, j, n
    -
    996 real(real64), dimension(size(a, 1), size(a, 2)) :: ac
    -
    997 real(real64), dimension(size(b, 1), size(b, 2)) :: bc
    -
    998
    -
    999 ! Memory Allocation
    -
    1000 n = size(a, 1)
    -
    1001 allocate(x%values(n))
    -
    1002 allocate(x%vectors(n,n))
    -
    1003
    -
    1004 ! Process
    -
    1005 do j = 1, n
    -
    1006 do i = 1, n
    -
    1007 ac(i,j) = a(i,j)
    -
    1008 bc(i,j) = b(i,j)
    -
    1009 end do
    -
    1010 end do
    -
    1011 call eigen(ac, bc, x%values, vecs = x%vectors)
    -
    1012
    -
    1013 ! Sort the eigenvalues and eigenvectors.
    -
    1014 call sort(x%values, x%vectors, .true.)
    -
    1015 end function
    -
    1016
    -
    1017! ------------------------------------------------------------------------------
    -
    1022 pure function identity(n) result(x)
    -
    1023 integer(int32), intent(in) :: n
    -
    1024 real(real64), dimension(n, n) :: x
    -
    1025 integer(int32) :: i
    -
    1026 x = 0.0d0
    -
    1027 do i = 1, n
    -
    1028 x(i,i) = 1.0d0
    -
    1029 end do
    -
    1030 end function
    -
    1031
    -
    1032end module
    -
    Computes the Cholesky factorization of a symmetric, positive definite matrix.
    -
    Computes the rank 1 downdate to a Cholesky factored matrix (upper triangular).
    -
    Computes the rank 1 update to a Cholesky factored matrix (upper triangular).
    -
    Computes the determinant of a square matrix.
    -
    Multiplies a diagonal matrix with another matrix or array.
    -
    Computes the eigenvalues, and optionally the eigenvectors, of a matrix.
    -
    Extracts the L and U matrices from the condensed [L\U] storage format used by the lu_factor.
    -
    Forms the full M-by-M orthogonal matrix Q from the elementary reflectors returned by the base QR fact...
    -
    Computes the LU factorization of an M-by-N matrix.
    -
    Computes the inverse of a square matrix.
    -
    Computes the Moore-Penrose pseudo-inverse of a M-by-N matrix using the singular value decomposition o...
    -
    Computes the QR factorization of an M-by-N matrix.
    -
    Computes the rank 1 update to an M-by-N QR factored matrix A (M >= N) where , and such that .
    -
    Performs the rank-1 update to matrix A such that: , where is an M-by-N matrix, is a scalar,...
    -
    Solves a triangular system of equations.
    -
    Sorts an array.
    -
    Computes the singular value decomposition of a matrix A. The SVD is defined as: , where is an M-by-M...
    -
    Computes the eigenvalues and eigenvectors (right) of a general N-by-N matrix.
    -
    Computes the LU factorization of a square matrix. Notice, partial row pivoting is utilized.
    -
    Computes the matrix operation: C = A * B, where A is a diagonal matrix.
    -
    Computes the matrix operation C = A * B, where A is a lower triangular matrix.
    -
    Computes the matrix operation C = A * B, where A is an upper triangular matrix.
    -
    Solves the lower triangular system A X = B, where A is a lower triangular matrix.
    -
    Solves the upper triangular system A X = B, where A is an upper triangular matrix.
    -
    Provides a set of constants and error flags for the library.
    -
    Provides a set of common linear algebra routines.
    Definition: linalg_core.f90:15
    +
    16 use linalg
    +
    17 implicit none
    +
    18 private
    +
    19 public :: mat_rank1_update
    +
    20 public :: mat_mult_diag
    +
    21 public :: mat_mult_upper_tri
    +
    22 public :: mat_mult_lower_tri
    +
    23 public :: mat_det
    +
    24 public :: mat_lu
    +
    25 public :: mat_qr
    +
    26 public :: mat_qr_rank1_update
    +
    27 public :: mat_svd
    +
    28 public :: mat_cholesky
    +
    29 public :: mat_cholesky_rank1_update
    +
    30 public :: mat_cholesky_rank1_downdate
    +
    31 public :: mat_inverse
    +
    32 public :: mat_pinverse
    +
    33 public :: mat_solve_upper_tri
    +
    34 public :: mat_solve_lower_tri
    +
    35 public :: mat_eigen
    +
    36 public :: lu_results
    +
    37 public :: lu_results_cmplx
    +
    38 public :: qr_results
    +
    39 public :: qr_results_cmplx
    +
    40 public :: svd_results
    +
    41 public :: svd_results_cmplx
    +
    42 public :: eigen_results
    +
    43 public :: identity
    +
    44
    +
    45! ------------------------------------------------------------------------------
    +
    48 interface mat_mult_diag
    +
    49 module procedure :: mat_mult_diag_1
    +
    50 module procedure :: mat_mult_diag_2
    +
    51 module procedure :: mat_mult_diag_3
    +
    52 module procedure :: mat_mult_diag_1_cmplx
    +
    53 module procedure :: mat_mult_diag_2_cmplx
    +
    54 module procedure :: mat_mult_diag_3_cmplx
    +
    55 end interface
    +
    56
    +
    57! ------------------------------------------------------------------------------
    + +
    61 module procedure :: mat_mult_upper_tri_1
    +
    62 module procedure :: mat_mult_upper_tri_2
    +
    63 module procedure :: mat_mult_upper_tri_1_cmplx
    +
    64 module procedure :: mat_mult_upper_tri_2_cmplx
    +
    65 end interface
    +
    66
    +
    67! ------------------------------------------------------------------------------
    + +
    71 module procedure :: mat_mult_lower_tri_1
    +
    72 module procedure :: mat_mult_lower_tri_2
    +
    73 module procedure :: mat_mult_lower_tri_1_cmplx
    +
    74 module procedure :: mat_mult_lower_tri_2_cmplx
    +
    75 end interface
    +
    76
    +
    77! ------------------------------------------------------------------------------
    + +
    81 module procedure :: mat_solve_upper_tri_1
    +
    82 module procedure :: mat_solve_upper_tri_2
    +
    83 module procedure :: mat_solve_upper_tri_1_cmplx
    +
    84 module procedure :: mat_solve_upper_tri_2_cmplx
    +
    85 end interface
    +
    86
    +
    87! ------------------------------------------------------------------------------
    + +
    91 module procedure :: mat_solve_lower_tri_1
    +
    92 module procedure :: mat_solve_lower_tri_2
    +
    93 module procedure :: mat_solve_lower_tri_1_cmplx
    +
    94 module procedure :: mat_solve_lower_tri_2_cmplx
    +
    95 end interface
    +
    96
    +
    97! ------------------------------------------------------------------------------
    +
    100 interface mat_lu
    +
    101 module procedure :: mat_lu_dbl
    +
    102 module procedure :: mat_lu_cmplx
    +
    103 end interface
    +
    104
    +
    105! ------------------------------------------------------------------------------
    +
    108 interface mat_eigen
    +
    109 module procedure :: mat_eigen_1
    +
    110 module procedure :: mat_eigen_2
    +
    111 end interface
    +
    112
    +
    113! ------------------------------------------------------------------------------
    + +
    117 real(real64), allocatable, dimension(:,:) :: l
    +
    119 real(real64), allocatable, dimension(:,:) :: u
    +
    121 real(real64), allocatable, dimension(:,:) :: p
    +
    122 end type
    +
    123
    +
    124! ------------------------------------------------------------------------------
    + +
    128 complex(real64), allocatable, dimension(:,:) :: l
    +
    130 complex(real64), allocatable, dimension(:,:) :: u
    +
    132 real(real64), allocatable, dimension(:,:) :: p
    +
    133 end type
    +
    134
    +
    135! ------------------------------------------------------------------------------
    + +
    139 real(real64), allocatable, dimension(:,:) :: q
    +
    141 real(real64), allocatable, dimension(:,:) :: r
    +
    144 real(real64), allocatable, dimension(:,:) :: p
    +
    145 end type
    +
    146
    +
    147! ------------------------------------------------------------------------------
    + +
    151 complex(real64), allocatable, dimension(:,:) :: q
    +
    153 complex(real64), allocatable, dimension(:,:) :: r
    +
    156 complex(real64), allocatable, dimension(:,:) :: p
    +
    157 end type
    +
    158
    +
    159! ------------------------------------------------------------------------------
    + +
    164 real(real64), allocatable, dimension(:,:) :: u
    +
    166 real(real64), allocatable, dimension(:,:) :: s
    +
    168 real(real64), allocatable, dimension(:,:) :: vt
    +
    169 end type
    +
    170
    +
    171! ------------------------------------------------------------------------------
    + +
    176 complex(real64), allocatable, dimension(:,:) :: u
    +
    178 real(real64), allocatable, dimension(:,:) :: s
    +
    180 complex(real64), allocatable, dimension(:,:) :: vt
    +
    181 end type
    +
    182
    +
    183! ------------------------------------------------------------------------------
    + +
    188 complex(real64), allocatable, dimension(:) :: values
    +
    191 complex(real64), allocatable, dimension(:,:) :: vectors
    +
    192 end type
    +
    193
    +
    194contains
    +
    195! ------------------------------------------------------------------------------
    +
    204 function mat_rank1_update(a, x, y) result(b)
    +
    205 ! Arguments
    +
    206 real(real64), intent(in), dimension(:,:) :: a
    +
    207 real(real64), intent(in), dimension(:) :: x, y
    +
    208 real(real64), dimension(size(a, 1), size(a, 2)) :: b
    +
    209
    +
    210 ! Process
    +
    211 b = a
    +
    212 call rank1_update(1.0d0, x, y, b)
    +
    213 end function
    +
    214
    +
    215! ------------------------------------------------------------------------------
    +
    223 function mat_mult_diag_1(a, b) result(c)
    +
    224 ! Arguments
    +
    225 real(real64), intent(in), dimension(:) :: a
    +
    226 real(real64), intent(in), dimension(:,:) :: b
    +
    227 real(real64), dimension(size(a), size(b, 2)) :: c
    +
    228
    +
    229 ! Process
    +
    230 if (size(b, 1) > size(a)) then
    +
    231 call diag_mtx_mult(.true., .false., 1.0d0, a, b(1:size(a),:), &
    +
    232 0.0d0, c)
    +
    233 else
    +
    234 call diag_mtx_mult(.true., .false., 1.0d0, a, b, 0.0d0, c)
    +
    235 end if
    +
    236 end function
    +
    237
    +
    238! ------------------------------------------------------------------------------
    +
    246 function mat_mult_diag_2(a, b) result(c)
    +
    247 ! Arguments
    +
    248 real(real64), intent(in), dimension(:) :: a, b
    +
    249 real(real64), dimension(size(a)) :: c
    +
    250
    +
    251 ! Local Variables
    +
    252 real(real64), dimension(size(a), 1) :: bc, cc
    +
    253
    +
    254 ! Process
    +
    255 bc(:,1) = b(1:min(size(a), size(b)))
    +
    256 call diag_mtx_mult(.true., .false., 1.0d0, a, bc, 0.0d0, cc)
    +
    257 c = cc(:,1)
    +
    258 end function
    +
    259
    +
    260! ------------------------------------------------------------------------------
    +
    268 function mat_mult_diag_3(a, b) result(c)
    +
    269 ! Arguments
    +
    270 real(real64), intent(in), dimension(:,:) :: a
    +
    271 real(real64), intent(in), dimension(:) :: b
    +
    272 real(real64), dimension(size(a, 1), size(b)) :: c
    +
    273
    +
    274 ! Process
    +
    275 if (size(a, 2) > size(b)) then
    +
    276 call diag_mtx_mult(.false., .false., 1.0d0, b, a(:,1:size(b)), &
    +
    277 0.0d0, c)
    +
    278 else
    +
    279 call diag_mtx_mult(.false., .false., 1.0d0, b, a, 0.0d0, c)
    +
    280 end if
    +
    281 end function
    +
    282
    +
    283! ------------------------------------------------------------------------------
    +
    291 function mat_mult_diag_1_cmplx(a, b) result(c)
    +
    292 ! Arguments
    +
    293 complex(real64), intent(in), dimension(:) :: a
    +
    294 complex(real64), intent(in), dimension(:,:) :: b
    +
    295 complex(real64), dimension(size(a), size(b, 2)) :: c
    +
    296
    +
    297 ! Parameters
    +
    298 complex(real64), parameter :: zero = (0.0d0, 0.0d0)
    +
    299 complex(real64), parameter :: one = (1.0d0, 0.0d0)
    +
    300
    +
    301 ! Process
    +
    302 if (size(b, 1) > size(a)) then
    +
    303 call diag_mtx_mult(.true., la_no_operation, one, a, b(1:size(a),:), &
    +
    304 zero, c)
    +
    305 else
    +
    306 call diag_mtx_mult(.true., la_no_operation, one, a, b, zero, c)
    +
    307 end if
    +
    308 end function
    +
    309
    +
    310! ------------------------------------------------------------------------------
    +
    318 function mat_mult_diag_2_cmplx(a, b) result(c)
    +
    319 ! Arguments
    +
    320 complex(real64), intent(in), dimension(:) :: a, b
    +
    321 complex(real64), dimension(size(a)) :: c
    +
    322
    +
    323 ! Parameters
    +
    324 complex(real64), parameter :: zero = (0.0d0, 0.0d0)
    +
    325 complex(real64), parameter :: one = (1.0d0, 0.0d0)
    +
    326
    +
    327 ! Local Variables
    +
    328 complex(real64), dimension(size(a), 1) :: bc, cc
    +
    329
    +
    330 ! Process
    +
    331 bc(:,1) = b(1:min(size(a), size(b)))
    +
    332 call diag_mtx_mult(.true., la_no_operation, one, a, bc, zero, cc)
    +
    333 c = cc(:,1)
    +
    334 end function
    +
    335
    +
    336! ------------------------------------------------------------------------------
    +
    344 function mat_mult_diag_3_cmplx(a, b) result(c)
    +
    345 ! Arguments
    +
    346 complex(real64), intent(in), dimension(:,:) :: a
    +
    347 complex(real64), intent(in), dimension(:) :: b
    +
    348 complex(real64), dimension(size(a, 1), size(b)) :: c
    +
    349
    +
    350 ! Process
    +
    351 if (size(a, 2) > size(b)) then
    +
    352 call diag_mtx_mult(.false., la_no_operation, 1.0d0, b, a(:,1:size(b)), &
    +
    353 0.0d0, c)
    +
    354 else
    +
    355 call diag_mtx_mult(.false., la_no_operation, 1.0d0, b, a, 0.0d0, c)
    +
    356 end if
    +
    357 end function
    +
    358
    +
    359! ------------------------------------------------------------------------------
    +
    366 function mat_mult_upper_tri_1(a, b) result(c)
    +
    367 ! Arguments
    +
    368 real(real64), intent(in), dimension(:,:) :: a, b
    +
    369 real(real64), dimension(size(a, 1), size(b, 2)) :: c
    +
    370
    +
    371 ! Process
    +
    372 c = b
    +
    373 call dtrmm('L', 'U', 'N', 'N', size(b, 1), size(b, 2), 1.0d0, &
    +
    374 a, size(a, 1), c, size(c, 1))
    +
    375 end function
    +
    376
    +
    377! ------------------------------------------------------------------------------
    +
    384 function mat_mult_upper_tri_2(a, b) result(c)
    +
    385 ! Arguments
    +
    386 real(real64), intent(in), dimension(:,:) :: a
    +
    387 real(real64), intent(in), dimension(:) :: b
    +
    388 real(real64), dimension(size(a, 1)) :: c
    +
    389
    +
    390 ! Process
    +
    391 c = b
    +
    392 call dtrmv('U', 'N', 'N', size(a, 1), a, size(a, 1), c, 1)
    +
    393 end function
    +
    394
    +
    395 ! ------------------------------------------------------------------------------
    +
    402 function mat_mult_lower_tri_1(a, b) result(c)
    +
    403 ! Arguments
    +
    404 real(real64), intent(in), dimension(:,:) :: a, b
    +
    405 real(real64), dimension(size(a, 1), size(b, 2)) :: c
    +
    406
    +
    407 ! Process
    +
    408 c = b
    +
    409 call dtrmm('L', 'L', 'N', 'N', size(b, 1), size(b, 2), 1.0d0, &
    +
    410 a, size(a, 1), c, size(c, 1))
    +
    411 end function
    +
    412
    +
    413 ! ------------------------------------------------------------------------------
    +
    420 function mat_mult_lower_tri_2(a, b) result(c)
    +
    421 ! Arguments
    +
    422 real(real64), intent(in), dimension(:,:) :: a
    +
    423 real(real64), intent(in), dimension(:) :: b
    +
    424 real(real64), dimension(size(a, 1)) :: c
    +
    425
    +
    426 ! Process
    +
    427 c = b
    +
    428 call dtrmv('L', 'N', 'N', size(a, 1), a, size(a, 1), c, 1)
    +
    429 end function
    +
    430
    +
    431! ------------------------------------------------------------------------------
    +
    438 function mat_mult_upper_tri_1_cmplx(a, b) result(c)
    +
    439 ! Arguments
    +
    440 complex(real64), intent(in), dimension(:,:) :: a, b
    +
    441 complex(real64), dimension(size(a, 1), size(b, 2)) :: c
    +
    442
    +
    443 ! Process
    +
    444 c = b
    +
    445 call ztrmm('L', 'U', 'N', 'N', size(b, 1), size(b, 2), 1.0d0, &
    +
    446 a, size(a, 1), c, size(c, 1))
    +
    447 end function
    +
    448
    +
    449! ------------------------------------------------------------------------------
    +
    456 function mat_mult_upper_tri_2_cmplx(a, b) result(c)
    +
    457 ! Arguments
    +
    458 complex(real64), intent(in), dimension(:,:) :: a
    +
    459 complex(real64), intent(in), dimension(:) :: b
    +
    460 complex(real64), dimension(size(a, 1)) :: c
    +
    461
    +
    462 ! Process
    +
    463 c = b
    +
    464 call ztrmv('U', 'N', 'N', size(a, 1), a, size(a, 1), c, 1)
    +
    465 end function
    +
    466
    +
    467 ! ------------------------------------------------------------------------------
    +
    474 function mat_mult_lower_tri_1_cmplx(a, b) result(c)
    +
    475 ! Arguments
    +
    476 complex(real64), intent(in), dimension(:,:) :: a, b
    +
    477 complex(real64), dimension(size(a, 1), size(b, 2)) :: c
    +
    478
    +
    479 ! Process
    +
    480 c = b
    +
    481 call ztrmm('L', 'L', 'N', 'N', size(b, 1), size(b, 2), 1.0d0, &
    +
    482 a, size(a, 1), c, size(c, 1))
    +
    483 end function
    +
    484
    +
    485 ! ------------------------------------------------------------------------------
    +
    492 function mat_mult_lower_tri_2_cmplx(a, b) result(c)
    +
    493 ! Arguments
    +
    494 complex(real64), intent(in), dimension(:,:) :: a
    +
    495 complex(real64), intent(in), dimension(:) :: b
    +
    496 complex(real64), dimension(size(a, 1)) :: c
    +
    497
    +
    498 ! Process
    +
    499 c = b
    +
    500 call ztrmv('L', 'N', 'N', size(a, 1), a, size(a, 1), c, 1)
    +
    501 end function
    +
    502
    +
    503! ------------------------------------------------------------------------------
    +
    508 function mat_det(a) result(x)
    +
    509 ! Arguments
    +
    510 real(real64), intent(in), dimension(:,:) :: a
    +
    511 real(real64) :: x
    +
    512
    +
    513 ! Local Variables
    +
    514 real(real64), dimension(size(a, 1), size(a, 2)) :: b
    +
    515
    +
    516 ! Process
    +
    517 b = a
    +
    518 x = det(b)
    +
    519 end function
    +
    520
    +
    521! ------------------------------------------------------------------------------
    +
    527 function mat_lu_dbl(a) result(x)
    +
    528 ! Arguments
    +
    529 real(real64), intent(in), dimension(:,:) :: a
    +
    530 type(lu_results) :: x
    +
    531
    +
    532 ! Local Variables
    +
    533 integer(int32) :: n
    +
    534 integer(int32), allocatable, dimension(:) :: ipvt
    +
    535
    +
    536 ! Memory Allocation
    +
    537 n = size(a, 1)
    +
    538 allocate(ipvt(n))
    +
    539 allocate(x%l(n,n))
    +
    540 allocate(x%u(n,n))
    +
    541 allocate(x%p(n,n))
    +
    542
    +
    543 ! Compute the factorization
    +
    544 x%l = a
    +
    545 call lu_factor(x%l, ipvt)
    +
    546
    +
    547 ! Form L, U, and P
    +
    548 call form_lu(x%l, ipvt, x%u, x%p)
    +
    549 end function
    +
    550
    +
    551! ------------------------------------------------------------------------------
    +
    557 function mat_lu_cmplx(a) result(x)
    +
    558 ! Arguments
    +
    559 complex(real64), intent(in), dimension(:,:) :: a
    +
    560 type(lu_results_cmplx) :: x
    +
    561
    +
    562 ! Local Variables
    +
    563 integer(int32) :: n
    +
    564 integer(int32), allocatable, dimension(:) :: ipvt
    +
    565
    +
    566 ! Memory Allocation
    +
    567 n = size(a, 1)
    +
    568 allocate(ipvt(n))
    +
    569 allocate(x%l(n,n))
    +
    570 allocate(x%u(n,n))
    +
    571 allocate(x%p(n,n))
    +
    572
    +
    573 ! Compute the factorization
    +
    574 x%l = a
    +
    575 call lu_factor(x%l, ipvt)
    +
    576
    +
    577 ! Form L, U, and P
    +
    578 call form_lu(x%l, ipvt, x%u, x%p)
    +
    579 end function
    +
    580
    +
    581! ------------------------------------------------------------------------------
    +
    591 function mat_qr(a, pvt) result(x)
    +
    592 ! Arguments
    +
    593 real(real64), intent(in), dimension(:,:) :: a
    +
    594 logical, intent(in), optional :: pvt
    +
    595 type(qr_results) :: x
    +
    596
    +
    597 ! Local Variables
    +
    598 logical :: use_pivot
    +
    599 integer(int32) :: m, n, mn
    +
    600 integer(int32), allocatable, dimension(:) :: jpvt
    +
    601 real(real64), allocatable, dimension(:) :: tau
    +
    602
    +
    603 ! Memory Allocation
    +
    604 use_pivot = .false.
    +
    605 if (present(pvt)) use_pivot = pvt
    +
    606 m = size(a, 1)
    +
    607 n = size(a, 2)
    +
    608 mn = min(m, n)
    +
    609 allocate(tau(mn))
    +
    610 allocate(x%q(m,m))
    +
    611 allocate(x%r(m,n))
    +
    612
    +
    613 ! Compute the factorization, and then form Q, R, and P
    +
    614 x%r = a
    +
    615 if (use_pivot) then
    +
    616 allocate(x%p(n,n))
    +
    617 allocate(jpvt(n))
    +
    618 jpvt = 0 ! Ensure all columns are free columns
    +
    619 call qr_factor(x%r, tau, jpvt)
    +
    620 call form_qr(x%r, tau, jpvt, x%q, x%p)
    +
    621 else
    +
    622 call qr_factor(x%r, tau)
    +
    623 call form_qr(x%r, tau, x%q)
    +
    624 end if
    +
    625 end function
    +
    626
    +
    627! ------------------------------------------------------------------------------
    +
    637 function mat_qr_rank1_update(q, r, x, y) result(rst)
    +
    638 ! Arguments
    +
    639 real(real64), intent(in), dimension(:,:) :: q, r
    +
    640 real(real64), intent(in), dimension(:) :: x, y
    +
    641 type(qr_results) :: rst
    +
    642
    +
    643 ! Local Variables
    +
    644 integer(int32) :: i, m, n
    +
    645 real(real64), allocatable, dimension(:) :: xc, yc
    +
    646
    +
    647 ! Memory allocation
    +
    648 m = size(q, 1)
    +
    649 n = size(r, 2)
    +
    650 allocate(xc(m))
    +
    651 allocate(yc(n))
    +
    652 allocate(rst%q(m,m))
    +
    653 allocate(rst%r(m,n))
    +
    654
    +
    655 ! Process
    +
    656 do i = 1, m
    +
    657 xc(i) = x(i)
    +
    658 rst%q(:,i) = q(:,i)
    +
    659 end do
    +
    660 do i = 1, n
    +
    661 yc(i) = y(i)
    +
    662 rst%r(:,i) = r(:,i)
    +
    663 end do
    +
    664 call qr_rank1_update(rst%q, rst%r, xc, yc)
    +
    665 end function
    +
    666
    +
    667! ------------------------------------------------------------------------------
    +
    673 function mat_svd(a) result(x)
    +
    674 ! Arguments
    +
    675 real(real64), intent(in), dimension(:,:) :: a
    +
    676 type(svd_results) :: x
    +
    677
    +
    678 ! Local Variables
    +
    679 integer(int32) :: i, m, n, mn
    +
    680 real(real64), allocatable, dimension(:) :: s
    +
    681 real(real64), allocatable, dimension(:,:) :: ac
    +
    682
    +
    683 ! Memory Allocation
    +
    684 m = size(a, 1)
    +
    685 n = size(a, 2)
    +
    686 mn = min(m, n)
    +
    687 allocate(s(mn))
    +
    688 allocate(ac(m,n))
    +
    689 allocate(x%u(m,m))
    +
    690 allocate(x%s(m,n))
    +
    691 allocate(x%vt(n,n))
    +
    692
    +
    693 ! Process
    +
    694 ac = a
    +
    695 call svd(ac, s, x%u, x%vt)
    +
    696
    +
    697 ! Extract the singular values, and populate the results matrix
    +
    698 x%s = 0.0d0
    +
    699 do i = 1, mn
    +
    700 x%s(i,i) = s(i)
    +
    701 end do
    +
    702 end function
    +
    703
    +
    704! ------------------------------------------------------------------------------
    +
    714 function mat_cholesky(a, upper) result(r)
    +
    715 ! Arguments
    +
    716 real(real64), intent(in), dimension(:,:) :: a
    +
    717 logical, intent(in), optional :: upper
    +
    718 real(real64), dimension(size(a, 1), size(a, 2)) :: r
    +
    719
    +
    720 ! Local Variables
    +
    721 logical :: compute_upper
    +
    722
    +
    723 ! Process
    +
    724 compute_upper = .true.
    +
    725 if (present(upper)) compute_upper = upper
    +
    726 r = a
    +
    727 call cholesky_factor(r, compute_upper)
    +
    728 end function
    +
    729
    +
    730! ------------------------------------------------------------------------------
    +
    737 function mat_cholesky_rank1_update(a, x) result(r)
    +
    738 ! Arguments
    +
    739 real(real64), intent(in), dimension(:,:) :: a
    +
    740 real(real64), intent(in), dimension(:) :: x
    +
    741 real(real64), dimension(size(a, 1), size(a, 2)) :: r
    +
    742
    +
    743 ! Local Variables
    +
    744 real(real64), dimension(size(x)) :: xc
    +
    745
    +
    746 ! Process
    +
    747 r = a
    +
    748 xc = x
    +
    749 call cholesky_rank1_update(r, xc)
    +
    750 end function
    +
    751
    +
    752! ------------------------------------------------------------------------------
    +
    759 function mat_cholesky_rank1_downdate(a, x) result(r)
    +
    760 ! Arguments
    +
    761 real(real64), intent(in), dimension(:,:) :: a
    +
    762 real(real64), intent(in), dimension(:) :: x
    +
    763 real(real64), dimension(size(a, 1), size(a, 2)) :: r
    +
    764
    +
    765 ! Local Variables
    +
    766 real(real64), dimension(size(x)) :: xc
    +
    767
    +
    768 ! Process
    +
    769 r = a
    +
    770 xc = x
    +
    771 call cholesky_rank1_downdate(r, xc)
    +
    772 end function
    +
    773
    +
    774! ------------------------------------------------------------------------------
    +
    779 function mat_inverse(a) result(x)
    +
    780 ! Arguments
    +
    781 real(real64), intent(in), dimension(:,:) :: a
    +
    782 real(real64), dimension(size(a, 2), size(a, 1)) :: x
    +
    783
    +
    784 ! Compute the inverse of A
    +
    785 x = a
    +
    786 call mtx_inverse(x)
    +
    787 end function
    +
    788
    +
    789! ------------------------------------------------------------------------------
    +
    794 function mat_pinverse(a) result(x)
    +
    795 ! Arguments
    +
    796 real(real64), intent(in), dimension(:,:) :: a
    +
    797 real(real64), dimension(size(a, 2), size(a, 1)) :: x
    +
    798
    +
    799 ! Local Variables
    +
    800 real(real64), dimension(size(a, 1), size(a, 2)) :: ac
    +
    801
    +
    802 ! Compute the inverse of A
    +
    803 ac = a
    +
    804 call mtx_pinverse(ac, x)
    +
    805 end function
    +
    806
    +
    807! ------------------------------------------------------------------------------
    +
    814 function mat_solve_upper_tri_1(a, b) result(x)
    +
    815 ! Arguments
    +
    816 real(real64), intent(in), dimension(:,:) :: a, b
    +
    817 real(real64), dimension(size(b, 1), size(b, 2)) :: x
    +
    818
    +
    819 ! Process
    +
    820 x = b
    +
    821 call solve_triangular_system(.true., .true., .false., .true., 1.0d0, &
    +
    822 a, x)
    +
    823 end function
    +
    824
    +
    825! ------------------------------------------------------------------------------
    +
    832 function mat_solve_upper_tri_2(a, b) result(x)
    +
    833 ! Arguments
    +
    834 real(real64), intent(in), dimension(:,:) :: a
    +
    835 real(real64), intent(in), dimension(:) :: b
    +
    836 real(real64), dimension(size(b)) :: x
    +
    837
    +
    838 ! Process
    +
    839 x = b
    +
    840 call solve_triangular_system(.true., .false., .true., a, x)
    +
    841 end function
    +
    842
    +
    843! ------------------------------------------------------------------------------
    +
    850 function mat_solve_upper_tri_1_cmplx(a, b) result(x)
    +
    851 ! Arguments
    +
    852 complex(real64), intent(in), dimension(:,:) :: a, b
    +
    853 complex(real64), dimension(size(b, 1), size(b, 2)) :: x
    +
    854
    +
    855 ! Process
    +
    856 x = b
    +
    857 call solve_triangular_system(.true., .true., .false., .true., &
    +
    858 (1.0d0, 0.0d0), a, x)
    +
    859 end function
    +
    860
    +
    861! ------------------------------------------------------------------------------
    +
    868 function mat_solve_upper_tri_2_cmplx(a, b) result(x)
    +
    869 ! Arguments
    +
    870 complex(real64), intent(in), dimension(:,:) :: a
    +
    871 complex(real64), intent(in), dimension(:) :: b
    +
    872 complex(real64), dimension(size(b)) :: x
    +
    873
    +
    874 ! Process
    +
    875 x = b
    +
    876 call solve_triangular_system(.true., .false., .true., a, x)
    +
    877 end function
    +
    878
    +
    879! ------------------------------------------------------------------------------
    +
    886 function mat_solve_lower_tri_1(a, b) result(x)
    +
    887 ! Arguments
    +
    888 real(real64), intent(in), dimension(:,:) :: a, b
    +
    889 real(real64), dimension(size(b, 1), size(b, 2)) :: x
    +
    890
    +
    891 ! Process
    +
    892 x = b
    +
    893 call solve_triangular_system(.true., .false., .false., .true., 1.0d0, &
    +
    894 a, x)
    +
    895 end function
    +
    896
    +
    897! ------------------------------------------------------------------------------
    +
    904 function mat_solve_lower_tri_2(a, b) result(x)
    +
    905 ! Arguments
    +
    906 real(real64), intent(in), dimension(:,:) :: a
    +
    907 real(real64), intent(in), dimension(:) :: b
    +
    908 real(real64), dimension(size(b)) :: x
    +
    909
    +
    910 ! Process
    +
    911 x = b
    +
    912 call solve_triangular_system(.false., .false., .true., a, x)
    +
    913 end function
    +
    914
    +
    915! ------------------------------------------------------------------------------
    +
    922 function mat_solve_lower_tri_1_cmplx(a, b) result(x)
    +
    923 ! Arguments
    +
    924 complex(real64), intent(in), dimension(:,:) :: a, b
    +
    925 complex(real64), dimension(size(b, 1), size(b, 2)) :: x
    +
    926
    +
    927 ! Process
    +
    928 x = b
    +
    929 call solve_triangular_system(.true., .false., .false., .true., &
    +
    930 (1.0d0, 0.0d0), a, x)
    +
    931 end function
    +
    932
    +
    933! ------------------------------------------------------------------------------
    +
    940 function mat_solve_lower_tri_2_cmplx(a, b) result(x)
    +
    941 ! Arguments
    +
    942 complex(real64), intent(in), dimension(:,:) :: a
    +
    943 complex(real64), intent(in), dimension(:) :: b
    +
    944 complex(real64), dimension(size(b)) :: x
    +
    945
    +
    946 ! Process
    +
    947 x = b
    +
    948 call solve_triangular_system(.false., .false., .true., a, x)
    +
    949 end function
    +
    950
    +
    951! ------------------------------------------------------------------------------
    +
    958 function mat_eigen_1(a) result(x)
    +
    959 ! Arguments
    +
    960 real(real64), intent(in), dimension(:,:) :: a
    +
    961 type(eigen_results) :: x
    +
    962
    +
    963 ! Local Variables
    +
    964 integer(int32) :: n
    +
    965 real(real64), dimension(size(a, 1), size(a, 2)) :: ac
    +
    966
    +
    967 ! Memory Allocation
    +
    968 n = size(a, 1)
    +
    969 allocate(x%values(n))
    +
    970 allocate(x%vectors(n,n))
    +
    971
    +
    972 ! Process
    +
    973 ac = a
    +
    974 call eigen(ac, x%values, x%vectors)
    +
    975
    +
    976 ! Sort the eigenvalues and eigenvectors.
    +
    977 call sort(x%values, x%vectors, .true.)
    +
    978 end function
    +
    979
    +
    980! ------------------------------------------------------------------------------
    +
    988 function mat_eigen_2(a, b) result(x)
    +
    989 ! Arguments
    +
    990 real(real64), intent(in), dimension(:,:) :: a, b
    +
    991 type(eigen_results) :: x
    +
    992
    +
    993 ! Local Variables
    +
    994 integer(int32) :: i, j, n
    +
    995 real(real64), dimension(size(a, 1), size(a, 2)) :: ac
    +
    996 real(real64), dimension(size(b, 1), size(b, 2)) :: bc
    +
    997
    +
    998 ! Memory Allocation
    +
    999 n = size(a, 1)
    +
    1000 allocate(x%values(n))
    +
    1001 allocate(x%vectors(n,n))
    +
    1002
    +
    1003 ! Process
    +
    1004 do j = 1, n
    +
    1005 do i = 1, n
    +
    1006 ac(i,j) = a(i,j)
    +
    1007 bc(i,j) = b(i,j)
    +
    1008 end do
    +
    1009 end do
    +
    1010 call eigen(ac, bc, x%values, vecs = x%vectors)
    +
    1011
    +
    1012 ! Sort the eigenvalues and eigenvectors.
    +
    1013 call sort(x%values, x%vectors, .true.)
    +
    1014 end function
    +
    1015
    +
    1016! ------------------------------------------------------------------------------
    +
    1021 pure function identity(n) result(x)
    +
    1022 integer(int32), intent(in) :: n
    +
    1023 real(real64), dimension(n, n) :: x
    +
    1024 integer(int32) :: i
    +
    1025 x = 0.0d0
    +
    1026 do i = 1, n
    +
    1027 x(i,i) = 1.0d0
    +
    1028 end do
    +
    1029 end function
    +
    1030
    +
    1031end module
    +
    Computes the Cholesky factorization of a symmetric, positive definite matrix.
    Definition: linalg.f90:1433
    +
    Computes the rank 1 downdate to a Cholesky factored matrix (upper triangular).
    Definition: linalg.f90:1639
    +
    Computes the rank 1 update to a Cholesky factored matrix (upper triangular).
    Definition: linalg.f90:1532
    +
    Computes the determinant of a square matrix.
    Definition: linalg.f90:434
    +
    Multiplies a diagonal matrix with another matrix or array.
    Definition: linalg.f90:329
    +
    Computes the eigenvalues, and optionally the eigenvectors, of a matrix.
    Definition: linalg.f90:3098
    +
    Extracts the L and U matrices from the condensed [L\U] storage format used by the lu_factor.
    Definition: linalg.f90:717
    +
    Forms the full M-by-M orthogonal matrix Q from the elementary reflectors returned by the base QR fact...
    Definition: linalg.f90:1031
    +
    Computes the LU factorization of an M-by-N matrix.
    Definition: linalg.f90:595
    +
    Computes the inverse of a square matrix.
    Definition: linalg.f90:2778
    +
    Computes the Moore-Penrose pseudo-inverse of a M-by-N matrix using the singular value decomposition o...
    Definition: linalg.f90:2884
    +
    Computes the QR factorization of an M-by-N matrix.
    Definition: linalg.f90:871
    +
    Computes the rank 1 update to an M-by-N QR factored matrix A (M >= N) where , and such that .
    Definition: linalg.f90:1334
    +
    Performs the rank-1 update to matrix A such that: , where is an M-by-N matrix, is a scalar,...
    Definition: linalg.f90:194
    +
    Solves a triangular system of equations.
    Definition: linalg.f90:2061
    +
    Sorts an array.
    Definition: linalg.f90:3181
    +
    Computes the singular value decomposition of a matrix A. The SVD is defined as: , where is an M-by-M...
    Definition: linalg.f90:1927
    +
    Computes the eigenvalues and eigenvectors (right) of a general N-by-N matrix.
    +
    Computes the LU factorization of a square matrix. Notice, partial row pivoting is utilized.
    +
    Computes the matrix operation: C = A * B, where A is a diagonal matrix.
    +
    Computes the matrix operation C = A * B, where A is a lower triangular matrix.
    +
    Computes the matrix operation C = A * B, where A is an upper triangular matrix.
    +
    Solves the lower triangular system A X = B, where A is a lower triangular matrix.
    +
    Solves the upper triangular system A X = B, where A is an upper triangular matrix.
    Provides an immutable interface to many of the core linear algebra routines in this library....
    -
    Defines a container for the output of an Eigen analysis of a square matrix.
    -
    Defines a container for the output of an LU factorization.
    -
    Defines a container for the output of an LU factorization.
    -
    Defines a container for the output of a QR factorization.
    -
    Defines a container for the output of a QR factorization.
    -
    Defines a container for the output of a singular value decomposition of a matrix.
    -
    Defines a container for the output of a singular value decomposition of a matrix.
    +
    Provides a set of common linear algebra routines.
    Definition: linalg.f90:15
    +
    Defines a container for the output of an Eigen analysis of a square matrix.
    +
    Defines a container for the output of an LU factorization.
    +
    Defines a container for the output of an LU factorization.
    +
    Defines a container for the output of a QR factorization.
    +
    Defines a container for the output of a QR factorization.
    +
    Defines a container for the output of a singular value decomposition of a matrix.
    +
    Defines a container for the output of a singular value decomposition of a matrix.
    diff --git a/doc/html/linalg__solve_8f90_source.html b/doc/html/linalg__solve_8f90_source.html index 8a844ac2..8177da91 100644 --- a/doc/html/linalg__solve_8f90_source.html +++ b/doc/html/linalg__solve_8f90_source.html @@ -102,7 +102,7 @@
    1! linalg_solve.f90
    2
    -
    7submodule(linalg_core) linalg_solve
    +
    7submodule(linalg) linalg_solve
    8contains
    9! ******************************************************************************
    10! TRIANGULAR MATRIX SOLUTION ROUTINES
    @@ -3481,7 +3481,7 @@
    3383 end subroutine
    3384
    3385end submodule
    -
    Provides a set of common linear algebra routines.
    Definition: linalg_core.f90:15
    +
    Provides a set of common linear algebra routines.
    Definition: linalg.f90:15
    diff --git a/doc/html/linalg__sorting_8f90_source.html b/doc/html/linalg__sorting_8f90_source.html index 33ac5257..1ea7a815 100644 --- a/doc/html/linalg__sorting_8f90_source.html +++ b/doc/html/linalg__sorting_8f90_source.html @@ -102,7 +102,7 @@
    1! linalg_sorting.f90
    2
    -
    7submodule(linalg_core) linalg_sorting
    +
    7submodule(linalg) linalg_sorting
    8contains
    9! ******************************************************************************
    10! SORTING ROUTINES
    @@ -643,7 +643,7 @@
    639
    640! ------------------------------------------------------------------------------
    641end submodule
    -
    Provides a set of common linear algebra routines.
    Definition: linalg_core.f90:15
    +
    Provides a set of common linear algebra routines.
    Definition: linalg.f90:15
    diff --git a/doc/html/menudata.js b/doc/html/menudata.js index 3be9094a..69403327 100644 --- a/doc/html/menudata.js +++ b/doc/html/menudata.js @@ -27,17 +27,8 @@ var menudata={children:[ {text:"Modules",url:"namespaces.html",children:[ {text:"Modules List",url:"namespaces.html"}, {text:"Module Members",url:"namespacemembers.html",children:[ -{text:"All",url:"namespacemembers.html",children:[ -{text:"h",url:"namespacemembers.html#index_h"}, -{text:"i",url:"namespacemembers.html#index_i"}, -{text:"l",url:"namespacemembers.html#index_l"}, -{text:"m",url:"namespacemembers.html#index_m"}, -{text:"n",url:"namespacemembers.html#index_n"}, -{text:"t",url:"namespacemembers.html#index_t"}]}, -{text:"Functions/Subroutines",url:"namespacemembers_func.html",children:[ -{text:"i",url:"namespacemembers_func.html#index_i"}, -{text:"l",url:"namespacemembers_func.html#index_l"}, -{text:"m",url:"namespacemembers_func.html#index_m"}]}, +{text:"All",url:"namespacemembers.html"}, +{text:"Functions/Subroutines",url:"namespacemembers_func.html"}, {text:"Variables",url:"namespacemembers_vars.html"}]}]}, {text:"Data Types List",url:"annotated.html",children:[ {text:"Data Types List",url:"annotated.html"}, diff --git a/doc/html/namespacelinalg.html b/doc/html/namespacelinalg.html new file mode 100644 index 00000000..5db538c0 --- /dev/null +++ b/doc/html/namespacelinalg.html @@ -0,0 +1,456 @@ + + + + + + + +linalg: linalg Module Reference + + + + + + + + + + + + + + + +
    +
    + + + + + + +
    +
    linalg 1.6.1 +
    +
    A linear algebra library that provides a user-friendly interface to several BLAS and LAPACK routines.
    +
    +
    + + + + + + + +
    +
    + +
    +
    +
    + +
    + +
    +
    + + +
    +
    +
    +
    +
    +
    Loading...
    +
    Searching...
    +
    No Matches
    +
    +
    +
    +
    + +
    + +
    linalg Module Reference
    +
    +
    + +

    Provides a set of common linear algebra routines. +More...

    + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +

    +Data Types

    interface  cholesky_factor
     Computes the Cholesky factorization of a symmetric, positive definite matrix. More...
     
    interface  cholesky_rank1_downdate
     Computes the rank 1 downdate to a Cholesky factored matrix (upper triangular). More...
     
    interface  cholesky_rank1_update
     Computes the rank 1 update to a Cholesky factored matrix (upper triangular). More...
     
    interface  det
     Computes the determinant of a square matrix. More...
     
    interface  diag_mtx_mult
     Multiplies a diagonal matrix with another matrix or array. More...
     
    interface  eigen
     Computes the eigenvalues, and optionally the eigenvectors, of a matrix. More...
     
    interface  form_lu
     Extracts the L and U matrices from the condensed [L\U] storage format used by the lu_factor. More...
     
    interface  form_qr
     Forms the full M-by-M orthogonal matrix Q from the elementary reflectors returned by the base QR factorization algorithm. More...
     
    interface  lu_factor
     Computes the LU factorization of an M-by-N matrix. More...
     
    interface  mtx_inverse
     Computes the inverse of a square matrix. More...
     
    interface  mtx_mult
     Performs the matrix operation: \( C = \alpha op(A) op(B) + \beta C \). More...
     
    interface  mtx_pinverse
     Computes the Moore-Penrose pseudo-inverse of a M-by-N matrix using the singular value decomposition of the matrix. More...
     
    interface  mtx_rank
     Computes the rank of a matrix. More...
     
    interface  mult_qr
     Multiplies a general matrix by the orthogonal matrix Q from a QR factorization. More...
     
    interface  mult_rz
     Multiplies a general matrix by the orthogonal matrix Z from an RZ factorization. More...
     
    interface  qr_factor
     Computes the QR factorization of an M-by-N matrix. More...
     
    interface  qr_rank1_update
     Computes the rank 1 update to an M-by-N QR factored matrix A (M >= N) where \( A = Q R \), and \( A1 = A + U V^T \) such that \( A1 = Q1 R1 \). More...
     
    interface  rank1_update
     Performs the rank-1 update to matrix A such that: \( A = \alpha X Y^T + A \), where \( A \) is an M-by-N matrix, \( \alpha \)is a scalar, \( X \) is an M-element array, and \( Y \) is an N-element array. In the event that \( Y \) is complex, \( Y^H \) is used instead of \( Y^T \). More...
     
    interface  recip_mult_array
     Multiplies a vector by the reciprocal of a real scalar. More...
     
    interface  rz_factor
     Factors an upper trapezoidal matrix by means of orthogonal transformations such that \( A = R Z = (R 0) Z \). Z is an orthogonal matrix of dimension N-by-N, and R is an M-by-M upper triangular matrix. More...
     
    interface  solve_cholesky
     Solves a system of Cholesky factored equations. More...
     
    interface  solve_least_squares
     Solves the overdetermined or underdetermined system \( A X = B \) of M equations of N unknowns. Notice, it is assumed that matrix A has full rank. More...
     
    interface  solve_least_squares_full
     Solves the overdetermined or underdetermined system \( A X = B \) of M equations of N unknowns, but uses a full orthogonal factorization of the system. More...
     
    interface  solve_least_squares_svd
     Solves the overdetermined or underdetermined system \( A X = B \) of M equations of N unknowns using a singular value decomposition of matrix A. More...
     
    interface  solve_lu
     Solves a system of LU-factored equations. More...
     
    interface  solve_qr
     Solves a system of M QR-factored equations of N unknowns. More...
     
    interface  solve_triangular_system
     Solves a triangular system of equations. More...
     
    interface  sort
     Sorts an array. More...
     
    interface  svd
     Computes the singular value decomposition of a matrix A. The SVD is defined as: \( A = U S V^T \), where \( U \) is an M-by-M orthogonal matrix, \( S \) is an M-by-N diagonal matrix, and \( V \) is an N-by-N orthogonal matrix. More...
     
    interface  swap
     Swaps the contents of two arrays. More...
     
    interface  trace
     Computes the trace of a matrix (the sum of the main diagonal elements). More...
     
    interface  tri_mtx_mult
     Computes the triangular matrix operation: \( B = \alpha A^T A + \beta B \), or \( B = \alpha A A^T + \beta B \), where A is a triangular matrix. More...
     
    + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +

    +Variables

    integer(int32), parameter, public la_no_operation = 0
     Defines no operation should be performed on the matrix. More...
     
    integer(int32), parameter, public la_transpose = 1
     Defines a transpose operation. More...
     
    integer(int32), parameter, public la_hermitian_transpose = 2
     Defines a Hermitian transpose operation for a complex-valued matrix. More...
     
    integer(int32), parameter, public la_no_error = 0
     A flag denoting no error condition. More...
     
    integer(int32), parameter, public la_invalid_input_error = 101
     An error flag denoting an invalid input. More...
     
    integer(int32), parameter, public la_array_size_error = 102
     An error flag denoting an improperly sized array. More...
     
    integer(int32), parameter, public la_singular_matrix_error = 103
     An error flag denoting a singular matrix. More...
     
    integer(int32), parameter, public la_matrix_format_error = 104
     An error flag denoting an issue with the matrix format. More...
     
    integer(int32), parameter, public la_out_of_memory_error = 105
     An error flag denoting that there is insufficient memory available. More...
     
    integer(int32), parameter, public la_convergence_error = 106
     An error flag denoting a convergence failure. More...
     
    integer(int32), parameter, public la_invalid_operation_error = 107
     An error resulting from an invalid operation. More...
     
    +

    Detailed Description

    +

    Provides a set of common linear algebra routines.

    +

    Variable Documentation

    + +

    ◆ la_array_size_error

    + +
    +
    + + + + +
    integer(int32), parameter, public linalg::la_array_size_error = 102
    +
    + +

    An error flag denoting an improperly sized array.

    + +

    Definition at line 83 of file linalg.f90.

    + +
    +
    + +

    ◆ la_convergence_error

    + +
    +
    + + + + +
    integer(int32), parameter, public linalg::la_convergence_error = 106
    +
    + +

    An error flag denoting a convergence failure.

    + +

    Definition at line 91 of file linalg.f90.

    + +
    +
    + +

    ◆ la_hermitian_transpose

    + +
    +
    + + + + +
    integer(int32), parameter, public linalg::la_hermitian_transpose = 2
    +
    + +

    Defines a Hermitian transpose operation for a complex-valued matrix.

    + +

    Definition at line 73 of file linalg.f90.

    + +
    +
    + +

    ◆ la_invalid_input_error

    + +
    +
    + + + + +
    integer(int32), parameter, public linalg::la_invalid_input_error = 101
    +
    + +

    An error flag denoting an invalid input.

    + +

    Definition at line 81 of file linalg.f90.

    + +
    +
    + +

    ◆ la_invalid_operation_error

    + +
    +
    + + + + +
    integer(int32), parameter, public linalg::la_invalid_operation_error = 107
    +
    + +

    An error resulting from an invalid operation.

    + +

    Definition at line 93 of file linalg.f90.

    + +
    +
    + +

    ◆ la_matrix_format_error

    + +
    +
    + + + + +
    integer(int32), parameter, public linalg::la_matrix_format_error = 104
    +
    + +

    An error flag denoting an issue with the matrix format.

    + +

    Definition at line 87 of file linalg.f90.

    + +
    +
    + +

    ◆ la_no_error

    + +
    +
    + + + + +
    integer(int32), parameter, public linalg::la_no_error = 0
    +
    + +

    A flag denoting no error condition.

    + +

    Definition at line 79 of file linalg.f90.

    + +
    +
    + +

    ◆ la_no_operation

    + +
    +
    + + + + +
    integer(int32), parameter, public linalg::la_no_operation = 0
    +
    + +

    Defines no operation should be performed on the matrix.

    + +

    Definition at line 69 of file linalg.f90.

    + +
    +
    + +

    ◆ la_out_of_memory_error

    + +
    +
    + + + + +
    integer(int32), parameter, public linalg::la_out_of_memory_error = 105
    +
    + +

    An error flag denoting that there is insufficient memory available.

    + +

    Definition at line 89 of file linalg.f90.

    + +
    +
    + +

    ◆ la_singular_matrix_error

    + +
    +
    + + + + +
    integer(int32), parameter, public linalg::la_singular_matrix_error = 103
    +
    + +

    An error flag denoting a singular matrix.

    + +

    Definition at line 85 of file linalg.f90.

    + +
    +
    + +

    ◆ la_transpose

    + +
    +
    + + + + +
    integer(int32), parameter, public linalg::la_transpose = 1
    +
    + +

    Defines a transpose operation.

    + +

    Definition at line 71 of file linalg.f90.

    + +
    +
    +
    +
    + + + + diff --git a/doc/html/namespacelinalg.js b/doc/html/namespacelinalg.js new file mode 100644 index 00000000..14f3facb --- /dev/null +++ b/doc/html/namespacelinalg.js @@ -0,0 +1,46 @@ +var namespacelinalg = +[ + [ "cholesky_factor", "interfacelinalg_1_1cholesky__factor.html", null ], + [ "cholesky_rank1_downdate", "interfacelinalg_1_1cholesky__rank1__downdate.html", null ], + [ "cholesky_rank1_update", "interfacelinalg_1_1cholesky__rank1__update.html", null ], + [ "det", "interfacelinalg_1_1det.html", null ], + [ "diag_mtx_mult", "interfacelinalg_1_1diag__mtx__mult.html", null ], + [ "eigen", "interfacelinalg_1_1eigen.html", null ], + [ "form_lu", "interfacelinalg_1_1form__lu.html", null ], + [ "form_qr", "interfacelinalg_1_1form__qr.html", null ], + [ "lu_factor", "interfacelinalg_1_1lu__factor.html", null ], + [ "mtx_inverse", "interfacelinalg_1_1mtx__inverse.html", null ], + [ "mtx_mult", "interfacelinalg_1_1mtx__mult.html", null ], + [ "mtx_pinverse", "interfacelinalg_1_1mtx__pinverse.html", null ], + [ "mtx_rank", "interfacelinalg_1_1mtx__rank.html", null ], + [ "mult_qr", "interfacelinalg_1_1mult__qr.html", null ], + [ "mult_rz", "interfacelinalg_1_1mult__rz.html", null ], + [ "qr_factor", "interfacelinalg_1_1qr__factor.html", null ], + [ "qr_rank1_update", "interfacelinalg_1_1qr__rank1__update.html", null ], + [ "rank1_update", "interfacelinalg_1_1rank1__update.html", null ], + [ "recip_mult_array", "interfacelinalg_1_1recip__mult__array.html", null ], + [ "rz_factor", "interfacelinalg_1_1rz__factor.html", null ], + [ "solve_cholesky", "interfacelinalg_1_1solve__cholesky.html", null ], + [ "solve_least_squares", "interfacelinalg_1_1solve__least__squares.html", null ], + [ "solve_least_squares_full", "interfacelinalg_1_1solve__least__squares__full.html", null ], + [ "solve_least_squares_svd", "interfacelinalg_1_1solve__least__squares__svd.html", null ], + [ "solve_lu", "interfacelinalg_1_1solve__lu.html", null ], + [ "solve_qr", "interfacelinalg_1_1solve__qr.html", null ], + [ "solve_triangular_system", "interfacelinalg_1_1solve__triangular__system.html", null ], + [ "sort", "interfacelinalg_1_1sort.html", null ], + [ "svd", "interfacelinalg_1_1svd.html", null ], + [ "swap", "interfacelinalg_1_1swap.html", null ], + [ "trace", "interfacelinalg_1_1trace.html", null ], + [ "tri_mtx_mult", "interfacelinalg_1_1tri__mtx__mult.html", null ], + [ "la_array_size_error", "namespacelinalg.html#a7974856c0c0c76e6f1f2098a1eb7eac9", null ], + [ "la_convergence_error", "namespacelinalg.html#ac691dea40873ac2a70c8b44c933774a7", null ], + [ "la_hermitian_transpose", "namespacelinalg.html#a0e420096028b759a87f2f4f4306d202a", null ], + [ "la_invalid_input_error", "namespacelinalg.html#ace738355659bce2e9591473f0d543ef7", null ], + [ "la_invalid_operation_error", "namespacelinalg.html#a4f47021e96cd813b568422a2eb3821bc", null ], + [ "la_matrix_format_error", "namespacelinalg.html#ad89b9d502b7c484df53f9b10b9545776", null ], + [ "la_no_error", "namespacelinalg.html#aefdfc0979567e89aa3b8c599d3f766f4", null ], + [ "la_no_operation", "namespacelinalg.html#a665d131453840e869510e9e8d2f7f151", null ], + [ "la_out_of_memory_error", "namespacelinalg.html#abfb78ba61c0c2751f1c771c984469006", null ], + [ "la_singular_matrix_error", "namespacelinalg.html#af5dc9d60151bb81436b442525871c8c9", null ], + [ "la_transpose", "namespacelinalg.html#a2b842a1fb17710d7ec2f117f5fdb2a59", null ] +]; \ No newline at end of file diff --git a/doc/html/namespacelinalg__c__api.html b/doc/html/namespacelinalg__c__api.html index 0e1d1f36..17d3afdb 100644 --- a/doc/html/namespacelinalg__c__api.html +++ b/doc/html/namespacelinalg__c__api.html @@ -350,7 +350,7 @@

    Definition at line 1705 of file linalg_c_api.f90.

    +

    Definition at line 1704 of file linalg_c_api.f90.

    @@ -409,7 +409,7 @@

    Definition at line 1749 of file linalg_c_api.f90.

    +

    Definition at line 1748 of file linalg_c_api.f90.

    @@ -469,7 +469,7 @@

    Definition at line 1878 of file linalg_c_api.f90.

    +

    Definition at line 1877 of file linalg_c_api.f90.

    @@ -529,7 +529,7 @@

    Definition at line 1922 of file linalg_c_api.f90.

    +

    Definition at line 1921 of file linalg_c_api.f90.

    @@ -588,7 +588,7 @@

    Definition at line 1792 of file linalg_c_api.f90.

    +

    Definition at line 1791 of file linalg_c_api.f90.

    @@ -647,7 +647,7 @@

    Definition at line 1834 of file linalg_c_api.f90.

    +

    Definition at line 1833 of file linalg_c_api.f90.

    @@ -706,7 +706,7 @@

    Definition at line 667 of file linalg_c_api.f90.

    +

    Definition at line 666 of file linalg_c_api.f90.

    @@ -765,7 +765,7 @@

    Definition at line 704 of file linalg_c_api.f90.

    +

    Definition at line 703 of file linalg_c_api.f90.

    @@ -886,7 +886,7 @@

    Definition at line 340 of file linalg_c_api.f90.

    +

    Definition at line 339 of file linalg_c_api.f90.

    @@ -980,7 +980,7 @@

    Parameters
    - + @@ -1007,7 +1007,7 @@

    Definition at line 517 of file linalg_c_api.f90.

    +

    Definition at line 516 of file linalg_c_api.f90.

    @@ -1101,7 +1101,7 @@

    Parameters

    lsideSet to true to apply matrix A from the left; else, set to false to apply matrix A from the left.
    opbSet to TRANSPOSE to compute op(B) as a direct transpose of B, set to HERMITIAN_TRANSPOSE to compute op(B) as the Hermitian transpose of B, otherwise, set to NO_OPERATION to compute op(B) as B.
    opbSet to LA_TRANSPOSE to compute op(B) as a direct transpose of B, set to LA_HERMITIAN_TRANSPOSE to compute op(B) as the Hermitian transpose of B, otherwise, set to NO_OPERATION to compute op(B) as B.
    mThe number of rows in the matrix C.
    nThe number of columns in the matrix C.
    kThe inner dimension of the matrix product A * op(B).
    - + @@ -1128,7 +1128,7 @@

    Definition at line 429 of file linalg_c_api.f90.

    +

    Definition at line 428 of file linalg_c_api.f90.

    @@ -1208,7 +1208,7 @@

    Definition at line 2892 of file linalg_c_api.f90.

    +

    Definition at line 2891 of file linalg_c_api.f90.

    @@ -1288,7 +1288,7 @@

    Definition at line 3027 of file linalg_c_api.f90.

    +

    Definition at line 3026 of file linalg_c_api.f90.

    @@ -1389,7 +1389,7 @@

    Definition at line 2965 of file linalg_c_api.f90.

    +

    Definition at line 2964 of file linalg_c_api.f90.

    @@ -1456,7 +1456,7 @@

    Definition at line 2843 of file linalg_c_api.f90.

    +

    Definition at line 2842 of file linalg_c_api.f90.

    @@ -1542,7 +1542,7 @@

    Definition at line 931 of file linalg_c_api.f90.

    +

    Definition at line 930 of file linalg_c_api.f90.

    @@ -1628,7 +1628,7 @@

    Definition at line 971 of file linalg_c_api.f90.

    +

    Definition at line 970 of file linalg_c_api.f90.

    @@ -1715,7 +1715,7 @@

    Definition at line 1223 of file linalg_c_api.f90.

    +

    Definition at line 1222 of file linalg_c_api.f90.

    @@ -1802,7 +1802,7 @@

    Definition at line 1281 of file linalg_c_api.f90.

    +

    Definition at line 1280 of file linalg_c_api.f90.

    @@ -1910,7 +1910,7 @@

    Definition at line 1411 of file linalg_c_api.f90.

    +

    Definition at line 1410 of file linalg_c_api.f90.

    @@ -2018,7 +2018,7 @@

    Definition at line 1345 of file linalg_c_api.f90.

    +

    Definition at line 1344 of file linalg_c_api.f90.

    @@ -2070,7 +2070,7 @@

    Definition at line 2672 of file linalg_c_api.f90.

    +

    Definition at line 2671 of file linalg_c_api.f90.

    @@ -2122,7 +2122,7 @@

    Definition at line 2709 of file linalg_c_api.f90.

    +

    Definition at line 2708 of file linalg_c_api.f90.

    @@ -2188,7 +2188,7 @@

    Definition at line 835 of file linalg_c_api.f90.

    +

    Definition at line 834 of file linalg_c_api.f90.

    @@ -2254,7 +2254,7 @@

    Definition at line 882 of file linalg_c_api.f90.

    +

    Definition at line 881 of file linalg_c_api.f90.

    @@ -2375,7 +2375,7 @@

    Definition at line 184 of file linalg_c_api.f90.

    +

    Definition at line 183 of file linalg_c_api.f90.

    @@ -2474,15 +2474,15 @@

    Parameters

    lsideSet to true to apply matrix A from the left; else, set to false to apply matrix A from the left.
    opbSet to TRANSPOSE to compute op(B) as a direct transpose of B, set to HERMITIAN_TRANSPOSE to compute op(B) as the Hermitian transpose of B, otherwise, set to NO_OPERATION to compute op(B) as B.
    opbSet to LA_TRANSPOSE to compute op(B) as a direct transpose of B, set to LA_HERMITIAN_TRANSPOSE to compute op(B) as the Hermitian transpose of B, otherwise, set to NO_OPERATION to compute op(B) as B.
    mThe number of rows in the matrix C.
    nThe number of columns in the matrix C.
    kThe inner dimension of the matrix product A * op(B).
    - - + + - + - + @@ -2496,7 +2496,7 @@

    Definition at line 255 of file linalg_c_api.f90.

    +

    Definition at line 254 of file linalg_c_api.f90.

    @@ -2597,7 +2597,7 @@

    Definition at line 1474 of file linalg_c_api.f90.

    +

    Definition at line 1473 of file linalg_c_api.f90.

    @@ -2698,7 +2698,7 @@

    Definition at line 1545 of file linalg_c_api.f90.

    +

    Definition at line 1544 of file linalg_c_api.f90.

    @@ -2769,7 +2769,7 @@

    Definition at line 2751 of file linalg_c_api.f90.

    +

    Definition at line 2750 of file linalg_c_api.f90.

    @@ -2840,7 +2840,7 @@

    Definition at line 2794 of file linalg_c_api.f90.

    +

    Definition at line 2793 of file linalg_c_api.f90.

    @@ -2906,7 +2906,7 @@

    Definition at line 1012 of file linalg_c_api.f90.

    +

    Definition at line 1011 of file linalg_c_api.f90.

    @@ -2972,7 +2972,7 @@

    Definition at line 1061 of file linalg_c_api.f90.

    +

    Definition at line 1060 of file linalg_c_api.f90.

    @@ -3045,7 +3045,7 @@

    Definition at line 1168 of file linalg_c_api.f90.

    +

    Definition at line 1167 of file linalg_c_api.f90.

    @@ -3118,7 +3118,7 @@

    Definition at line 1114 of file linalg_c_api.f90.

    +

    Definition at line 1113 of file linalg_c_api.f90.

    @@ -3205,7 +3205,7 @@

    Definition at line 1610 of file linalg_c_api.f90.

    +

    Definition at line 1609 of file linalg_c_api.f90.

    @@ -3292,7 +3292,7 @@

    Definition at line 1660 of file linalg_c_api.f90.

    +

    Definition at line 1659 of file linalg_c_api.f90.

    @@ -3359,7 +3359,7 @@

    Definition at line 589 of file linalg_c_api.f90.

    +

    Definition at line 588 of file linalg_c_api.f90.

    @@ -3438,7 +3438,7 @@

    Definition at line 30 of file linalg_c_api.f90.

    +

    Definition at line 29 of file linalg_c_api.f90.

    @@ -3517,7 +3517,7 @@

    Definition at line 69 of file linalg_c_api.f90.

    +

    Definition at line 68 of file linalg_c_api.f90.

    @@ -3584,7 +3584,7 @@

    Definition at line 629 of file linalg_c_api.f90.

    +

    Definition at line 628 of file linalg_c_api.f90.

    @@ -3663,7 +3663,7 @@

    Definition at line 2491 of file linalg_c_api.f90.

    +

    Definition at line 2490 of file linalg_c_api.f90.

    @@ -3742,7 +3742,7 @@

    Definition at line 2532 of file linalg_c_api.f90.

    +

    Definition at line 2531 of file linalg_c_api.f90.

    @@ -3823,7 +3823,7 @@

    Definition at line 2580 of file linalg_c_api.f90.

    +

    Definition at line 2579 of file linalg_c_api.f90.

    @@ -3904,7 +3904,7 @@

    Definition at line 2632 of file linalg_c_api.f90.

    +

    Definition at line 2631 of file linalg_c_api.f90.

    @@ -3983,7 +3983,7 @@

    Definition at line 2201 of file linalg_c_api.f90.

    +

    Definition at line 2200 of file linalg_c_api.f90.

    @@ -4062,7 +4062,7 @@

    Definition at line 2240 of file linalg_c_api.f90.

    +

    Definition at line 2239 of file linalg_c_api.f90.

    @@ -4149,7 +4149,7 @@

    Definition at line 2286 of file linalg_c_api.f90.

    +

    Definition at line 2285 of file linalg_c_api.f90.

    @@ -4236,7 +4236,7 @@

    Definition at line 2337 of file linalg_c_api.f90.

    +

    Definition at line 2336 of file linalg_c_api.f90.

    @@ -4330,7 +4330,7 @@

    Definition at line 2442 of file linalg_c_api.f90.

    +

    Definition at line 2441 of file linalg_c_api.f90.

    @@ -4424,7 +4424,7 @@

    Definition at line 2388 of file linalg_c_api.f90.

    +

    Definition at line 2387 of file linalg_c_api.f90.

    @@ -4531,7 +4531,7 @@

    Definition at line 2090 of file linalg_c_api.f90.

    +

    Definition at line 2089 of file linalg_c_api.f90.

    @@ -4638,7 +4638,7 @@

    Definition at line 2151 of file linalg_c_api.f90.

    +

    Definition at line 2150 of file linalg_c_api.f90.

    @@ -4704,7 +4704,7 @@

    Definition at line 3084 of file linalg_c_api.f90.

    +

    Definition at line 3083 of file linalg_c_api.f90.

    @@ -4770,7 +4770,7 @@

    Definition at line 3129 of file linalg_c_api.f90.

    +

    Definition at line 3128 of file linalg_c_api.f90.

    @@ -4865,7 +4865,7 @@

    Definition at line 1976 of file linalg_c_api.f90.

    +

    Definition at line 1975 of file linalg_c_api.f90.

    @@ -4960,7 +4960,7 @@

    Definition at line 2033 of file linalg_c_api.f90.

    +

    Definition at line 2032 of file linalg_c_api.f90.

    @@ -5025,7 +5025,7 @@

    Definition at line 104 of file linalg_c_api.f90.

    +

    Definition at line 103 of file linalg_c_api.f90.

    @@ -5090,7 +5090,7 @@

    Definition at line 138 of file linalg_c_api.f90.

    +

    Definition at line 137 of file linalg_c_api.f90.

    @@ -5176,7 +5176,7 @@

    Definition at line 751 of file linalg_c_api.f90.

    +

    Definition at line 750 of file linalg_c_api.f90.

    @@ -5262,7 +5262,7 @@

    Definition at line 796 of file linalg_c_api.f90.

    +

    Definition at line 795 of file linalg_c_api.f90.

    diff --git a/doc/html/namespacelinalg__immutable.html b/doc/html/namespacelinalg__immutable.html index 0012003c..f6826a8b 100644 --- a/doc/html/namespacelinalg__immutable.html +++ b/doc/html/namespacelinalg__immutable.html @@ -217,7 +217,7 @@

    Returns
    The N-by-N identity matrix.
    -

    Definition at line 1022 of file linalg_immutable.f90.

    +

    Definition at line 1021 of file linalg_immutable.f90.

    @@ -256,7 +256,7 @@

    Definition at line 715 of file linalg_immutable.f90.

    +

    Definition at line 714 of file linalg_immutable.f90.

    @@ -296,7 +296,7 @@

    Returns
    The downdated M-by-M upper triangular matrix.
    -

    Definition at line 760 of file linalg_immutable.f90.

    +

    Definition at line 759 of file linalg_immutable.f90.

    @@ -336,7 +336,7 @@

    Returns
    The updated M-by-M upper triangular matrix.
    -

    Definition at line 738 of file linalg_immutable.f90.

    +

    Definition at line 737 of file linalg_immutable.f90.

    @@ -365,7 +365,7 @@

    Returns
    The determinant of the matrix.
    -

    Definition at line 509 of file linalg_immutable.f90.

    +

    Definition at line 508 of file linalg_immutable.f90.

    @@ -394,7 +394,7 @@

    Returns
    The M-by-M inverted matrix.
    -

    Definition at line 780 of file linalg_immutable.f90.

    +

    Definition at line 779 of file linalg_immutable.f90.

    @@ -423,7 +423,7 @@

    Returns
    The N-by-M inverted matrix.
    -

    Definition at line 795 of file linalg_immutable.f90.

    +

    Definition at line 794 of file linalg_immutable.f90.

    @@ -463,7 +463,7 @@

    Returns
    The Q, R, and optionally P matrices resulting from the factorization.
    -

    Definition at line 592 of file linalg_immutable.f90.

    +

    Definition at line 591 of file linalg_immutable.f90.

    @@ -517,7 +517,7 @@

    Returns
    The updated Q and R matrices.
    -

    Definition at line 638 of file linalg_immutable.f90.

    +

    Definition at line 637 of file linalg_immutable.f90.

    @@ -564,7 +564,7 @@

    Returns
    The resulting M-by-N matrix.
    -

    Definition at line 205 of file linalg_immutable.f90.

    +

    Definition at line 204 of file linalg_immutable.f90.

    @@ -593,7 +593,7 @@

    Returns
    The U, S, and transpose of V matrices resulting from the factorization where A = U * S * V**T.
    -

    Definition at line 674 of file linalg_immutable.f90.

    +

    Definition at line 673 of file linalg_immutable.f90.

    diff --git a/doc/html/namespacemembers.html b/doc/html/namespacemembers.html index 83435f38..16f2b6ee 100644 --- a/doc/html/namespacemembers.html +++ b/doc/html/namespacemembers.html @@ -97,92 +97,19 @@
    -
    Here is a list of all documented module members with links to the modules they belong to:
    - -

    - h -

    - - -

    - i -

    diff --git a/doc/html/namespacemembers_func.html b/doc/html/namespacemembers_func.html index fdda7432..fc01187d 100644 --- a/doc/html/namespacemembers_func.html +++ b/doc/html/namespacemembers_func.html @@ -97,79 +97,8 @@
    -  - -

    - i -

    diff --git a/doc/html/namespaces.html b/doc/html/namespaces.html index 879e025a..3154e87b 100644 --- a/doc/html/namespaces.html +++ b/doc/html/namespaces.html @@ -102,56 +102,54 @@
    Here is a list of all documented modules with brief descriptions:
    [detail level 12]

    opaSet to TRANSPOSE to compute op(A) as a direct transpose of A, set to HERMITIAN_TRANSPOSE to compute op(A) as the Hermitian transpose of A, otherwise, set to NO_OPERATION to compute op(A) as A.
    opbSet to TRANSPOSE to compute op(B) as a direct transpose of B, set to HERMITIAN_TRANSPOSE to compute op(B) as the Hermitian transpose of B, otherwise, set to NO_OPERATION to compute op(B) as B.
    opaSet to LA_TRANSPOSE to compute op(A) as a direct transpose of A, set to LA_HERMITIAN_TRANSPOSE to compute op(A) as the Hermitian transpose of A, otherwise, set to NO_OPERATION to compute op(A) as A.
    opbSet to LA_TRANSPOSE to compute op(B) as a direct transpose of B, set to LA_HERMITIAN_TRANSPOSE to compute op(B) as the Hermitian transpose of B, otherwise, set to NO_OPERATION to compute op(B) as B.
    mThenumber of rows in c.
    nThe number of columns in c.
    kThe interior dimension of the product a and b.
    alphaA scalar multiplier.
    aIf opa is TRANSPOSE or HERMITIAN_TRANSPOSE, this matrix must be k by m; else, this matrix must be m by k.
    aIf opa is LA_TRANSPOSE or LA_HERMITIAN_TRANSPOSE, this matrix must be k by m; else, this matrix must be m by k.
    ldaThe leading dimension of matrix a.
    bIf opb is TRANSPOSE or HERMITIAN_TRANSPOSE, this matrix must be n by k; else, this matrix must be k by n.
    bIf opb is LA_TRANSPOSE or LA_HERMITIAN_TRANSPOSE, this matrix must be n by k; else, this matrix must be k by n.
    ldbThe leading dimension of matrix b.
    betaA scalar multiplier.
    cThe m by n matrix C.
    - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
     Nlinalg_c_apiProvides a C-friendly API to the LINALG library. Notice, all C-API LINALG routines begin with the prefix "la_"
     Nlinalg_constantsProvides a set of constants and error flags for the library
     Nlinalg_coreProvides a set of common linear algebra routines
     Ccholesky_factorComputes the Cholesky factorization of a symmetric, positive definite matrix
     Ccholesky_rank1_downdateComputes the rank 1 downdate to a Cholesky factored matrix (upper triangular)
     Ccholesky_rank1_updateComputes the rank 1 update to a Cholesky factored matrix (upper triangular)
     CdetComputes the determinant of a square matrix
     Cdiag_mtx_multMultiplies a diagonal matrix with another matrix or array
     CeigenComputes the eigenvalues, and optionally the eigenvectors, of a matrix
     Cform_luExtracts the L and U matrices from the condensed [L\U] storage format used by the lu_factor
     Cform_qrForms the full M-by-M orthogonal matrix Q from the elementary reflectors returned by the base QR factorization algorithm
     Clu_factorComputes the LU factorization of an M-by-N matrix
     Cmtx_inverseComputes the inverse of a square matrix
     Cmtx_multPerforms the matrix operation: \( C = \alpha op(A) op(B) + \beta C \)
     Cmtx_pinverseComputes the Moore-Penrose pseudo-inverse of a M-by-N matrix using the singular value decomposition of the matrix
     Cmtx_rankComputes the rank of a matrix
     Cmult_qrMultiplies a general matrix by the orthogonal matrix Q from a QR factorization
     Cmult_rzMultiplies a general matrix by the orthogonal matrix Z from an RZ factorization
     Cqr_factorComputes the QR factorization of an M-by-N matrix
     Cqr_rank1_updateComputes the rank 1 update to an M-by-N QR factored matrix A (M >= N) where \( A = Q R \), and \( A1 = A + U V^T \) such that \( A1 = Q1 R1 \)
     Crank1_updatePerforms the rank-1 update to matrix A such that: \( A = \alpha X Y^T + A \), where \( A \) is an M-by-N matrix, \( \alpha \)is a scalar, \( X \) is an M-element array, and \( Y \) is an N-element array. In the event that \( Y \) is complex, \( Y^H \) is used instead of \( Y^T \)
     Crecip_mult_arrayMultiplies a vector by the reciprocal of a real scalar
     Crz_factorFactors an upper trapezoidal matrix by means of orthogonal transformations such that \( A = R Z = (R 0) Z \). Z is an orthogonal matrix of dimension N-by-N, and R is an M-by-M upper triangular matrix
     Csolve_choleskySolves a system of Cholesky factored equations
     Csolve_least_squaresSolves the overdetermined or underdetermined system \( A X = B \) of M equations of N unknowns. Notice, it is assumed that matrix A has full rank
     Csolve_least_squares_fullSolves the overdetermined or underdetermined system \( A X = B \) of M equations of N unknowns, but uses a full orthogonal factorization of the system
     Csolve_least_squares_svdSolves the overdetermined or underdetermined system \( A X = B \) of M equations of N unknowns using a singular value decomposition of matrix A
     Csolve_luSolves a system of LU-factored equations
     Csolve_qrSolves a system of M QR-factored equations of N unknowns
     Csolve_triangular_systemSolves a triangular system of equations
     CsortSorts an array
     CsvdComputes the singular value decomposition of a matrix A. The SVD is defined as: \( A = U S V^T \), where \( U \) is an M-by-M orthogonal matrix, \( S \) is an M-by-N diagonal matrix, and \( V \) is an N-by-N orthogonal matrix
     CswapSwaps the contents of two arrays
     CtraceComputes the trace of a matrix (the sum of the main diagonal elements)
     Ctri_mtx_multComputes the triangular matrix operation: \( B = \alpha A^T A + \beta B \), or \( B = \alpha A A^T + \beta B \), where A is a triangular matrix
     Nlinalg_immutableProvides an immutable interface to many of the core linear algebra routines in this library. The intent is to allow for ease of use in situations where memory allocation, or absolute speed are of lesser importance to code readability
     Ceigen_resultsDefines a container for the output of an Eigen analysis of a square matrix
     Clu_resultsDefines a container for the output of an LU factorization
     Clu_results_cmplxDefines a container for the output of an LU factorization
     Cmat_eigenComputes the eigenvalues and eigenvectors (right) of a general N-by-N matrix
     Cmat_luComputes the LU factorization of a square matrix. Notice, partial row pivoting is utilized
     Cmat_mult_diagComputes the matrix operation: C = A * B, where A is a diagonal matrix
     Cmat_mult_lower_triComputes the matrix operation C = A * B, where A is a lower triangular matrix
     Cmat_mult_upper_triComputes the matrix operation C = A * B, where A is an upper triangular matrix
     Cmat_solve_lower_triSolves the lower triangular system A X = B, where A is a lower triangular matrix
     Cmat_solve_upper_triSolves the upper triangular system A X = B, where A is an upper triangular matrix
     Cqr_resultsDefines a container for the output of a QR factorization
     Cqr_results_cmplxDefines a container for the output of a QR factorization
     Csvd_resultsDefines a container for the output of a singular value decomposition of a matrix
     Csvd_results_cmplxDefines a container for the output of a singular value decomposition of a matrix
     NlinalgProvides a set of common linear algebra routines
     Ccholesky_factorComputes the Cholesky factorization of a symmetric, positive definite matrix
     Ccholesky_rank1_downdateComputes the rank 1 downdate to a Cholesky factored matrix (upper triangular)
     Ccholesky_rank1_updateComputes the rank 1 update to a Cholesky factored matrix (upper triangular)
     CdetComputes the determinant of a square matrix
     Cdiag_mtx_multMultiplies a diagonal matrix with another matrix or array
     CeigenComputes the eigenvalues, and optionally the eigenvectors, of a matrix
     Cform_luExtracts the L and U matrices from the condensed [L\U] storage format used by the lu_factor
     Cform_qrForms the full M-by-M orthogonal matrix Q from the elementary reflectors returned by the base QR factorization algorithm
     Clu_factorComputes the LU factorization of an M-by-N matrix
     Cmtx_inverseComputes the inverse of a square matrix
     Cmtx_multPerforms the matrix operation: \( C = \alpha op(A) op(B) + \beta C \)
     Cmtx_pinverseComputes the Moore-Penrose pseudo-inverse of a M-by-N matrix using the singular value decomposition of the matrix
     Cmtx_rankComputes the rank of a matrix
     Cmult_qrMultiplies a general matrix by the orthogonal matrix Q from a QR factorization
     Cmult_rzMultiplies a general matrix by the orthogonal matrix Z from an RZ factorization
     Cqr_factorComputes the QR factorization of an M-by-N matrix
     Cqr_rank1_updateComputes the rank 1 update to an M-by-N QR factored matrix A (M >= N) where \( A = Q R \), and \( A1 = A + U V^T \) such that \( A1 = Q1 R1 \)
     Crank1_updatePerforms the rank-1 update to matrix A such that: \( A = \alpha X Y^T + A \), where \( A \) is an M-by-N matrix, \( \alpha \)is a scalar, \( X \) is an M-element array, and \( Y \) is an N-element array. In the event that \( Y \) is complex, \( Y^H \) is used instead of \( Y^T \)
     Crecip_mult_arrayMultiplies a vector by the reciprocal of a real scalar
     Crz_factorFactors an upper trapezoidal matrix by means of orthogonal transformations such that \( A = R Z = (R 0) Z \). Z is an orthogonal matrix of dimension N-by-N, and R is an M-by-M upper triangular matrix
     Csolve_choleskySolves a system of Cholesky factored equations
     Csolve_least_squaresSolves the overdetermined or underdetermined system \( A X = B \) of M equations of N unknowns. Notice, it is assumed that matrix A has full rank
     Csolve_least_squares_fullSolves the overdetermined or underdetermined system \( A X = B \) of M equations of N unknowns, but uses a full orthogonal factorization of the system
     Csolve_least_squares_svdSolves the overdetermined or underdetermined system \( A X = B \) of M equations of N unknowns using a singular value decomposition of matrix A
     Csolve_luSolves a system of LU-factored equations
     Csolve_qrSolves a system of M QR-factored equations of N unknowns
     Csolve_triangular_systemSolves a triangular system of equations
     CsortSorts an array
     CsvdComputes the singular value decomposition of a matrix A. The SVD is defined as: \( A = U S V^T \), where \( U \) is an M-by-M orthogonal matrix, \( S \) is an M-by-N diagonal matrix, and \( V \) is an N-by-N orthogonal matrix
     CswapSwaps the contents of two arrays
     CtraceComputes the trace of a matrix (the sum of the main diagonal elements)
     Ctri_mtx_multComputes the triangular matrix operation: \( B = \alpha A^T A + \beta B \), or \( B = \alpha A A^T + \beta B \), where A is a triangular matrix
     Nlinalg_immutableProvides an immutable interface to many of the core linear algebra routines in this library. The intent is to allow for ease of use in situations where memory allocation, or absolute speed are of lesser importance to code readability
     Ceigen_resultsDefines a container for the output of an Eigen analysis of a square matrix
     Clu_resultsDefines a container for the output of an LU factorization
     Clu_results_cmplxDefines a container for the output of an LU factorization
     Cmat_eigenComputes the eigenvalues and eigenvectors (right) of a general N-by-N matrix
     Cmat_luComputes the LU factorization of a square matrix. Notice, partial row pivoting is utilized
     Cmat_mult_diagComputes the matrix operation: C = A * B, where A is a diagonal matrix
     Cmat_mult_lower_triComputes the matrix operation C = A * B, where A is a lower triangular matrix
     Cmat_mult_upper_triComputes the matrix operation C = A * B, where A is an upper triangular matrix
     Cmat_solve_lower_triSolves the lower triangular system A X = B, where A is a lower triangular matrix
     Cmat_solve_upper_triSolves the upper triangular system A X = B, where A is an upper triangular matrix
     Cqr_resultsDefines a container for the output of a QR factorization
     Cqr_results_cmplxDefines a container for the output of a QR factorization
     Csvd_resultsDefines a container for the output of a singular value decomposition of a matrix
     Csvd_results_cmplxDefines a container for the output of a singular value decomposition of a matrix
    diff --git a/doc/html/namespaces_dup.js b/doc/html/namespaces_dup.js index 915cf409..60d57fb3 100644 --- a/doc/html/namespaces_dup.js +++ b/doc/html/namespaces_dup.js @@ -1,81 +1,5 @@ var namespaces_dup = [ - [ "linalg_c_api", "namespacelinalg__c__api.html", [ - [ "la_cholesky_factor", "namespacelinalg__c__api.html#a99d3ac7f90cad0c643dd8abff6592032", null ], - [ "la_cholesky_factor_cmplx", "namespacelinalg__c__api.html#a800b0d6ba6f8d812d8038dd06c0967a8", null ], - [ "la_cholesky_rank1_downdate", "namespacelinalg__c__api.html#a5b5758f439d34c765ff5285c21fa88c1", null ], - [ "la_cholesky_rank1_downdate_cmplx", "namespacelinalg__c__api.html#a3232c643af8f8615961c4b1bab422a4a", null ], - [ "la_cholesky_rank1_update", "namespacelinalg__c__api.html#ae5c0bda2e1ae3a4dbdaf6d0586247b4c", null ], - [ "la_cholesky_rank1_update_cmplx", "namespacelinalg__c__api.html#a5746e1736802b9a082057c7997325049", null ], - [ "la_det", "namespacelinalg__c__api.html#afd21b0e476168de7eb9a6a5ef3a2e8b4", null ], - [ "la_det_cmplx", "namespacelinalg__c__api.html#a82fcbd45f4a92431587312560fbcc636", null ], - [ "la_diag_mtx_mult", "namespacelinalg__c__api.html#ae866f3e174aed82f3fdfa3483ac91333", null ], - [ "la_diag_mtx_mult_cmplx", "namespacelinalg__c__api.html#a1af56ff742938c0be90fb34146b13365", null ], - [ "la_diag_mtx_mult_mixed", "namespacelinalg__c__api.html#adadfcde438cabd5b104b62f2541712d1", null ], - [ "la_eigen_asymm", "namespacelinalg__c__api.html#af2ed46a8b1285ac08f0f86162288a865", null ], - [ "la_eigen_cmplx", "namespacelinalg__c__api.html#ab133f51c44eb244be0b6e966f5893259", null ], - [ "la_eigen_gen", "namespacelinalg__c__api.html#a93920f1db884cbad9bfc335abe36bed4", null ], - [ "la_eigen_symm", "namespacelinalg__c__api.html#a63372e9678f7052d17c8676324d6e7a7", null ], - [ "la_form_lu", "namespacelinalg__c__api.html#aeab30d9e07601b343f15bf03d8220044", null ], - [ "la_form_lu_cmplx", "namespacelinalg__c__api.html#ae9bcd3e2df3151a5d92da48973501f6b", null ], - [ "la_form_qr", "namespacelinalg__c__api.html#a9426f737c5d551a133f44e2d7cb98a1d", null ], - [ "la_form_qr_cmplx", "namespacelinalg__c__api.html#a9be60e86103e09be4d19fd3728f5d64b", null ], - [ "la_form_qr_cmplx_pvt", "namespacelinalg__c__api.html#a5146fcf6552a097e05d46afaf91f424e", null ], - [ "la_form_qr_pvt", "namespacelinalg__c__api.html#a69d0ec69152e04fc5f766dd7c6d23f98", null ], - [ "la_inverse", "namespacelinalg__c__api.html#a307a6d5e27d90b28a38fba8c02e14461", null ], - [ "la_inverse_cmplx", "namespacelinalg__c__api.html#a715855159abe740aff7bf95303a3f715", null ], - [ "la_lu_factor", "namespacelinalg__c__api.html#a3e91c088c8d173e9b12c17b1ebc9bfa4", null ], - [ "la_lu_factor_cmplx", "namespacelinalg__c__api.html#a1788fe3192429b2cfd3a169d879a6f0e", null ], - [ "la_mtx_mult", "namespacelinalg__c__api.html#a434338a38a5fde94d8df3119b169fd01", null ], - [ "la_mtx_mult_cmplx", "namespacelinalg__c__api.html#abdc93ffffffefdef839370da19f01430", null ], - [ "la_mult_qr", "namespacelinalg__c__api.html#a2604ade114e67587300b3916846fc961", null ], - [ "la_mult_qr_cmplx", "namespacelinalg__c__api.html#a4b8c42819e069a18ec39c5ebb9ef8703", null ], - [ "la_pinverse", "namespacelinalg__c__api.html#a39bb26dcab43d8f54471af87af69e606", null ], - [ "la_pinverse_cmplx", "namespacelinalg__c__api.html#ad0eefe5cf5a74d6848bbde0e8bb22550", null ], - [ "la_qr_factor", "namespacelinalg__c__api.html#a2c896885507a331ad89e579868da0fd3", null ], - [ "la_qr_factor_cmplx", "namespacelinalg__c__api.html#a13a75b6d7bce1788b5e286a879456347", null ], - [ "la_qr_factor_cmplx_pvt", "namespacelinalg__c__api.html#aa7bc80d9671a82aafdfc9a8ab904cb22", null ], - [ "la_qr_factor_pvt", "namespacelinalg__c__api.html#a9868095d332ba323afce1cda4085dd8c", null ], - [ "la_qr_rank1_update", "namespacelinalg__c__api.html#a056fb14e92f98c660573886c0ad940ff", null ], - [ "la_qr_rank1_update_cmplx", "namespacelinalg__c__api.html#a01cf2129d7af3ddc8fb6e1fff7786ff1", null ], - [ "la_rank", "namespacelinalg__c__api.html#a32548b9eb091164d51ed3793afee83e9", null ], - [ "la_rank1_update", "namespacelinalg__c__api.html#a6e47b549d59377db83a0eb27d739df8d", null ], - [ "la_rank1_update_cmplx", "namespacelinalg__c__api.html#ac46bdb1315742f700571bf4f7c705ffd", null ], - [ "la_rank_cmplx", "namespacelinalg__c__api.html#a60244c1c8ef1ac3217a9efa69fdbd229", null ], - [ "la_solve_cholesky", "namespacelinalg__c__api.html#ac286fe9a7ed4d69ca30ecbe03959f209", null ], - [ "la_solve_cholesky_cmplx", "namespacelinalg__c__api.html#a83a08022c84ac2e76f7d20486797bd33", null ], - [ "la_solve_least_squares", "namespacelinalg__c__api.html#af1d700238a8ab71b17ff8c15221a9e02", null ], - [ "la_solve_least_squares_cmplx", "namespacelinalg__c__api.html#a2c691c114d54a8eb89ce2882d0557550", null ], - [ "la_solve_lu", "namespacelinalg__c__api.html#a846baffbc77d4348d7b15d3f83983a04", null ], - [ "la_solve_lu_cmplx", "namespacelinalg__c__api.html#aae9625f2ff12a73b6007b429132a1531", null ], - [ "la_solve_qr", "namespacelinalg__c__api.html#a13ed5d138ff59a9f649babc5c1dd9eab", null ], - [ "la_solve_qr_cmplx", "namespacelinalg__c__api.html#ad05206b75a9cd1c5a2bda147307ef2d5", null ], - [ "la_solve_qr_cmplx_pvt", "namespacelinalg__c__api.html#a17bfa880bc9019cbd654d20cab263ce3", null ], - [ "la_solve_qr_pvt", "namespacelinalg__c__api.html#a0d12474b0ca7772e4ad4ebc7ce227315", null ], - [ "la_solve_tri_mtx", "namespacelinalg__c__api.html#a7a72759b932b32e346a70cec542557ff", null ], - [ "la_solve_tri_mtx_cmplx", "namespacelinalg__c__api.html#a7a8e491e75d2d00911d0992b37aac43d", null ], - [ "la_sort_eigen", "namespacelinalg__c__api.html#ab81f25f6835feac7a88250c9863a4120", null ], - [ "la_sort_eigen_cmplx", "namespacelinalg__c__api.html#a2a0c8ddfd134f3d57849925d359d53b2", null ], - [ "la_svd", "namespacelinalg__c__api.html#a436b645816859aea4a8fbd55e733ab92", null ], - [ "la_svd_cmplx", "namespacelinalg__c__api.html#a45eeb38b8a0d572fc25a7db98690f705", null ], - [ "la_trace", "namespacelinalg__c__api.html#af8627c89c2201ae47c9cfac1d65abfd4", null ], - [ "la_trace_cmplx", "namespacelinalg__c__api.html#a315ef452fe9f00baa454dc930813fedc", null ], - [ "la_tri_mtx_mult", "namespacelinalg__c__api.html#a754866d88e140dbf618c1d85f016c633", null ], - [ "la_tri_mtx_mult_cmplx", "namespacelinalg__c__api.html#aeb63de65aa9a9bc040860b8f78dcd3fa", null ] - ] ], - [ "linalg_constants", "namespacelinalg__constants.html", [ - [ "hermitian_transpose", "namespacelinalg__constants.html#a389e35467a5a18f90927d28fb12ddf70", null ], - [ "la_array_size_error", "namespacelinalg__constants.html#aee0ebff93d8751cc57a3e8e5965b1344", null ], - [ "la_convergence_error", "namespacelinalg__constants.html#a39da5de4ea671010ee5f1e358c991cee", null ], - [ "la_invalid_input_error", "namespacelinalg__constants.html#ac7d8bace23640b21a6d8a960371eb732", null ], - [ "la_invalid_operation_error", "namespacelinalg__constants.html#aaafde862f4d348fecccdccc695e25622", null ], - [ "la_matrix_format_error", "namespacelinalg__constants.html#a252c96a6e7c24b40bf7ef96063824f01", null ], - [ "la_no_error", "namespacelinalg__constants.html#ad4b52ca61ccf1199dead23faa80b9ac7", null ], - [ "la_out_of_memory_error", "namespacelinalg__constants.html#a8d5820c41090117b508a033309ad0870", null ], - [ "la_singular_matrix_error", "namespacelinalg__constants.html#a6607d2d2ac92fe5d902527519279e646", null ], - [ "no_operation", "namespacelinalg__constants.html#abf9e3b763502c2b0af0cbf48b14c918f", null ], - [ "transpose", "namespacelinalg__constants.html#a045d4c1cc5fe061467924ad01bfe77c4", null ] - ] ], - [ "linalg_core", "namespacelinalg__core.html", "namespacelinalg__core" ], + [ "linalg", "namespacelinalg.html", "namespacelinalg" ], [ "linalg_immutable", "namespacelinalg__immutable.html", "namespacelinalg__immutable" ] ]; \ No newline at end of file diff --git a/doc/html/navtreeindex0.js b/doc/html/navtreeindex0.js index 2ec02867..161ddbf9 100644 --- a/doc/html/navtreeindex0.js +++ b/doc/html/navtreeindex0.js @@ -9,238 +9,173 @@ var NAVTREEINDEX0 = "functions_vars.html":[2,2,1], "index.html":[], "index.html#intro_sec":[0], -"interfacelinalg__core_1_1cholesky__factor.html":[2,0,0,0], -"interfacelinalg__core_1_1cholesky__factor.html":[1,0,2,0], -"interfacelinalg__core_1_1cholesky__rank1__downdate.html":[2,0,0,1], -"interfacelinalg__core_1_1cholesky__rank1__downdate.html":[1,0,2,1], -"interfacelinalg__core_1_1cholesky__rank1__update.html":[2,0,0,2], -"interfacelinalg__core_1_1cholesky__rank1__update.html":[1,0,2,2], -"interfacelinalg__core_1_1det.html":[1,0,2,3], -"interfacelinalg__core_1_1det.html":[2,0,0,3], -"interfacelinalg__core_1_1diag__mtx__mult.html":[1,0,2,4], -"interfacelinalg__core_1_1diag__mtx__mult.html":[2,0,0,4], -"interfacelinalg__core_1_1eigen.html":[2,0,0,5], -"interfacelinalg__core_1_1eigen.html":[1,0,2,5], -"interfacelinalg__core_1_1form__lu.html":[1,0,2,6], -"interfacelinalg__core_1_1form__lu.html":[2,0,0,6], -"interfacelinalg__core_1_1form__qr.html":[1,0,2,7], -"interfacelinalg__core_1_1form__qr.html":[2,0,0,7], -"interfacelinalg__core_1_1lu__factor.html":[1,0,2,8], -"interfacelinalg__core_1_1lu__factor.html":[2,0,0,8], -"interfacelinalg__core_1_1mtx__inverse.html":[1,0,2,9], -"interfacelinalg__core_1_1mtx__inverse.html":[2,0,0,9], -"interfacelinalg__core_1_1mtx__mult.html":[1,0,2,10], -"interfacelinalg__core_1_1mtx__mult.html":[2,0,0,10], -"interfacelinalg__core_1_1mtx__pinverse.html":[1,0,2,11], -"interfacelinalg__core_1_1mtx__pinverse.html":[2,0,0,11], -"interfacelinalg__core_1_1mtx__rank.html":[1,0,2,12], -"interfacelinalg__core_1_1mtx__rank.html":[2,0,0,12], -"interfacelinalg__core_1_1mult__qr.html":[1,0,2,13], -"interfacelinalg__core_1_1mult__qr.html":[2,0,0,13], -"interfacelinalg__core_1_1mult__rz.html":[1,0,2,14], -"interfacelinalg__core_1_1mult__rz.html":[2,0,0,14], -"interfacelinalg__core_1_1qr__factor.html":[1,0,2,15], -"interfacelinalg__core_1_1qr__factor.html":[2,0,0,15], -"interfacelinalg__core_1_1qr__rank1__update.html":[1,0,2,16], -"interfacelinalg__core_1_1qr__rank1__update.html":[2,0,0,16], -"interfacelinalg__core_1_1rank1__update.html":[2,0,0,17], -"interfacelinalg__core_1_1rank1__update.html":[1,0,2,17], -"interfacelinalg__core_1_1recip__mult__array.html":[2,0,0,18], -"interfacelinalg__core_1_1recip__mult__array.html":[1,0,2,18], -"interfacelinalg__core_1_1rz__factor.html":[2,0,0,19], -"interfacelinalg__core_1_1rz__factor.html":[1,0,2,19], -"interfacelinalg__core_1_1solve__cholesky.html":[1,0,2,20], -"interfacelinalg__core_1_1solve__cholesky.html":[2,0,0,20], -"interfacelinalg__core_1_1solve__least__squares.html":[2,0,0,21], -"interfacelinalg__core_1_1solve__least__squares.html":[1,0,2,21], -"interfacelinalg__core_1_1solve__least__squares__full.html":[2,0,0,22], -"interfacelinalg__core_1_1solve__least__squares__full.html":[1,0,2,22], -"interfacelinalg__core_1_1solve__least__squares__svd.html":[2,0,0,23], -"interfacelinalg__core_1_1solve__least__squares__svd.html":[1,0,2,23], -"interfacelinalg__core_1_1solve__lu.html":[2,0,0,24], -"interfacelinalg__core_1_1solve__lu.html":[1,0,2,24], -"interfacelinalg__core_1_1solve__qr.html":[2,0,0,25], -"interfacelinalg__core_1_1solve__qr.html":[1,0,2,25], -"interfacelinalg__core_1_1solve__triangular__system.html":[2,0,0,26], -"interfacelinalg__core_1_1solve__triangular__system.html":[1,0,2,26], -"interfacelinalg__core_1_1sort.html":[2,0,0,27], -"interfacelinalg__core_1_1sort.html":[1,0,2,27], -"interfacelinalg__core_1_1svd.html":[2,0,0,28], -"interfacelinalg__core_1_1svd.html":[1,0,2,28], -"interfacelinalg__core_1_1swap.html":[1,0,2,29], -"interfacelinalg__core_1_1swap.html":[2,0,0,29], -"interfacelinalg__core_1_1trace.html":[1,0,2,30], -"interfacelinalg__core_1_1trace.html":[2,0,0,30], -"interfacelinalg__core_1_1tri__mtx__mult.html":[1,0,2,31], -"interfacelinalg__core_1_1tri__mtx__mult.html":[2,0,0,31], -"interfacelinalg__immutable_1_1mat__eigen.html":[1,0,3,3], +"interfacelinalg_1_1cholesky__factor.html":[2,0,0,0], +"interfacelinalg_1_1cholesky__factor.html":[1,0,0,0], +"interfacelinalg_1_1cholesky__rank1__downdate.html":[2,0,0,1], +"interfacelinalg_1_1cholesky__rank1__downdate.html":[1,0,0,1], +"interfacelinalg_1_1cholesky__rank1__update.html":[1,0,0,2], +"interfacelinalg_1_1cholesky__rank1__update.html":[2,0,0,2], +"interfacelinalg_1_1det.html":[2,0,0,3], +"interfacelinalg_1_1det.html":[1,0,0,3], +"interfacelinalg_1_1diag__mtx__mult.html":[1,0,0,4], +"interfacelinalg_1_1diag__mtx__mult.html":[2,0,0,4], +"interfacelinalg_1_1eigen.html":[2,0,0,5], +"interfacelinalg_1_1eigen.html":[1,0,0,5], +"interfacelinalg_1_1form__lu.html":[1,0,0,6], +"interfacelinalg_1_1form__lu.html":[2,0,0,6], +"interfacelinalg_1_1form__qr.html":[1,0,0,7], +"interfacelinalg_1_1form__qr.html":[2,0,0,7], +"interfacelinalg_1_1lu__factor.html":[1,0,0,8], +"interfacelinalg_1_1lu__factor.html":[2,0,0,8], +"interfacelinalg_1_1mtx__inverse.html":[2,0,0,9], +"interfacelinalg_1_1mtx__inverse.html":[1,0,0,9], +"interfacelinalg_1_1mtx__mult.html":[2,0,0,10], +"interfacelinalg_1_1mtx__mult.html":[1,0,0,10], +"interfacelinalg_1_1mtx__pinverse.html":[2,0,0,11], +"interfacelinalg_1_1mtx__pinverse.html":[1,0,0,11], +"interfacelinalg_1_1mtx__rank.html":[2,0,0,12], +"interfacelinalg_1_1mtx__rank.html":[1,0,0,12], +"interfacelinalg_1_1mult__qr.html":[2,0,0,13], +"interfacelinalg_1_1mult__qr.html":[1,0,0,13], +"interfacelinalg_1_1mult__rz.html":[2,0,0,14], +"interfacelinalg_1_1mult__rz.html":[1,0,0,14], +"interfacelinalg_1_1qr__factor.html":[2,0,0,15], +"interfacelinalg_1_1qr__factor.html":[1,0,0,15], +"interfacelinalg_1_1qr__rank1__update.html":[2,0,0,16], +"interfacelinalg_1_1qr__rank1__update.html":[1,0,0,16], +"interfacelinalg_1_1rank1__update.html":[1,0,0,17], +"interfacelinalg_1_1rank1__update.html":[2,0,0,17], +"interfacelinalg_1_1recip__mult__array.html":[1,0,0,18], +"interfacelinalg_1_1recip__mult__array.html":[2,0,0,18], +"interfacelinalg_1_1rz__factor.html":[1,0,0,19], +"interfacelinalg_1_1rz__factor.html":[2,0,0,19], +"interfacelinalg_1_1solve__cholesky.html":[1,0,0,20], +"interfacelinalg_1_1solve__cholesky.html":[2,0,0,20], +"interfacelinalg_1_1solve__least__squares.html":[1,0,0,21], +"interfacelinalg_1_1solve__least__squares.html":[2,0,0,21], +"interfacelinalg_1_1solve__least__squares__full.html":[1,0,0,22], +"interfacelinalg_1_1solve__least__squares__full.html":[2,0,0,22], +"interfacelinalg_1_1solve__least__squares__svd.html":[1,0,0,23], +"interfacelinalg_1_1solve__least__squares__svd.html":[2,0,0,23], +"interfacelinalg_1_1solve__lu.html":[1,0,0,24], +"interfacelinalg_1_1solve__lu.html":[2,0,0,24], +"interfacelinalg_1_1solve__qr.html":[2,0,0,25], +"interfacelinalg_1_1solve__qr.html":[1,0,0,25], +"interfacelinalg_1_1solve__triangular__system.html":[2,0,0,26], +"interfacelinalg_1_1solve__triangular__system.html":[1,0,0,26], +"interfacelinalg_1_1sort.html":[1,0,0,27], +"interfacelinalg_1_1sort.html":[2,0,0,27], +"interfacelinalg_1_1svd.html":[1,0,0,28], +"interfacelinalg_1_1svd.html":[2,0,0,28], +"interfacelinalg_1_1swap.html":[2,0,0,29], +"interfacelinalg_1_1swap.html":[1,0,0,29], +"interfacelinalg_1_1trace.html":[2,0,0,30], +"interfacelinalg_1_1trace.html":[1,0,0,30], +"interfacelinalg_1_1tri__mtx__mult.html":[1,0,0,31], +"interfacelinalg_1_1tri__mtx__mult.html":[2,0,0,31], +"interfacelinalg__immutable_1_1mat__eigen.html":[1,0,1,3], "interfacelinalg__immutable_1_1mat__eigen.html":[2,0,1,3], -"interfacelinalg__immutable_1_1mat__lu.html":[1,0,3,4], "interfacelinalg__immutable_1_1mat__lu.html":[2,0,1,4], +"interfacelinalg__immutable_1_1mat__lu.html":[1,0,1,4], +"interfacelinalg__immutable_1_1mat__mult__diag.html":[1,0,1,5], "interfacelinalg__immutable_1_1mat__mult__diag.html":[2,0,1,5], -"interfacelinalg__immutable_1_1mat__mult__diag.html":[1,0,3,5], -"interfacelinalg__immutable_1_1mat__mult__lower__tri.html":[1,0,3,6], +"interfacelinalg__immutable_1_1mat__mult__lower__tri.html":[1,0,1,6], "interfacelinalg__immutable_1_1mat__mult__lower__tri.html":[2,0,1,6], +"interfacelinalg__immutable_1_1mat__mult__upper__tri.html":[1,0,1,7], "interfacelinalg__immutable_1_1mat__mult__upper__tri.html":[2,0,1,7], -"interfacelinalg__immutable_1_1mat__mult__upper__tri.html":[1,0,3,7], -"interfacelinalg__immutable_1_1mat__solve__lower__tri.html":[1,0,3,8], "interfacelinalg__immutable_1_1mat__solve__lower__tri.html":[2,0,1,8], -"interfacelinalg__immutable_1_1mat__solve__upper__tri.html":[1,0,3,9], +"interfacelinalg__immutable_1_1mat__solve__lower__tri.html":[1,0,1,8], +"interfacelinalg__immutable_1_1mat__solve__upper__tri.html":[1,0,1,9], "interfacelinalg__immutable_1_1mat__solve__upper__tri.html":[2,0,1,9], +"linalg_8f90_source.html":[3,0,1,0], "linalg_8h_source.html":[3,0,0,0], -"linalg__basic_8f90_source.html":[3,0,1,0], -"linalg__c__api_8f90_source.html":[3,0,1,1], -"linalg__constants_8f90_source.html":[3,0,1,2], -"linalg__core_8f90_source.html":[3,0,1,3], -"linalg__eigen_8f90_source.html":[3,0,1,4], -"linalg__factor_8f90_source.html":[3,0,1,5], -"linalg__immutable_8f90_source.html":[3,0,1,6], -"linalg__solve_8f90_source.html":[3,0,1,7], -"linalg__sorting_8f90_source.html":[3,0,1,8], -"namespacelinalg__c__api.html":[1,0,0], -"namespacelinalg__c__api.html#a01cf2129d7af3ddc8fb6e1fff7786ff1":[1,0,0,36], -"namespacelinalg__c__api.html#a056fb14e92f98c660573886c0ad940ff":[1,0,0,35], -"namespacelinalg__c__api.html#a0d12474b0ca7772e4ad4ebc7ce227315":[1,0,0,50], -"namespacelinalg__c__api.html#a13a75b6d7bce1788b5e286a879456347":[1,0,0,32], -"namespacelinalg__c__api.html#a13ed5d138ff59a9f649babc5c1dd9eab":[1,0,0,47], -"namespacelinalg__c__api.html#a1788fe3192429b2cfd3a169d879a6f0e":[1,0,0,24], -"namespacelinalg__c__api.html#a17bfa880bc9019cbd654d20cab263ce3":[1,0,0,49], -"namespacelinalg__c__api.html#a1af56ff742938c0be90fb34146b13365":[1,0,0,9], -"namespacelinalg__c__api.html#a2604ade114e67587300b3916846fc961":[1,0,0,27], -"namespacelinalg__c__api.html#a2a0c8ddfd134f3d57849925d359d53b2":[1,0,0,54], -"namespacelinalg__c__api.html#a2c691c114d54a8eb89ce2882d0557550":[1,0,0,44], -"namespacelinalg__c__api.html#a2c896885507a331ad89e579868da0fd3":[1,0,0,31], -"namespacelinalg__c__api.html#a307a6d5e27d90b28a38fba8c02e14461":[1,0,0,21], -"namespacelinalg__c__api.html#a315ef452fe9f00baa454dc930813fedc":[1,0,0,58], -"namespacelinalg__c__api.html#a3232c643af8f8615961c4b1bab422a4a":[1,0,0,3], -"namespacelinalg__c__api.html#a32548b9eb091164d51ed3793afee83e9":[1,0,0,37], -"namespacelinalg__c__api.html#a39bb26dcab43d8f54471af87af69e606":[1,0,0,29], -"namespacelinalg__c__api.html#a3e91c088c8d173e9b12c17b1ebc9bfa4":[1,0,0,23], -"namespacelinalg__c__api.html#a434338a38a5fde94d8df3119b169fd01":[1,0,0,25], -"namespacelinalg__c__api.html#a436b645816859aea4a8fbd55e733ab92":[1,0,0,55], -"namespacelinalg__c__api.html#a45eeb38b8a0d572fc25a7db98690f705":[1,0,0,56], -"namespacelinalg__c__api.html#a4b8c42819e069a18ec39c5ebb9ef8703":[1,0,0,28], -"namespacelinalg__c__api.html#a5146fcf6552a097e05d46afaf91f424e":[1,0,0,19], -"namespacelinalg__c__api.html#a5746e1736802b9a082057c7997325049":[1,0,0,5], -"namespacelinalg__c__api.html#a5b5758f439d34c765ff5285c21fa88c1":[1,0,0,2], -"namespacelinalg__c__api.html#a60244c1c8ef1ac3217a9efa69fdbd229":[1,0,0,40], -"namespacelinalg__c__api.html#a63372e9678f7052d17c8676324d6e7a7":[1,0,0,14], -"namespacelinalg__c__api.html#a69d0ec69152e04fc5f766dd7c6d23f98":[1,0,0,20], -"namespacelinalg__c__api.html#a6e47b549d59377db83a0eb27d739df8d":[1,0,0,38], -"namespacelinalg__c__api.html#a715855159abe740aff7bf95303a3f715":[1,0,0,22], -"namespacelinalg__c__api.html#a754866d88e140dbf618c1d85f016c633":[1,0,0,59], -"namespacelinalg__c__api.html#a7a72759b932b32e346a70cec542557ff":[1,0,0,51], -"namespacelinalg__c__api.html#a7a8e491e75d2d00911d0992b37aac43d":[1,0,0,52], -"namespacelinalg__c__api.html#a800b0d6ba6f8d812d8038dd06c0967a8":[1,0,0,1], -"namespacelinalg__c__api.html#a82fcbd45f4a92431587312560fbcc636":[1,0,0,7], -"namespacelinalg__c__api.html#a83a08022c84ac2e76f7d20486797bd33":[1,0,0,42], -"namespacelinalg__c__api.html#a846baffbc77d4348d7b15d3f83983a04":[1,0,0,45], -"namespacelinalg__c__api.html#a93920f1db884cbad9bfc335abe36bed4":[1,0,0,13], -"namespacelinalg__c__api.html#a9426f737c5d551a133f44e2d7cb98a1d":[1,0,0,17], -"namespacelinalg__c__api.html#a9868095d332ba323afce1cda4085dd8c":[1,0,0,34], -"namespacelinalg__c__api.html#a99d3ac7f90cad0c643dd8abff6592032":[1,0,0,0], -"namespacelinalg__c__api.html#a9be60e86103e09be4d19fd3728f5d64b":[1,0,0,18], -"namespacelinalg__c__api.html#aa7bc80d9671a82aafdfc9a8ab904cb22":[1,0,0,33], -"namespacelinalg__c__api.html#aae9625f2ff12a73b6007b429132a1531":[1,0,0,46], -"namespacelinalg__c__api.html#ab133f51c44eb244be0b6e966f5893259":[1,0,0,12], -"namespacelinalg__c__api.html#ab81f25f6835feac7a88250c9863a4120":[1,0,0,53], -"namespacelinalg__c__api.html#abdc93ffffffefdef839370da19f01430":[1,0,0,26], -"namespacelinalg__c__api.html#ac286fe9a7ed4d69ca30ecbe03959f209":[1,0,0,41], -"namespacelinalg__c__api.html#ac46bdb1315742f700571bf4f7c705ffd":[1,0,0,39], -"namespacelinalg__c__api.html#ad05206b75a9cd1c5a2bda147307ef2d5":[1,0,0,48], -"namespacelinalg__c__api.html#ad0eefe5cf5a74d6848bbde0e8bb22550":[1,0,0,30], -"namespacelinalg__c__api.html#adadfcde438cabd5b104b62f2541712d1":[1,0,0,10], -"namespacelinalg__c__api.html#ae5c0bda2e1ae3a4dbdaf6d0586247b4c":[1,0,0,4], -"namespacelinalg__c__api.html#ae866f3e174aed82f3fdfa3483ac91333":[1,0,0,8], -"namespacelinalg__c__api.html#ae9bcd3e2df3151a5d92da48973501f6b":[1,0,0,16], -"namespacelinalg__c__api.html#aeab30d9e07601b343f15bf03d8220044":[1,0,0,15], -"namespacelinalg__c__api.html#aeb63de65aa9a9bc040860b8f78dcd3fa":[1,0,0,60], -"namespacelinalg__c__api.html#af1d700238a8ab71b17ff8c15221a9e02":[1,0,0,43], -"namespacelinalg__c__api.html#af2ed46a8b1285ac08f0f86162288a865":[1,0,0,11], -"namespacelinalg__c__api.html#af8627c89c2201ae47c9cfac1d65abfd4":[1,0,0,57], -"namespacelinalg__c__api.html#afd21b0e476168de7eb9a6a5ef3a2e8b4":[1,0,0,6], -"namespacelinalg__constants.html":[1,0,1], -"namespacelinalg__constants.html#a045d4c1cc5fe061467924ad01bfe77c4":[1,0,1,10], -"namespacelinalg__constants.html#a252c96a6e7c24b40bf7ef96063824f01":[1,0,1,5], -"namespacelinalg__constants.html#a389e35467a5a18f90927d28fb12ddf70":[1,0,1,0], -"namespacelinalg__constants.html#a39da5de4ea671010ee5f1e358c991cee":[1,0,1,2], -"namespacelinalg__constants.html#a6607d2d2ac92fe5d902527519279e646":[1,0,1,8], -"namespacelinalg__constants.html#a8d5820c41090117b508a033309ad0870":[1,0,1,7], -"namespacelinalg__constants.html#aaafde862f4d348fecccdccc695e25622":[1,0,1,4], -"namespacelinalg__constants.html#abf9e3b763502c2b0af0cbf48b14c918f":[1,0,1,9], -"namespacelinalg__constants.html#ac7d8bace23640b21a6d8a960371eb732":[1,0,1,3], -"namespacelinalg__constants.html#ad4b52ca61ccf1199dead23faa80b9ac7":[1,0,1,6], -"namespacelinalg__constants.html#aee0ebff93d8751cc57a3e8e5965b1344":[1,0,1,1], -"namespacelinalg__core.html":[1,0,2], -"namespacelinalg__immutable.html":[1,0,3], -"namespacelinalg__immutable.html#a4b09077ad1495833919bab84b144b297":[1,0,3,22], -"namespacelinalg__immutable.html#a5876e7f21f20679fd6c0c84768061a30":[1,0,3,15], -"namespacelinalg__immutable.html#a6236acadb527f7762e3e1c0ee3d9ca82":[1,0,3,24], -"namespacelinalg__immutable.html#a83eaeadc3a3cc5d81c46824174e5a90b":[1,0,3,17], -"namespacelinalg__immutable.html#a8f1ba0ce9f8fbece16a512145bbc197f":[1,0,3,21], -"namespacelinalg__immutable.html#a9648fd41cc3ce8ec40f67236d274f9a8":[1,0,3,23], -"namespacelinalg__immutable.html#a98f5b4e5de682d686cb763ab60fcde7f":[1,0,3,19], -"namespacelinalg__immutable.html#aaf39795f72fad79a38213893b850d793":[1,0,3,20], -"namespacelinalg__immutable.html#ab7abd8e3fd4170b5b5dfad4448a651c9":[1,0,3,18], -"namespacelinalg__immutable.html#aeb1f553973ae3e9b86cb30a1ca1f5700":[1,0,3,14], -"namespacelinalg__immutable.html#afb844327cadfdd08580c94cb1668c2a8":[1,0,3,16], +"linalg__basic_8f90_source.html":[3,0,1,1], +"linalg__eigen_8f90_source.html":[3,0,1,2], +"linalg__factor_8f90_source.html":[3,0,1,3], +"linalg__immutable_8f90_source.html":[3,0,1,4], +"linalg__solve_8f90_source.html":[3,0,1,5], +"linalg__sorting_8f90_source.html":[3,0,1,6], +"namespacelinalg.html":[1,0,0], +"namespacelinalg.html#a0e420096028b759a87f2f4f4306d202a":[1,0,0,34], +"namespacelinalg.html#a2b842a1fb17710d7ec2f117f5fdb2a59":[1,0,0,42], +"namespacelinalg.html#a4f47021e96cd813b568422a2eb3821bc":[1,0,0,36], +"namespacelinalg.html#a665d131453840e869510e9e8d2f7f151":[1,0,0,39], +"namespacelinalg.html#a7974856c0c0c76e6f1f2098a1eb7eac9":[1,0,0,32], +"namespacelinalg.html#abfb78ba61c0c2751f1c771c984469006":[1,0,0,40], +"namespacelinalg.html#ac691dea40873ac2a70c8b44c933774a7":[1,0,0,33], +"namespacelinalg.html#ace738355659bce2e9591473f0d543ef7":[1,0,0,35], +"namespacelinalg.html#ad89b9d502b7c484df53f9b10b9545776":[1,0,0,37], +"namespacelinalg.html#aefdfc0979567e89aa3b8c599d3f766f4":[1,0,0,38], +"namespacelinalg.html#af5dc9d60151bb81436b442525871c8c9":[1,0,0,41], +"namespacelinalg__immutable.html":[1,0,1], +"namespacelinalg__immutable.html#a4b09077ad1495833919bab84b144b297":[1,0,1,22], +"namespacelinalg__immutable.html#a5876e7f21f20679fd6c0c84768061a30":[1,0,1,15], +"namespacelinalg__immutable.html#a6236acadb527f7762e3e1c0ee3d9ca82":[1,0,1,24], +"namespacelinalg__immutable.html#a83eaeadc3a3cc5d81c46824174e5a90b":[1,0,1,17], +"namespacelinalg__immutable.html#a8f1ba0ce9f8fbece16a512145bbc197f":[1,0,1,21], +"namespacelinalg__immutable.html#a9648fd41cc3ce8ec40f67236d274f9a8":[1,0,1,23], +"namespacelinalg__immutable.html#a98f5b4e5de682d686cb763ab60fcde7f":[1,0,1,19], +"namespacelinalg__immutable.html#aaf39795f72fad79a38213893b850d793":[1,0,1,20], +"namespacelinalg__immutable.html#ab7abd8e3fd4170b5b5dfad4448a651c9":[1,0,1,18], +"namespacelinalg__immutable.html#aeb1f553973ae3e9b86cb30a1ca1f5700":[1,0,1,14], +"namespacelinalg__immutable.html#afb844327cadfdd08580c94cb1668c2a8":[1,0,1,16], "namespacemembers.html":[1,1,0], "namespacemembers_func.html":[1,1,1], "namespacemembers_vars.html":[1,1,2], "namespaces.html":[1,0], "pages.html":[], -"structlinalg__immutable_1_1eigen__results.html":[1,0,3,0], +"structlinalg__immutable_1_1eigen__results.html":[1,0,1,0], "structlinalg__immutable_1_1eigen__results.html":[2,0,1,0], +"structlinalg__immutable_1_1eigen__results.html#a982607b9c3ff93504bb4524dcd31a442":[1,0,1,0,1], "structlinalg__immutable_1_1eigen__results.html#a982607b9c3ff93504bb4524dcd31a442":[2,0,1,0,1], -"structlinalg__immutable_1_1eigen__results.html#a982607b9c3ff93504bb4524dcd31a442":[1,0,3,0,1], -"structlinalg__immutable_1_1eigen__results.html#abb60901ab160c6fd232cfb46ed0bf3cc":[1,0,3,0,0], +"structlinalg__immutable_1_1eigen__results.html#abb60901ab160c6fd232cfb46ed0bf3cc":[1,0,1,0,0], "structlinalg__immutable_1_1eigen__results.html#abb60901ab160c6fd232cfb46ed0bf3cc":[2,0,1,0,0], -"structlinalg__immutable_1_1lu__results.html":[1,0,3,1], +"structlinalg__immutable_1_1lu__results.html":[1,0,1,1], "structlinalg__immutable_1_1lu__results.html":[2,0,1,1], -"structlinalg__immutable_1_1lu__results.html#a7a11c264a8858527ebc021e609600cbb":[1,0,3,1,0], +"structlinalg__immutable_1_1lu__results.html#a7a11c264a8858527ebc021e609600cbb":[1,0,1,1,0], "structlinalg__immutable_1_1lu__results.html#a7a11c264a8858527ebc021e609600cbb":[2,0,1,1,0], +"structlinalg__immutable_1_1lu__results.html#ab1af96c7808037f63563e1bf912c4dad":[1,0,1,1,2], "structlinalg__immutable_1_1lu__results.html#ab1af96c7808037f63563e1bf912c4dad":[2,0,1,1,2], -"structlinalg__immutable_1_1lu__results.html#ab1af96c7808037f63563e1bf912c4dad":[1,0,3,1,2], +"structlinalg__immutable_1_1lu__results.html#ae1e1fd78123e04a2be4f1bfd25ddddb1":[1,0,1,1,1], "structlinalg__immutable_1_1lu__results.html#ae1e1fd78123e04a2be4f1bfd25ddddb1":[2,0,1,1,1], -"structlinalg__immutable_1_1lu__results.html#ae1e1fd78123e04a2be4f1bfd25ddddb1":[1,0,3,1,1], -"structlinalg__immutable_1_1lu__results__cmplx.html":[1,0,3,2], "structlinalg__immutable_1_1lu__results__cmplx.html":[2,0,1,2], +"structlinalg__immutable_1_1lu__results__cmplx.html":[1,0,1,2], "structlinalg__immutable_1_1lu__results__cmplx.html#a0634e363082d3c94fab5d5c73755f4ae":[2,0,1,2,0], -"structlinalg__immutable_1_1lu__results__cmplx.html#a0634e363082d3c94fab5d5c73755f4ae":[1,0,3,2,0], +"structlinalg__immutable_1_1lu__results__cmplx.html#a0634e363082d3c94fab5d5c73755f4ae":[1,0,1,2,0], "structlinalg__immutable_1_1lu__results__cmplx.html#a7488afe2004b11c8fed4c517400fde98":[2,0,1,2,2], -"structlinalg__immutable_1_1lu__results__cmplx.html#a7488afe2004b11c8fed4c517400fde98":[1,0,3,2,2], +"structlinalg__immutable_1_1lu__results__cmplx.html#a7488afe2004b11c8fed4c517400fde98":[1,0,1,2,2], "structlinalg__immutable_1_1lu__results__cmplx.html#a99d03bc910361aab08d17fcc4aaa960d":[2,0,1,2,1], -"structlinalg__immutable_1_1lu__results__cmplx.html#a99d03bc910361aab08d17fcc4aaa960d":[1,0,3,2,1], +"structlinalg__immutable_1_1lu__results__cmplx.html#a99d03bc910361aab08d17fcc4aaa960d":[1,0,1,2,1], "structlinalg__immutable_1_1qr__results.html":[2,0,1,10], -"structlinalg__immutable_1_1qr__results.html":[1,0,3,10], +"structlinalg__immutable_1_1qr__results.html":[1,0,1,10], "structlinalg__immutable_1_1qr__results.html#a053899b9dffba08b5052544c13d4983c":[2,0,1,10,0], -"structlinalg__immutable_1_1qr__results.html#a053899b9dffba08b5052544c13d4983c":[1,0,3,10,0], -"structlinalg__immutable_1_1qr__results.html#a91547ec8def57c0cc59271ccf59b3a01":[1,0,3,10,1], +"structlinalg__immutable_1_1qr__results.html#a053899b9dffba08b5052544c13d4983c":[1,0,1,10,0], "structlinalg__immutable_1_1qr__results.html#a91547ec8def57c0cc59271ccf59b3a01":[2,0,1,10,1], -"structlinalg__immutable_1_1qr__results.html#aeeea31b1fad256f5fcc2462b2990d56b":[1,0,3,10,2], +"structlinalg__immutable_1_1qr__results.html#a91547ec8def57c0cc59271ccf59b3a01":[1,0,1,10,1], "structlinalg__immutable_1_1qr__results.html#aeeea31b1fad256f5fcc2462b2990d56b":[2,0,1,10,2], +"structlinalg__immutable_1_1qr__results.html#aeeea31b1fad256f5fcc2462b2990d56b":[1,0,1,10,2], "structlinalg__immutable_1_1qr__results__cmplx.html":[2,0,1,11], -"structlinalg__immutable_1_1qr__results__cmplx.html":[1,0,3,11], +"structlinalg__immutable_1_1qr__results__cmplx.html":[1,0,1,11], "structlinalg__immutable_1_1qr__results__cmplx.html#a782d54320ca646427702d5f2e0a9372f":[2,0,1,11,0], -"structlinalg__immutable_1_1qr__results__cmplx.html#a782d54320ca646427702d5f2e0a9372f":[1,0,3,11,0], +"structlinalg__immutable_1_1qr__results__cmplx.html#a782d54320ca646427702d5f2e0a9372f":[1,0,1,11,0], +"structlinalg__immutable_1_1qr__results__cmplx.html#a7fa839ced2d020c61550d5b6cff9bb69":[1,0,1,11,1], "structlinalg__immutable_1_1qr__results__cmplx.html#a7fa839ced2d020c61550d5b6cff9bb69":[2,0,1,11,1], -"structlinalg__immutable_1_1qr__results__cmplx.html#a7fa839ced2d020c61550d5b6cff9bb69":[1,0,3,11,1], -"structlinalg__immutable_1_1qr__results__cmplx.html#a9382745395a25db425c5de89c33df2cd":[1,0,3,11,2], +"structlinalg__immutable_1_1qr__results__cmplx.html#a9382745395a25db425c5de89c33df2cd":[1,0,1,11,2], "structlinalg__immutable_1_1qr__results__cmplx.html#a9382745395a25db425c5de89c33df2cd":[2,0,1,11,2], +"structlinalg__immutable_1_1svd__results.html":[1,0,1,12], "structlinalg__immutable_1_1svd__results.html":[2,0,1,12], -"structlinalg__immutable_1_1svd__results.html":[1,0,3,12], +"structlinalg__immutable_1_1svd__results.html#a582822c9765048fcb8632d72a6ed506a":[1,0,1,12,1], "structlinalg__immutable_1_1svd__results.html#a582822c9765048fcb8632d72a6ed506a":[2,0,1,12,1], -"structlinalg__immutable_1_1svd__results.html#a582822c9765048fcb8632d72a6ed506a":[1,0,3,12,1], +"structlinalg__immutable_1_1svd__results.html#acbc05e1d170351bbfcd4cd1f089c81d8":[1,0,1,12,0], "structlinalg__immutable_1_1svd__results.html#acbc05e1d170351bbfcd4cd1f089c81d8":[2,0,1,12,0], -"structlinalg__immutable_1_1svd__results.html#acbc05e1d170351bbfcd4cd1f089c81d8":[1,0,3,12,0], +"structlinalg__immutable_1_1svd__results.html#af5c35f3392431179a5cb15d1cddf7cb1":[1,0,1,12,2], "structlinalg__immutable_1_1svd__results.html#af5c35f3392431179a5cb15d1cddf7cb1":[2,0,1,12,2], -"structlinalg__immutable_1_1svd__results.html#af5c35f3392431179a5cb15d1cddf7cb1":[1,0,3,12,2], "structlinalg__immutable_1_1svd__results__cmplx.html":[2,0,1,13], -"structlinalg__immutable_1_1svd__results__cmplx.html":[1,0,3,13], +"structlinalg__immutable_1_1svd__results__cmplx.html":[1,0,1,13], "structlinalg__immutable_1_1svd__results__cmplx.html#a66544dafaacf2b5465e6b1c55d804fff":[2,0,1,13,0], -"structlinalg__immutable_1_1svd__results__cmplx.html#a66544dafaacf2b5465e6b1c55d804fff":[1,0,3,13,0], -"structlinalg__immutable_1_1svd__results__cmplx.html#ae65cfdf6d19c3bbb3a7e425db266cb3c":[1,0,3,13,1], +"structlinalg__immutable_1_1svd__results__cmplx.html#a66544dafaacf2b5465e6b1c55d804fff":[1,0,1,13,0], "structlinalg__immutable_1_1svd__results__cmplx.html#ae65cfdf6d19c3bbb3a7e425db266cb3c":[2,0,1,13,1], -"structlinalg__immutable_1_1svd__results__cmplx.html#af9e74638b38510fb24de3f3a6ea30de8":[2,0,1,13,2], -"structlinalg__immutable_1_1svd__results__cmplx.html#af9e74638b38510fb24de3f3a6ea30de8":[1,0,3,13,2] +"structlinalg__immutable_1_1svd__results__cmplx.html#ae65cfdf6d19c3bbb3a7e425db266cb3c":[1,0,1,13,1], +"structlinalg__immutable_1_1svd__results__cmplx.html#af9e74638b38510fb24de3f3a6ea30de8":[1,0,1,13,2], +"structlinalg__immutable_1_1svd__results__cmplx.html#af9e74638b38510fb24de3f3a6ea30de8":[2,0,1,13,2] }; diff --git a/doc/html/search/all_0.js b/doc/html/search/all_0.js index 1fe80caa..23e04882 100644 --- a/doc/html/search/all_0.js +++ b/doc/html/search/all_0.js @@ -1,6 +1,6 @@ var searchData= [ - ['cholesky_5ffactor_0',['cholesky_factor',['../interfacelinalg__core_1_1cholesky__factor.html',1,'linalg_core']]], - ['cholesky_5frank1_5fdowndate_1',['cholesky_rank1_downdate',['../interfacelinalg__core_1_1cholesky__rank1__downdate.html',1,'linalg_core']]], - ['cholesky_5frank1_5fupdate_2',['cholesky_rank1_update',['../interfacelinalg__core_1_1cholesky__rank1__update.html',1,'linalg_core']]] + ['cholesky_5ffactor_0',['cholesky_factor',['../interfacelinalg_1_1cholesky__factor.html',1,'linalg']]], + ['cholesky_5frank1_5fdowndate_1',['cholesky_rank1_downdate',['../interfacelinalg_1_1cholesky__rank1__downdate.html',1,'linalg']]], + ['cholesky_5frank1_5fupdate_2',['cholesky_rank1_update',['../interfacelinalg_1_1cholesky__rank1__update.html',1,'linalg']]] ]; diff --git a/doc/html/search/all_1.js b/doc/html/search/all_1.js index fa28fb28..81a2288a 100644 --- a/doc/html/search/all_1.js +++ b/doc/html/search/all_1.js @@ -1,5 +1,5 @@ var searchData= [ - ['det_0',['det',['../interfacelinalg__core_1_1det.html',1,'linalg_core']]], - ['diag_5fmtx_5fmult_1',['diag_mtx_mult',['../interfacelinalg__core_1_1diag__mtx__mult.html',1,'linalg_core']]] + ['det_0',['det',['../interfacelinalg_1_1det.html',1,'linalg']]], + ['diag_5fmtx_5fmult_1',['diag_mtx_mult',['../interfacelinalg_1_1diag__mtx__mult.html',1,'linalg']]] ]; diff --git a/doc/html/search/all_2.js b/doc/html/search/all_2.js index 269daff0..86179e2a 100644 --- a/doc/html/search/all_2.js +++ b/doc/html/search/all_2.js @@ -1,5 +1,5 @@ var searchData= [ - ['eigen_0',['eigen',['../interfacelinalg__core_1_1eigen.html',1,'linalg_core']]], + ['eigen_0',['eigen',['../interfacelinalg_1_1eigen.html',1,'linalg']]], ['eigen_5fresults_1',['eigen_results',['../structlinalg__immutable_1_1eigen__results.html',1,'linalg_immutable']]] ]; diff --git a/doc/html/search/all_3.js b/doc/html/search/all_3.js index 28f50b33..d6925134 100644 --- a/doc/html/search/all_3.js +++ b/doc/html/search/all_3.js @@ -1,5 +1,5 @@ var searchData= [ - ['form_5flu_0',['form_lu',['../interfacelinalg__core_1_1form__lu.html',1,'linalg_core']]], - ['form_5fqr_1',['form_qr',['../interfacelinalg__core_1_1form__qr.html',1,'linalg_core']]] + ['form_5flu_0',['form_lu',['../interfacelinalg_1_1form__lu.html',1,'linalg']]], + ['form_5fqr_1',['form_qr',['../interfacelinalg_1_1form__qr.html',1,'linalg']]] ]; diff --git a/doc/html/search/all_4.js b/doc/html/search/all_4.js index fea70413..7cf2a492 100644 --- a/doc/html/search/all_4.js +++ b/doc/html/search/all_4.js @@ -1,4 +1,4 @@ var searchData= [ - ['hermitian_5ftranspose_0',['hermitian_transpose',['../namespacelinalg__constants.html#a389e35467a5a18f90927d28fb12ddf70',1,'linalg_constants']]] + ['identity_0',['identity',['../namespacelinalg__immutable.html#aeb1f553973ae3e9b86cb30a1ca1f5700',1,'linalg_immutable']]] ]; diff --git a/doc/html/search/all_5.js b/doc/html/search/all_5.js index 7cf2a492..6547516f 100644 --- a/doc/html/search/all_5.js +++ b/doc/html/search/all_5.js @@ -1,4 +1,20 @@ var searchData= [ - ['identity_0',['identity',['../namespacelinalg__immutable.html#aeb1f553973ae3e9b86cb30a1ca1f5700',1,'linalg_immutable']]] + ['l_0',['l',['../structlinalg__immutable_1_1lu__results.html#a7a11c264a8858527ebc021e609600cbb',1,'linalg_immutable::lu_results::l()'],['../structlinalg__immutable_1_1lu__results__cmplx.html#a0634e363082d3c94fab5d5c73755f4ae',1,'linalg_immutable::lu_results_cmplx::l()']]], + ['la_5farray_5fsize_5ferror_1',['la_array_size_error',['../namespacelinalg.html#a7974856c0c0c76e6f1f2098a1eb7eac9',1,'linalg']]], + ['la_5fconvergence_5ferror_2',['la_convergence_error',['../namespacelinalg.html#ac691dea40873ac2a70c8b44c933774a7',1,'linalg']]], + ['la_5fhermitian_5ftranspose_3',['la_hermitian_transpose',['../namespacelinalg.html#a0e420096028b759a87f2f4f4306d202a',1,'linalg']]], + ['la_5finvalid_5finput_5ferror_4',['la_invalid_input_error',['../namespacelinalg.html#ace738355659bce2e9591473f0d543ef7',1,'linalg']]], + ['la_5finvalid_5foperation_5ferror_5',['la_invalid_operation_error',['../namespacelinalg.html#a4f47021e96cd813b568422a2eb3821bc',1,'linalg']]], + ['la_5fmatrix_5fformat_5ferror_6',['la_matrix_format_error',['../namespacelinalg.html#ad89b9d502b7c484df53f9b10b9545776',1,'linalg']]], + ['la_5fno_5ferror_7',['la_no_error',['../namespacelinalg.html#aefdfc0979567e89aa3b8c599d3f766f4',1,'linalg']]], + ['la_5fno_5foperation_8',['la_no_operation',['../namespacelinalg.html#a665d131453840e869510e9e8d2f7f151',1,'linalg']]], + ['la_5fout_5fof_5fmemory_5ferror_9',['la_out_of_memory_error',['../namespacelinalg.html#abfb78ba61c0c2751f1c771c984469006',1,'linalg']]], + ['la_5fsingular_5fmatrix_5ferror_10',['la_singular_matrix_error',['../namespacelinalg.html#af5dc9d60151bb81436b442525871c8c9',1,'linalg']]], + ['la_5ftranspose_11',['la_transpose',['../namespacelinalg.html#a2b842a1fb17710d7ec2f117f5fdb2a59',1,'linalg']]], + ['linalg_12',['linalg',['../index.html',1,'(Global Namespace)'],['../namespacelinalg.html',1,'linalg']]], + ['linalg_5fimmutable_13',['linalg_immutable',['../namespacelinalg__immutable.html',1,'']]], + ['lu_5ffactor_14',['lu_factor',['../interfacelinalg_1_1lu__factor.html',1,'linalg']]], + ['lu_5fresults_15',['lu_results',['../structlinalg__immutable_1_1lu__results.html',1,'linalg_immutable']]], + ['lu_5fresults_5fcmplx_16',['lu_results_cmplx',['../structlinalg__immutable_1_1lu__results__cmplx.html',1,'linalg_immutable']]] ]; diff --git a/doc/html/search/all_6.js b/doc/html/search/all_6.js index 9f45affb..0110ae92 100644 --- a/doc/html/search/all_6.js +++ b/doc/html/search/all_6.js @@ -1,81 +1,26 @@ var searchData= [ - ['l_0',['l',['../structlinalg__immutable_1_1lu__results.html#a7a11c264a8858527ebc021e609600cbb',1,'linalg_immutable::lu_results::l()'],['../structlinalg__immutable_1_1lu__results__cmplx.html#a0634e363082d3c94fab5d5c73755f4ae',1,'linalg_immutable::lu_results_cmplx::l()']]], - ['la_5farray_5fsize_5ferror_1',['la_array_size_error',['../namespacelinalg__constants.html#aee0ebff93d8751cc57a3e8e5965b1344',1,'linalg_constants']]], - ['la_5fcholesky_5ffactor_2',['la_cholesky_factor',['../namespacelinalg__c__api.html#a99d3ac7f90cad0c643dd8abff6592032',1,'linalg_c_api']]], - ['la_5fcholesky_5ffactor_5fcmplx_3',['la_cholesky_factor_cmplx',['../namespacelinalg__c__api.html#a800b0d6ba6f8d812d8038dd06c0967a8',1,'linalg_c_api']]], - ['la_5fcholesky_5frank1_5fdowndate_4',['la_cholesky_rank1_downdate',['../namespacelinalg__c__api.html#a5b5758f439d34c765ff5285c21fa88c1',1,'linalg_c_api']]], - ['la_5fcholesky_5frank1_5fdowndate_5fcmplx_5',['la_cholesky_rank1_downdate_cmplx',['../namespacelinalg__c__api.html#a3232c643af8f8615961c4b1bab422a4a',1,'linalg_c_api']]], - ['la_5fcholesky_5frank1_5fupdate_6',['la_cholesky_rank1_update',['../namespacelinalg__c__api.html#ae5c0bda2e1ae3a4dbdaf6d0586247b4c',1,'linalg_c_api']]], - ['la_5fcholesky_5frank1_5fupdate_5fcmplx_7',['la_cholesky_rank1_update_cmplx',['../namespacelinalg__c__api.html#a5746e1736802b9a082057c7997325049',1,'linalg_c_api']]], - ['la_5fconvergence_5ferror_8',['la_convergence_error',['../namespacelinalg__constants.html#a39da5de4ea671010ee5f1e358c991cee',1,'linalg_constants']]], - ['la_5fdet_9',['la_det',['../namespacelinalg__c__api.html#afd21b0e476168de7eb9a6a5ef3a2e8b4',1,'linalg_c_api']]], - ['la_5fdet_5fcmplx_10',['la_det_cmplx',['../namespacelinalg__c__api.html#a82fcbd45f4a92431587312560fbcc636',1,'linalg_c_api']]], - ['la_5fdiag_5fmtx_5fmult_11',['la_diag_mtx_mult',['../namespacelinalg__c__api.html#ae866f3e174aed82f3fdfa3483ac91333',1,'linalg_c_api']]], - ['la_5fdiag_5fmtx_5fmult_5fcmplx_12',['la_diag_mtx_mult_cmplx',['../namespacelinalg__c__api.html#a1af56ff742938c0be90fb34146b13365',1,'linalg_c_api']]], - ['la_5fdiag_5fmtx_5fmult_5fmixed_13',['la_diag_mtx_mult_mixed',['../namespacelinalg__c__api.html#adadfcde438cabd5b104b62f2541712d1',1,'linalg_c_api']]], - ['la_5feigen_5fasymm_14',['la_eigen_asymm',['../namespacelinalg__c__api.html#af2ed46a8b1285ac08f0f86162288a865',1,'linalg_c_api']]], - ['la_5feigen_5fcmplx_15',['la_eigen_cmplx',['../namespacelinalg__c__api.html#ab133f51c44eb244be0b6e966f5893259',1,'linalg_c_api']]], - ['la_5feigen_5fgen_16',['la_eigen_gen',['../namespacelinalg__c__api.html#a93920f1db884cbad9bfc335abe36bed4',1,'linalg_c_api']]], - ['la_5feigen_5fsymm_17',['la_eigen_symm',['../namespacelinalg__c__api.html#a63372e9678f7052d17c8676324d6e7a7',1,'linalg_c_api']]], - ['la_5fform_5flu_18',['la_form_lu',['../namespacelinalg__c__api.html#aeab30d9e07601b343f15bf03d8220044',1,'linalg_c_api']]], - ['la_5fform_5flu_5fcmplx_19',['la_form_lu_cmplx',['../namespacelinalg__c__api.html#ae9bcd3e2df3151a5d92da48973501f6b',1,'linalg_c_api']]], - ['la_5fform_5fqr_20',['la_form_qr',['../namespacelinalg__c__api.html#a9426f737c5d551a133f44e2d7cb98a1d',1,'linalg_c_api']]], - ['la_5fform_5fqr_5fcmplx_21',['la_form_qr_cmplx',['../namespacelinalg__c__api.html#a9be60e86103e09be4d19fd3728f5d64b',1,'linalg_c_api']]], - ['la_5fform_5fqr_5fcmplx_5fpvt_22',['la_form_qr_cmplx_pvt',['../namespacelinalg__c__api.html#a5146fcf6552a097e05d46afaf91f424e',1,'linalg_c_api']]], - ['la_5fform_5fqr_5fpvt_23',['la_form_qr_pvt',['../namespacelinalg__c__api.html#a69d0ec69152e04fc5f766dd7c6d23f98',1,'linalg_c_api']]], - ['la_5finvalid_5finput_5ferror_24',['la_invalid_input_error',['../namespacelinalg__constants.html#ac7d8bace23640b21a6d8a960371eb732',1,'linalg_constants']]], - ['la_5finvalid_5foperation_5ferror_25',['la_invalid_operation_error',['../namespacelinalg__constants.html#aaafde862f4d348fecccdccc695e25622',1,'linalg_constants']]], - ['la_5finverse_26',['la_inverse',['../namespacelinalg__c__api.html#a307a6d5e27d90b28a38fba8c02e14461',1,'linalg_c_api']]], - ['la_5finverse_5fcmplx_27',['la_inverse_cmplx',['../namespacelinalg__c__api.html#a715855159abe740aff7bf95303a3f715',1,'linalg_c_api']]], - ['la_5flu_5ffactor_28',['la_lu_factor',['../namespacelinalg__c__api.html#a3e91c088c8d173e9b12c17b1ebc9bfa4',1,'linalg_c_api']]], - ['la_5flu_5ffactor_5fcmplx_29',['la_lu_factor_cmplx',['../namespacelinalg__c__api.html#a1788fe3192429b2cfd3a169d879a6f0e',1,'linalg_c_api']]], - ['la_5fmatrix_5fformat_5ferror_30',['la_matrix_format_error',['../namespacelinalg__constants.html#a252c96a6e7c24b40bf7ef96063824f01',1,'linalg_constants']]], - ['la_5fmtx_5fmult_31',['la_mtx_mult',['../namespacelinalg__c__api.html#a434338a38a5fde94d8df3119b169fd01',1,'linalg_c_api']]], - ['la_5fmtx_5fmult_5fcmplx_32',['la_mtx_mult_cmplx',['../namespacelinalg__c__api.html#abdc93ffffffefdef839370da19f01430',1,'linalg_c_api']]], - ['la_5fmult_5fqr_33',['la_mult_qr',['../namespacelinalg__c__api.html#a2604ade114e67587300b3916846fc961',1,'linalg_c_api']]], - ['la_5fmult_5fqr_5fcmplx_34',['la_mult_qr_cmplx',['../namespacelinalg__c__api.html#a4b8c42819e069a18ec39c5ebb9ef8703',1,'linalg_c_api']]], - ['la_5fno_5ferror_35',['la_no_error',['../namespacelinalg__constants.html#ad4b52ca61ccf1199dead23faa80b9ac7',1,'linalg_constants']]], - ['la_5fout_5fof_5fmemory_5ferror_36',['la_out_of_memory_error',['../namespacelinalg__constants.html#a8d5820c41090117b508a033309ad0870',1,'linalg_constants']]], - ['la_5fpinverse_37',['la_pinverse',['../namespacelinalg__c__api.html#a39bb26dcab43d8f54471af87af69e606',1,'linalg_c_api']]], - ['la_5fpinverse_5fcmplx_38',['la_pinverse_cmplx',['../namespacelinalg__c__api.html#ad0eefe5cf5a74d6848bbde0e8bb22550',1,'linalg_c_api']]], - ['la_5fqr_5ffactor_39',['la_qr_factor',['../namespacelinalg__c__api.html#a2c896885507a331ad89e579868da0fd3',1,'linalg_c_api']]], - ['la_5fqr_5ffactor_5fcmplx_40',['la_qr_factor_cmplx',['../namespacelinalg__c__api.html#a13a75b6d7bce1788b5e286a879456347',1,'linalg_c_api']]], - ['la_5fqr_5ffactor_5fcmplx_5fpvt_41',['la_qr_factor_cmplx_pvt',['../namespacelinalg__c__api.html#aa7bc80d9671a82aafdfc9a8ab904cb22',1,'linalg_c_api']]], - ['la_5fqr_5ffactor_5fpvt_42',['la_qr_factor_pvt',['../namespacelinalg__c__api.html#a9868095d332ba323afce1cda4085dd8c',1,'linalg_c_api']]], - ['la_5fqr_5frank1_5fupdate_43',['la_qr_rank1_update',['../namespacelinalg__c__api.html#a056fb14e92f98c660573886c0ad940ff',1,'linalg_c_api']]], - ['la_5fqr_5frank1_5fupdate_5fcmplx_44',['la_qr_rank1_update_cmplx',['../namespacelinalg__c__api.html#a01cf2129d7af3ddc8fb6e1fff7786ff1',1,'linalg_c_api']]], - ['la_5frank_45',['la_rank',['../namespacelinalg__c__api.html#a32548b9eb091164d51ed3793afee83e9',1,'linalg_c_api']]], - ['la_5frank1_5fupdate_46',['la_rank1_update',['../namespacelinalg__c__api.html#a6e47b549d59377db83a0eb27d739df8d',1,'linalg_c_api']]], - ['la_5frank1_5fupdate_5fcmplx_47',['la_rank1_update_cmplx',['../namespacelinalg__c__api.html#ac46bdb1315742f700571bf4f7c705ffd',1,'linalg_c_api']]], - ['la_5frank_5fcmplx_48',['la_rank_cmplx',['../namespacelinalg__c__api.html#a60244c1c8ef1ac3217a9efa69fdbd229',1,'linalg_c_api']]], - ['la_5fsingular_5fmatrix_5ferror_49',['la_singular_matrix_error',['../namespacelinalg__constants.html#a6607d2d2ac92fe5d902527519279e646',1,'linalg_constants']]], - ['la_5fsolve_5fcholesky_50',['la_solve_cholesky',['../namespacelinalg__c__api.html#ac286fe9a7ed4d69ca30ecbe03959f209',1,'linalg_c_api']]], - ['la_5fsolve_5fcholesky_5fcmplx_51',['la_solve_cholesky_cmplx',['../namespacelinalg__c__api.html#a83a08022c84ac2e76f7d20486797bd33',1,'linalg_c_api']]], - ['la_5fsolve_5fleast_5fsquares_52',['la_solve_least_squares',['../namespacelinalg__c__api.html#af1d700238a8ab71b17ff8c15221a9e02',1,'linalg_c_api']]], - ['la_5fsolve_5fleast_5fsquares_5fcmplx_53',['la_solve_least_squares_cmplx',['../namespacelinalg__c__api.html#a2c691c114d54a8eb89ce2882d0557550',1,'linalg_c_api']]], - ['la_5fsolve_5flu_54',['la_solve_lu',['../namespacelinalg__c__api.html#a846baffbc77d4348d7b15d3f83983a04',1,'linalg_c_api']]], - ['la_5fsolve_5flu_5fcmplx_55',['la_solve_lu_cmplx',['../namespacelinalg__c__api.html#aae9625f2ff12a73b6007b429132a1531',1,'linalg_c_api']]], - ['la_5fsolve_5fqr_56',['la_solve_qr',['../namespacelinalg__c__api.html#a13ed5d138ff59a9f649babc5c1dd9eab',1,'linalg_c_api']]], - ['la_5fsolve_5fqr_5fcmplx_57',['la_solve_qr_cmplx',['../namespacelinalg__c__api.html#ad05206b75a9cd1c5a2bda147307ef2d5',1,'linalg_c_api']]], - ['la_5fsolve_5fqr_5fcmplx_5fpvt_58',['la_solve_qr_cmplx_pvt',['../namespacelinalg__c__api.html#a17bfa880bc9019cbd654d20cab263ce3',1,'linalg_c_api']]], - ['la_5fsolve_5fqr_5fpvt_59',['la_solve_qr_pvt',['../namespacelinalg__c__api.html#a0d12474b0ca7772e4ad4ebc7ce227315',1,'linalg_c_api']]], - ['la_5fsolve_5ftri_5fmtx_60',['la_solve_tri_mtx',['../namespacelinalg__c__api.html#a7a72759b932b32e346a70cec542557ff',1,'linalg_c_api']]], - ['la_5fsolve_5ftri_5fmtx_5fcmplx_61',['la_solve_tri_mtx_cmplx',['../namespacelinalg__c__api.html#a7a8e491e75d2d00911d0992b37aac43d',1,'linalg_c_api']]], - ['la_5fsort_5feigen_62',['la_sort_eigen',['../namespacelinalg__c__api.html#ab81f25f6835feac7a88250c9863a4120',1,'linalg_c_api']]], - ['la_5fsort_5feigen_5fcmplx_63',['la_sort_eigen_cmplx',['../namespacelinalg__c__api.html#a2a0c8ddfd134f3d57849925d359d53b2',1,'linalg_c_api']]], - ['la_5fsvd_64',['la_svd',['../namespacelinalg__c__api.html#a436b645816859aea4a8fbd55e733ab92',1,'linalg_c_api']]], - ['la_5fsvd_5fcmplx_65',['la_svd_cmplx',['../namespacelinalg__c__api.html#a45eeb38b8a0d572fc25a7db98690f705',1,'linalg_c_api']]], - ['la_5ftrace_66',['la_trace',['../namespacelinalg__c__api.html#af8627c89c2201ae47c9cfac1d65abfd4',1,'linalg_c_api']]], - ['la_5ftrace_5fcmplx_67',['la_trace_cmplx',['../namespacelinalg__c__api.html#a315ef452fe9f00baa454dc930813fedc',1,'linalg_c_api']]], - ['la_5ftri_5fmtx_5fmult_68',['la_tri_mtx_mult',['../namespacelinalg__c__api.html#a754866d88e140dbf618c1d85f016c633',1,'linalg_c_api']]], - ['la_5ftri_5fmtx_5fmult_5fcmplx_69',['la_tri_mtx_mult_cmplx',['../namespacelinalg__c__api.html#aeb63de65aa9a9bc040860b8f78dcd3fa',1,'linalg_c_api']]], - ['linalg_70',['linalg',['../index.html',1,'']]], - ['linalg_5fc_5fapi_71',['linalg_c_api',['../namespacelinalg__c__api.html',1,'']]], - ['linalg_5fconstants_72',['linalg_constants',['../namespacelinalg__constants.html',1,'']]], - ['linalg_5fcore_73',['linalg_core',['../namespacelinalg__core.html',1,'']]], - ['linalg_5fimmutable_74',['linalg_immutable',['../namespacelinalg__immutable.html',1,'']]], - ['lu_5ffactor_75',['lu_factor',['../interfacelinalg__core_1_1lu__factor.html',1,'linalg_core']]], - ['lu_5fresults_76',['lu_results',['../structlinalg__immutable_1_1lu__results.html',1,'linalg_immutable']]], - ['lu_5fresults_5fcmplx_77',['lu_results_cmplx',['../structlinalg__immutable_1_1lu__results__cmplx.html',1,'linalg_immutable']]] + ['mat_5fcholesky_0',['mat_cholesky',['../namespacelinalg__immutable.html#a5876e7f21f20679fd6c0c84768061a30',1,'linalg_immutable']]], + ['mat_5fcholesky_5frank1_5fdowndate_1',['mat_cholesky_rank1_downdate',['../namespacelinalg__immutable.html#afb844327cadfdd08580c94cb1668c2a8',1,'linalg_immutable']]], + ['mat_5fcholesky_5frank1_5fupdate_2',['mat_cholesky_rank1_update',['../namespacelinalg__immutable.html#a83eaeadc3a3cc5d81c46824174e5a90b',1,'linalg_immutable']]], + ['mat_5fdet_3',['mat_det',['../namespacelinalg__immutable.html#ab7abd8e3fd4170b5b5dfad4448a651c9',1,'linalg_immutable']]], + ['mat_5feigen_4',['mat_eigen',['../interfacelinalg__immutable_1_1mat__eigen.html',1,'linalg_immutable']]], + ['mat_5finverse_5',['mat_inverse',['../namespacelinalg__immutable.html#a98f5b4e5de682d686cb763ab60fcde7f',1,'linalg_immutable']]], + ['mat_5flu_6',['mat_lu',['../interfacelinalg__immutable_1_1mat__lu.html',1,'linalg_immutable']]], + ['mat_5fmult_5fdiag_7',['mat_mult_diag',['../interfacelinalg__immutable_1_1mat__mult__diag.html',1,'linalg_immutable']]], + ['mat_5fmult_5flower_5ftri_8',['mat_mult_lower_tri',['../interfacelinalg__immutable_1_1mat__mult__lower__tri.html',1,'linalg_immutable']]], + ['mat_5fmult_5fupper_5ftri_9',['mat_mult_upper_tri',['../interfacelinalg__immutable_1_1mat__mult__upper__tri.html',1,'linalg_immutable']]], + ['mat_5fpinverse_10',['mat_pinverse',['../namespacelinalg__immutable.html#aaf39795f72fad79a38213893b850d793',1,'linalg_immutable']]], + ['mat_5fqr_11',['mat_qr',['../namespacelinalg__immutable.html#a8f1ba0ce9f8fbece16a512145bbc197f',1,'linalg_immutable']]], + ['mat_5fqr_5frank1_5fupdate_12',['mat_qr_rank1_update',['../namespacelinalg__immutable.html#a4b09077ad1495833919bab84b144b297',1,'linalg_immutable']]], + ['mat_5frank1_5fupdate_13',['mat_rank1_update',['../namespacelinalg__immutable.html#a9648fd41cc3ce8ec40f67236d274f9a8',1,'linalg_immutable']]], + ['mat_5fsolve_5flower_5ftri_14',['mat_solve_lower_tri',['../interfacelinalg__immutable_1_1mat__solve__lower__tri.html',1,'linalg_immutable']]], + ['mat_5fsolve_5fupper_5ftri_15',['mat_solve_upper_tri',['../interfacelinalg__immutable_1_1mat__solve__upper__tri.html',1,'linalg_immutable']]], + ['mat_5fsvd_16',['mat_svd',['../namespacelinalg__immutable.html#a6236acadb527f7762e3e1c0ee3d9ca82',1,'linalg_immutable']]], + ['mtx_5finverse_17',['mtx_inverse',['../interfacelinalg_1_1mtx__inverse.html',1,'linalg']]], + ['mtx_5fmult_18',['mtx_mult',['../interfacelinalg_1_1mtx__mult.html',1,'linalg']]], + ['mtx_5fpinverse_19',['mtx_pinverse',['../interfacelinalg_1_1mtx__pinverse.html',1,'linalg']]], + ['mtx_5frank_20',['mtx_rank',['../interfacelinalg_1_1mtx__rank.html',1,'linalg']]], + ['mult_5fqr_21',['mult_qr',['../interfacelinalg_1_1mult__qr.html',1,'linalg']]], + ['mult_5frz_22',['mult_rz',['../interfacelinalg_1_1mult__rz.html',1,'linalg']]] ]; diff --git a/doc/html/search/all_7.js b/doc/html/search/all_7.js index e6a483d9..f0e2a425 100644 --- a/doc/html/search/all_7.js +++ b/doc/html/search/all_7.js @@ -1,26 +1,4 @@ var searchData= [ - ['mat_5fcholesky_0',['mat_cholesky',['../namespacelinalg__immutable.html#a5876e7f21f20679fd6c0c84768061a30',1,'linalg_immutable']]], - ['mat_5fcholesky_5frank1_5fdowndate_1',['mat_cholesky_rank1_downdate',['../namespacelinalg__immutable.html#afb844327cadfdd08580c94cb1668c2a8',1,'linalg_immutable']]], - ['mat_5fcholesky_5frank1_5fupdate_2',['mat_cholesky_rank1_update',['../namespacelinalg__immutable.html#a83eaeadc3a3cc5d81c46824174e5a90b',1,'linalg_immutable']]], - ['mat_5fdet_3',['mat_det',['../namespacelinalg__immutable.html#ab7abd8e3fd4170b5b5dfad4448a651c9',1,'linalg_immutable']]], - ['mat_5feigen_4',['mat_eigen',['../interfacelinalg__immutable_1_1mat__eigen.html',1,'linalg_immutable']]], - ['mat_5finverse_5',['mat_inverse',['../namespacelinalg__immutable.html#a98f5b4e5de682d686cb763ab60fcde7f',1,'linalg_immutable']]], - ['mat_5flu_6',['mat_lu',['../interfacelinalg__immutable_1_1mat__lu.html',1,'linalg_immutable']]], - ['mat_5fmult_5fdiag_7',['mat_mult_diag',['../interfacelinalg__immutable_1_1mat__mult__diag.html',1,'linalg_immutable']]], - ['mat_5fmult_5flower_5ftri_8',['mat_mult_lower_tri',['../interfacelinalg__immutable_1_1mat__mult__lower__tri.html',1,'linalg_immutable']]], - ['mat_5fmult_5fupper_5ftri_9',['mat_mult_upper_tri',['../interfacelinalg__immutable_1_1mat__mult__upper__tri.html',1,'linalg_immutable']]], - ['mat_5fpinverse_10',['mat_pinverse',['../namespacelinalg__immutable.html#aaf39795f72fad79a38213893b850d793',1,'linalg_immutable']]], - ['mat_5fqr_11',['mat_qr',['../namespacelinalg__immutable.html#a8f1ba0ce9f8fbece16a512145bbc197f',1,'linalg_immutable']]], - ['mat_5fqr_5frank1_5fupdate_12',['mat_qr_rank1_update',['../namespacelinalg__immutable.html#a4b09077ad1495833919bab84b144b297',1,'linalg_immutable']]], - ['mat_5frank1_5fupdate_13',['mat_rank1_update',['../namespacelinalg__immutable.html#a9648fd41cc3ce8ec40f67236d274f9a8',1,'linalg_immutable']]], - ['mat_5fsolve_5flower_5ftri_14',['mat_solve_lower_tri',['../interfacelinalg__immutable_1_1mat__solve__lower__tri.html',1,'linalg_immutable']]], - ['mat_5fsolve_5fupper_5ftri_15',['mat_solve_upper_tri',['../interfacelinalg__immutable_1_1mat__solve__upper__tri.html',1,'linalg_immutable']]], - ['mat_5fsvd_16',['mat_svd',['../namespacelinalg__immutable.html#a6236acadb527f7762e3e1c0ee3d9ca82',1,'linalg_immutable']]], - ['mtx_5finverse_17',['mtx_inverse',['../interfacelinalg__core_1_1mtx__inverse.html',1,'linalg_core']]], - ['mtx_5fmult_18',['mtx_mult',['../interfacelinalg__core_1_1mtx__mult.html',1,'linalg_core']]], - ['mtx_5fpinverse_19',['mtx_pinverse',['../interfacelinalg__core_1_1mtx__pinverse.html',1,'linalg_core']]], - ['mtx_5frank_20',['mtx_rank',['../interfacelinalg__core_1_1mtx__rank.html',1,'linalg_core']]], - ['mult_5fqr_21',['mult_qr',['../interfacelinalg__core_1_1mult__qr.html',1,'linalg_core']]], - ['mult_5frz_22',['mult_rz',['../interfacelinalg__core_1_1mult__rz.html',1,'linalg_core']]] + ['p_0',['p',['../structlinalg__immutable_1_1lu__results.html#ae1e1fd78123e04a2be4f1bfd25ddddb1',1,'linalg_immutable::lu_results::p()'],['../structlinalg__immutable_1_1lu__results__cmplx.html#a99d03bc910361aab08d17fcc4aaa960d',1,'linalg_immutable::lu_results_cmplx::p()'],['../structlinalg__immutable_1_1qr__results.html#a053899b9dffba08b5052544c13d4983c',1,'linalg_immutable::qr_results::p()'],['../structlinalg__immutable_1_1qr__results__cmplx.html#a782d54320ca646427702d5f2e0a9372f',1,'linalg_immutable::qr_results_cmplx::p()']]] ]; diff --git a/doc/html/search/all_8.js b/doc/html/search/all_8.js index 1511857c..a3eee615 100644 --- a/doc/html/search/all_8.js +++ b/doc/html/search/all_8.js @@ -1,4 +1,8 @@ var searchData= [ - ['no_5foperation_0',['no_operation',['../namespacelinalg__constants.html#abf9e3b763502c2b0af0cbf48b14c918f',1,'linalg_constants']]] + ['q_0',['q',['../structlinalg__immutable_1_1qr__results.html#a91547ec8def57c0cc59271ccf59b3a01',1,'linalg_immutable::qr_results::q()'],['../structlinalg__immutable_1_1qr__results__cmplx.html#a7fa839ced2d020c61550d5b6cff9bb69',1,'linalg_immutable::qr_results_cmplx::q()']]], + ['qr_5ffactor_1',['qr_factor',['../interfacelinalg_1_1qr__factor.html',1,'linalg']]], + ['qr_5frank1_5fupdate_2',['qr_rank1_update',['../interfacelinalg_1_1qr__rank1__update.html',1,'linalg']]], + ['qr_5fresults_3',['qr_results',['../structlinalg__immutable_1_1qr__results.html',1,'linalg_immutable']]], + ['qr_5fresults_5fcmplx_4',['qr_results_cmplx',['../structlinalg__immutable_1_1qr__results__cmplx.html',1,'linalg_immutable']]] ]; diff --git a/doc/html/search/all_9.js b/doc/html/search/all_9.js index f0e2a425..e638d2af 100644 --- a/doc/html/search/all_9.js +++ b/doc/html/search/all_9.js @@ -1,4 +1,7 @@ var searchData= [ - ['p_0',['p',['../structlinalg__immutable_1_1lu__results.html#ae1e1fd78123e04a2be4f1bfd25ddddb1',1,'linalg_immutable::lu_results::p()'],['../structlinalg__immutable_1_1lu__results__cmplx.html#a99d03bc910361aab08d17fcc4aaa960d',1,'linalg_immutable::lu_results_cmplx::p()'],['../structlinalg__immutable_1_1qr__results.html#a053899b9dffba08b5052544c13d4983c',1,'linalg_immutable::qr_results::p()'],['../structlinalg__immutable_1_1qr__results__cmplx.html#a782d54320ca646427702d5f2e0a9372f',1,'linalg_immutable::qr_results_cmplx::p()']]] + ['r_0',['r',['../structlinalg__immutable_1_1qr__results.html#aeeea31b1fad256f5fcc2462b2990d56b',1,'linalg_immutable::qr_results::r()'],['../structlinalg__immutable_1_1qr__results__cmplx.html#a9382745395a25db425c5de89c33df2cd',1,'linalg_immutable::qr_results_cmplx::r()']]], + ['rank1_5fupdate_1',['rank1_update',['../interfacelinalg_1_1rank1__update.html',1,'linalg']]], + ['recip_5fmult_5farray_2',['recip_mult_array',['../interfacelinalg_1_1recip__mult__array.html',1,'linalg']]], + ['rz_5ffactor_3',['rz_factor',['../interfacelinalg_1_1rz__factor.html',1,'linalg']]] ]; diff --git a/doc/html/search/all_a.js b/doc/html/search/all_a.js index f7f73294..eacbab01 100644 --- a/doc/html/search/all_a.js +++ b/doc/html/search/all_a.js @@ -1,8 +1,16 @@ var searchData= [ - ['q_0',['q',['../structlinalg__immutable_1_1qr__results.html#a91547ec8def57c0cc59271ccf59b3a01',1,'linalg_immutable::qr_results::q()'],['../structlinalg__immutable_1_1qr__results__cmplx.html#a7fa839ced2d020c61550d5b6cff9bb69',1,'linalg_immutable::qr_results_cmplx::q()']]], - ['qr_5ffactor_1',['qr_factor',['../interfacelinalg__core_1_1qr__factor.html',1,'linalg_core']]], - ['qr_5frank1_5fupdate_2',['qr_rank1_update',['../interfacelinalg__core_1_1qr__rank1__update.html',1,'linalg_core']]], - ['qr_5fresults_3',['qr_results',['../structlinalg__immutable_1_1qr__results.html',1,'linalg_immutable']]], - ['qr_5fresults_5fcmplx_4',['qr_results_cmplx',['../structlinalg__immutable_1_1qr__results__cmplx.html',1,'linalg_immutable']]] + ['s_0',['s',['../structlinalg__immutable_1_1svd__results.html#acbc05e1d170351bbfcd4cd1f089c81d8',1,'linalg_immutable::svd_results::s()'],['../structlinalg__immutable_1_1svd__results__cmplx.html#a66544dafaacf2b5465e6b1c55d804fff',1,'linalg_immutable::svd_results_cmplx::s()']]], + ['solve_5fcholesky_1',['solve_cholesky',['../interfacelinalg_1_1solve__cholesky.html',1,'linalg']]], + ['solve_5fleast_5fsquares_2',['solve_least_squares',['../interfacelinalg_1_1solve__least__squares.html',1,'linalg']]], + ['solve_5fleast_5fsquares_5ffull_3',['solve_least_squares_full',['../interfacelinalg_1_1solve__least__squares__full.html',1,'linalg']]], + ['solve_5fleast_5fsquares_5fsvd_4',['solve_least_squares_svd',['../interfacelinalg_1_1solve__least__squares__svd.html',1,'linalg']]], + ['solve_5flu_5',['solve_lu',['../interfacelinalg_1_1solve__lu.html',1,'linalg']]], + ['solve_5fqr_6',['solve_qr',['../interfacelinalg_1_1solve__qr.html',1,'linalg']]], + ['solve_5ftriangular_5fsystem_7',['solve_triangular_system',['../interfacelinalg_1_1solve__triangular__system.html',1,'linalg']]], + ['sort_8',['sort',['../interfacelinalg_1_1sort.html',1,'linalg']]], + ['svd_9',['svd',['../interfacelinalg_1_1svd.html',1,'linalg']]], + ['svd_5fresults_10',['svd_results',['../structlinalg__immutable_1_1svd__results.html',1,'linalg_immutable']]], + ['svd_5fresults_5fcmplx_11',['svd_results_cmplx',['../structlinalg__immutable_1_1svd__results__cmplx.html',1,'linalg_immutable']]], + ['swap_12',['swap',['../interfacelinalg_1_1swap.html',1,'linalg']]] ]; diff --git a/doc/html/search/all_b.js b/doc/html/search/all_b.js index e656de12..90d19100 100644 --- a/doc/html/search/all_b.js +++ b/doc/html/search/all_b.js @@ -1,7 +1,5 @@ var searchData= [ - ['r_0',['r',['../structlinalg__immutable_1_1qr__results.html#aeeea31b1fad256f5fcc2462b2990d56b',1,'linalg_immutable::qr_results::r()'],['../structlinalg__immutable_1_1qr__results__cmplx.html#a9382745395a25db425c5de89c33df2cd',1,'linalg_immutable::qr_results_cmplx::r()']]], - ['rank1_5fupdate_1',['rank1_update',['../interfacelinalg__core_1_1rank1__update.html',1,'linalg_core']]], - ['recip_5fmult_5farray_2',['recip_mult_array',['../interfacelinalg__core_1_1recip__mult__array.html',1,'linalg_core']]], - ['rz_5ffactor_3',['rz_factor',['../interfacelinalg__core_1_1rz__factor.html',1,'linalg_core']]] + ['trace_0',['trace',['../interfacelinalg_1_1trace.html',1,'linalg']]], + ['tri_5fmtx_5fmult_1',['tri_mtx_mult',['../interfacelinalg_1_1tri__mtx__mult.html',1,'linalg']]] ]; diff --git a/doc/html/search/all_c.js b/doc/html/search/all_c.js index 037c0866..a5b8bb0e 100644 --- a/doc/html/search/all_c.js +++ b/doc/html/search/all_c.js @@ -1,16 +1,4 @@ var searchData= [ - ['s_0',['s',['../structlinalg__immutable_1_1svd__results.html#acbc05e1d170351bbfcd4cd1f089c81d8',1,'linalg_immutable::svd_results::s()'],['../structlinalg__immutable_1_1svd__results__cmplx.html#a66544dafaacf2b5465e6b1c55d804fff',1,'linalg_immutable::svd_results_cmplx::s()']]], - ['solve_5fcholesky_1',['solve_cholesky',['../interfacelinalg__core_1_1solve__cholesky.html',1,'linalg_core']]], - ['solve_5fleast_5fsquares_2',['solve_least_squares',['../interfacelinalg__core_1_1solve__least__squares.html',1,'linalg_core']]], - ['solve_5fleast_5fsquares_5ffull_3',['solve_least_squares_full',['../interfacelinalg__core_1_1solve__least__squares__full.html',1,'linalg_core']]], - ['solve_5fleast_5fsquares_5fsvd_4',['solve_least_squares_svd',['../interfacelinalg__core_1_1solve__least__squares__svd.html',1,'linalg_core']]], - ['solve_5flu_5',['solve_lu',['../interfacelinalg__core_1_1solve__lu.html',1,'linalg_core']]], - ['solve_5fqr_6',['solve_qr',['../interfacelinalg__core_1_1solve__qr.html',1,'linalg_core']]], - ['solve_5ftriangular_5fsystem_7',['solve_triangular_system',['../interfacelinalg__core_1_1solve__triangular__system.html',1,'linalg_core']]], - ['sort_8',['sort',['../interfacelinalg__core_1_1sort.html',1,'linalg_core']]], - ['svd_9',['svd',['../interfacelinalg__core_1_1svd.html',1,'linalg_core']]], - ['svd_5fresults_10',['svd_results',['../structlinalg__immutable_1_1svd__results.html',1,'linalg_immutable']]], - ['svd_5fresults_5fcmplx_11',['svd_results_cmplx',['../structlinalg__immutable_1_1svd__results__cmplx.html',1,'linalg_immutable']]], - ['swap_12',['swap',['../interfacelinalg__core_1_1swap.html',1,'linalg_core']]] + ['u_0',['u',['../structlinalg__immutable_1_1lu__results.html#ab1af96c7808037f63563e1bf912c4dad',1,'linalg_immutable::lu_results::u()'],['../structlinalg__immutable_1_1lu__results__cmplx.html#a7488afe2004b11c8fed4c517400fde98',1,'linalg_immutable::lu_results_cmplx::u()'],['../structlinalg__immutable_1_1svd__results.html#a582822c9765048fcb8632d72a6ed506a',1,'linalg_immutable::svd_results::u()'],['../structlinalg__immutable_1_1svd__results__cmplx.html#ae65cfdf6d19c3bbb3a7e425db266cb3c',1,'linalg_immutable::svd_results_cmplx::u()']]] ]; diff --git a/doc/html/search/all_d.js b/doc/html/search/all_d.js index ccf59912..760107f9 100644 --- a/doc/html/search/all_d.js +++ b/doc/html/search/all_d.js @@ -1,6 +1,6 @@ var searchData= [ - ['trace_0',['trace',['../interfacelinalg__core_1_1trace.html',1,'linalg_core']]], - ['transpose_1',['transpose',['../namespacelinalg__constants.html#a045d4c1cc5fe061467924ad01bfe77c4',1,'linalg_constants']]], - ['tri_5fmtx_5fmult_2',['tri_mtx_mult',['../interfacelinalg__core_1_1tri__mtx__mult.html',1,'linalg_core']]] + ['values_0',['values',['../structlinalg__immutable_1_1eigen__results.html#abb60901ab160c6fd232cfb46ed0bf3cc',1,'linalg_immutable::eigen_results']]], + ['vectors_1',['vectors',['../structlinalg__immutable_1_1eigen__results.html#a982607b9c3ff93504bb4524dcd31a442',1,'linalg_immutable::eigen_results']]], + ['vt_2',['vt',['../structlinalg__immutable_1_1svd__results.html#af5c35f3392431179a5cb15d1cddf7cb1',1,'linalg_immutable::svd_results::vt()'],['../structlinalg__immutable_1_1svd__results__cmplx.html#af9e74638b38510fb24de3f3a6ea30de8',1,'linalg_immutable::svd_results_cmplx::vt()']]] ]; diff --git a/doc/html/search/classes_0.js b/doc/html/search/classes_0.js index 1fe80caa..23e04882 100644 --- a/doc/html/search/classes_0.js +++ b/doc/html/search/classes_0.js @@ -1,6 +1,6 @@ var searchData= [ - ['cholesky_5ffactor_0',['cholesky_factor',['../interfacelinalg__core_1_1cholesky__factor.html',1,'linalg_core']]], - ['cholesky_5frank1_5fdowndate_1',['cholesky_rank1_downdate',['../interfacelinalg__core_1_1cholesky__rank1__downdate.html',1,'linalg_core']]], - ['cholesky_5frank1_5fupdate_2',['cholesky_rank1_update',['../interfacelinalg__core_1_1cholesky__rank1__update.html',1,'linalg_core']]] + ['cholesky_5ffactor_0',['cholesky_factor',['../interfacelinalg_1_1cholesky__factor.html',1,'linalg']]], + ['cholesky_5frank1_5fdowndate_1',['cholesky_rank1_downdate',['../interfacelinalg_1_1cholesky__rank1__downdate.html',1,'linalg']]], + ['cholesky_5frank1_5fupdate_2',['cholesky_rank1_update',['../interfacelinalg_1_1cholesky__rank1__update.html',1,'linalg']]] ]; diff --git a/doc/html/search/classes_1.js b/doc/html/search/classes_1.js index fa28fb28..81a2288a 100644 --- a/doc/html/search/classes_1.js +++ b/doc/html/search/classes_1.js @@ -1,5 +1,5 @@ var searchData= [ - ['det_0',['det',['../interfacelinalg__core_1_1det.html',1,'linalg_core']]], - ['diag_5fmtx_5fmult_1',['diag_mtx_mult',['../interfacelinalg__core_1_1diag__mtx__mult.html',1,'linalg_core']]] + ['det_0',['det',['../interfacelinalg_1_1det.html',1,'linalg']]], + ['diag_5fmtx_5fmult_1',['diag_mtx_mult',['../interfacelinalg_1_1diag__mtx__mult.html',1,'linalg']]] ]; diff --git a/doc/html/search/classes_2.js b/doc/html/search/classes_2.js index 269daff0..86179e2a 100644 --- a/doc/html/search/classes_2.js +++ b/doc/html/search/classes_2.js @@ -1,5 +1,5 @@ var searchData= [ - ['eigen_0',['eigen',['../interfacelinalg__core_1_1eigen.html',1,'linalg_core']]], + ['eigen_0',['eigen',['../interfacelinalg_1_1eigen.html',1,'linalg']]], ['eigen_5fresults_1',['eigen_results',['../structlinalg__immutable_1_1eigen__results.html',1,'linalg_immutable']]] ]; diff --git a/doc/html/search/classes_3.js b/doc/html/search/classes_3.js index 28f50b33..d6925134 100644 --- a/doc/html/search/classes_3.js +++ b/doc/html/search/classes_3.js @@ -1,5 +1,5 @@ var searchData= [ - ['form_5flu_0',['form_lu',['../interfacelinalg__core_1_1form__lu.html',1,'linalg_core']]], - ['form_5fqr_1',['form_qr',['../interfacelinalg__core_1_1form__qr.html',1,'linalg_core']]] + ['form_5flu_0',['form_lu',['../interfacelinalg_1_1form__lu.html',1,'linalg']]], + ['form_5fqr_1',['form_qr',['../interfacelinalg_1_1form__qr.html',1,'linalg']]] ]; diff --git a/doc/html/search/classes_4.js b/doc/html/search/classes_4.js index c3d893b7..19ae8c9c 100644 --- a/doc/html/search/classes_4.js +++ b/doc/html/search/classes_4.js @@ -1,6 +1,6 @@ var searchData= [ - ['lu_5ffactor_0',['lu_factor',['../interfacelinalg__core_1_1lu__factor.html',1,'linalg_core']]], + ['lu_5ffactor_0',['lu_factor',['../interfacelinalg_1_1lu__factor.html',1,'linalg']]], ['lu_5fresults_1',['lu_results',['../structlinalg__immutable_1_1lu__results.html',1,'linalg_immutable']]], ['lu_5fresults_5fcmplx_2',['lu_results_cmplx',['../structlinalg__immutable_1_1lu__results__cmplx.html',1,'linalg_immutable']]] ]; diff --git a/doc/html/search/classes_5.js b/doc/html/search/classes_5.js index 0a072974..2ecc95d3 100644 --- a/doc/html/search/classes_5.js +++ b/doc/html/search/classes_5.js @@ -7,10 +7,10 @@ var searchData= ['mat_5fmult_5fupper_5ftri_4',['mat_mult_upper_tri',['../interfacelinalg__immutable_1_1mat__mult__upper__tri.html',1,'linalg_immutable']]], ['mat_5fsolve_5flower_5ftri_5',['mat_solve_lower_tri',['../interfacelinalg__immutable_1_1mat__solve__lower__tri.html',1,'linalg_immutable']]], ['mat_5fsolve_5fupper_5ftri_6',['mat_solve_upper_tri',['../interfacelinalg__immutable_1_1mat__solve__upper__tri.html',1,'linalg_immutable']]], - ['mtx_5finverse_7',['mtx_inverse',['../interfacelinalg__core_1_1mtx__inverse.html',1,'linalg_core']]], - ['mtx_5fmult_8',['mtx_mult',['../interfacelinalg__core_1_1mtx__mult.html',1,'linalg_core']]], - ['mtx_5fpinverse_9',['mtx_pinverse',['../interfacelinalg__core_1_1mtx__pinverse.html',1,'linalg_core']]], - ['mtx_5frank_10',['mtx_rank',['../interfacelinalg__core_1_1mtx__rank.html',1,'linalg_core']]], - ['mult_5fqr_11',['mult_qr',['../interfacelinalg__core_1_1mult__qr.html',1,'linalg_core']]], - ['mult_5frz_12',['mult_rz',['../interfacelinalg__core_1_1mult__rz.html',1,'linalg_core']]] + ['mtx_5finverse_7',['mtx_inverse',['../interfacelinalg_1_1mtx__inverse.html',1,'linalg']]], + ['mtx_5fmult_8',['mtx_mult',['../interfacelinalg_1_1mtx__mult.html',1,'linalg']]], + ['mtx_5fpinverse_9',['mtx_pinverse',['../interfacelinalg_1_1mtx__pinverse.html',1,'linalg']]], + ['mtx_5frank_10',['mtx_rank',['../interfacelinalg_1_1mtx__rank.html',1,'linalg']]], + ['mult_5fqr_11',['mult_qr',['../interfacelinalg_1_1mult__qr.html',1,'linalg']]], + ['mult_5frz_12',['mult_rz',['../interfacelinalg_1_1mult__rz.html',1,'linalg']]] ]; diff --git a/doc/html/search/classes_6.js b/doc/html/search/classes_6.js index 2bc71d51..b1deebe6 100644 --- a/doc/html/search/classes_6.js +++ b/doc/html/search/classes_6.js @@ -1,7 +1,7 @@ var searchData= [ - ['qr_5ffactor_0',['qr_factor',['../interfacelinalg__core_1_1qr__factor.html',1,'linalg_core']]], - ['qr_5frank1_5fupdate_1',['qr_rank1_update',['../interfacelinalg__core_1_1qr__rank1__update.html',1,'linalg_core']]], + ['qr_5ffactor_0',['qr_factor',['../interfacelinalg_1_1qr__factor.html',1,'linalg']]], + ['qr_5frank1_5fupdate_1',['qr_rank1_update',['../interfacelinalg_1_1qr__rank1__update.html',1,'linalg']]], ['qr_5fresults_2',['qr_results',['../structlinalg__immutable_1_1qr__results.html',1,'linalg_immutable']]], ['qr_5fresults_5fcmplx_3',['qr_results_cmplx',['../structlinalg__immutable_1_1qr__results__cmplx.html',1,'linalg_immutable']]] ]; diff --git a/doc/html/search/classes_7.js b/doc/html/search/classes_7.js index ec47a635..686d365a 100644 --- a/doc/html/search/classes_7.js +++ b/doc/html/search/classes_7.js @@ -1,6 +1,6 @@ var searchData= [ - ['rank1_5fupdate_0',['rank1_update',['../interfacelinalg__core_1_1rank1__update.html',1,'linalg_core']]], - ['recip_5fmult_5farray_1',['recip_mult_array',['../interfacelinalg__core_1_1recip__mult__array.html',1,'linalg_core']]], - ['rz_5ffactor_2',['rz_factor',['../interfacelinalg__core_1_1rz__factor.html',1,'linalg_core']]] + ['rank1_5fupdate_0',['rank1_update',['../interfacelinalg_1_1rank1__update.html',1,'linalg']]], + ['recip_5fmult_5farray_1',['recip_mult_array',['../interfacelinalg_1_1recip__mult__array.html',1,'linalg']]], + ['rz_5ffactor_2',['rz_factor',['../interfacelinalg_1_1rz__factor.html',1,'linalg']]] ]; diff --git a/doc/html/search/classes_8.js b/doc/html/search/classes_8.js index 69551f42..c4a74011 100644 --- a/doc/html/search/classes_8.js +++ b/doc/html/search/classes_8.js @@ -1,15 +1,15 @@ var searchData= [ - ['solve_5fcholesky_0',['solve_cholesky',['../interfacelinalg__core_1_1solve__cholesky.html',1,'linalg_core']]], - ['solve_5fleast_5fsquares_1',['solve_least_squares',['../interfacelinalg__core_1_1solve__least__squares.html',1,'linalg_core']]], - ['solve_5fleast_5fsquares_5ffull_2',['solve_least_squares_full',['../interfacelinalg__core_1_1solve__least__squares__full.html',1,'linalg_core']]], - ['solve_5fleast_5fsquares_5fsvd_3',['solve_least_squares_svd',['../interfacelinalg__core_1_1solve__least__squares__svd.html',1,'linalg_core']]], - ['solve_5flu_4',['solve_lu',['../interfacelinalg__core_1_1solve__lu.html',1,'linalg_core']]], - ['solve_5fqr_5',['solve_qr',['../interfacelinalg__core_1_1solve__qr.html',1,'linalg_core']]], - ['solve_5ftriangular_5fsystem_6',['solve_triangular_system',['../interfacelinalg__core_1_1solve__triangular__system.html',1,'linalg_core']]], - ['sort_7',['sort',['../interfacelinalg__core_1_1sort.html',1,'linalg_core']]], - ['svd_8',['svd',['../interfacelinalg__core_1_1svd.html',1,'linalg_core']]], + ['solve_5fcholesky_0',['solve_cholesky',['../interfacelinalg_1_1solve__cholesky.html',1,'linalg']]], + ['solve_5fleast_5fsquares_1',['solve_least_squares',['../interfacelinalg_1_1solve__least__squares.html',1,'linalg']]], + ['solve_5fleast_5fsquares_5ffull_2',['solve_least_squares_full',['../interfacelinalg_1_1solve__least__squares__full.html',1,'linalg']]], + ['solve_5fleast_5fsquares_5fsvd_3',['solve_least_squares_svd',['../interfacelinalg_1_1solve__least__squares__svd.html',1,'linalg']]], + ['solve_5flu_4',['solve_lu',['../interfacelinalg_1_1solve__lu.html',1,'linalg']]], + ['solve_5fqr_5',['solve_qr',['../interfacelinalg_1_1solve__qr.html',1,'linalg']]], + ['solve_5ftriangular_5fsystem_6',['solve_triangular_system',['../interfacelinalg_1_1solve__triangular__system.html',1,'linalg']]], + ['sort_7',['sort',['../interfacelinalg_1_1sort.html',1,'linalg']]], + ['svd_8',['svd',['../interfacelinalg_1_1svd.html',1,'linalg']]], ['svd_5fresults_9',['svd_results',['../structlinalg__immutable_1_1svd__results.html',1,'linalg_immutable']]], ['svd_5fresults_5fcmplx_10',['svd_results_cmplx',['../structlinalg__immutable_1_1svd__results__cmplx.html',1,'linalg_immutable']]], - ['swap_11',['swap',['../interfacelinalg__core_1_1swap.html',1,'linalg_core']]] + ['swap_11',['swap',['../interfacelinalg_1_1swap.html',1,'linalg']]] ]; diff --git a/doc/html/search/classes_9.js b/doc/html/search/classes_9.js index 251dd1a8..90d19100 100644 --- a/doc/html/search/classes_9.js +++ b/doc/html/search/classes_9.js @@ -1,5 +1,5 @@ var searchData= [ - ['trace_0',['trace',['../interfacelinalg__core_1_1trace.html',1,'linalg_core']]], - ['tri_5fmtx_5fmult_1',['tri_mtx_mult',['../interfacelinalg__core_1_1tri__mtx__mult.html',1,'linalg_core']]] + ['trace_0',['trace',['../interfacelinalg_1_1trace.html',1,'linalg']]], + ['tri_5fmtx_5fmult_1',['tri_mtx_mult',['../interfacelinalg_1_1tri__mtx__mult.html',1,'linalg']]] ]; diff --git a/doc/html/search/functions_1.js b/doc/html/search/functions_1.js index b0c66b60..c5450b53 100644 --- a/doc/html/search/functions_1.js +++ b/doc/html/search/functions_1.js @@ -1,64 +1,13 @@ var searchData= [ - ['la_5fcholesky_5ffactor_0',['la_cholesky_factor',['../namespacelinalg__c__api.html#a99d3ac7f90cad0c643dd8abff6592032',1,'linalg_c_api']]], - ['la_5fcholesky_5ffactor_5fcmplx_1',['la_cholesky_factor_cmplx',['../namespacelinalg__c__api.html#a800b0d6ba6f8d812d8038dd06c0967a8',1,'linalg_c_api']]], - ['la_5fcholesky_5frank1_5fdowndate_2',['la_cholesky_rank1_downdate',['../namespacelinalg__c__api.html#a5b5758f439d34c765ff5285c21fa88c1',1,'linalg_c_api']]], - ['la_5fcholesky_5frank1_5fdowndate_5fcmplx_3',['la_cholesky_rank1_downdate_cmplx',['../namespacelinalg__c__api.html#a3232c643af8f8615961c4b1bab422a4a',1,'linalg_c_api']]], - ['la_5fcholesky_5frank1_5fupdate_4',['la_cholesky_rank1_update',['../namespacelinalg__c__api.html#ae5c0bda2e1ae3a4dbdaf6d0586247b4c',1,'linalg_c_api']]], - ['la_5fcholesky_5frank1_5fupdate_5fcmplx_5',['la_cholesky_rank1_update_cmplx',['../namespacelinalg__c__api.html#a5746e1736802b9a082057c7997325049',1,'linalg_c_api']]], - ['la_5fdet_6',['la_det',['../namespacelinalg__c__api.html#afd21b0e476168de7eb9a6a5ef3a2e8b4',1,'linalg_c_api']]], - ['la_5fdet_5fcmplx_7',['la_det_cmplx',['../namespacelinalg__c__api.html#a82fcbd45f4a92431587312560fbcc636',1,'linalg_c_api']]], - ['la_5fdiag_5fmtx_5fmult_8',['la_diag_mtx_mult',['../namespacelinalg__c__api.html#ae866f3e174aed82f3fdfa3483ac91333',1,'linalg_c_api']]], - ['la_5fdiag_5fmtx_5fmult_5fcmplx_9',['la_diag_mtx_mult_cmplx',['../namespacelinalg__c__api.html#a1af56ff742938c0be90fb34146b13365',1,'linalg_c_api']]], - ['la_5fdiag_5fmtx_5fmult_5fmixed_10',['la_diag_mtx_mult_mixed',['../namespacelinalg__c__api.html#adadfcde438cabd5b104b62f2541712d1',1,'linalg_c_api']]], - ['la_5feigen_5fasymm_11',['la_eigen_asymm',['../namespacelinalg__c__api.html#af2ed46a8b1285ac08f0f86162288a865',1,'linalg_c_api']]], - ['la_5feigen_5fcmplx_12',['la_eigen_cmplx',['../namespacelinalg__c__api.html#ab133f51c44eb244be0b6e966f5893259',1,'linalg_c_api']]], - ['la_5feigen_5fgen_13',['la_eigen_gen',['../namespacelinalg__c__api.html#a93920f1db884cbad9bfc335abe36bed4',1,'linalg_c_api']]], - ['la_5feigen_5fsymm_14',['la_eigen_symm',['../namespacelinalg__c__api.html#a63372e9678f7052d17c8676324d6e7a7',1,'linalg_c_api']]], - ['la_5fform_5flu_15',['la_form_lu',['../namespacelinalg__c__api.html#aeab30d9e07601b343f15bf03d8220044',1,'linalg_c_api']]], - ['la_5fform_5flu_5fcmplx_16',['la_form_lu_cmplx',['../namespacelinalg__c__api.html#ae9bcd3e2df3151a5d92da48973501f6b',1,'linalg_c_api']]], - ['la_5fform_5fqr_17',['la_form_qr',['../namespacelinalg__c__api.html#a9426f737c5d551a133f44e2d7cb98a1d',1,'linalg_c_api']]], - ['la_5fform_5fqr_5fcmplx_18',['la_form_qr_cmplx',['../namespacelinalg__c__api.html#a9be60e86103e09be4d19fd3728f5d64b',1,'linalg_c_api']]], - ['la_5fform_5fqr_5fcmplx_5fpvt_19',['la_form_qr_cmplx_pvt',['../namespacelinalg__c__api.html#a5146fcf6552a097e05d46afaf91f424e',1,'linalg_c_api']]], - ['la_5fform_5fqr_5fpvt_20',['la_form_qr_pvt',['../namespacelinalg__c__api.html#a69d0ec69152e04fc5f766dd7c6d23f98',1,'linalg_c_api']]], - ['la_5finverse_21',['la_inverse',['../namespacelinalg__c__api.html#a307a6d5e27d90b28a38fba8c02e14461',1,'linalg_c_api']]], - ['la_5finverse_5fcmplx_22',['la_inverse_cmplx',['../namespacelinalg__c__api.html#a715855159abe740aff7bf95303a3f715',1,'linalg_c_api']]], - ['la_5flu_5ffactor_23',['la_lu_factor',['../namespacelinalg__c__api.html#a3e91c088c8d173e9b12c17b1ebc9bfa4',1,'linalg_c_api']]], - ['la_5flu_5ffactor_5fcmplx_24',['la_lu_factor_cmplx',['../namespacelinalg__c__api.html#a1788fe3192429b2cfd3a169d879a6f0e',1,'linalg_c_api']]], - ['la_5fmtx_5fmult_25',['la_mtx_mult',['../namespacelinalg__c__api.html#a434338a38a5fde94d8df3119b169fd01',1,'linalg_c_api']]], - ['la_5fmtx_5fmult_5fcmplx_26',['la_mtx_mult_cmplx',['../namespacelinalg__c__api.html#abdc93ffffffefdef839370da19f01430',1,'linalg_c_api']]], - ['la_5fmult_5fqr_27',['la_mult_qr',['../namespacelinalg__c__api.html#a2604ade114e67587300b3916846fc961',1,'linalg_c_api']]], - ['la_5fmult_5fqr_5fcmplx_28',['la_mult_qr_cmplx',['../namespacelinalg__c__api.html#a4b8c42819e069a18ec39c5ebb9ef8703',1,'linalg_c_api']]], - ['la_5fpinverse_29',['la_pinverse',['../namespacelinalg__c__api.html#a39bb26dcab43d8f54471af87af69e606',1,'linalg_c_api']]], - ['la_5fpinverse_5fcmplx_30',['la_pinverse_cmplx',['../namespacelinalg__c__api.html#ad0eefe5cf5a74d6848bbde0e8bb22550',1,'linalg_c_api']]], - ['la_5fqr_5ffactor_31',['la_qr_factor',['../namespacelinalg__c__api.html#a2c896885507a331ad89e579868da0fd3',1,'linalg_c_api']]], - ['la_5fqr_5ffactor_5fcmplx_32',['la_qr_factor_cmplx',['../namespacelinalg__c__api.html#a13a75b6d7bce1788b5e286a879456347',1,'linalg_c_api']]], - ['la_5fqr_5ffactor_5fcmplx_5fpvt_33',['la_qr_factor_cmplx_pvt',['../namespacelinalg__c__api.html#aa7bc80d9671a82aafdfc9a8ab904cb22',1,'linalg_c_api']]], - ['la_5fqr_5ffactor_5fpvt_34',['la_qr_factor_pvt',['../namespacelinalg__c__api.html#a9868095d332ba323afce1cda4085dd8c',1,'linalg_c_api']]], - ['la_5fqr_5frank1_5fupdate_35',['la_qr_rank1_update',['../namespacelinalg__c__api.html#a056fb14e92f98c660573886c0ad940ff',1,'linalg_c_api']]], - ['la_5fqr_5frank1_5fupdate_5fcmplx_36',['la_qr_rank1_update_cmplx',['../namespacelinalg__c__api.html#a01cf2129d7af3ddc8fb6e1fff7786ff1',1,'linalg_c_api']]], - ['la_5frank_37',['la_rank',['../namespacelinalg__c__api.html#a32548b9eb091164d51ed3793afee83e9',1,'linalg_c_api']]], - ['la_5frank1_5fupdate_38',['la_rank1_update',['../namespacelinalg__c__api.html#a6e47b549d59377db83a0eb27d739df8d',1,'linalg_c_api']]], - ['la_5frank1_5fupdate_5fcmplx_39',['la_rank1_update_cmplx',['../namespacelinalg__c__api.html#ac46bdb1315742f700571bf4f7c705ffd',1,'linalg_c_api']]], - ['la_5frank_5fcmplx_40',['la_rank_cmplx',['../namespacelinalg__c__api.html#a60244c1c8ef1ac3217a9efa69fdbd229',1,'linalg_c_api']]], - ['la_5fsolve_5fcholesky_41',['la_solve_cholesky',['../namespacelinalg__c__api.html#ac286fe9a7ed4d69ca30ecbe03959f209',1,'linalg_c_api']]], - ['la_5fsolve_5fcholesky_5fcmplx_42',['la_solve_cholesky_cmplx',['../namespacelinalg__c__api.html#a83a08022c84ac2e76f7d20486797bd33',1,'linalg_c_api']]], - ['la_5fsolve_5fleast_5fsquares_43',['la_solve_least_squares',['../namespacelinalg__c__api.html#af1d700238a8ab71b17ff8c15221a9e02',1,'linalg_c_api']]], - ['la_5fsolve_5fleast_5fsquares_5fcmplx_44',['la_solve_least_squares_cmplx',['../namespacelinalg__c__api.html#a2c691c114d54a8eb89ce2882d0557550',1,'linalg_c_api']]], - ['la_5fsolve_5flu_45',['la_solve_lu',['../namespacelinalg__c__api.html#a846baffbc77d4348d7b15d3f83983a04',1,'linalg_c_api']]], - ['la_5fsolve_5flu_5fcmplx_46',['la_solve_lu_cmplx',['../namespacelinalg__c__api.html#aae9625f2ff12a73b6007b429132a1531',1,'linalg_c_api']]], - ['la_5fsolve_5fqr_47',['la_solve_qr',['../namespacelinalg__c__api.html#a13ed5d138ff59a9f649babc5c1dd9eab',1,'linalg_c_api']]], - ['la_5fsolve_5fqr_5fcmplx_48',['la_solve_qr_cmplx',['../namespacelinalg__c__api.html#ad05206b75a9cd1c5a2bda147307ef2d5',1,'linalg_c_api']]], - ['la_5fsolve_5fqr_5fcmplx_5fpvt_49',['la_solve_qr_cmplx_pvt',['../namespacelinalg__c__api.html#a17bfa880bc9019cbd654d20cab263ce3',1,'linalg_c_api']]], - ['la_5fsolve_5fqr_5fpvt_50',['la_solve_qr_pvt',['../namespacelinalg__c__api.html#a0d12474b0ca7772e4ad4ebc7ce227315',1,'linalg_c_api']]], - ['la_5fsolve_5ftri_5fmtx_51',['la_solve_tri_mtx',['../namespacelinalg__c__api.html#a7a72759b932b32e346a70cec542557ff',1,'linalg_c_api']]], - ['la_5fsolve_5ftri_5fmtx_5fcmplx_52',['la_solve_tri_mtx_cmplx',['../namespacelinalg__c__api.html#a7a8e491e75d2d00911d0992b37aac43d',1,'linalg_c_api']]], - ['la_5fsort_5feigen_53',['la_sort_eigen',['../namespacelinalg__c__api.html#ab81f25f6835feac7a88250c9863a4120',1,'linalg_c_api']]], - ['la_5fsort_5feigen_5fcmplx_54',['la_sort_eigen_cmplx',['../namespacelinalg__c__api.html#a2a0c8ddfd134f3d57849925d359d53b2',1,'linalg_c_api']]], - ['la_5fsvd_55',['la_svd',['../namespacelinalg__c__api.html#a436b645816859aea4a8fbd55e733ab92',1,'linalg_c_api']]], - ['la_5fsvd_5fcmplx_56',['la_svd_cmplx',['../namespacelinalg__c__api.html#a45eeb38b8a0d572fc25a7db98690f705',1,'linalg_c_api']]], - ['la_5ftrace_57',['la_trace',['../namespacelinalg__c__api.html#af8627c89c2201ae47c9cfac1d65abfd4',1,'linalg_c_api']]], - ['la_5ftrace_5fcmplx_58',['la_trace_cmplx',['../namespacelinalg__c__api.html#a315ef452fe9f00baa454dc930813fedc',1,'linalg_c_api']]], - ['la_5ftri_5fmtx_5fmult_59',['la_tri_mtx_mult',['../namespacelinalg__c__api.html#a754866d88e140dbf618c1d85f016c633',1,'linalg_c_api']]], - ['la_5ftri_5fmtx_5fmult_5fcmplx_60',['la_tri_mtx_mult_cmplx',['../namespacelinalg__c__api.html#aeb63de65aa9a9bc040860b8f78dcd3fa',1,'linalg_c_api']]] + ['mat_5fcholesky_0',['mat_cholesky',['../namespacelinalg__immutable.html#a5876e7f21f20679fd6c0c84768061a30',1,'linalg_immutable']]], + ['mat_5fcholesky_5frank1_5fdowndate_1',['mat_cholesky_rank1_downdate',['../namespacelinalg__immutable.html#afb844327cadfdd08580c94cb1668c2a8',1,'linalg_immutable']]], + ['mat_5fcholesky_5frank1_5fupdate_2',['mat_cholesky_rank1_update',['../namespacelinalg__immutable.html#a83eaeadc3a3cc5d81c46824174e5a90b',1,'linalg_immutable']]], + ['mat_5fdet_3',['mat_det',['../namespacelinalg__immutable.html#ab7abd8e3fd4170b5b5dfad4448a651c9',1,'linalg_immutable']]], + ['mat_5finverse_4',['mat_inverse',['../namespacelinalg__immutable.html#a98f5b4e5de682d686cb763ab60fcde7f',1,'linalg_immutable']]], + ['mat_5fpinverse_5',['mat_pinverse',['../namespacelinalg__immutable.html#aaf39795f72fad79a38213893b850d793',1,'linalg_immutable']]], + ['mat_5fqr_6',['mat_qr',['../namespacelinalg__immutable.html#a8f1ba0ce9f8fbece16a512145bbc197f',1,'linalg_immutable']]], + ['mat_5fqr_5frank1_5fupdate_7',['mat_qr_rank1_update',['../namespacelinalg__immutable.html#a4b09077ad1495833919bab84b144b297',1,'linalg_immutable']]], + ['mat_5frank1_5fupdate_8',['mat_rank1_update',['../namespacelinalg__immutable.html#a9648fd41cc3ce8ec40f67236d274f9a8',1,'linalg_immutable']]], + ['mat_5fsvd_9',['mat_svd',['../namespacelinalg__immutable.html#a6236acadb527f7762e3e1c0ee3d9ca82',1,'linalg_immutable']]] ]; diff --git a/doc/html/search/namespaces_0.js b/doc/html/search/namespaces_0.js index ecf60b9d..02ed74d3 100644 --- a/doc/html/search/namespaces_0.js +++ b/doc/html/search/namespaces_0.js @@ -1,7 +1,5 @@ var searchData= [ - ['linalg_5fc_5fapi_0',['linalg_c_api',['../namespacelinalg__c__api.html',1,'']]], - ['linalg_5fconstants_1',['linalg_constants',['../namespacelinalg__constants.html',1,'']]], - ['linalg_5fcore_2',['linalg_core',['../namespacelinalg__core.html',1,'']]], - ['linalg_5fimmutable_3',['linalg_immutable',['../namespacelinalg__immutable.html',1,'']]] + ['linalg_0',['linalg',['../namespacelinalg.html',1,'']]], + ['linalg_5fimmutable_1',['linalg_immutable',['../namespacelinalg__immutable.html',1,'']]] ]; diff --git a/doc/html/search/searchdata.js b/doc/html/search/searchdata.js index 039d951d..89be3c58 100644 --- a/doc/html/search/searchdata.js +++ b/doc/html/search/searchdata.js @@ -1,10 +1,10 @@ var indexSectionsWithContent = { - 0: "cdefhilmnpqrstuv", + 0: "cdefilmpqrstuv", 1: "cdeflmqrst", 2: "l", - 3: "ilm", - 4: "hlnpqrstuv", + 3: "im", + 4: "lpqrsuv", 5: "l" }; diff --git a/doc/html/search/variables_0.js b/doc/html/search/variables_0.js index fea70413..0f1b0ab5 100644 --- a/doc/html/search/variables_0.js +++ b/doc/html/search/variables_0.js @@ -1,4 +1,15 @@ var searchData= [ - ['hermitian_5ftranspose_0',['hermitian_transpose',['../namespacelinalg__constants.html#a389e35467a5a18f90927d28fb12ddf70',1,'linalg_constants']]] + ['l_0',['l',['../structlinalg__immutable_1_1lu__results.html#a7a11c264a8858527ebc021e609600cbb',1,'linalg_immutable::lu_results::l()'],['../structlinalg__immutable_1_1lu__results__cmplx.html#a0634e363082d3c94fab5d5c73755f4ae',1,'linalg_immutable::lu_results_cmplx::l()']]], + ['la_5farray_5fsize_5ferror_1',['la_array_size_error',['../namespacelinalg.html#a7974856c0c0c76e6f1f2098a1eb7eac9',1,'linalg']]], + ['la_5fconvergence_5ferror_2',['la_convergence_error',['../namespacelinalg.html#ac691dea40873ac2a70c8b44c933774a7',1,'linalg']]], + ['la_5fhermitian_5ftranspose_3',['la_hermitian_transpose',['../namespacelinalg.html#a0e420096028b759a87f2f4f4306d202a',1,'linalg']]], + ['la_5finvalid_5finput_5ferror_4',['la_invalid_input_error',['../namespacelinalg.html#ace738355659bce2e9591473f0d543ef7',1,'linalg']]], + ['la_5finvalid_5foperation_5ferror_5',['la_invalid_operation_error',['../namespacelinalg.html#a4f47021e96cd813b568422a2eb3821bc',1,'linalg']]], + ['la_5fmatrix_5fformat_5ferror_6',['la_matrix_format_error',['../namespacelinalg.html#ad89b9d502b7c484df53f9b10b9545776',1,'linalg']]], + ['la_5fno_5ferror_7',['la_no_error',['../namespacelinalg.html#aefdfc0979567e89aa3b8c599d3f766f4',1,'linalg']]], + ['la_5fno_5foperation_8',['la_no_operation',['../namespacelinalg.html#a665d131453840e869510e9e8d2f7f151',1,'linalg']]], + ['la_5fout_5fof_5fmemory_5ferror_9',['la_out_of_memory_error',['../namespacelinalg.html#abfb78ba61c0c2751f1c771c984469006',1,'linalg']]], + ['la_5fsingular_5fmatrix_5ferror_10',['la_singular_matrix_error',['../namespacelinalg.html#af5dc9d60151bb81436b442525871c8c9',1,'linalg']]], + ['la_5ftranspose_11',['la_transpose',['../namespacelinalg.html#a2b842a1fb17710d7ec2f117f5fdb2a59',1,'linalg']]] ]; diff --git a/doc/html/search/variables_1.js b/doc/html/search/variables_1.js index e3b562d6..f0e2a425 100644 --- a/doc/html/search/variables_1.js +++ b/doc/html/search/variables_1.js @@ -1,12 +1,4 @@ var searchData= [ - ['l_0',['l',['../structlinalg__immutable_1_1lu__results.html#a7a11c264a8858527ebc021e609600cbb',1,'linalg_immutable::lu_results::l()'],['../structlinalg__immutable_1_1lu__results__cmplx.html#a0634e363082d3c94fab5d5c73755f4ae',1,'linalg_immutable::lu_results_cmplx::l()']]], - ['la_5farray_5fsize_5ferror_1',['la_array_size_error',['../namespacelinalg__constants.html#aee0ebff93d8751cc57a3e8e5965b1344',1,'linalg_constants']]], - ['la_5fconvergence_5ferror_2',['la_convergence_error',['../namespacelinalg__constants.html#a39da5de4ea671010ee5f1e358c991cee',1,'linalg_constants']]], - ['la_5finvalid_5finput_5ferror_3',['la_invalid_input_error',['../namespacelinalg__constants.html#ac7d8bace23640b21a6d8a960371eb732',1,'linalg_constants']]], - ['la_5finvalid_5foperation_5ferror_4',['la_invalid_operation_error',['../namespacelinalg__constants.html#aaafde862f4d348fecccdccc695e25622',1,'linalg_constants']]], - ['la_5fmatrix_5fformat_5ferror_5',['la_matrix_format_error',['../namespacelinalg__constants.html#a252c96a6e7c24b40bf7ef96063824f01',1,'linalg_constants']]], - ['la_5fno_5ferror_6',['la_no_error',['../namespacelinalg__constants.html#ad4b52ca61ccf1199dead23faa80b9ac7',1,'linalg_constants']]], - ['la_5fout_5fof_5fmemory_5ferror_7',['la_out_of_memory_error',['../namespacelinalg__constants.html#a8d5820c41090117b508a033309ad0870',1,'linalg_constants']]], - ['la_5fsingular_5fmatrix_5ferror_8',['la_singular_matrix_error',['../namespacelinalg__constants.html#a6607d2d2ac92fe5d902527519279e646',1,'linalg_constants']]] + ['p_0',['p',['../structlinalg__immutable_1_1lu__results.html#ae1e1fd78123e04a2be4f1bfd25ddddb1',1,'linalg_immutable::lu_results::p()'],['../structlinalg__immutable_1_1lu__results__cmplx.html#a99d03bc910361aab08d17fcc4aaa960d',1,'linalg_immutable::lu_results_cmplx::p()'],['../structlinalg__immutable_1_1qr__results.html#a053899b9dffba08b5052544c13d4983c',1,'linalg_immutable::qr_results::p()'],['../structlinalg__immutable_1_1qr__results__cmplx.html#a782d54320ca646427702d5f2e0a9372f',1,'linalg_immutable::qr_results_cmplx::p()']]] ]; diff --git a/doc/html/search/variables_2.js b/doc/html/search/variables_2.js index 1511857c..4201d28a 100644 --- a/doc/html/search/variables_2.js +++ b/doc/html/search/variables_2.js @@ -1,4 +1,4 @@ var searchData= [ - ['no_5foperation_0',['no_operation',['../namespacelinalg__constants.html#abf9e3b763502c2b0af0cbf48b14c918f',1,'linalg_constants']]] + ['q_0',['q',['../structlinalg__immutable_1_1qr__results.html#a91547ec8def57c0cc59271ccf59b3a01',1,'linalg_immutable::qr_results::q()'],['../structlinalg__immutable_1_1qr__results__cmplx.html#a7fa839ced2d020c61550d5b6cff9bb69',1,'linalg_immutable::qr_results_cmplx::q()']]] ]; diff --git a/doc/html/search/variables_3.js b/doc/html/search/variables_3.js index f0e2a425..30a4e410 100644 --- a/doc/html/search/variables_3.js +++ b/doc/html/search/variables_3.js @@ -1,4 +1,4 @@ var searchData= [ - ['p_0',['p',['../structlinalg__immutable_1_1lu__results.html#ae1e1fd78123e04a2be4f1bfd25ddddb1',1,'linalg_immutable::lu_results::p()'],['../structlinalg__immutable_1_1lu__results__cmplx.html#a99d03bc910361aab08d17fcc4aaa960d',1,'linalg_immutable::lu_results_cmplx::p()'],['../structlinalg__immutable_1_1qr__results.html#a053899b9dffba08b5052544c13d4983c',1,'linalg_immutable::qr_results::p()'],['../structlinalg__immutable_1_1qr__results__cmplx.html#a782d54320ca646427702d5f2e0a9372f',1,'linalg_immutable::qr_results_cmplx::p()']]] + ['r_0',['r',['../structlinalg__immutable_1_1qr__results.html#aeeea31b1fad256f5fcc2462b2990d56b',1,'linalg_immutable::qr_results::r()'],['../structlinalg__immutable_1_1qr__results__cmplx.html#a9382745395a25db425c5de89c33df2cd',1,'linalg_immutable::qr_results_cmplx::r()']]] ]; diff --git a/doc/html/search/variables_4.js b/doc/html/search/variables_4.js index 4201d28a..2a4689c8 100644 --- a/doc/html/search/variables_4.js +++ b/doc/html/search/variables_4.js @@ -1,4 +1,4 @@ var searchData= [ - ['q_0',['q',['../structlinalg__immutable_1_1qr__results.html#a91547ec8def57c0cc59271ccf59b3a01',1,'linalg_immutable::qr_results::q()'],['../structlinalg__immutable_1_1qr__results__cmplx.html#a7fa839ced2d020c61550d5b6cff9bb69',1,'linalg_immutable::qr_results_cmplx::q()']]] + ['s_0',['s',['../structlinalg__immutable_1_1svd__results.html#acbc05e1d170351bbfcd4cd1f089c81d8',1,'linalg_immutable::svd_results::s()'],['../structlinalg__immutable_1_1svd__results__cmplx.html#a66544dafaacf2b5465e6b1c55d804fff',1,'linalg_immutable::svd_results_cmplx::s()']]] ]; diff --git a/doc/html/search/variables_5.js b/doc/html/search/variables_5.js index 30a4e410..a5b8bb0e 100644 --- a/doc/html/search/variables_5.js +++ b/doc/html/search/variables_5.js @@ -1,4 +1,4 @@ var searchData= [ - ['r_0',['r',['../structlinalg__immutable_1_1qr__results.html#aeeea31b1fad256f5fcc2462b2990d56b',1,'linalg_immutable::qr_results::r()'],['../structlinalg__immutable_1_1qr__results__cmplx.html#a9382745395a25db425c5de89c33df2cd',1,'linalg_immutable::qr_results_cmplx::r()']]] + ['u_0',['u',['../structlinalg__immutable_1_1lu__results.html#ab1af96c7808037f63563e1bf912c4dad',1,'linalg_immutable::lu_results::u()'],['../structlinalg__immutable_1_1lu__results__cmplx.html#a7488afe2004b11c8fed4c517400fde98',1,'linalg_immutable::lu_results_cmplx::u()'],['../structlinalg__immutable_1_1svd__results.html#a582822c9765048fcb8632d72a6ed506a',1,'linalg_immutable::svd_results::u()'],['../structlinalg__immutable_1_1svd__results__cmplx.html#ae65cfdf6d19c3bbb3a7e425db266cb3c',1,'linalg_immutable::svd_results_cmplx::u()']]] ]; diff --git a/doc/html/search/variables_6.js b/doc/html/search/variables_6.js index 2a4689c8..760107f9 100644 --- a/doc/html/search/variables_6.js +++ b/doc/html/search/variables_6.js @@ -1,4 +1,6 @@ var searchData= [ - ['s_0',['s',['../structlinalg__immutable_1_1svd__results.html#acbc05e1d170351bbfcd4cd1f089c81d8',1,'linalg_immutable::svd_results::s()'],['../structlinalg__immutable_1_1svd__results__cmplx.html#a66544dafaacf2b5465e6b1c55d804fff',1,'linalg_immutable::svd_results_cmplx::s()']]] + ['values_0',['values',['../structlinalg__immutable_1_1eigen__results.html#abb60901ab160c6fd232cfb46ed0bf3cc',1,'linalg_immutable::eigen_results']]], + ['vectors_1',['vectors',['../structlinalg__immutable_1_1eigen__results.html#a982607b9c3ff93504bb4524dcd31a442',1,'linalg_immutable::eigen_results']]], + ['vt_2',['vt',['../structlinalg__immutable_1_1svd__results.html#af5c35f3392431179a5cb15d1cddf7cb1',1,'linalg_immutable::svd_results::vt()'],['../structlinalg__immutable_1_1svd__results__cmplx.html#af9e74638b38510fb24de3f3a6ea30de8',1,'linalg_immutable::svd_results_cmplx::vt()']]] ]; diff --git a/doc/html/structlinalg__immutable_1_1eigen__results.html b/doc/html/structlinalg__immutable_1_1eigen__results.html index 5efd2485..35cf3ed6 100644 --- a/doc/html/structlinalg__immutable_1_1eigen__results.html +++ b/doc/html/structlinalg__immutable_1_1eigen__results.html @@ -119,7 +119,7 @@

    Detailed Description

    Defines a container for the output of an Eigen analysis of a square matrix.

    -

    Definition at line 187 of file linalg_immutable.f90.

    +

    Definition at line 186 of file linalg_immutable.f90.

    Member Data Documentation

    ◆ values

    @@ -135,7 +135,7 @@

    Definition at line 189 of file linalg_immutable.f90.

    +

    Definition at line 188 of file linalg_immutable.f90.

    @@ -153,7 +153,7 @@

    Definition at line 192 of file linalg_immutable.f90.

    +

    Definition at line 191 of file linalg_immutable.f90.

    diff --git a/doc/html/structlinalg__immutable_1_1lu__results.html b/doc/html/structlinalg__immutable_1_1lu__results.html index 6ab6a505..99cecb13 100644 --- a/doc/html/structlinalg__immutable_1_1lu__results.html +++ b/doc/html/structlinalg__immutable_1_1lu__results.html @@ -122,7 +122,7 @@

    Detailed Description

    Defines a container for the output of an LU factorization.

    -

    Definition at line 116 of file linalg_immutable.f90.

    +

    Definition at line 115 of file linalg_immutable.f90.

    Member Data Documentation

    ◆ l

    @@ -138,7 +138,7 @@

    Definition at line 118 of file linalg_immutable.f90.

    +

    Definition at line 117 of file linalg_immutable.f90.

    @@ -156,7 +156,7 @@

    Definition at line 122 of file linalg_immutable.f90.

    +

    Definition at line 121 of file linalg_immutable.f90.

    @@ -174,7 +174,7 @@

    Definition at line 120 of file linalg_immutable.f90.

    +

    Definition at line 119 of file linalg_immutable.f90.

    diff --git a/doc/html/structlinalg__immutable_1_1lu__results__cmplx.html b/doc/html/structlinalg__immutable_1_1lu__results__cmplx.html index 0dbbfbca..cae65370 100644 --- a/doc/html/structlinalg__immutable_1_1lu__results__cmplx.html +++ b/doc/html/structlinalg__immutable_1_1lu__results__cmplx.html @@ -122,7 +122,7 @@

    Detailed Description

    Defines a container for the output of an LU factorization.

    -

    Definition at line 127 of file linalg_immutable.f90.

    +

    Definition at line 126 of file linalg_immutable.f90.

    Member Data Documentation

    ◆ l

    @@ -138,7 +138,7 @@

    Definition at line 129 of file linalg_immutable.f90.

    +

    Definition at line 128 of file linalg_immutable.f90.

    @@ -156,7 +156,7 @@

    Definition at line 133 of file linalg_immutable.f90.

    +

    Definition at line 132 of file linalg_immutable.f90.

    @@ -174,7 +174,7 @@

    Definition at line 131 of file linalg_immutable.f90.

    +

    Definition at line 130 of file linalg_immutable.f90.

    diff --git a/doc/html/structlinalg__immutable_1_1qr__results.html b/doc/html/structlinalg__immutable_1_1qr__results.html index fb5ad841..d6ceb0d6 100644 --- a/doc/html/structlinalg__immutable_1_1qr__results.html +++ b/doc/html/structlinalg__immutable_1_1qr__results.html @@ -122,7 +122,7 @@

    Detailed Description

    Defines a container for the output of a QR factorization.

    -

    Definition at line 138 of file linalg_immutable.f90.

    +

    Definition at line 137 of file linalg_immutable.f90.

    Member Data Documentation

    ◆ p

    @@ -138,7 +138,7 @@

    Definition at line 145 of file linalg_immutable.f90.

    +

    Definition at line 144 of file linalg_immutable.f90.

    @@ -156,7 +156,7 @@

    Definition at line 140 of file linalg_immutable.f90.

    +

    Definition at line 139 of file linalg_immutable.f90.

    @@ -174,7 +174,7 @@

    Definition at line 142 of file linalg_immutable.f90.

    +

    Definition at line 141 of file linalg_immutable.f90.

    diff --git a/doc/html/structlinalg__immutable_1_1qr__results__cmplx.html b/doc/html/structlinalg__immutable_1_1qr__results__cmplx.html index 434f3148..3199aed2 100644 --- a/doc/html/structlinalg__immutable_1_1qr__results__cmplx.html +++ b/doc/html/structlinalg__immutable_1_1qr__results__cmplx.html @@ -122,7 +122,7 @@

    Detailed Description

    Defines a container for the output of a QR factorization.

    -

    Definition at line 150 of file linalg_immutable.f90.

    +

    Definition at line 149 of file linalg_immutable.f90.

    Member Data Documentation

    ◆ p

    @@ -138,7 +138,7 @@

    Definition at line 157 of file linalg_immutable.f90.

    +

    Definition at line 156 of file linalg_immutable.f90.

    @@ -156,7 +156,7 @@

    Definition at line 152 of file linalg_immutable.f90.

    +

    Definition at line 151 of file linalg_immutable.f90.

    @@ -174,7 +174,7 @@

    Definition at line 154 of file linalg_immutable.f90.

    +

    Definition at line 153 of file linalg_immutable.f90.

    diff --git a/doc/html/structlinalg__immutable_1_1svd__results.html b/doc/html/structlinalg__immutable_1_1svd__results.html index 9ce241f0..18d82e0b 100644 --- a/doc/html/structlinalg__immutable_1_1svd__results.html +++ b/doc/html/structlinalg__immutable_1_1svd__results.html @@ -122,7 +122,7 @@

    Detailed Description

    Defines a container for the output of a singular value decomposition of a matrix.

    -

    Definition at line 163 of file linalg_immutable.f90.

    +

    Definition at line 162 of file linalg_immutable.f90.

    Member Data Documentation

    ◆ s

    @@ -138,7 +138,7 @@

    Definition at line 167 of file linalg_immutable.f90.

    +

    Definition at line 166 of file linalg_immutable.f90.

    @@ -156,7 +156,7 @@

    Definition at line 165 of file linalg_immutable.f90.

    +

    Definition at line 164 of file linalg_immutable.f90.

    @@ -174,7 +174,7 @@

    Definition at line 169 of file linalg_immutable.f90.

    +

    Definition at line 168 of file linalg_immutable.f90.

    diff --git a/doc/html/structlinalg__immutable_1_1svd__results__cmplx.html b/doc/html/structlinalg__immutable_1_1svd__results__cmplx.html index d1142499..ea20918b 100644 --- a/doc/html/structlinalg__immutable_1_1svd__results__cmplx.html +++ b/doc/html/structlinalg__immutable_1_1svd__results__cmplx.html @@ -122,7 +122,7 @@

    Detailed Description

    Defines a container for the output of a singular value decomposition of a matrix.

    -

    Definition at line 175 of file linalg_immutable.f90.

    +

    Definition at line 174 of file linalg_immutable.f90.

    Member Data Documentation

    ◆ s

    @@ -138,7 +138,7 @@

    Definition at line 179 of file linalg_immutable.f90.

    +

    Definition at line 178 of file linalg_immutable.f90.

    @@ -156,7 +156,7 @@

    Definition at line 177 of file linalg_immutable.f90.

    +

    Definition at line 176 of file linalg_immutable.f90.

    @@ -174,7 +174,7 @@

    Definition at line 181 of file linalg_immutable.f90.

    +

    Definition at line 180 of file linalg_immutable.f90.

    From 0cb41525a3a49a8ae4aa898fde5493a620947e8d Mon Sep 17 00:00:00 2001 From: jchristopherson Date: Fri, 16 Dec 2022 05:48:00 -0600 Subject: [PATCH 25/65] Remove immutable API as redundant --- src/CMakeLists.txt | 1 - src/linalg_immutable.f90 | 1031 -------------------------------------- tests/CMakeLists.txt | 1 - tests/linalg_test.f90 | 29 -- tests/test_immutable.f90 | 249 --------- 5 files changed, 1311 deletions(-) delete mode 100644 src/linalg_immutable.f90 delete mode 100644 tests/test_immutable.f90 diff --git a/src/CMakeLists.txt b/src/CMakeLists.txt index 6b023aaf..681638c0 100644 --- a/src/CMakeLists.txt +++ b/src/CMakeLists.txt @@ -87,7 +87,6 @@ set(LINALG_SOURCES ${dir}/linalg_solve.f90 ${dir}/linalg_sorting.f90 ${dir}/linalg_basic.f90 - ${dir}/linalg_immutable.f90 ${dir}/linalg_c_api.f90 ) list(APPEND LINALG_SOURCES ${qrupdate_sources}) diff --git a/src/linalg_immutable.f90 b/src/linalg_immutable.f90 deleted file mode 100644 index d2f80f33..00000000 --- a/src/linalg_immutable.f90 +++ /dev/null @@ -1,1031 +0,0 @@ -! linalg_immutable.f90 - -!> @brief Provides an immutable interface to many of the core linear algebra routines -!! in this library. The intent is to allow for ease of use in situations -!! where memory allocation, or absolute speed are of lesser importance to code -!! readability. -!! -!! @par -!! Routines in this module do not provide an error handling interface. Any -!! errors encountered will result in an error message printed to the prompt, -!! the generation (or appending to) an error file, and termination of the -!! program. Notice, warning situations will be handled similarily, but without -!! termination of the program. -module linalg_immutable - use, intrinsic :: iso_fortran_env, only : int32, real64 - use linalg - implicit none - private - public :: mat_rank1_update - public :: mat_mult_diag - public :: mat_mult_upper_tri - public :: mat_mult_lower_tri - public :: mat_det - public :: mat_lu - public :: mat_qr - public :: mat_qr_rank1_update - public :: mat_svd - public :: mat_cholesky - public :: mat_cholesky_rank1_update - public :: mat_cholesky_rank1_downdate - public :: mat_inverse - public :: mat_pinverse - public :: mat_solve_upper_tri - public :: mat_solve_lower_tri - public :: mat_eigen - public :: lu_results - public :: lu_results_cmplx - public :: qr_results - public :: qr_results_cmplx - public :: svd_results - public :: svd_results_cmplx - public :: eigen_results - public :: identity - -! ------------------------------------------------------------------------------ - !> @brief Computes the matrix operation: C = A * B, where A is a - !! diagonal matrix. - interface mat_mult_diag - module procedure :: mat_mult_diag_1 - module procedure :: mat_mult_diag_2 - module procedure :: mat_mult_diag_3 - module procedure :: mat_mult_diag_1_cmplx - module procedure :: mat_mult_diag_2_cmplx - module procedure :: mat_mult_diag_3_cmplx - end interface - -! ------------------------------------------------------------------------------ - !> @brief Computes the matrix operation C = A * B, where A is an upper - !! triangular matrix. - interface mat_mult_upper_tri - module procedure :: mat_mult_upper_tri_1 - module procedure :: mat_mult_upper_tri_2 - module procedure :: mat_mult_upper_tri_1_cmplx - module procedure :: mat_mult_upper_tri_2_cmplx - end interface - -! ------------------------------------------------------------------------------ - !> @brief Computes the matrix operation C = A * B, where A is a lower - !! triangular matrix. - interface mat_mult_lower_tri - module procedure :: mat_mult_lower_tri_1 - module procedure :: mat_mult_lower_tri_2 - module procedure :: mat_mult_lower_tri_1_cmplx - module procedure :: mat_mult_lower_tri_2_cmplx - end interface - -! ------------------------------------------------------------------------------ - !> @brief Solves the upper triangular system A X = B, where A is an - !! upper triangular matrix. - interface mat_solve_upper_tri - module procedure :: mat_solve_upper_tri_1 - module procedure :: mat_solve_upper_tri_2 - module procedure :: mat_solve_upper_tri_1_cmplx - module procedure :: mat_solve_upper_tri_2_cmplx - end interface - -! ------------------------------------------------------------------------------ - !> @brief Solves the lower triangular system A X = B, where A is a - !! lower triangular matrix. - interface mat_solve_lower_tri - module procedure :: mat_solve_lower_tri_1 - module procedure :: mat_solve_lower_tri_2 - module procedure :: mat_solve_lower_tri_1_cmplx - module procedure :: mat_solve_lower_tri_2_cmplx - end interface - -! ------------------------------------------------------------------------------ - !> @brief Computes the LU factorization of a square matrix. Notice, - !! partial row pivoting is utilized. - interface mat_lu - module procedure :: mat_lu_dbl - module procedure :: mat_lu_cmplx - end interface - -! ------------------------------------------------------------------------------ - !> @brief Computes the eigenvalues and eigenvectors (right) of a general - !! N-by-N matrix. - interface mat_eigen - module procedure :: mat_eigen_1 - module procedure :: mat_eigen_2 - end interface - -! ------------------------------------------------------------------------------ - !> @brief Defines a container for the output of an LU factorization. - type lu_results - !> The lower triangular matrix L. - real(real64), allocatable, dimension(:,:) :: l - !> The upper triangular matrix U. - real(real64), allocatable, dimension(:,:) :: u - !> The row pivot tracking matrix P where P A = L U. - real(real64), allocatable, dimension(:,:) :: p - end type - -! ------------------------------------------------------------------------------ - !> @brief Defines a container for the output of an LU factorization. - type lu_results_cmplx - !> The lower triangular matrix L. - complex(real64), allocatable, dimension(:,:) :: l - !> The upper triangular matrix U. - complex(real64), allocatable, dimension(:,:) :: u - !> The row pivot tracking matrix P where P A = L U. - real(real64), allocatable, dimension(:,:) :: p - end type - -! ------------------------------------------------------------------------------ - !> @brief Defines a container for the output of a QR factorization. - type qr_results - !> The M-by-M orthogonal matrix Q. - real(real64), allocatable, dimension(:,:) :: q - !> The M-by-N upper trapezoidal matrix R. - real(real64), allocatable, dimension(:,:) :: r - !> The N-by-N column pivot tracking matrix P where A P = Q R. If no - !! column pivoting is utilized, this matrix is left unallocated. - real(real64), allocatable, dimension(:,:) :: p - end type - -! ------------------------------------------------------------------------------ - !> @brief Defines a container for the output of a QR factorization. - type qr_results_cmplx - !> The M-by-M orthogonal matrix Q. - complex(real64), allocatable, dimension(:,:) :: q - !> The M-by-N upper trapezoidal matrix R. - complex(real64), allocatable, dimension(:,:) :: r - !> The N-by-N column pivot tracking matrix P where A P = Q R. If no - !! column pivoting is utilized, this matrix is left unallocated. - complex(real64), allocatable, dimension(:,:) :: p - end type - -! ------------------------------------------------------------------------------ - !> @brief Defines a container for the output of a singular value - !! decomposition of a matrix. - type svd_results - !> The M-by-M orthogonal matrix U. - real(real64), allocatable, dimension(:,:) :: u - !> The M-by-N matrix containing the singular values on its diagonal. - real(real64), allocatable, dimension(:,:) :: s - !> The N-by-N transpose of the matrix V. - real(real64), allocatable, dimension(:,:) :: vt - end type - -! ------------------------------------------------------------------------------ - !> @brief Defines a container for the output of a singular value - !! decomposition of a matrix. - type svd_results_cmplx - !> The M-by-M orthogonal matrix U. - complex(real64), allocatable, dimension(:,:) :: u - !> The M-by-N matrix containing the singular values on its diagonal. - real(real64), allocatable, dimension(:,:) :: s - !> The N-by-N conjugate transpose of the matrix V. - complex(real64), allocatable, dimension(:,:) :: vt - end type - -! ------------------------------------------------------------------------------ - !> @brief Defines a container for the output of an Eigen analysis of a - !! square matrix. - type eigen_results - !> @brief An N-element array containing the eigenvalues. - complex(real64), allocatable, dimension(:) :: values - !> @brief An N-by-N matrix containing the N right eigenvectors (one per - !! column). - complex(real64), allocatable, dimension(:,:) :: vectors - end type - -contains -! ------------------------------------------------------------------------------ - !> @brief Performs the rank-1 update to matrix A such that: - !! B = X * Y**T + A, where A is an M-by-N matrix, X is an M-element array, - !! and N is an N-element array. - !! - !! @param[in] a The M-by-N matrix A. - !! @param[in] x The M-element array X. - !! @param[in] y THe N-element array Y. - !! @return The resulting M-by-N matrix. - function mat_rank1_update(a, x, y) result(b) - ! Arguments - real(real64), intent(in), dimension(:,:) :: a - real(real64), intent(in), dimension(:) :: x, y - real(real64), dimension(size(a, 1), size(a, 2)) :: b - - ! Process - b = a - call rank1_update(1.0d0, x, y, b) - end function - -! ------------------------------------------------------------------------------ - !> @brief Computes the matrix operation: C = A * B, where A is a - !! diagonal matrix. - !! - !! @param[in] a The M-element array containing the diagonal elements of - !! the matrix A. - !! @param[in] b The P-by-N matrix B where P is greater than or equal to M. - !! @return The resulting M-by-N matrix. - function mat_mult_diag_1(a, b) result(c) - ! Arguments - real(real64), intent(in), dimension(:) :: a - real(real64), intent(in), dimension(:,:) :: b - real(real64), dimension(size(a), size(b, 2)) :: c - - ! Process - if (size(b, 1) > size(a)) then - call diag_mtx_mult(.true., .false., 1.0d0, a, b(1:size(a),:), & - 0.0d0, c) - else - call diag_mtx_mult(.true., .false., 1.0d0, a, b, 0.0d0, c) - end if - end function - -! ------------------------------------------------------------------------------ - !> @brief Computes the matrix operation: C = A * B, where A is a - !! diagonal matrix. - !! - !! @param[in] a The M-element array containing the diagonal elements of - !! the matrix A. - !! @param[in] b The P-element array B where P is greater than or equal to M. - !! @return The resulting M-element array. - function mat_mult_diag_2(a, b) result(c) - ! Arguments - real(real64), intent(in), dimension(:) :: a, b - real(real64), dimension(size(a)) :: c - - ! Local Variables - real(real64), dimension(size(a), 1) :: bc, cc - - ! Process - bc(:,1) = b(1:min(size(a), size(b))) - call diag_mtx_mult(.true., .false., 1.0d0, a, bc, 0.0d0, cc) - c = cc(:,1) - end function - -! ------------------------------------------------------------------------------ - !> @brief Computes the matrix operation: C = A * B, where B is a diagonal - !! matrix. - !! - !! @param[in] a The M-by-N matrix A. - !! @param[in] b The P-element array containing the diagonal matrix B where - !! P is at least N. - !! @return The resulting M-by-P matrix. - function mat_mult_diag_3(a, b) result(c) - ! Arguments - real(real64), intent(in), dimension(:,:) :: a - real(real64), intent(in), dimension(:) :: b - real(real64), dimension(size(a, 1), size(b)) :: c - - ! Process - if (size(a, 2) > size(b)) then - call diag_mtx_mult(.false., .false., 1.0d0, b, a(:,1:size(b)), & - 0.0d0, c) - else - call diag_mtx_mult(.false., .false., 1.0d0, b, a, 0.0d0, c) - end if - end function - -! ------------------------------------------------------------------------------ - !> @brief Computes the matrix operation: C = A * B, where A is a - !! diagonal matrix. - !! - !! @param[in] a The M-element array containing the diagonal elements of - !! the matrix A. - !! @param[in] b The P-by-N matrix B where P is greater than or equal to M. - !! @return The resulting M-by-N matrix. - function mat_mult_diag_1_cmplx(a, b) result(c) - ! Arguments - complex(real64), intent(in), dimension(:) :: a - complex(real64), intent(in), dimension(:,:) :: b - complex(real64), dimension(size(a), size(b, 2)) :: c - - ! Parameters - complex(real64), parameter :: zero = (0.0d0, 0.0d0) - complex(real64), parameter :: one = (1.0d0, 0.0d0) - - ! Process - if (size(b, 1) > size(a)) then - call diag_mtx_mult(.true., LA_NO_OPERATION, one, a, b(1:size(a),:), & - zero, c) - else - call diag_mtx_mult(.true., LA_NO_OPERATION, one, a, b, zero, c) - end if - end function - -! ------------------------------------------------------------------------------ - !> @brief Computes the matrix operation: C = A * B, where A is a - !! diagonal matrix. - !! - !! @param[in] a The M-element array containing the diagonal elements of - !! the matrix A. - !! @param[in] b The P-element array B where P is greater than or equal to M. - !! @return The resulting M-element array. - function mat_mult_diag_2_cmplx(a, b) result(c) - ! Arguments - complex(real64), intent(in), dimension(:) :: a, b - complex(real64), dimension(size(a)) :: c - - ! Parameters - complex(real64), parameter :: zero = (0.0d0, 0.0d0) - complex(real64), parameter :: one = (1.0d0, 0.0d0) - - ! Local Variables - complex(real64), dimension(size(a), 1) :: bc, cc - - ! Process - bc(:,1) = b(1:min(size(a), size(b))) - call diag_mtx_mult(.true., LA_NO_OPERATION, one, a, bc, zero, cc) - c = cc(:,1) - end function - -! ------------------------------------------------------------------------------ - !> @brief Computes the matrix operation: C = A * B, where B is a diagonal - !! matrix. - !! - !! @param[in] a The M-by-N matrix A. - !! @param[in] b The P-element array containing the diagonal matrix B where - !! P is at least N. - !! @return The resulting M-by-P matrix. - function mat_mult_diag_3_cmplx(a, b) result(c) - ! Arguments - complex(real64), intent(in), dimension(:,:) :: a - complex(real64), intent(in), dimension(:) :: b - complex(real64), dimension(size(a, 1), size(b)) :: c - - ! Process - if (size(a, 2) > size(b)) then - call diag_mtx_mult(.false., LA_NO_OPERATION, 1.0d0, b, a(:,1:size(b)), & - 0.0d0, c) - else - call diag_mtx_mult(.false., LA_NO_OPERATION, 1.0d0, b, a, 0.0d0, c) - end if - end function - -! ------------------------------------------------------------------------------ - !> @brief Computes the matrix operation C = A * B, where A is an upper - !! triangular matrix. - !! - !! @param[in] a The M-by-M triangular matrix A. - !! @param[in] b The M-by-N matrix B. - !! @return The resulting M-by-N matrix. - function mat_mult_upper_tri_1(a, b) result(c) - ! Arguments - real(real64), intent(in), dimension(:,:) :: a, b - real(real64), dimension(size(a, 1), size(b, 2)) :: c - - ! Process - c = b - call DTRMM('L', 'U', 'N', 'N', size(b, 1), size(b, 2), 1.0d0, & - a, size(a, 1), c, size(c, 1)) - end function - -! ------------------------------------------------------------------------------ - !> @brief Computes the matrix operation C = A * B, where A is an upper - !! triangular matrix. - !! - !! @param[in] a The M-by-M triangular matrix A. - !! @param[in] b The M-element array B. - !! @return The resulting M-element array. - function mat_mult_upper_tri_2(a, b) result(c) - ! Arguments - real(real64), intent(in), dimension(:,:) :: a - real(real64), intent(in), dimension(:) :: b - real(real64), dimension(size(a, 1)) :: c - - ! Process - c = b - call DTRMV('U', 'N', 'N', size(a, 1), a, size(a, 1), c, 1) - end function - - ! ------------------------------------------------------------------------------ - !> @brief Computes the matrix operation C = A * B, where A is a lower - !! triangular matrix. - !! - !! @param[in] a The M-by-M triangular matrix A. - !! @param[in] b The M-by-N matrix B. - !! @return The resulting M-by-N matrix. - function mat_mult_lower_tri_1(a, b) result(c) - ! Arguments - real(real64), intent(in), dimension(:,:) :: a, b - real(real64), dimension(size(a, 1), size(b, 2)) :: c - - ! Process - c = b - call DTRMM('L', 'L', 'N', 'N', size(b, 1), size(b, 2), 1.0d0, & - a, size(a, 1), c, size(c, 1)) - end function - - ! ------------------------------------------------------------------------------ - !> @brief Computes the matrix operation C = A * B, where A is a lower - !! triangular matrix. - !! - !! @param[in] a The M-by-M triangular matrix A. - !! @param[in] b The M-element array B. - !! @return The resulting M-element array. - function mat_mult_lower_tri_2(a, b) result(c) - ! Arguments - real(real64), intent(in), dimension(:,:) :: a - real(real64), intent(in), dimension(:) :: b - real(real64), dimension(size(a, 1)) :: c - - ! Process - c = b - call DTRMV('L', 'N', 'N', size(a, 1), a, size(a, 1), c, 1) - end function - -! ------------------------------------------------------------------------------ - !> @brief Computes the matrix operation C = A * B, where A is an upper - !! triangular matrix. - !! - !! @param[in] a The M-by-M triangular matrix A. - !! @param[in] b The M-by-N matrix B. - !! @return The resulting M-by-N matrix. - function mat_mult_upper_tri_1_cmplx(a, b) result(c) - ! Arguments - complex(real64), intent(in), dimension(:,:) :: a, b - complex(real64), dimension(size(a, 1), size(b, 2)) :: c - - ! Process - c = b - call ZTRMM('L', 'U', 'N', 'N', size(b, 1), size(b, 2), 1.0d0, & - a, size(a, 1), c, size(c, 1)) - end function - -! ------------------------------------------------------------------------------ - !> @brief Computes the matrix operation C = A * B, where A is an upper - !! triangular matrix. - !! - !! @param[in] a The M-by-M triangular matrix A. - !! @param[in] b The M-element array B. - !! @return The resulting M-element array. - function mat_mult_upper_tri_2_cmplx(a, b) result(c) - ! Arguments - complex(real64), intent(in), dimension(:,:) :: a - complex(real64), intent(in), dimension(:) :: b - complex(real64), dimension(size(a, 1)) :: c - - ! Process - c = b - call ZTRMV('U', 'N', 'N', size(a, 1), a, size(a, 1), c, 1) - end function - - ! ------------------------------------------------------------------------------ - !> @brief Computes the matrix operation C = A * B, where A is a lower - !! triangular matrix. - !! - !! @param[in] a The M-by-M triangular matrix A. - !! @param[in] b The M-by-N matrix B. - !! @return The resulting M-by-N matrix. - function mat_mult_lower_tri_1_cmplx(a, b) result(c) - ! Arguments - complex(real64), intent(in), dimension(:,:) :: a, b - complex(real64), dimension(size(a, 1), size(b, 2)) :: c - - ! Process - c = b - call ZTRMM('L', 'L', 'N', 'N', size(b, 1), size(b, 2), 1.0d0, & - a, size(a, 1), c, size(c, 1)) - end function - - ! ------------------------------------------------------------------------------ - !> @brief Computes the matrix operation C = A * B, where A is a lower - !! triangular matrix. - !! - !! @param[in] a The M-by-M triangular matrix A. - !! @param[in] b The M-element array B. - !! @return The resulting M-element array. - function mat_mult_lower_tri_2_cmplx(a, b) result(c) - ! Arguments - complex(real64), intent(in), dimension(:,:) :: a - complex(real64), intent(in), dimension(:) :: b - complex(real64), dimension(size(a, 1)) :: c - - ! Process - c = b - call ZTRMV('L', 'N', 'N', size(a, 1), a, size(a, 1), c, 1) - end function - -! ------------------------------------------------------------------------------ - !> @brief Computes the determinant of a square matrix. - !! - !! @param[in] a The N-by-N matrix on which to operate. - !! @return The determinant of the matrix. - function mat_det(a) result(x) - ! Arguments - real(real64), intent(in), dimension(:,:) :: a - real(real64) :: x - - ! Local Variables - real(real64), dimension(size(a, 1), size(a, 2)) :: b - - ! Process - b = a - x = det(b) - end function - -! ------------------------------------------------------------------------------ - !> @brief Computes the LU factorization of a square matrix. Notice, - !! partial row pivoting is utilized. - !! - !! @param[in] a The N-by-N matrix to factor. - !! @result The L, U, and P matrices resulting from the factorization. - function mat_lu_dbl(a) result(x) - ! Arguments - real(real64), intent(in), dimension(:,:) :: a - type(lu_results) :: x - - ! Local Variables - integer(int32) :: n - integer(int32), allocatable, dimension(:) :: ipvt - - ! Memory Allocation - n = size(a, 1) - allocate(ipvt(n)) - allocate(x%l(n,n)) - allocate(x%u(n,n)) - allocate(x%p(n,n)) - - ! Compute the factorization - x%l = a - call lu_factor(x%l, ipvt) - - ! Form L, U, and P - call form_lu(x%l, ipvt, x%u, x%p) - end function - -! ------------------------------------------------------------------------------ - !> @brief Computes the LU factorization of a square matrix. Notice, - !! partial row pivoting is utilized. - !! - !! @param[in] a The N-by-N matrix to factor. - !! @result The L, U, and P matrices resulting from the factorization. - function mat_lu_cmplx(a) result(x) - ! Arguments - complex(real64), intent(in), dimension(:,:) :: a - type(lu_results_cmplx) :: x - - ! Local Variables - integer(int32) :: n - integer(int32), allocatable, dimension(:) :: ipvt - - ! Memory Allocation - n = size(a, 1) - allocate(ipvt(n)) - allocate(x%l(n,n)) - allocate(x%u(n,n)) - allocate(x%p(n,n)) - - ! Compute the factorization - x%l = a - call lu_factor(x%l, ipvt) - - ! Form L, U, and P - call form_lu(x%l, ipvt, x%u, x%p) - end function - -! ------------------------------------------------------------------------------ - !> @brief Computes the QR factorization of an M-by-N matrix. column - !! pivoting can be used by this routine. - !! - !! @param[in] a The M-by-N matrix to factor. - !! @param[in] pvt An optional value that, if supplied, can be used to turn - !! on column pivoting. The default value is false, such that no column - !! pivoting is utilized. - !! @return The Q, R, and optionally P matrices resulting from the - !! factorization. - function mat_qr(a, pvt) result(x) - ! Arguments - real(real64), intent(in), dimension(:,:) :: a - logical, intent(in), optional :: pvt - type(qr_results) :: x - - ! Local Variables - logical :: use_pivot - integer(int32) :: m, n, mn - integer(int32), allocatable, dimension(:) :: jpvt - real(real64), allocatable, dimension(:) :: tau - - ! Memory Allocation - use_pivot = .false. - if (present(pvt)) use_pivot = pvt - m = size(a, 1) - n = size(a, 2) - mn = min(m, n) - allocate(tau(mn)) - allocate(x%q(m,m)) - allocate(x%r(m,n)) - - ! Compute the factorization, and then form Q, R, and P - x%r = a - if (use_pivot) then - allocate(x%p(n,n)) - allocate(jpvt(n)) - jpvt = 0 ! Ensure all columns are free columns - call qr_factor(x%r, tau, jpvt) - call form_qr(x%r, tau, jpvt, x%q, x%p) - else - call qr_factor(x%r, tau) - call form_qr(x%r, tau, x%q) - end if - end function - -! ------------------------------------------------------------------------------ - !> @brief Computes the rank-1 update of a QR-factored system. - !! - !! @param[in] q The M-by-M orthogonal matrix Q from the factorization of - !! the original system. - !! @param[in] r The M-by-N upper trapezoidal matrix R from the factorization - !! of the original system. - !! @param[in] x The M-element update vector. - !! @param[in] y The N-element update vector. - !! @return The updated Q and R matrices. - function mat_qr_rank1_update(q, r, x, y) result(rst) - ! Arguments - real(real64), intent(in), dimension(:,:) :: q, r - real(real64), intent(in), dimension(:) :: x, y - type(qr_results) :: rst - - ! Local Variables - integer(int32) :: i, m, n - real(real64), allocatable, dimension(:) :: xc, yc - - ! Memory allocation - m = size(q, 1) - n = size(r, 2) - allocate(xc(m)) - allocate(yc(n)) - allocate(rst%q(m,m)) - allocate(rst%r(m,n)) - - ! Process - do i = 1, m - xc(i) = x(i) - rst%q(:,i) = q(:,i) - end do - do i = 1, n - yc(i) = y(i) - rst%r(:,i) = r(:,i) - end do - call qr_rank1_update(rst%q, rst%r, xc, yc) - end function - -! ------------------------------------------------------------------------------ - !> @brief Computes the singular value decomposition of an M-by-N matrix. - !! - !! @param[in] a The M-by-N matrix to factor. - !! @result The U, S, and transpose of V matrices resulting from the - !! factorization where A = U * S * V**T. - function mat_svd(a) result(x) - ! Arguments - real(real64), intent(in), dimension(:,:) :: a - type(svd_results) :: x - - ! Local Variables - integer(int32) :: i, m, n, mn - real(real64), allocatable, dimension(:) :: s - real(real64), allocatable, dimension(:,:) :: ac - - ! Memory Allocation - m = size(a, 1) - n = size(a, 2) - mn = min(m, n) - allocate(s(mn)) - allocate(ac(m,n)) - allocate(x%u(m,m)) - allocate(x%s(m,n)) - allocate(x%vt(n,n)) - - ! Process - ac = a - call svd(ac, s, x%u, x%vt) - - ! Extract the singular values, and populate the results matrix - x%s = 0.0d0 - do i = 1, mn - x%s(i,i) = s(i) - end do - end function - -! ------------------------------------------------------------------------------ - !> @brief Computes the Cholesky factorization of a positive-definite - !! matrix. - !! - !! @param[in] a The M-by-M positive definite matrix to factor. - !! @param[in] upper An optional input that can be used to determine if the - !! upper triangular factorization should be computed such that - !! A = R**T * R, or if the lower triangular facotrization should be - !! computed such that A = L * L**T. The default is true such that the - !! upper triangular form is computed. - function mat_cholesky(a, upper) result(r) - ! Arguments - real(real64), intent(in), dimension(:,:) :: a - logical, intent(in), optional :: upper - real(real64), dimension(size(a, 1), size(a, 2)) :: r - - ! Local Variables - logical :: compute_upper - - ! Process - compute_upper = .true. - if (present(upper)) compute_upper = upper - r = a - call cholesky_factor(r, compute_upper) - end function - -! ------------------------------------------------------------------------------ - !> @brief Computes the rank 1 update to a Cholesky factored matrix. - !! - !! @param[in] a The M-by-M upper triangular Cholesky factored matrix to - !! update. - !! @param[in] x The M-element update array. - !! @return The updated M-by-M upper triangular matrix. - function mat_cholesky_rank1_update(a, x) result(r) - ! Arguments - real(real64), intent(in), dimension(:,:) :: a - real(real64), intent(in), dimension(:) :: x - real(real64), dimension(size(a, 1), size(a, 2)) :: r - - ! Local Variables - real(real64), dimension(size(x)) :: xc - - ! Process - r = a - xc = x - call cholesky_rank1_update(r, xc) - end function - -! ------------------------------------------------------------------------------ - !> @brief Computes the rank 1 downdate to a Cholesky factored matrix. - !! - !! @param[in] a The M-by-M upper triangular Cholesky factored matrix to - !! downdate. - !! @param[in] x The M-element downdate array. - !! @return The downdated M-by-M upper triangular matrix. - function mat_cholesky_rank1_downdate(a, x) result(r) - ! Arguments - real(real64), intent(in), dimension(:,:) :: a - real(real64), intent(in), dimension(:) :: x - real(real64), dimension(size(a, 1), size(a, 2)) :: r - - ! Local Variables - real(real64), dimension(size(x)) :: xc - - ! Process - r = a - xc = x - call cholesky_rank1_downdate(r, xc) - end function - -! ------------------------------------------------------------------------------ - !> @brief Computes the inverse of a square matrix. - !! - !! @param[in] a The M-by-M matrix to invert. - !! @return The M-by-M inverted matrix. - function mat_inverse(a) result(x) - ! Arguments - real(real64), intent(in), dimension(:,:) :: a - real(real64), dimension(size(a, 2), size(a, 1)) :: x - - ! Compute the inverse of A - x = a - call mtx_inverse(x) - end function - -! ------------------------------------------------------------------------------ - !> @brief Computes the Moore-Penrose pseudo-inverse of a M-by-N matrix. - !! - !! @param[in] a The M-by-N matrix to invert. - !! @return The N-by-M inverted matrix. - function mat_pinverse(a) result(x) - ! Arguments - real(real64), intent(in), dimension(:,:) :: a - real(real64), dimension(size(a, 2), size(a, 1)) :: x - - ! Local Variables - real(real64), dimension(size(a, 1), size(a, 2)) :: ac - - ! Compute the inverse of A - ac = a - call mtx_pinverse(ac, x) - end function - -! ------------------------------------------------------------------------------ - !> @brief Solves the upper triangular system A X = B, where A is an - !! upper triangular matrix. - !! - !! @param[in] a The M-by-M upper triangluar matrix A. - !! @param[in] b The M-by-NRHS matrix B. - !! @return The M-by-NRHS solution matrix X. - function mat_solve_upper_tri_1(a, b) result(x) - ! Arguments - real(real64), intent(in), dimension(:,:) :: a, b - real(real64), dimension(size(b, 1), size(b, 2)) :: x - - ! Process - x = b - call solve_triangular_system(.true., .true., .false., .true., 1.0d0, & - a, x) - end function - -! ------------------------------------------------------------------------------ - !> @brief Solves the upper triangular system A X = B, where A is an - !! upper triangular matrix. - !! - !! @param[in] a The M-by-M upper triangluar matrix A. - !! @param[in] b The M-element array B. - !! @return The M-element solution array X. - function mat_solve_upper_tri_2(a, b) result(x) - ! Arguments - real(real64), intent(in), dimension(:,:) :: a - real(real64), intent(in), dimension(:) :: b - real(real64), dimension(size(b)) :: x - - ! Process - x = b - call solve_triangular_system(.true., .false., .true., a, x) - end function - -! ------------------------------------------------------------------------------ - !> @brief Solves the upper triangular system A X = B, where A is an - !! upper triangular matrix. - !! - !! @param[in] a The M-by-M upper triangluar matrix A. - !! @param[in] b The M-by-NRHS matrix B. - !! @return The M-by-NRHS solution matrix X. - function mat_solve_upper_tri_1_cmplx(a, b) result(x) - ! Arguments - complex(real64), intent(in), dimension(:,:) :: a, b - complex(real64), dimension(size(b, 1), size(b, 2)) :: x - - ! Process - x = b - call solve_triangular_system(.true., .true., .false., .true., & - (1.0d0, 0.0d0), a, x) - end function - -! ------------------------------------------------------------------------------ - !> @brief Solves the upper triangular system A X = B, where A is an - !! upper triangular matrix. - !! - !! @param[in] a The M-by-M upper triangluar matrix A. - !! @param[in] b The M-element array B. - !! @return The M-element solution array X. - function mat_solve_upper_tri_2_cmplx(a, b) result(x) - ! Arguments - complex(real64), intent(in), dimension(:,:) :: a - complex(real64), intent(in), dimension(:) :: b - complex(real64), dimension(size(b)) :: x - - ! Process - x = b - call solve_triangular_system(.true., .false., .true., a, x) - end function - -! ------------------------------------------------------------------------------ - !> @brief Solves the lower triangular system A X = B, where A is a - !! lower triangular matrix. - !! - !! @param[in] a The M-by-M lower triangluar matrix A. - !! @param[in] b The M-by-NRHS matrix B. - !! @return The M-by-NRHS solution matrix X. - function mat_solve_lower_tri_1(a, b) result(x) - ! Arguments - real(real64), intent(in), dimension(:,:) :: a, b - real(real64), dimension(size(b, 1), size(b, 2)) :: x - - ! Process - x = b - call solve_triangular_system(.true., .false., .false., .true., 1.0d0, & - a, x) - end function - -! ------------------------------------------------------------------------------ - !> @brief Solves the lower triangular system A X = B, where A is a - !! lower triangular matrix. - !! - !! @param[in] a The M-by-M lower triangluar matrix A. - !! @param[in] b The M-element array B. - !! @return The M-element solution array X. - function mat_solve_lower_tri_2(a, b) result(x) - ! Arguments - real(real64), intent(in), dimension(:,:) :: a - real(real64), intent(in), dimension(:) :: b - real(real64), dimension(size(b)) :: x - - ! Process - x = b - call solve_triangular_system(.false., .false., .true., a, x) - end function - -! ------------------------------------------------------------------------------ - !> @brief Solves the lower triangular system A X = B, where A is a - !! lower triangular matrix. - !! - !! @param[in] a The M-by-M lower triangluar matrix A. - !! @param[in] b The M-by-NRHS matrix B. - !! @return The M-by-NRHS solution matrix X. - function mat_solve_lower_tri_1_cmplx(a, b) result(x) - ! Arguments - complex(real64), intent(in), dimension(:,:) :: a, b - complex(real64), dimension(size(b, 1), size(b, 2)) :: x - - ! Process - x = b - call solve_triangular_system(.true., .false., .false., .true., & - (1.0d0, 0.0d0), a, x) - end function - -! ------------------------------------------------------------------------------ - !> @brief Solves the lower triangular system A X = B, where A is a - !! lower triangular matrix. - !! - !! @param[in] a The M-by-M lower triangluar matrix A. - !! @param[in] b The M-element array B. - !! @return The M-element solution array X. - function mat_solve_lower_tri_2_cmplx(a, b) result(x) - ! Arguments - complex(real64), intent(in), dimension(:,:) :: a - complex(real64), intent(in), dimension(:) :: b - complex(real64), dimension(size(b)) :: x - - ! Process - x = b - call solve_triangular_system(.false., .false., .true., a, x) - end function - -! ------------------------------------------------------------------------------ - !> @brief Computes the eigenvalues and eigenvectors (right) of a general - !! N-by-N matrix. - !! - !! @param[in] a The N-by-N matrix on which to operate. - !! @return The eigenvalues and eigenvectors of the matrix. The results are - !! sorted into ascending order. - function mat_eigen_1(a) result(x) - ! Arguments - real(real64), intent(in), dimension(:,:) :: a - type(eigen_results) :: x - - ! Local Variables - integer(int32) :: n - real(real64), dimension(size(a, 1), size(a, 2)) :: ac - - ! Memory Allocation - n = size(a, 1) - allocate(x%values(n)) - allocate(x%vectors(n,n)) - - ! Process - ac = a - call eigen(ac, x%values, x%vectors) - - ! Sort the eigenvalues and eigenvectors. - call sort(x%values, x%vectors, .true.) - end function - -! ------------------------------------------------------------------------------ - !> @brief Computes eigenvalues and eigenvectors (right) from the eigenvalue - !! problem: A X = lambda B X. - !! - !! @param[in] a The N-by-N matrix A. - !! @param[in] b The N-by-N matrix B. - !! @return The eigenvalues and eigenvectors. The results are sorted into - !! ascending order. - function mat_eigen_2(a, b) result(x) - ! Arguments - real(real64), intent(in), dimension(:,:) :: a, b - type(eigen_results) :: x - - ! Local Variables - integer(int32) :: i, j, n - real(real64), dimension(size(a, 1), size(a, 2)) :: ac - real(real64), dimension(size(b, 1), size(b, 2)) :: bc - - ! Memory Allocation - n = size(a, 1) - allocate(x%values(n)) - allocate(x%vectors(n,n)) - - ! Process - do j = 1, n - do i = 1, n - ac(i,j) = a(i,j) - bc(i,j) = b(i,j) - end do - end do - call eigen(ac, bc, x%values, vecs = x%vectors) - - ! Sort the eigenvalues and eigenvectors. - call sort(x%values, x%vectors, .true.) - end function - -! ------------------------------------------------------------------------------ - !> @brief Creates an N-by-N identity matrix. - !! - !! @param[in] n The dimension of the matrix. - !! @return The N-by-N identity matrix. - pure function identity(n) result(x) - integer(int32), intent(in) :: n - real(real64), dimension(n, n) :: x - integer(int32) :: i - x = 0.0d0 - do i = 1, n - x(i,i) = 1.0d0 - end do - end function - -end module diff --git a/tests/CMakeLists.txt b/tests/CMakeLists.txt index fbd84252..946a5333 100644 --- a/tests/CMakeLists.txt +++ b/tests/CMakeLists.txt @@ -12,7 +12,6 @@ set(linalg_test_sources test_misc.f90 test_lu.f90 test_sort.f90 - test_immutable.f90 ) # Build the Fortran API tests diff --git a/tests/linalg_test.f90 b/tests/linalg_test.f90 index 31172017..abb0c760 100644 --- a/tests/linalg_test.f90 +++ b/tests/linalg_test.f90 @@ -11,7 +11,6 @@ program main use test_misc use test_lu use test_sort - use test_immutable ! Local Variables logical :: rst, overall @@ -161,34 +160,6 @@ program main rst = test_dbl_descend_sort() if (.not.rst) overall = .false. - ! Immutable Tests - rst = test_im_lu_factor() - if (.not.rst) overall = .false. - - rst = test_im_lu_solve() - if (.not.rst) overall = .false. - - rst = test_im_qr_factor() - if (.not.rst) overall = .false. - - rst = test_im_qr_factor_pvt() - if (.not.rst) overall = .false. - - rst = test_im_cholesky() - if (.not.rst) overall = .false. - - rst = test_im_svd() - if (.not.rst) overall = .false. - - rst = test_im_inverse() - if (.not.rst) overall = .false. - - rst = test_im_pinverse() - if (.not.rst) overall = .false. - - rst = test_im_eigen() - if (.not.rst) overall = .false. - ! End if (overall) then print '(A)', "LINALG TEST STATUS: PASS" diff --git a/tests/test_immutable.f90 b/tests/test_immutable.f90 deleted file mode 100644 index c3837e73..00000000 --- a/tests/test_immutable.f90 +++ /dev/null @@ -1,249 +0,0 @@ -! test_immutable.f90 - -module test_immutable - use, intrinsic :: iso_fortran_env, only : int32, real64 - use test_core - use linalg_immutable - implicit none -contains -! ****************************************************************************** -! LU FACTORIZATION -! ------------------------------------------------------------------------------ - function test_im_lu_factor() result(rst) - ! Parameters - integer(int32), parameter :: n = 75 - real(real64), parameter :: tol = 1.0d-8 - - ! Local Variables - real(real64), dimension(n, n) :: a - type(lu_results) :: lu_rst - logical :: rst - - ! Initialization - rst = .true. - call random_number(a) - - ! Compute the factorization - lu_rst = mat_lu(a) - - ! Ensuure P * A = L * U - if (.not.is_mtx_equal(matmul(lu_rst%p, a), & - matmul(lu_rst%l, lu_rst%u), tol)) then - rst = .false. - print '(A)', "Test Failed: Immutable LU Factorization Test" - end if - end function - -! ------------------------------------------------------------------------------ - function test_im_lu_solve() result(rst) - ! Parameters - integer(int32), parameter :: n = 75 - integer(int32), parameter :: nrhs = 20 - real(real64), parameter :: tol = 1.0d-8 - - ! Local Variables - real(real64) :: a(n, n), b(n, nrhs), x(n, nrhs), y(n, nrhs) - type(lu_results) :: lu_rst - logical :: rst - - ! Initialization - rst = .true. - call random_number(a) - call random_number(b) - - ! Compute the factorization - lu_rst = mat_lu(a) - - ! Solve L * Y = P * B, for Y - y = mat_solve_lower_tri(lu_rst%l, matmul(lu_rst%p, b)) - - ! Solve U * X = Y, for X - x = mat_solve_upper_tri(lu_rst%u, y) - - ! Ensure A * X = B - if (.not.is_mtx_equal(matmul(a, x), b, tol)) then - rst = .false. - print '(A)', "Test Failed: Immutable LU Solution Test" - end if - end function - -! ------------------------------------------------------------------------------ - function test_im_qr_factor() result(rst) - ! Parameters - integer(int32), parameter :: m = 100 - integer(int32), parameter :: n = 75 - real(real64), parameter :: tol = 1.0d-8 - - ! Local Variables - real(real64) :: a(m, n) - type(qr_results) :: qr_rst - logical :: rst - - ! Initialization - rst = .true. - call random_number(a) - - ! Compute the factorization - qr_rst = mat_qr(a) - - ! Test to see if A = Q * R - if (.not.is_mtx_equal(a, matmul(qr_rst%q, qr_rst%r), tol)) then - rst = .false. - print '(A)', "Test Failed: Immutable QR Factorization Test" - end if - end function - -! ------------------------------------------------------------------------------ - function test_im_qr_factor_pvt() result(rst) - ! Parameters - integer(int32), parameter :: m = 100 - integer(int32), parameter :: n = 75 - real(real64), parameter :: tol = 1.0d-8 - - ! Local Variables - real(real64) :: a(m, n) - type(qr_results) :: qr_rst - logical :: rst - - ! Initialization - rst = .true. - call random_number(a) - - ! Compute the factorization - qr_rst = mat_qr(a, .true.) - - ! Test to see if A * P = Q * R - if (.not.is_mtx_equal(matmul(a, qr_rst%p), matmul(qr_rst%q, qr_rst%r), tol)) then - rst = .false. - print '(A)', "Test Failed: Immutable QR Factorization Test with Pivoting" - end if - end function - -! ------------------------------------------------------------------------------ - function test_im_cholesky() result(rst) - ! Parameters - integer(int32), parameter :: n = 100 - real(real64), parameter :: tol = 1.0d-8 - - ! Local Variables - real(real64) :: a(n, n), r(n, n) - logical :: rst - - ! Initialization - rst = .true. - call random_number(a) - - ! Ensure A is positive definite - a = matmul(a, transpose(a)) - - ! Compute the factorization - r = mat_cholesky(a) - - ! Ensure A = R**T * R - if (.not.is_mtx_equal(a, matmul(transpose(r), r), tol)) then - rst = .false. - print '(A)', "Test Failed: Immutable Cholesky Factorization" - end if - end function - -! ------------------------------------------------------------------------------ - function test_im_svd() result(rst) - ! Parameters - integer(int32), parameter :: m = 100 - integer(int32), parameter :: n = 75 - real(real64), parameter :: tol = 1.0d-8 - - ! Local Variables - real(real64) :: a(m, n) - type(svd_results) :: x - logical :: rst - - ! Initialization - rst = .true. - call random_number(a) - - ! Compute the factorization - x = mat_svd(a) - - ! Ensure U * S * V**T = A - if (.not.is_mtx_equal(matmul(x%u, matmul(x%s, x%vt)), a, tol)) then - rst = .false. - print '(A)', "Test Failed: Immutable SVD" - end if - end function - -! ------------------------------------------------------------------------------ - function test_im_inverse() result(rst) - ! Parameters - integer(int32), parameter :: n = 100 - real(real64), parameter :: tol = 1.0d-8 - - ! Local Variables - real(real64) :: a(n, n), i(n, n), ainv(n, n) - logical :: rst - - ! Initialization - rst = .true. - call random_number(a) - i = identity(n) - - ! Compute the inverse - ainv = mat_inverse(a) - - ! Ensure ainv * a == I - if (.not.is_mtx_equal(matmul(ainv, a), i, tol)) then - rst = .false. - print '(A)', "Test Failed: Immutable Inverse" - end if - end function - -! ------------------------------------------------------------------------------ - function test_im_pinverse() result(rst) - ! Parameters - integer(int32), parameter :: m = 100 - integer(int32), parameter :: n = 75 - real(real64), parameter :: tol = 1.0d-8 - - ! Local Variables - real(real64) :: a(m, n), ainv(n, m) - logical :: rst - - ! Initialization - rst = .true. - call random_number(a) - - ! Compute the inverse - ainv = mat_pinverse(a) - - ! Ensure A * A+ * A = A - if (.not.is_mtx_equal(matmul(a, matmul(ainv, a)), a, tol)) then - rst = .false. - print '(A)', "Test Failed: Immutable Pseudo-Inverse" - end if - end function - -! ------------------------------------------------------------------------------ - function test_im_eigen() result(rst) - ! Parameters - integer(int32), parameter :: n = 100 - real(real64), parameter :: tol = 1.0d-8 - - ! Local Variables - real(real64) :: a(n, n) - type(eigen_results) :: x - logical :: rst - - ! Initialization - rst = .true. - call random_number(a) - - ! Compute the eigenvalues and eigenvectors - x = mat_eigen(a) - - ! Ensure A * v = lambda * v - if (.not.is_mtx_equal(matmul(a, x%vectors), mat_mult_diag(x%vectors, x%values), tol)) then - rst = .false. - print '(A)', "Test Failed: Immutable Eigen Analysis" - end if - end function -end module From d927bdec811c158466251d5ded1f5d3b8b62d6e3 Mon Sep 17 00:00:00 2001 From: jchristopherson Date: Fri, 16 Dec 2022 05:48:06 -0600 Subject: [PATCH 26/65] Update documentation --- doc/html/annotated.html | 15 --- doc/html/annotated_dup.js | 16 --- doc/html/classes.html | 10 +- .../dir_68267d1309a1af8e8297ef4c3efbcdba.html | 2 - .../dir_68267d1309a1af8e8297ef4c3efbcdba.js | 1 - doc/html/files.html | 5 +- doc/html/menudata.js | 6 +- doc/html/namespacelinalg__immutable.html | 6 +- doc/html/namespacemembers.html | 11 -- doc/html/namespaces.html | 15 --- doc/html/namespaces_dup.js | 3 +- doc/html/navtreedata.js | 7 +- doc/html/navtreeindex0.js | 122 +++--------------- doc/html/search/all_2.js | 3 +- doc/html/search/all_4.js | 14 +- doc/html/search/all_5.js | 23 +--- doc/html/search/all_6.js | 25 +--- doc/html/search/all_7.js | 4 +- doc/html/search/all_8.js | 15 ++- doc/html/search/all_9.js | 6 +- doc/html/search/classes_2.js | 3 +- doc/html/search/classes_4.js | 4 +- doc/html/search/classes_5.js | 19 +-- doc/html/search/classes_6.js | 4 +- doc/html/search/classes_8.js | 4 +- doc/html/search/namespaces_0.js | 3 +- doc/html/search/searchdata.js | 17 +-- doc/html/search/variables_0.js | 23 ++-- 28 files changed, 98 insertions(+), 288 deletions(-) diff --git a/doc/html/annotated.html b/doc/html/annotated.html index 9d5b16b3..bc9df1cd 100644 --- a/doc/html/annotated.html +++ b/doc/html/annotated.html @@ -135,21 +135,6 @@  CswapSwaps the contents of two arrays  CtraceComputes the trace of a matrix (the sum of the main diagonal elements)  Ctri_mtx_multComputes the triangular matrix operation: \( B = \alpha A^T A + \beta B \), or \( B = \alpha A A^T + \beta B \), where A is a triangular matrix - Nlinalg_immutableProvides an immutable interface to many of the core linear algebra routines in this library. The intent is to allow for ease of use in situations where memory allocation, or absolute speed are of lesser importance to code readability - Ceigen_resultsDefines a container for the output of an Eigen analysis of a square matrix - Clu_resultsDefines a container for the output of an LU factorization - Clu_results_cmplxDefines a container for the output of an LU factorization - Cmat_eigenComputes the eigenvalues and eigenvectors (right) of a general N-by-N matrix - Cmat_luComputes the LU factorization of a square matrix. Notice, partial row pivoting is utilized - Cmat_mult_diagComputes the matrix operation: C = A * B, where A is a diagonal matrix - Cmat_mult_lower_triComputes the matrix operation C = A * B, where A is a lower triangular matrix - Cmat_mult_upper_triComputes the matrix operation C = A * B, where A is an upper triangular matrix - Cmat_solve_lower_triSolves the lower triangular system A X = B, where A is a lower triangular matrix - Cmat_solve_upper_triSolves the upper triangular system A X = B, where A is an upper triangular matrix - Cqr_resultsDefines a container for the output of a QR factorization - Cqr_results_cmplxDefines a container for the output of a QR factorization - Csvd_resultsDefines a container for the output of a singular value decomposition of a matrix - Csvd_results_cmplxDefines a container for the output of a singular value decomposition of a matrix diff --git a/doc/html/annotated_dup.js b/doc/html/annotated_dup.js index 737fb99b..f71f057e 100644 --- a/doc/html/annotated_dup.js +++ b/doc/html/annotated_dup.js @@ -33,21 +33,5 @@ var annotated_dup = [ "swap", "interfacelinalg_1_1swap.html", null ], [ "trace", "interfacelinalg_1_1trace.html", null ], [ "tri_mtx_mult", "interfacelinalg_1_1tri__mtx__mult.html", null ] - ] ], - [ "linalg_immutable", "namespacelinalg__immutable.html", [ - [ "eigen_results", "structlinalg__immutable_1_1eigen__results.html", "structlinalg__immutable_1_1eigen__results" ], - [ "lu_results", "structlinalg__immutable_1_1lu__results.html", "structlinalg__immutable_1_1lu__results" ], - [ "lu_results_cmplx", "structlinalg__immutable_1_1lu__results__cmplx.html", "structlinalg__immutable_1_1lu__results__cmplx" ], - [ "mat_eigen", "interfacelinalg__immutable_1_1mat__eigen.html", null ], - [ "mat_lu", "interfacelinalg__immutable_1_1mat__lu.html", null ], - [ "mat_mult_diag", "interfacelinalg__immutable_1_1mat__mult__diag.html", null ], - [ "mat_mult_lower_tri", "interfacelinalg__immutable_1_1mat__mult__lower__tri.html", null ], - [ "mat_mult_upper_tri", "interfacelinalg__immutable_1_1mat__mult__upper__tri.html", null ], - [ "mat_solve_lower_tri", "interfacelinalg__immutable_1_1mat__solve__lower__tri.html", null ], - [ "mat_solve_upper_tri", "interfacelinalg__immutable_1_1mat__solve__upper__tri.html", null ], - [ "qr_results", "structlinalg__immutable_1_1qr__results.html", "structlinalg__immutable_1_1qr__results" ], - [ "qr_results_cmplx", "structlinalg__immutable_1_1qr__results__cmplx.html", "structlinalg__immutable_1_1qr__results__cmplx" ], - [ "svd_results", "structlinalg__immutable_1_1svd__results.html", "structlinalg__immutable_1_1svd__results" ], - [ "svd_results_cmplx", "structlinalg__immutable_1_1svd__results__cmplx.html", "structlinalg__immutable_1_1svd__results__cmplx" ] ] ] ]; \ No newline at end of file diff --git a/doc/html/classes.html b/doc/html/classes.html index dee12caa..cbcb5b1a 100644 --- a/doc/html/classes.html +++ b/doc/html/classes.html @@ -110,25 +110,25 @@
    det (linalg)
    diag_mtx_mult (linalg)
    E
    -
    eigen (linalg)
    eigen_results (linalg_immutable)
    +
    eigen (linalg)
    F
    form_lu (linalg)
    form_qr (linalg)
    L
    -
    lu_factor (linalg)
    lu_results (linalg_immutable)
    lu_results_cmplx (linalg_immutable)
    +
    lu_factor (linalg)
    M
    -
    mat_eigen (linalg_immutable)
    mat_lu (linalg_immutable)
    mat_mult_diag (linalg_immutable)
    mat_mult_lower_tri (linalg_immutable)
    mat_mult_upper_tri (linalg_immutable)
    mat_solve_lower_tri (linalg_immutable)
    mat_solve_upper_tri (linalg_immutable)
    mtx_inverse (linalg)
    mtx_mult (linalg)
    mtx_pinverse (linalg)
    mtx_rank (linalg)
    mult_qr (linalg)
    mult_rz (linalg)
    +
    mtx_inverse (linalg)
    mtx_mult (linalg)
    mtx_pinverse (linalg)
    mtx_rank (linalg)
    mult_qr (linalg)
    mult_rz (linalg)
    Q
    -
    qr_factor (linalg)
    qr_rank1_update (linalg)
    qr_results (linalg_immutable)
    qr_results_cmplx (linalg_immutable)
    +
    qr_factor (linalg)
    qr_rank1_update (linalg)
    R
    rank1_update (linalg)
    recip_mult_array (linalg)
    rz_factor (linalg)
    S
    -
    solve_cholesky (linalg)
    solve_least_squares (linalg)
    solve_least_squares_full (linalg)
    solve_least_squares_svd (linalg)
    solve_lu (linalg)
    solve_qr (linalg)
    solve_triangular_system (linalg)
    sort (linalg)
    svd (linalg)
    svd_results (linalg_immutable)
    svd_results_cmplx (linalg_immutable)
    swap (linalg)
    +
    solve_cholesky (linalg)
    solve_least_squares (linalg)
    solve_least_squares_full (linalg)
    solve_least_squares_svd (linalg)
    solve_lu (linalg)
    solve_qr (linalg)
    solve_triangular_system (linalg)
    sort (linalg)
    svd (linalg)
    swap (linalg)
    T
    trace (linalg)
    tri_mtx_mult (linalg)
    diff --git a/doc/html/dir_68267d1309a1af8e8297ef4c3efbcdba.html b/doc/html/dir_68267d1309a1af8e8297ef4c3efbcdba.html index bb4c5baf..4dba4eb0 100644 --- a/doc/html/dir_68267d1309a1af8e8297ef4c3efbcdba.html +++ b/doc/html/dir_68267d1309a1af8e8297ef4c3efbcdba.html @@ -111,8 +111,6 @@   file  linalg_factor.f90 [code]   -file  linalg_immutable.f90 [code] -  file  linalg_solve.f90 [code]   file  linalg_sorting.f90 [code] diff --git a/doc/html/dir_68267d1309a1af8e8297ef4c3efbcdba.js b/doc/html/dir_68267d1309a1af8e8297ef4c3efbcdba.js index 4add8d95..53d71a0b 100644 --- a/doc/html/dir_68267d1309a1af8e8297ef4c3efbcdba.js +++ b/doc/html/dir_68267d1309a1af8e8297ef4c3efbcdba.js @@ -4,7 +4,6 @@ var dir_68267d1309a1af8e8297ef4c3efbcdba = [ "linalg_basic.f90", "linalg__basic_8f90_source.html", null ], [ "linalg_eigen.f90", "linalg__eigen_8f90_source.html", null ], [ "linalg_factor.f90", "linalg__factor_8f90_source.html", null ], - [ "linalg_immutable.f90", "linalg__immutable_8f90_source.html", null ], [ "linalg_solve.f90", "linalg__solve_8f90_source.html", null ], [ "linalg_sorting.f90", "linalg__sorting_8f90_source.html", null ] ]; \ No newline at end of file diff --git a/doc/html/files.html b/doc/html/files.html index ad089dc8..02ccfd67 100644 --- a/doc/html/files.html +++ b/doc/html/files.html @@ -109,9 +109,8 @@  linalg_basic.f90  linalg_eigen.f90  linalg_factor.f90 - linalg_immutable.f90 - linalg_solve.f90 - linalg_sorting.f90 + linalg_solve.f90 + linalg_sorting.f90 diff --git a/doc/html/menudata.js b/doc/html/menudata.js index 69403327..845aa810 100644 --- a/doc/html/menudata.js +++ b/doc/html/menudata.js @@ -28,13 +28,9 @@ var menudata={children:[ {text:"Modules List",url:"namespaces.html"}, {text:"Module Members",url:"namespacemembers.html",children:[ {text:"All",url:"namespacemembers.html"}, -{text:"Functions/Subroutines",url:"namespacemembers_func.html"}, {text:"Variables",url:"namespacemembers_vars.html"}]}]}, {text:"Data Types List",url:"annotated.html",children:[ {text:"Data Types List",url:"annotated.html"}, -{text:"Data Types",url:"classes.html"}, -{text:"Data Fields",url:"functions.html",children:[ -{text:"All",url:"functions.html"}, -{text:"Variables",url:"functions_vars.html"}]}]}, +{text:"Data Types",url:"classes.html"}]}, {text:"Files",url:"files.html",children:[ {text:"File List",url:"files.html"}]}]} diff --git a/doc/html/namespacelinalg__immutable.html b/doc/html/namespacelinalg__immutable.html index f6826a8b..508965e0 100644 --- a/doc/html/namespacelinalg__immutable.html +++ b/doc/html/namespacelinalg__immutable.html @@ -155,7 +155,7 @@

    Functions/Subroutines

    real(real64) function, dimension(size(a, 1), size(a, 2)), public mat_rank1_update (a, x, y) - Performs the rank-1 update to matrix A such that: B = X * Y**T + A, where A is an M-by-N matrix, X is an M-element array, and N is an N-element array. More...
    + Performs the rank-1 update to matrix A such that: \( B = X Y^T + A \), where \( A \) is an M-by-N matrix, \( X \) is an M-element array, and \( Y \) is an N-element array. More...
      real(real64) function, public mat_det (a)  Computes the determinant of a square matrix. More...
    @@ -553,12 +553,12 @@

    -

    Performs the rank-1 update to matrix A such that: B = X * Y**T + A, where A is an M-by-N matrix, X is an M-element array, and N is an N-element array.

    +

    Performs the rank-1 update to matrix A such that: \( B = X Y^T + A \), where \( A \) is an M-by-N matrix, \( X \) is an M-element array, and \( Y \) is an N-element array.

    Parameters
    - +
    [in]aThe M-by-N matrix A.
    [in]xThe M-element array X.
    [in]yTHe N-element array Y.
    [in]yThe N-element array Y.
    diff --git a/doc/html/namespacemembers.html b/doc/html/namespacemembers.html index 16f2b6ee..65201632 100644 --- a/doc/html/namespacemembers.html +++ b/doc/html/namespacemembers.html @@ -98,7 +98,6 @@
    Here is a list of all documented module members with links to the modules they belong to:
    diff --git a/doc/html/namespaces.html b/doc/html/namespaces.html index 3154e87b..544b9fad 100644 --- a/doc/html/namespaces.html +++ b/doc/html/namespaces.html @@ -135,21 +135,6 @@  CswapSwaps the contents of two arrays  CtraceComputes the trace of a matrix (the sum of the main diagonal elements)  Ctri_mtx_multComputes the triangular matrix operation: \( B = \alpha A^T A + \beta B \), or \( B = \alpha A A^T + \beta B \), where A is a triangular matrix - Nlinalg_immutableProvides an immutable interface to many of the core linear algebra routines in this library. The intent is to allow for ease of use in situations where memory allocation, or absolute speed are of lesser importance to code readability - Ceigen_resultsDefines a container for the output of an Eigen analysis of a square matrix - Clu_resultsDefines a container for the output of an LU factorization - Clu_results_cmplxDefines a container for the output of an LU factorization - Cmat_eigenComputes the eigenvalues and eigenvectors (right) of a general N-by-N matrix - Cmat_luComputes the LU factorization of a square matrix. Notice, partial row pivoting is utilized - Cmat_mult_diagComputes the matrix operation: C = A * B, where A is a diagonal matrix - Cmat_mult_lower_triComputes the matrix operation C = A * B, where A is a lower triangular matrix - Cmat_mult_upper_triComputes the matrix operation C = A * B, where A is an upper triangular matrix - Cmat_solve_lower_triSolves the lower triangular system A X = B, where A is a lower triangular matrix - Cmat_solve_upper_triSolves the upper triangular system A X = B, where A is an upper triangular matrix - Cqr_resultsDefines a container for the output of a QR factorization - Cqr_results_cmplxDefines a container for the output of a QR factorization - Csvd_resultsDefines a container for the output of a singular value decomposition of a matrix - Csvd_results_cmplxDefines a container for the output of a singular value decomposition of a matrix diff --git a/doc/html/namespaces_dup.js b/doc/html/namespaces_dup.js index 60d57fb3..b5268083 100644 --- a/doc/html/namespaces_dup.js +++ b/doc/html/namespaces_dup.js @@ -1,5 +1,4 @@ var namespaces_dup = [ - [ "linalg", "namespacelinalg.html", "namespacelinalg" ], - [ "linalg_immutable", "namespacelinalg__immutable.html", "namespacelinalg__immutable" ] + [ "linalg", "namespacelinalg.html", "namespacelinalg" ] ]; \ No newline at end of file diff --git a/doc/html/navtreedata.js b/doc/html/navtreedata.js index a744a0c3..d27fffa8 100644 --- a/doc/html/navtreedata.js +++ b/doc/html/navtreedata.js @@ -30,17 +30,12 @@ var NAVTREE = [ "Modules List", "namespaces.html", "namespaces_dup" ], [ "Module Members", "namespacemembers.html", [ [ "All", "namespacemembers.html", null ], - [ "Functions/Subroutines", "namespacemembers_func.html", null ], [ "Variables", "namespacemembers_vars.html", null ] ] ] ] ], [ "Data Types List", "annotated.html", [ [ "Data Types List", "annotated.html", "annotated_dup" ], - [ "Data Types", "classes.html", null ], - [ "Data Fields", "functions.html", [ - [ "All", "functions.html", null ], - [ "Variables", "functions_vars.html", null ] - ] ] + [ "Data Types", "classes.html", null ] ] ], [ "Files", "files.html", [ [ "File List", "files.html", "files_dup" ] diff --git a/doc/html/navtreeindex0.js b/doc/html/navtreeindex0.js index 161ddbf9..7d06be01 100644 --- a/doc/html/navtreeindex0.js +++ b/doc/html/navtreeindex0.js @@ -5,96 +5,79 @@ var NAVTREEINDEX0 = "dir_68267d1309a1af8e8297ef4c3efbcdba.html":[3,0,1], "dir_d44c64559bbebec7f509842c48db8b23.html":[3,0,0], "files.html":[3,0], -"functions.html":[2,2,0], -"functions_vars.html":[2,2,1], "index.html":[], "index.html#intro_sec":[0], -"interfacelinalg_1_1cholesky__factor.html":[2,0,0,0], "interfacelinalg_1_1cholesky__factor.html":[1,0,0,0], -"interfacelinalg_1_1cholesky__rank1__downdate.html":[2,0,0,1], +"interfacelinalg_1_1cholesky__factor.html":[2,0,0,0], "interfacelinalg_1_1cholesky__rank1__downdate.html":[1,0,0,1], +"interfacelinalg_1_1cholesky__rank1__downdate.html":[2,0,0,1], "interfacelinalg_1_1cholesky__rank1__update.html":[1,0,0,2], "interfacelinalg_1_1cholesky__rank1__update.html":[2,0,0,2], -"interfacelinalg_1_1det.html":[2,0,0,3], "interfacelinalg_1_1det.html":[1,0,0,3], +"interfacelinalg_1_1det.html":[2,0,0,3], "interfacelinalg_1_1diag__mtx__mult.html":[1,0,0,4], "interfacelinalg_1_1diag__mtx__mult.html":[2,0,0,4], "interfacelinalg_1_1eigen.html":[2,0,0,5], "interfacelinalg_1_1eigen.html":[1,0,0,5], -"interfacelinalg_1_1form__lu.html":[1,0,0,6], "interfacelinalg_1_1form__lu.html":[2,0,0,6], +"interfacelinalg_1_1form__lu.html":[1,0,0,6], "interfacelinalg_1_1form__qr.html":[1,0,0,7], "interfacelinalg_1_1form__qr.html":[2,0,0,7], -"interfacelinalg_1_1lu__factor.html":[1,0,0,8], "interfacelinalg_1_1lu__factor.html":[2,0,0,8], +"interfacelinalg_1_1lu__factor.html":[1,0,0,8], "interfacelinalg_1_1mtx__inverse.html":[2,0,0,9], "interfacelinalg_1_1mtx__inverse.html":[1,0,0,9], -"interfacelinalg_1_1mtx__mult.html":[2,0,0,10], "interfacelinalg_1_1mtx__mult.html":[1,0,0,10], +"interfacelinalg_1_1mtx__mult.html":[2,0,0,10], "interfacelinalg_1_1mtx__pinverse.html":[2,0,0,11], "interfacelinalg_1_1mtx__pinverse.html":[1,0,0,11], -"interfacelinalg_1_1mtx__rank.html":[2,0,0,12], "interfacelinalg_1_1mtx__rank.html":[1,0,0,12], +"interfacelinalg_1_1mtx__rank.html":[2,0,0,12], "interfacelinalg_1_1mult__qr.html":[2,0,0,13], "interfacelinalg_1_1mult__qr.html":[1,0,0,13], "interfacelinalg_1_1mult__rz.html":[2,0,0,14], "interfacelinalg_1_1mult__rz.html":[1,0,0,14], -"interfacelinalg_1_1qr__factor.html":[2,0,0,15], "interfacelinalg_1_1qr__factor.html":[1,0,0,15], -"interfacelinalg_1_1qr__rank1__update.html":[2,0,0,16], +"interfacelinalg_1_1qr__factor.html":[2,0,0,15], "interfacelinalg_1_1qr__rank1__update.html":[1,0,0,16], +"interfacelinalg_1_1qr__rank1__update.html":[2,0,0,16], "interfacelinalg_1_1rank1__update.html":[1,0,0,17], "interfacelinalg_1_1rank1__update.html":[2,0,0,17], "interfacelinalg_1_1recip__mult__array.html":[1,0,0,18], "interfacelinalg_1_1recip__mult__array.html":[2,0,0,18], "interfacelinalg_1_1rz__factor.html":[1,0,0,19], "interfacelinalg_1_1rz__factor.html":[2,0,0,19], -"interfacelinalg_1_1solve__cholesky.html":[1,0,0,20], "interfacelinalg_1_1solve__cholesky.html":[2,0,0,20], -"interfacelinalg_1_1solve__least__squares.html":[1,0,0,21], +"interfacelinalg_1_1solve__cholesky.html":[1,0,0,20], "interfacelinalg_1_1solve__least__squares.html":[2,0,0,21], -"interfacelinalg_1_1solve__least__squares__full.html":[1,0,0,22], +"interfacelinalg_1_1solve__least__squares.html":[1,0,0,21], "interfacelinalg_1_1solve__least__squares__full.html":[2,0,0,22], +"interfacelinalg_1_1solve__least__squares__full.html":[1,0,0,22], "interfacelinalg_1_1solve__least__squares__svd.html":[1,0,0,23], "interfacelinalg_1_1solve__least__squares__svd.html":[2,0,0,23], "interfacelinalg_1_1solve__lu.html":[1,0,0,24], "interfacelinalg_1_1solve__lu.html":[2,0,0,24], -"interfacelinalg_1_1solve__qr.html":[2,0,0,25], "interfacelinalg_1_1solve__qr.html":[1,0,0,25], -"interfacelinalg_1_1solve__triangular__system.html":[2,0,0,26], +"interfacelinalg_1_1solve__qr.html":[2,0,0,25], "interfacelinalg_1_1solve__triangular__system.html":[1,0,0,26], +"interfacelinalg_1_1solve__triangular__system.html":[2,0,0,26], "interfacelinalg_1_1sort.html":[1,0,0,27], "interfacelinalg_1_1sort.html":[2,0,0,27], "interfacelinalg_1_1svd.html":[1,0,0,28], "interfacelinalg_1_1svd.html":[2,0,0,28], "interfacelinalg_1_1swap.html":[2,0,0,29], "interfacelinalg_1_1swap.html":[1,0,0,29], -"interfacelinalg_1_1trace.html":[2,0,0,30], "interfacelinalg_1_1trace.html":[1,0,0,30], +"interfacelinalg_1_1trace.html":[2,0,0,30], "interfacelinalg_1_1tri__mtx__mult.html":[1,0,0,31], "interfacelinalg_1_1tri__mtx__mult.html":[2,0,0,31], -"interfacelinalg__immutable_1_1mat__eigen.html":[1,0,1,3], -"interfacelinalg__immutable_1_1mat__eigen.html":[2,0,1,3], -"interfacelinalg__immutable_1_1mat__lu.html":[2,0,1,4], -"interfacelinalg__immutable_1_1mat__lu.html":[1,0,1,4], -"interfacelinalg__immutable_1_1mat__mult__diag.html":[1,0,1,5], -"interfacelinalg__immutable_1_1mat__mult__diag.html":[2,0,1,5], -"interfacelinalg__immutable_1_1mat__mult__lower__tri.html":[1,0,1,6], -"interfacelinalg__immutable_1_1mat__mult__lower__tri.html":[2,0,1,6], -"interfacelinalg__immutable_1_1mat__mult__upper__tri.html":[1,0,1,7], -"interfacelinalg__immutable_1_1mat__mult__upper__tri.html":[2,0,1,7], -"interfacelinalg__immutable_1_1mat__solve__lower__tri.html":[2,0,1,8], -"interfacelinalg__immutable_1_1mat__solve__lower__tri.html":[1,0,1,8], -"interfacelinalg__immutable_1_1mat__solve__upper__tri.html":[1,0,1,9], -"interfacelinalg__immutable_1_1mat__solve__upper__tri.html":[2,0,1,9], "linalg_8f90_source.html":[3,0,1,0], "linalg_8h_source.html":[3,0,0,0], "linalg__basic_8f90_source.html":[3,0,1,1], "linalg__eigen_8f90_source.html":[3,0,1,2], "linalg__factor_8f90_source.html":[3,0,1,3], -"linalg__immutable_8f90_source.html":[3,0,1,4], -"linalg__solve_8f90_source.html":[3,0,1,5], -"linalg__sorting_8f90_source.html":[3,0,1,6], +"linalg__solve_8f90_source.html":[3,0,1,4], +"linalg__sorting_8f90_source.html":[3,0,1,5], "namespacelinalg.html":[1,0,0], "namespacelinalg.html#a0e420096028b759a87f2f4f4306d202a":[1,0,0,34], "namespacelinalg.html#a2b842a1fb17710d7ec2f117f5fdb2a59":[1,0,0,42], @@ -107,75 +90,8 @@ var NAVTREEINDEX0 = "namespacelinalg.html#ad89b9d502b7c484df53f9b10b9545776":[1,0,0,37], "namespacelinalg.html#aefdfc0979567e89aa3b8c599d3f766f4":[1,0,0,38], "namespacelinalg.html#af5dc9d60151bb81436b442525871c8c9":[1,0,0,41], -"namespacelinalg__immutable.html":[1,0,1], -"namespacelinalg__immutable.html#a4b09077ad1495833919bab84b144b297":[1,0,1,22], -"namespacelinalg__immutable.html#a5876e7f21f20679fd6c0c84768061a30":[1,0,1,15], -"namespacelinalg__immutable.html#a6236acadb527f7762e3e1c0ee3d9ca82":[1,0,1,24], -"namespacelinalg__immutable.html#a83eaeadc3a3cc5d81c46824174e5a90b":[1,0,1,17], -"namespacelinalg__immutable.html#a8f1ba0ce9f8fbece16a512145bbc197f":[1,0,1,21], -"namespacelinalg__immutable.html#a9648fd41cc3ce8ec40f67236d274f9a8":[1,0,1,23], -"namespacelinalg__immutable.html#a98f5b4e5de682d686cb763ab60fcde7f":[1,0,1,19], -"namespacelinalg__immutable.html#aaf39795f72fad79a38213893b850d793":[1,0,1,20], -"namespacelinalg__immutable.html#ab7abd8e3fd4170b5b5dfad4448a651c9":[1,0,1,18], -"namespacelinalg__immutable.html#aeb1f553973ae3e9b86cb30a1ca1f5700":[1,0,1,14], -"namespacelinalg__immutable.html#afb844327cadfdd08580c94cb1668c2a8":[1,0,1,16], "namespacemembers.html":[1,1,0], -"namespacemembers_func.html":[1,1,1], -"namespacemembers_vars.html":[1,1,2], +"namespacemembers_vars.html":[1,1,1], "namespaces.html":[1,0], -"pages.html":[], -"structlinalg__immutable_1_1eigen__results.html":[1,0,1,0], -"structlinalg__immutable_1_1eigen__results.html":[2,0,1,0], -"structlinalg__immutable_1_1eigen__results.html#a982607b9c3ff93504bb4524dcd31a442":[1,0,1,0,1], -"structlinalg__immutable_1_1eigen__results.html#a982607b9c3ff93504bb4524dcd31a442":[2,0,1,0,1], -"structlinalg__immutable_1_1eigen__results.html#abb60901ab160c6fd232cfb46ed0bf3cc":[1,0,1,0,0], -"structlinalg__immutable_1_1eigen__results.html#abb60901ab160c6fd232cfb46ed0bf3cc":[2,0,1,0,0], -"structlinalg__immutable_1_1lu__results.html":[1,0,1,1], -"structlinalg__immutable_1_1lu__results.html":[2,0,1,1], -"structlinalg__immutable_1_1lu__results.html#a7a11c264a8858527ebc021e609600cbb":[1,0,1,1,0], -"structlinalg__immutable_1_1lu__results.html#a7a11c264a8858527ebc021e609600cbb":[2,0,1,1,0], -"structlinalg__immutable_1_1lu__results.html#ab1af96c7808037f63563e1bf912c4dad":[1,0,1,1,2], -"structlinalg__immutable_1_1lu__results.html#ab1af96c7808037f63563e1bf912c4dad":[2,0,1,1,2], -"structlinalg__immutable_1_1lu__results.html#ae1e1fd78123e04a2be4f1bfd25ddddb1":[1,0,1,1,1], -"structlinalg__immutable_1_1lu__results.html#ae1e1fd78123e04a2be4f1bfd25ddddb1":[2,0,1,1,1], -"structlinalg__immutable_1_1lu__results__cmplx.html":[2,0,1,2], -"structlinalg__immutable_1_1lu__results__cmplx.html":[1,0,1,2], -"structlinalg__immutable_1_1lu__results__cmplx.html#a0634e363082d3c94fab5d5c73755f4ae":[2,0,1,2,0], -"structlinalg__immutable_1_1lu__results__cmplx.html#a0634e363082d3c94fab5d5c73755f4ae":[1,0,1,2,0], -"structlinalg__immutable_1_1lu__results__cmplx.html#a7488afe2004b11c8fed4c517400fde98":[2,0,1,2,2], -"structlinalg__immutable_1_1lu__results__cmplx.html#a7488afe2004b11c8fed4c517400fde98":[1,0,1,2,2], -"structlinalg__immutable_1_1lu__results__cmplx.html#a99d03bc910361aab08d17fcc4aaa960d":[2,0,1,2,1], -"structlinalg__immutable_1_1lu__results__cmplx.html#a99d03bc910361aab08d17fcc4aaa960d":[1,0,1,2,1], -"structlinalg__immutable_1_1qr__results.html":[2,0,1,10], -"structlinalg__immutable_1_1qr__results.html":[1,0,1,10], -"structlinalg__immutable_1_1qr__results.html#a053899b9dffba08b5052544c13d4983c":[2,0,1,10,0], -"structlinalg__immutable_1_1qr__results.html#a053899b9dffba08b5052544c13d4983c":[1,0,1,10,0], -"structlinalg__immutable_1_1qr__results.html#a91547ec8def57c0cc59271ccf59b3a01":[2,0,1,10,1], -"structlinalg__immutable_1_1qr__results.html#a91547ec8def57c0cc59271ccf59b3a01":[1,0,1,10,1], -"structlinalg__immutable_1_1qr__results.html#aeeea31b1fad256f5fcc2462b2990d56b":[2,0,1,10,2], -"structlinalg__immutable_1_1qr__results.html#aeeea31b1fad256f5fcc2462b2990d56b":[1,0,1,10,2], -"structlinalg__immutable_1_1qr__results__cmplx.html":[2,0,1,11], -"structlinalg__immutable_1_1qr__results__cmplx.html":[1,0,1,11], -"structlinalg__immutable_1_1qr__results__cmplx.html#a782d54320ca646427702d5f2e0a9372f":[2,0,1,11,0], -"structlinalg__immutable_1_1qr__results__cmplx.html#a782d54320ca646427702d5f2e0a9372f":[1,0,1,11,0], -"structlinalg__immutable_1_1qr__results__cmplx.html#a7fa839ced2d020c61550d5b6cff9bb69":[1,0,1,11,1], -"structlinalg__immutable_1_1qr__results__cmplx.html#a7fa839ced2d020c61550d5b6cff9bb69":[2,0,1,11,1], -"structlinalg__immutable_1_1qr__results__cmplx.html#a9382745395a25db425c5de89c33df2cd":[1,0,1,11,2], -"structlinalg__immutable_1_1qr__results__cmplx.html#a9382745395a25db425c5de89c33df2cd":[2,0,1,11,2], -"structlinalg__immutable_1_1svd__results.html":[1,0,1,12], -"structlinalg__immutable_1_1svd__results.html":[2,0,1,12], -"structlinalg__immutable_1_1svd__results.html#a582822c9765048fcb8632d72a6ed506a":[1,0,1,12,1], -"structlinalg__immutable_1_1svd__results.html#a582822c9765048fcb8632d72a6ed506a":[2,0,1,12,1], -"structlinalg__immutable_1_1svd__results.html#acbc05e1d170351bbfcd4cd1f089c81d8":[1,0,1,12,0], -"structlinalg__immutable_1_1svd__results.html#acbc05e1d170351bbfcd4cd1f089c81d8":[2,0,1,12,0], -"structlinalg__immutable_1_1svd__results.html#af5c35f3392431179a5cb15d1cddf7cb1":[1,0,1,12,2], -"structlinalg__immutable_1_1svd__results.html#af5c35f3392431179a5cb15d1cddf7cb1":[2,0,1,12,2], -"structlinalg__immutable_1_1svd__results__cmplx.html":[2,0,1,13], -"structlinalg__immutable_1_1svd__results__cmplx.html":[1,0,1,13], -"structlinalg__immutable_1_1svd__results__cmplx.html#a66544dafaacf2b5465e6b1c55d804fff":[2,0,1,13,0], -"structlinalg__immutable_1_1svd__results__cmplx.html#a66544dafaacf2b5465e6b1c55d804fff":[1,0,1,13,0], -"structlinalg__immutable_1_1svd__results__cmplx.html#ae65cfdf6d19c3bbb3a7e425db266cb3c":[2,0,1,13,1], -"structlinalg__immutable_1_1svd__results__cmplx.html#ae65cfdf6d19c3bbb3a7e425db266cb3c":[1,0,1,13,1], -"structlinalg__immutable_1_1svd__results__cmplx.html#af9e74638b38510fb24de3f3a6ea30de8":[1,0,1,13,2], -"structlinalg__immutable_1_1svd__results__cmplx.html#af9e74638b38510fb24de3f3a6ea30de8":[2,0,1,13,2] +"pages.html":[] }; diff --git a/doc/html/search/all_2.js b/doc/html/search/all_2.js index 86179e2a..66cad2be 100644 --- a/doc/html/search/all_2.js +++ b/doc/html/search/all_2.js @@ -1,5 +1,4 @@ var searchData= [ - ['eigen_0',['eigen',['../interfacelinalg_1_1eigen.html',1,'linalg']]], - ['eigen_5fresults_1',['eigen_results',['../structlinalg__immutable_1_1eigen__results.html',1,'linalg_immutable']]] + ['eigen_0',['eigen',['../interfacelinalg_1_1eigen.html',1,'linalg']]] ]; diff --git a/doc/html/search/all_4.js b/doc/html/search/all_4.js index 7cf2a492..b18ca7dc 100644 --- a/doc/html/search/all_4.js +++ b/doc/html/search/all_4.js @@ -1,4 +1,16 @@ var searchData= [ - ['identity_0',['identity',['../namespacelinalg__immutable.html#aeb1f553973ae3e9b86cb30a1ca1f5700',1,'linalg_immutable']]] + ['la_5farray_5fsize_5ferror_0',['la_array_size_error',['../namespacelinalg.html#a7974856c0c0c76e6f1f2098a1eb7eac9',1,'linalg']]], + ['la_5fconvergence_5ferror_1',['la_convergence_error',['../namespacelinalg.html#ac691dea40873ac2a70c8b44c933774a7',1,'linalg']]], + ['la_5fhermitian_5ftranspose_2',['la_hermitian_transpose',['../namespacelinalg.html#a0e420096028b759a87f2f4f4306d202a',1,'linalg']]], + ['la_5finvalid_5finput_5ferror_3',['la_invalid_input_error',['../namespacelinalg.html#ace738355659bce2e9591473f0d543ef7',1,'linalg']]], + ['la_5finvalid_5foperation_5ferror_4',['la_invalid_operation_error',['../namespacelinalg.html#a4f47021e96cd813b568422a2eb3821bc',1,'linalg']]], + ['la_5fmatrix_5fformat_5ferror_5',['la_matrix_format_error',['../namespacelinalg.html#ad89b9d502b7c484df53f9b10b9545776',1,'linalg']]], + ['la_5fno_5ferror_6',['la_no_error',['../namespacelinalg.html#aefdfc0979567e89aa3b8c599d3f766f4',1,'linalg']]], + ['la_5fno_5foperation_7',['la_no_operation',['../namespacelinalg.html#a665d131453840e869510e9e8d2f7f151',1,'linalg']]], + ['la_5fout_5fof_5fmemory_5ferror_8',['la_out_of_memory_error',['../namespacelinalg.html#abfb78ba61c0c2751f1c771c984469006',1,'linalg']]], + ['la_5fsingular_5fmatrix_5ferror_9',['la_singular_matrix_error',['../namespacelinalg.html#af5dc9d60151bb81436b442525871c8c9',1,'linalg']]], + ['la_5ftranspose_10',['la_transpose',['../namespacelinalg.html#a2b842a1fb17710d7ec2f117f5fdb2a59',1,'linalg']]], + ['linalg_11',['linalg',['../index.html',1,'(Global Namespace)'],['../namespacelinalg.html',1,'linalg']]], + ['lu_5ffactor_12',['lu_factor',['../interfacelinalg_1_1lu__factor.html',1,'linalg']]] ]; diff --git a/doc/html/search/all_5.js b/doc/html/search/all_5.js index 6547516f..9dc478d5 100644 --- a/doc/html/search/all_5.js +++ b/doc/html/search/all_5.js @@ -1,20 +1,9 @@ var searchData= [ - ['l_0',['l',['../structlinalg__immutable_1_1lu__results.html#a7a11c264a8858527ebc021e609600cbb',1,'linalg_immutable::lu_results::l()'],['../structlinalg__immutable_1_1lu__results__cmplx.html#a0634e363082d3c94fab5d5c73755f4ae',1,'linalg_immutable::lu_results_cmplx::l()']]], - ['la_5farray_5fsize_5ferror_1',['la_array_size_error',['../namespacelinalg.html#a7974856c0c0c76e6f1f2098a1eb7eac9',1,'linalg']]], - ['la_5fconvergence_5ferror_2',['la_convergence_error',['../namespacelinalg.html#ac691dea40873ac2a70c8b44c933774a7',1,'linalg']]], - ['la_5fhermitian_5ftranspose_3',['la_hermitian_transpose',['../namespacelinalg.html#a0e420096028b759a87f2f4f4306d202a',1,'linalg']]], - ['la_5finvalid_5finput_5ferror_4',['la_invalid_input_error',['../namespacelinalg.html#ace738355659bce2e9591473f0d543ef7',1,'linalg']]], - ['la_5finvalid_5foperation_5ferror_5',['la_invalid_operation_error',['../namespacelinalg.html#a4f47021e96cd813b568422a2eb3821bc',1,'linalg']]], - ['la_5fmatrix_5fformat_5ferror_6',['la_matrix_format_error',['../namespacelinalg.html#ad89b9d502b7c484df53f9b10b9545776',1,'linalg']]], - ['la_5fno_5ferror_7',['la_no_error',['../namespacelinalg.html#aefdfc0979567e89aa3b8c599d3f766f4',1,'linalg']]], - ['la_5fno_5foperation_8',['la_no_operation',['../namespacelinalg.html#a665d131453840e869510e9e8d2f7f151',1,'linalg']]], - ['la_5fout_5fof_5fmemory_5ferror_9',['la_out_of_memory_error',['../namespacelinalg.html#abfb78ba61c0c2751f1c771c984469006',1,'linalg']]], - ['la_5fsingular_5fmatrix_5ferror_10',['la_singular_matrix_error',['../namespacelinalg.html#af5dc9d60151bb81436b442525871c8c9',1,'linalg']]], - ['la_5ftranspose_11',['la_transpose',['../namespacelinalg.html#a2b842a1fb17710d7ec2f117f5fdb2a59',1,'linalg']]], - ['linalg_12',['linalg',['../index.html',1,'(Global Namespace)'],['../namespacelinalg.html',1,'linalg']]], - ['linalg_5fimmutable_13',['linalg_immutable',['../namespacelinalg__immutable.html',1,'']]], - ['lu_5ffactor_14',['lu_factor',['../interfacelinalg_1_1lu__factor.html',1,'linalg']]], - ['lu_5fresults_15',['lu_results',['../structlinalg__immutable_1_1lu__results.html',1,'linalg_immutable']]], - ['lu_5fresults_5fcmplx_16',['lu_results_cmplx',['../structlinalg__immutable_1_1lu__results__cmplx.html',1,'linalg_immutable']]] + ['mtx_5finverse_0',['mtx_inverse',['../interfacelinalg_1_1mtx__inverse.html',1,'linalg']]], + ['mtx_5fmult_1',['mtx_mult',['../interfacelinalg_1_1mtx__mult.html',1,'linalg']]], + ['mtx_5fpinverse_2',['mtx_pinverse',['../interfacelinalg_1_1mtx__pinverse.html',1,'linalg']]], + ['mtx_5frank_3',['mtx_rank',['../interfacelinalg_1_1mtx__rank.html',1,'linalg']]], + ['mult_5fqr_4',['mult_qr',['../interfacelinalg_1_1mult__qr.html',1,'linalg']]], + ['mult_5frz_5',['mult_rz',['../interfacelinalg_1_1mult__rz.html',1,'linalg']]] ]; diff --git a/doc/html/search/all_6.js b/doc/html/search/all_6.js index 0110ae92..15a9615a 100644 --- a/doc/html/search/all_6.js +++ b/doc/html/search/all_6.js @@ -1,26 +1,5 @@ var searchData= [ - ['mat_5fcholesky_0',['mat_cholesky',['../namespacelinalg__immutable.html#a5876e7f21f20679fd6c0c84768061a30',1,'linalg_immutable']]], - ['mat_5fcholesky_5frank1_5fdowndate_1',['mat_cholesky_rank1_downdate',['../namespacelinalg__immutable.html#afb844327cadfdd08580c94cb1668c2a8',1,'linalg_immutable']]], - ['mat_5fcholesky_5frank1_5fupdate_2',['mat_cholesky_rank1_update',['../namespacelinalg__immutable.html#a83eaeadc3a3cc5d81c46824174e5a90b',1,'linalg_immutable']]], - ['mat_5fdet_3',['mat_det',['../namespacelinalg__immutable.html#ab7abd8e3fd4170b5b5dfad4448a651c9',1,'linalg_immutable']]], - ['mat_5feigen_4',['mat_eigen',['../interfacelinalg__immutable_1_1mat__eigen.html',1,'linalg_immutable']]], - ['mat_5finverse_5',['mat_inverse',['../namespacelinalg__immutable.html#a98f5b4e5de682d686cb763ab60fcde7f',1,'linalg_immutable']]], - ['mat_5flu_6',['mat_lu',['../interfacelinalg__immutable_1_1mat__lu.html',1,'linalg_immutable']]], - ['mat_5fmult_5fdiag_7',['mat_mult_diag',['../interfacelinalg__immutable_1_1mat__mult__diag.html',1,'linalg_immutable']]], - ['mat_5fmult_5flower_5ftri_8',['mat_mult_lower_tri',['../interfacelinalg__immutable_1_1mat__mult__lower__tri.html',1,'linalg_immutable']]], - ['mat_5fmult_5fupper_5ftri_9',['mat_mult_upper_tri',['../interfacelinalg__immutable_1_1mat__mult__upper__tri.html',1,'linalg_immutable']]], - ['mat_5fpinverse_10',['mat_pinverse',['../namespacelinalg__immutable.html#aaf39795f72fad79a38213893b850d793',1,'linalg_immutable']]], - ['mat_5fqr_11',['mat_qr',['../namespacelinalg__immutable.html#a8f1ba0ce9f8fbece16a512145bbc197f',1,'linalg_immutable']]], - ['mat_5fqr_5frank1_5fupdate_12',['mat_qr_rank1_update',['../namespacelinalg__immutable.html#a4b09077ad1495833919bab84b144b297',1,'linalg_immutable']]], - ['mat_5frank1_5fupdate_13',['mat_rank1_update',['../namespacelinalg__immutable.html#a9648fd41cc3ce8ec40f67236d274f9a8',1,'linalg_immutable']]], - ['mat_5fsolve_5flower_5ftri_14',['mat_solve_lower_tri',['../interfacelinalg__immutable_1_1mat__solve__lower__tri.html',1,'linalg_immutable']]], - ['mat_5fsolve_5fupper_5ftri_15',['mat_solve_upper_tri',['../interfacelinalg__immutable_1_1mat__solve__upper__tri.html',1,'linalg_immutable']]], - ['mat_5fsvd_16',['mat_svd',['../namespacelinalg__immutable.html#a6236acadb527f7762e3e1c0ee3d9ca82',1,'linalg_immutable']]], - ['mtx_5finverse_17',['mtx_inverse',['../interfacelinalg_1_1mtx__inverse.html',1,'linalg']]], - ['mtx_5fmult_18',['mtx_mult',['../interfacelinalg_1_1mtx__mult.html',1,'linalg']]], - ['mtx_5fpinverse_19',['mtx_pinverse',['../interfacelinalg_1_1mtx__pinverse.html',1,'linalg']]], - ['mtx_5frank_20',['mtx_rank',['../interfacelinalg_1_1mtx__rank.html',1,'linalg']]], - ['mult_5fqr_21',['mult_qr',['../interfacelinalg_1_1mult__qr.html',1,'linalg']]], - ['mult_5frz_22',['mult_rz',['../interfacelinalg_1_1mult__rz.html',1,'linalg']]] + ['qr_5ffactor_0',['qr_factor',['../interfacelinalg_1_1qr__factor.html',1,'linalg']]], + ['qr_5frank1_5fupdate_1',['qr_rank1_update',['../interfacelinalg_1_1qr__rank1__update.html',1,'linalg']]] ]; diff --git a/doc/html/search/all_7.js b/doc/html/search/all_7.js index f0e2a425..686d365a 100644 --- a/doc/html/search/all_7.js +++ b/doc/html/search/all_7.js @@ -1,4 +1,6 @@ var searchData= [ - ['p_0',['p',['../structlinalg__immutable_1_1lu__results.html#ae1e1fd78123e04a2be4f1bfd25ddddb1',1,'linalg_immutable::lu_results::p()'],['../structlinalg__immutable_1_1lu__results__cmplx.html#a99d03bc910361aab08d17fcc4aaa960d',1,'linalg_immutable::lu_results_cmplx::p()'],['../structlinalg__immutable_1_1qr__results.html#a053899b9dffba08b5052544c13d4983c',1,'linalg_immutable::qr_results::p()'],['../structlinalg__immutable_1_1qr__results__cmplx.html#a782d54320ca646427702d5f2e0a9372f',1,'linalg_immutable::qr_results_cmplx::p()']]] + ['rank1_5fupdate_0',['rank1_update',['../interfacelinalg_1_1rank1__update.html',1,'linalg']]], + ['recip_5fmult_5farray_1',['recip_mult_array',['../interfacelinalg_1_1recip__mult__array.html',1,'linalg']]], + ['rz_5ffactor_2',['rz_factor',['../interfacelinalg_1_1rz__factor.html',1,'linalg']]] ]; diff --git a/doc/html/search/all_8.js b/doc/html/search/all_8.js index a3eee615..9de17823 100644 --- a/doc/html/search/all_8.js +++ b/doc/html/search/all_8.js @@ -1,8 +1,13 @@ var searchData= [ - ['q_0',['q',['../structlinalg__immutable_1_1qr__results.html#a91547ec8def57c0cc59271ccf59b3a01',1,'linalg_immutable::qr_results::q()'],['../structlinalg__immutable_1_1qr__results__cmplx.html#a7fa839ced2d020c61550d5b6cff9bb69',1,'linalg_immutable::qr_results_cmplx::q()']]], - ['qr_5ffactor_1',['qr_factor',['../interfacelinalg_1_1qr__factor.html',1,'linalg']]], - ['qr_5frank1_5fupdate_2',['qr_rank1_update',['../interfacelinalg_1_1qr__rank1__update.html',1,'linalg']]], - ['qr_5fresults_3',['qr_results',['../structlinalg__immutable_1_1qr__results.html',1,'linalg_immutable']]], - ['qr_5fresults_5fcmplx_4',['qr_results_cmplx',['../structlinalg__immutable_1_1qr__results__cmplx.html',1,'linalg_immutable']]] + ['solve_5fcholesky_0',['solve_cholesky',['../interfacelinalg_1_1solve__cholesky.html',1,'linalg']]], + ['solve_5fleast_5fsquares_1',['solve_least_squares',['../interfacelinalg_1_1solve__least__squares.html',1,'linalg']]], + ['solve_5fleast_5fsquares_5ffull_2',['solve_least_squares_full',['../interfacelinalg_1_1solve__least__squares__full.html',1,'linalg']]], + ['solve_5fleast_5fsquares_5fsvd_3',['solve_least_squares_svd',['../interfacelinalg_1_1solve__least__squares__svd.html',1,'linalg']]], + ['solve_5flu_4',['solve_lu',['../interfacelinalg_1_1solve__lu.html',1,'linalg']]], + ['solve_5fqr_5',['solve_qr',['../interfacelinalg_1_1solve__qr.html',1,'linalg']]], + ['solve_5ftriangular_5fsystem_6',['solve_triangular_system',['../interfacelinalg_1_1solve__triangular__system.html',1,'linalg']]], + ['sort_7',['sort',['../interfacelinalg_1_1sort.html',1,'linalg']]], + ['svd_8',['svd',['../interfacelinalg_1_1svd.html',1,'linalg']]], + ['swap_9',['swap',['../interfacelinalg_1_1swap.html',1,'linalg']]] ]; diff --git a/doc/html/search/all_9.js b/doc/html/search/all_9.js index e638d2af..90d19100 100644 --- a/doc/html/search/all_9.js +++ b/doc/html/search/all_9.js @@ -1,7 +1,5 @@ var searchData= [ - ['r_0',['r',['../structlinalg__immutable_1_1qr__results.html#aeeea31b1fad256f5fcc2462b2990d56b',1,'linalg_immutable::qr_results::r()'],['../structlinalg__immutable_1_1qr__results__cmplx.html#a9382745395a25db425c5de89c33df2cd',1,'linalg_immutable::qr_results_cmplx::r()']]], - ['rank1_5fupdate_1',['rank1_update',['../interfacelinalg_1_1rank1__update.html',1,'linalg']]], - ['recip_5fmult_5farray_2',['recip_mult_array',['../interfacelinalg_1_1recip__mult__array.html',1,'linalg']]], - ['rz_5ffactor_3',['rz_factor',['../interfacelinalg_1_1rz__factor.html',1,'linalg']]] + ['trace_0',['trace',['../interfacelinalg_1_1trace.html',1,'linalg']]], + ['tri_5fmtx_5fmult_1',['tri_mtx_mult',['../interfacelinalg_1_1tri__mtx__mult.html',1,'linalg']]] ]; diff --git a/doc/html/search/classes_2.js b/doc/html/search/classes_2.js index 86179e2a..66cad2be 100644 --- a/doc/html/search/classes_2.js +++ b/doc/html/search/classes_2.js @@ -1,5 +1,4 @@ var searchData= [ - ['eigen_0',['eigen',['../interfacelinalg_1_1eigen.html',1,'linalg']]], - ['eigen_5fresults_1',['eigen_results',['../structlinalg__immutable_1_1eigen__results.html',1,'linalg_immutable']]] + ['eigen_0',['eigen',['../interfacelinalg_1_1eigen.html',1,'linalg']]] ]; diff --git a/doc/html/search/classes_4.js b/doc/html/search/classes_4.js index 19ae8c9c..cd2d1a10 100644 --- a/doc/html/search/classes_4.js +++ b/doc/html/search/classes_4.js @@ -1,6 +1,4 @@ var searchData= [ - ['lu_5ffactor_0',['lu_factor',['../interfacelinalg_1_1lu__factor.html',1,'linalg']]], - ['lu_5fresults_1',['lu_results',['../structlinalg__immutable_1_1lu__results.html',1,'linalg_immutable']]], - ['lu_5fresults_5fcmplx_2',['lu_results_cmplx',['../structlinalg__immutable_1_1lu__results__cmplx.html',1,'linalg_immutable']]] + ['lu_5ffactor_0',['lu_factor',['../interfacelinalg_1_1lu__factor.html',1,'linalg']]] ]; diff --git a/doc/html/search/classes_5.js b/doc/html/search/classes_5.js index 2ecc95d3..9dc478d5 100644 --- a/doc/html/search/classes_5.js +++ b/doc/html/search/classes_5.js @@ -1,16 +1,9 @@ var searchData= [ - ['mat_5feigen_0',['mat_eigen',['../interfacelinalg__immutable_1_1mat__eigen.html',1,'linalg_immutable']]], - ['mat_5flu_1',['mat_lu',['../interfacelinalg__immutable_1_1mat__lu.html',1,'linalg_immutable']]], - ['mat_5fmult_5fdiag_2',['mat_mult_diag',['../interfacelinalg__immutable_1_1mat__mult__diag.html',1,'linalg_immutable']]], - ['mat_5fmult_5flower_5ftri_3',['mat_mult_lower_tri',['../interfacelinalg__immutable_1_1mat__mult__lower__tri.html',1,'linalg_immutable']]], - ['mat_5fmult_5fupper_5ftri_4',['mat_mult_upper_tri',['../interfacelinalg__immutable_1_1mat__mult__upper__tri.html',1,'linalg_immutable']]], - ['mat_5fsolve_5flower_5ftri_5',['mat_solve_lower_tri',['../interfacelinalg__immutable_1_1mat__solve__lower__tri.html',1,'linalg_immutable']]], - ['mat_5fsolve_5fupper_5ftri_6',['mat_solve_upper_tri',['../interfacelinalg__immutable_1_1mat__solve__upper__tri.html',1,'linalg_immutable']]], - ['mtx_5finverse_7',['mtx_inverse',['../interfacelinalg_1_1mtx__inverse.html',1,'linalg']]], - ['mtx_5fmult_8',['mtx_mult',['../interfacelinalg_1_1mtx__mult.html',1,'linalg']]], - ['mtx_5fpinverse_9',['mtx_pinverse',['../interfacelinalg_1_1mtx__pinverse.html',1,'linalg']]], - ['mtx_5frank_10',['mtx_rank',['../interfacelinalg_1_1mtx__rank.html',1,'linalg']]], - ['mult_5fqr_11',['mult_qr',['../interfacelinalg_1_1mult__qr.html',1,'linalg']]], - ['mult_5frz_12',['mult_rz',['../interfacelinalg_1_1mult__rz.html',1,'linalg']]] + ['mtx_5finverse_0',['mtx_inverse',['../interfacelinalg_1_1mtx__inverse.html',1,'linalg']]], + ['mtx_5fmult_1',['mtx_mult',['../interfacelinalg_1_1mtx__mult.html',1,'linalg']]], + ['mtx_5fpinverse_2',['mtx_pinverse',['../interfacelinalg_1_1mtx__pinverse.html',1,'linalg']]], + ['mtx_5frank_3',['mtx_rank',['../interfacelinalg_1_1mtx__rank.html',1,'linalg']]], + ['mult_5fqr_4',['mult_qr',['../interfacelinalg_1_1mult__qr.html',1,'linalg']]], + ['mult_5frz_5',['mult_rz',['../interfacelinalg_1_1mult__rz.html',1,'linalg']]] ]; diff --git a/doc/html/search/classes_6.js b/doc/html/search/classes_6.js index b1deebe6..15a9615a 100644 --- a/doc/html/search/classes_6.js +++ b/doc/html/search/classes_6.js @@ -1,7 +1,5 @@ var searchData= [ ['qr_5ffactor_0',['qr_factor',['../interfacelinalg_1_1qr__factor.html',1,'linalg']]], - ['qr_5frank1_5fupdate_1',['qr_rank1_update',['../interfacelinalg_1_1qr__rank1__update.html',1,'linalg']]], - ['qr_5fresults_2',['qr_results',['../structlinalg__immutable_1_1qr__results.html',1,'linalg_immutable']]], - ['qr_5fresults_5fcmplx_3',['qr_results_cmplx',['../structlinalg__immutable_1_1qr__results__cmplx.html',1,'linalg_immutable']]] + ['qr_5frank1_5fupdate_1',['qr_rank1_update',['../interfacelinalg_1_1qr__rank1__update.html',1,'linalg']]] ]; diff --git a/doc/html/search/classes_8.js b/doc/html/search/classes_8.js index c4a74011..9de17823 100644 --- a/doc/html/search/classes_8.js +++ b/doc/html/search/classes_8.js @@ -9,7 +9,5 @@ var searchData= ['solve_5ftriangular_5fsystem_6',['solve_triangular_system',['../interfacelinalg_1_1solve__triangular__system.html',1,'linalg']]], ['sort_7',['sort',['../interfacelinalg_1_1sort.html',1,'linalg']]], ['svd_8',['svd',['../interfacelinalg_1_1svd.html',1,'linalg']]], - ['svd_5fresults_9',['svd_results',['../structlinalg__immutable_1_1svd__results.html',1,'linalg_immutable']]], - ['svd_5fresults_5fcmplx_10',['svd_results_cmplx',['../structlinalg__immutable_1_1svd__results__cmplx.html',1,'linalg_immutable']]], - ['swap_11',['swap',['../interfacelinalg_1_1swap.html',1,'linalg']]] + ['swap_9',['swap',['../interfacelinalg_1_1swap.html',1,'linalg']]] ]; diff --git a/doc/html/search/namespaces_0.js b/doc/html/search/namespaces_0.js index 02ed74d3..d8f7f6f0 100644 --- a/doc/html/search/namespaces_0.js +++ b/doc/html/search/namespaces_0.js @@ -1,5 +1,4 @@ var searchData= [ - ['linalg_0',['linalg',['../namespacelinalg.html',1,'']]], - ['linalg_5fimmutable_1',['linalg_immutable',['../namespacelinalg__immutable.html',1,'']]] + ['linalg_0',['linalg',['../namespacelinalg.html',1,'']]] ]; diff --git a/doc/html/search/searchdata.js b/doc/html/search/searchdata.js index 89be3c58..fe73d8e6 100644 --- a/doc/html/search/searchdata.js +++ b/doc/html/search/searchdata.js @@ -1,11 +1,10 @@ var indexSectionsWithContent = { - 0: "cdefilmpqrstuv", + 0: "cdeflmqrst", 1: "cdeflmqrst", 2: "l", - 3: "im", - 4: "lpqrsuv", - 5: "l" + 3: "l", + 4: "l" }; var indexSectionNames = @@ -13,9 +12,8 @@ var indexSectionNames = 0: "all", 1: "classes", 2: "namespaces", - 3: "functions", - 4: "variables", - 5: "pages" + 3: "variables", + 4: "pages" }; var indexSectionLabels = @@ -23,8 +21,7 @@ var indexSectionLabels = 0: "All", 1: "Classes", 2: "Namespaces", - 3: "Functions", - 4: "Variables", - 5: "Pages" + 3: "Variables", + 4: "Pages" }; diff --git a/doc/html/search/variables_0.js b/doc/html/search/variables_0.js index 0f1b0ab5..5dd8e2c7 100644 --- a/doc/html/search/variables_0.js +++ b/doc/html/search/variables_0.js @@ -1,15 +1,14 @@ var searchData= [ - ['l_0',['l',['../structlinalg__immutable_1_1lu__results.html#a7a11c264a8858527ebc021e609600cbb',1,'linalg_immutable::lu_results::l()'],['../structlinalg__immutable_1_1lu__results__cmplx.html#a0634e363082d3c94fab5d5c73755f4ae',1,'linalg_immutable::lu_results_cmplx::l()']]], - ['la_5farray_5fsize_5ferror_1',['la_array_size_error',['../namespacelinalg.html#a7974856c0c0c76e6f1f2098a1eb7eac9',1,'linalg']]], - ['la_5fconvergence_5ferror_2',['la_convergence_error',['../namespacelinalg.html#ac691dea40873ac2a70c8b44c933774a7',1,'linalg']]], - ['la_5fhermitian_5ftranspose_3',['la_hermitian_transpose',['../namespacelinalg.html#a0e420096028b759a87f2f4f4306d202a',1,'linalg']]], - ['la_5finvalid_5finput_5ferror_4',['la_invalid_input_error',['../namespacelinalg.html#ace738355659bce2e9591473f0d543ef7',1,'linalg']]], - ['la_5finvalid_5foperation_5ferror_5',['la_invalid_operation_error',['../namespacelinalg.html#a4f47021e96cd813b568422a2eb3821bc',1,'linalg']]], - ['la_5fmatrix_5fformat_5ferror_6',['la_matrix_format_error',['../namespacelinalg.html#ad89b9d502b7c484df53f9b10b9545776',1,'linalg']]], - ['la_5fno_5ferror_7',['la_no_error',['../namespacelinalg.html#aefdfc0979567e89aa3b8c599d3f766f4',1,'linalg']]], - ['la_5fno_5foperation_8',['la_no_operation',['../namespacelinalg.html#a665d131453840e869510e9e8d2f7f151',1,'linalg']]], - ['la_5fout_5fof_5fmemory_5ferror_9',['la_out_of_memory_error',['../namespacelinalg.html#abfb78ba61c0c2751f1c771c984469006',1,'linalg']]], - ['la_5fsingular_5fmatrix_5ferror_10',['la_singular_matrix_error',['../namespacelinalg.html#af5dc9d60151bb81436b442525871c8c9',1,'linalg']]], - ['la_5ftranspose_11',['la_transpose',['../namespacelinalg.html#a2b842a1fb17710d7ec2f117f5fdb2a59',1,'linalg']]] + ['la_5farray_5fsize_5ferror_0',['la_array_size_error',['../namespacelinalg.html#a7974856c0c0c76e6f1f2098a1eb7eac9',1,'linalg']]], + ['la_5fconvergence_5ferror_1',['la_convergence_error',['../namespacelinalg.html#ac691dea40873ac2a70c8b44c933774a7',1,'linalg']]], + ['la_5fhermitian_5ftranspose_2',['la_hermitian_transpose',['../namespacelinalg.html#a0e420096028b759a87f2f4f4306d202a',1,'linalg']]], + ['la_5finvalid_5finput_5ferror_3',['la_invalid_input_error',['../namespacelinalg.html#ace738355659bce2e9591473f0d543ef7',1,'linalg']]], + ['la_5finvalid_5foperation_5ferror_4',['la_invalid_operation_error',['../namespacelinalg.html#a4f47021e96cd813b568422a2eb3821bc',1,'linalg']]], + ['la_5fmatrix_5fformat_5ferror_5',['la_matrix_format_error',['../namespacelinalg.html#ad89b9d502b7c484df53f9b10b9545776',1,'linalg']]], + ['la_5fno_5ferror_6',['la_no_error',['../namespacelinalg.html#aefdfc0979567e89aa3b8c599d3f766f4',1,'linalg']]], + ['la_5fno_5foperation_7',['la_no_operation',['../namespacelinalg.html#a665d131453840e869510e9e8d2f7f151',1,'linalg']]], + ['la_5fout_5fof_5fmemory_5ferror_8',['la_out_of_memory_error',['../namespacelinalg.html#abfb78ba61c0c2751f1c771c984469006',1,'linalg']]], + ['la_5fsingular_5fmatrix_5ferror_9',['la_singular_matrix_error',['../namespacelinalg.html#af5dc9d60151bb81436b442525871c8c9',1,'linalg']]], + ['la_5ftranspose_10',['la_transpose',['../namespacelinalg.html#a2b842a1fb17710d7ec2f117f5fdb2a59',1,'linalg']]] ]; From b599e2d305d277f7374286428f48f2e754914efb Mon Sep 17 00:00:00 2001 From: jchristopherson Date: Fri, 16 Dec 2022 07:16:37 -0600 Subject: [PATCH 27/65] Code clean up --- src/linalg_factor.f90 | 166 ++++++++++++++++++++++++++++++++--------- src/linalg_solve.f90 | 148 ++++++++++++++++++++++++++++-------- src/linalg_sorting.f90 | 20 ++++- 3 files changed, 264 insertions(+), 70 deletions(-) diff --git a/src/linalg_factor.f90 b/src/linalg_factor.f90 index 2adb352e..7ffa1845 100644 --- a/src/linalg_factor.f90 +++ b/src/linalg_factor.f90 @@ -49,11 +49,14 @@ module subroutine lu_factor_dbl(a, ipvt, err) ! call to LAPACK if (flag > 0) then ! WARNING: Singular matrix - write(errmsg, '(AI0A)') & + write(errmsg, 100) & "Singular matrix encountered (row ", flag, ")" call errmgr%report_warning("lu_factor_dbl", trim(errmsg), & LA_SINGULAR_MATRIX_ERROR) end if + + ! Formatting +100 format(A, I0, A) end subroutine ! ------------------------------------------------------------------------------ @@ -97,11 +100,14 @@ module subroutine lu_factor_cmplx(a, ipvt, err) ! call to LAPACK if (flag > 0) then ! WARNING: Singular matrix - write(errmsg, '(AI0A)') & + write(errmsg, 100) & "Singular matrix encountered (row ", flag, ")" call errmgr%report_warning("lu_factor_cmplx", trim(errmsg), & LA_SINGULAR_MATRIX_ERROR) end if + + ! Formatting +100 format(A, I0, A) end subroutine ! ------------------------------------------------------------------------------ @@ -143,7 +149,7 @@ module subroutine form_lu_all(lu, ipvt, u, p, err) end if if (flag /= 0) then ! One of the input arrays is not sized correctly - write(errmsg, '(AI0A)') "Input number ", flag, & + write(errmsg, 100) "Input number ", flag, & " is not sized correctly." call errmgr%report_error("form_lu_all", trim(errmsg), & LA_ARRAY_SIZE_ERROR) @@ -166,6 +172,9 @@ module subroutine form_lu_all(lu, ipvt, u, p, err) if (j > 1) lu(1:j-1,j) = zero lu(j,j) = one end do + + ! Formatting +100 format(A, I0, A) end subroutine ! ------------------------------------------------------------------------------ @@ -210,7 +219,7 @@ module subroutine form_lu_all_cmplx(lu, ipvt, u, p, err) end if if (flag /= 0) then ! One of the input arrays is not sized correctly - write(errmsg, '(AI0A)') "Input number ", flag, & + write(errmsg, 100) "Input number ", flag, & " is not sized correctly." call errmgr%report_error("form_lu_all_cmplx", trim(errmsg), & LA_ARRAY_SIZE_ERROR) @@ -233,6 +242,9 @@ module subroutine form_lu_all_cmplx(lu, ipvt, u, p, err) if (j > 1) lu(1:j-1,j) = c_zero lu(j,j) = c_one end do + + ! Formatting +100 format(A, I0, A) end subroutine ! ------------------------------------------------------------------------------ @@ -269,7 +281,7 @@ module subroutine form_lu_only(lu, u, err) end if if (flag /= 0) then ! One of the input arrays is not sized correctly - write(errmsg, '(AI0A)') "Input number ", flag, & + write(errmsg, 100) "Input number ", flag, & " is not sized correctly." call errmgr%report_error("form_lu_only", trim(errmsg), & LA_ARRAY_SIZE_ERROR) @@ -285,6 +297,9 @@ module subroutine form_lu_only(lu, u, err) if (j > 1) lu(1:j-1,j) = zero lu(j,j) = one end do + + ! Formatting +100 format(A, I0, A) end subroutine ! ------------------------------------------------------------------------------ @@ -321,7 +336,7 @@ module subroutine form_lu_only_cmplx(lu, u, err) end if if (flag /= 0) then ! One of the input arrays is not sized correctly - write(errmsg, '(AI0A)') "Input number ", flag, & + write(errmsg, 100) "Input number ", flag, & " is not sized correctly." call errmgr%report_error("form_lu_only_cmplx", trim(errmsg), & LA_ARRAY_SIZE_ERROR) @@ -337,6 +352,9 @@ module subroutine form_lu_only_cmplx(lu, u, err) if (j > 1) lu(1:j-1,j) = zero lu(j,j) = one end do + + ! Formatting +100 format(A, I0, A) end subroutine ! ****************************************************************************** @@ -519,7 +537,7 @@ module subroutine qr_factor_pivot(a, tau, jpvt, work, olwork, err) end if if (flag /= 0) then ! ERROR: One of the input arrays is not sized correctly - write(errmsg, '(AI0A)') "Input number ", flag, & + write(errmsg, 100) "Input number ", flag, & " is not sized correctly." call errmgr%report_error("qr_factor_pivot", trim(errmsg), & LA_ARRAY_SIZE_ERROR) @@ -561,6 +579,9 @@ module subroutine qr_factor_pivot(a, tau, jpvt, work, olwork, err) ! End if (allocated(wrk)) deallocate(wrk) + + ! Formatting +100 format(A, I0, A) end subroutine ! ------------------------------------------------------------------------------ @@ -605,7 +626,7 @@ module subroutine qr_factor_pivot_cmplx(a, tau, jpvt, work, olwork, rwork, & end if if (flag /= 0) then ! ERROR: One of the input arrays is not sized correctly - write(errmsg, '(AI0A)') "Input number ", flag, & + write(errmsg, 100) "Input number ", flag, & " is not sized correctly." call errmgr%report_error("qr_factor_pivot_cmplx", trim(errmsg), & LA_ARRAY_SIZE_ERROR) @@ -665,6 +686,9 @@ module subroutine qr_factor_pivot_cmplx(a, tau, jpvt, work, olwork, rwork, & ! End if (allocated(wrk)) deallocate(wrk) + + ! Formatting +100 format(A, I0, A) end subroutine ! ------------------------------------------------------------------------------ @@ -711,7 +735,7 @@ module subroutine form_qr_no_pivot(r, tau, q, work, olwork, err) end if if (flag /= 0) then ! ERROR: One of the input arrays is not sized correctly - write(errmsg, '(AI0A)') "Input number ", flag, & + write(errmsg, 100) "Input number ", flag, & " is not sized correctly." call errmgr%report_error("form_qr_no_pivot", trim(errmsg), & LA_ARRAY_SIZE_ERROR) @@ -760,6 +784,9 @@ module subroutine form_qr_no_pivot(r, tau, q, work, olwork, err) ! End if (allocated(wrk)) deallocate(wrk) + + ! Formatting +100 format(A, I0, A) end subroutine ! ------------------------------------------------------------------------------ @@ -806,7 +833,7 @@ module subroutine form_qr_no_pivot_cmplx(r, tau, q, work, olwork, err) end if if (flag /= 0) then ! ERROR: One of the input arrays is not sized correctly - write(errmsg, '(AI0A)') "Input number ", flag, & + write(errmsg, 100) "Input number ", flag, & " is not sized correctly." call errmgr%report_error("form_qr_no_pivot_cmplx", trim(errmsg), & LA_ARRAY_SIZE_ERROR) @@ -855,6 +882,9 @@ module subroutine form_qr_no_pivot_cmplx(r, tau, q, work, olwork, err) ! End if (allocated(wrk)) deallocate(wrk) + + ! Formatting +100 format(A, I0, A) end subroutine ! ------------------------------------------------------------------------------ @@ -904,7 +934,7 @@ module subroutine form_qr_pivot(r, tau, pvt, q, p, work, olwork, err) end if if (flag /= 0) then ! ERROR: One of the input arrays is not sized correctly - write(errmsg, '(AI0A)') "Input number ", flag, & + write(errmsg, 100) "Input number ", flag, & " is not sized correctly." call errmgr%report_error("form_qr_pivot", trim(errmsg), & LA_ARRAY_SIZE_ERROR) @@ -923,6 +953,9 @@ module subroutine form_qr_pivot(r, tau, pvt, q, p, work, olwork, err) p(:,j) = zero p(jp,j) = one end do + + ! Formatting +100 format(A, I0, A) end subroutine ! ------------------------------------------------------------------------------ @@ -972,7 +1005,7 @@ module subroutine form_qr_pivot_cmplx(r, tau, pvt, q, p, work, olwork, err) end if if (flag /= 0) then ! ERROR: One of the input arrays is not sized correctly - write(errmsg, '(AI0A)') "Input number ", flag, & + write(errmsg, 100) "Input number ", flag, & " is not sized correctly." call errmgr%report_error("form_qr_pivot_cmplx", trim(errmsg), & LA_ARRAY_SIZE_ERROR) @@ -991,6 +1024,9 @@ module subroutine form_qr_pivot_cmplx(r, tau, pvt, q, p, work, olwork, err) p(:,j) = zero p(jp,j) = one end do + + ! Formatting +100 format(A, I0, A) end subroutine ! ------------------------------------------------------------------------------ @@ -1049,7 +1085,7 @@ module subroutine mult_qr_mtx(lside, trans, a, tau, c, work, olwork, err) end if if (flag /= 0) then ! ERROR: One of the input arrays is not sized correctly - write(errmsg, '(AI0A)') "Input number ", flag, & + write(errmsg, 100) "Input number ", flag, & " is not sized correctly." call errmgr%report_error("mult_qr_mtx", trim(errmsg), & LA_ARRAY_SIZE_ERROR) @@ -1088,6 +1124,9 @@ module subroutine mult_qr_mtx(lside, trans, a, tau, c, work, olwork, err) ! Call DORMQR call DORMQR(side, t, m, n, k, a, nrowa, tau, c, m, wptr, lwork, flag) + + ! Formatting +100 format(A, I0, A) end subroutine ! ------------------------------------------------------------------------------ @@ -1146,7 +1185,7 @@ module subroutine mult_qr_mtx_cmplx(lside, trans, a, tau, c, work, olwork, err) end if if (flag /= 0) then ! ERROR: One of the input arrays is not sized correctly - write(errmsg, '(AI0A)') "Input number ", flag, & + write(errmsg, 100) "Input number ", flag, & " is not sized correctly." call errmgr%report_error("mult_qr_mtx_cmplx", trim(errmsg), & LA_ARRAY_SIZE_ERROR) @@ -1185,6 +1224,9 @@ module subroutine mult_qr_mtx_cmplx(lside, trans, a, tau, c, work, olwork, err) ! Call ZUNMQR call ZUNMQR(side, t, m, n, k, a, nrowa, tau, c, m, wptr, lwork, flag) + + ! Formatting +100 format(A, I0, A) end subroutine ! ------------------------------------------------------------------------------ @@ -1232,7 +1274,7 @@ module subroutine mult_qr_vec(trans, a, tau, c, work, olwork, err) if (size(a, 1) /= m .or. size(a, 2) < k) flag = 3 if (flag /= 0) then ! ERROR: One of the input arrays is not sized correctly - write(errmsg, '(AI0A)') "Input number ", flag, & + write(errmsg, 100) "Input number ", flag, & " is not sized correctly." call errmgr%report_error("mult_qr_vec", trim(errmsg), & LA_ARRAY_SIZE_ERROR) @@ -1271,6 +1313,9 @@ module subroutine mult_qr_vec(trans, a, tau, c, work, olwork, err) ! Call DORMQR call DORMQR(side, t, m, 1, k, a, nrowa, tau, c, m, wptr, lwork, flag) + + ! Formatting +100 format(A, I0, A) end subroutine ! ------------------------------------------------------------------------------ @@ -1318,7 +1363,7 @@ module subroutine mult_qr_vec_cmplx(trans, a, tau, c, work, olwork, err) if (size(a, 1) /= m .or. size(a, 2) < k) flag = 3 if (flag /= 0) then ! ERROR: One of the input arrays is not sized correctly - write(errmsg, '(AI0A)') "Input number ", flag, & + write(errmsg, 100) "Input number ", flag, & " is not sized correctly." call errmgr%report_error("mult_qr_vec", trim(errmsg), & LA_ARRAY_SIZE_ERROR) @@ -1357,6 +1402,9 @@ module subroutine mult_qr_vec_cmplx(trans, a, tau, c, work, olwork, err) ! Call ZUNMQR call ZUNMQR(side, t, m, 1, k, a, nrowa, tau, c, m, wptr, lwork, flag) + + ! Formatting +100 format(A, I0, A) end subroutine ! ------------------------------------------------------------------------------ @@ -1403,7 +1451,7 @@ module subroutine qr_rank1_update_dbl(q, r, u, v, work, err) end if if (flag /= 0) then ! ERROR: One of the input arrays is not sized correctly - write(errmsg, '(AI0A)') "Input number ", flag, & + write(errmsg, 100) "Input number ", flag, & " is not sized correctly." call errmgr%report_error("qr_rank1_update", trim(errmsg), & LA_ARRAY_SIZE_ERROR) @@ -1437,6 +1485,9 @@ module subroutine qr_rank1_update_dbl(q, r, u, v, work, err) ! End if (allocated(wrk)) deallocate(wrk) + + ! Formatting +100 format(A, I0, A) end subroutine ! ------------------------------------------------------------------------------ @@ -1487,7 +1538,7 @@ module subroutine qr_rank1_update_cmplx(q, r, u, v, work, rwork, err) end if if (flag /= 0) then ! ERROR: One of the input arrays is not sized correctly - write(errmsg, '(AI0A)') "Input number ", flag, & + write(errmsg, 100) "Input number ", flag, & " is not sized correctly." call errmgr%report_error("qr_rank1_update_cmplx", trim(errmsg), & LA_ARRAY_SIZE_ERROR) @@ -1542,6 +1593,9 @@ module subroutine qr_rank1_update_cmplx(q, r, u, v, work, rwork, err) ! End if (allocated(wrk)) deallocate(wrk) + + ! Formatting +100 format(A, I0, A) end subroutine ! ****************************************************************************** @@ -1592,7 +1646,7 @@ module subroutine cholesky_factor_dbl(a, upper, err) call DPOTRF(uplo, n, a, n, flag) if (flag > 0) then ! ERROR: Matrix is not positive definite - write(errmsg, '(AI0A)') "The leading minor of order ", flag, & + write(errmsg, 100) "The leading minor of order ", flag, & " is not positive definite." call errmgr%report_error("cholesky_factor", trim(errmsg), & LA_MATRIX_FORMAT_ERROR) @@ -1610,6 +1664,9 @@ module subroutine cholesky_factor_dbl(a, upper, err) a(1:i-1,i) = zero end do end if + + ! Formatting +100 format(A, I0, A) end subroutine ! ------------------------------------------------------------------------------ @@ -1658,7 +1715,7 @@ module subroutine cholesky_factor_cmplx(a, upper, err) call ZPOTRF(uplo, n, a, n, flag) if (flag > 0) then ! ERROR: Matrix is not positive definite - write(errmsg, '(AI0A)') "The leading minor of order ", flag, & + write(errmsg, 100) "The leading minor of order ", flag, & " is not positive definite." call errmgr%report_error("cholesky_factor_cmplx", trim(errmsg), & LA_MATRIX_FORMAT_ERROR) @@ -1676,6 +1733,9 @@ module subroutine cholesky_factor_cmplx(a, upper, err) a(1:i-1,i) = zero end do end if + + ! Formatting +100 format(A, I0, A) end subroutine ! ------------------------------------------------------------------------------ @@ -1711,7 +1771,7 @@ module subroutine cholesky_rank1_update_dbl(r, u, work, err) flag = 2 end if if (flag /= 0) then - write(errmsg, '(AI0A)') "Input number ", flag, & + write(errmsg, 100) "Input number ", flag, & " is not sized correctly." call errmgr%report_error("cholesky_rank1_update", trim(errmsg), & LA_ARRAY_SIZE_ERROR) @@ -1741,6 +1801,9 @@ module subroutine cholesky_rank1_update_dbl(r, u, work, err) ! Process call DCH1UP(n, r, n, u, wptr) + + ! Formatting +100 format(A, I0, A) end subroutine ! ------------------------------------------------------------------------------ @@ -1776,7 +1839,7 @@ module subroutine cholesky_rank1_update_cmplx(r, u, work, err) flag = 2 end if if (flag /= 0) then - write(errmsg, '(AI0A)') "Input number ", flag, & + write(errmsg, 100) "Input number ", flag, & " is not sized correctly." call errmgr%report_error("cholesky_rank1_update_cmplx", & trim(errmsg), & @@ -1807,6 +1870,9 @@ module subroutine cholesky_rank1_update_cmplx(r, u, work, err) ! Process call ZCH1UP(n, r, n, u, wptr) + + ! Formatting +100 format(A, I0, A) end subroutine ! ------------------------------------------------------------------------------ @@ -1842,7 +1908,7 @@ module subroutine cholesky_rank1_downdate_dbl(r, u, work, err) flag = 2 end if if (flag /= 0) then - write(errmsg, '(AI0A)') "Input number ", flag, & + write(errmsg, 100) "Input number ", flag, & " is not sized correctly." call errmgr%report_error("cholesky_rank1_downdate", trim(errmsg), & LA_ARRAY_SIZE_ERROR) @@ -1882,6 +1948,9 @@ module subroutine cholesky_rank1_downdate_dbl(r, u, work, err) call errmgr%report_error("cholesky_rank1_downdate", & "The input matrix is singular.", LA_SINGULAR_MATRIX_ERROR) end if + + ! Formatting +100 format(A, I0, A) end subroutine ! ------------------------------------------------------------------------------ @@ -1917,7 +1986,7 @@ module subroutine cholesky_rank1_downdate_cmplx(r, u, work, err) flag = 2 end if if (flag /= 0) then - write(errmsg, '(AI0A)') "Input number ", flag, & + write(errmsg, 100) "Input number ", flag, & " is not sized correctly." call errmgr%report_error("cholesky_rank1_downdate_cmplx", & trim(errmsg), & @@ -1958,6 +2027,9 @@ module subroutine cholesky_rank1_downdate_cmplx(r, u, work, err) call errmgr%report_error("cholesky_rank1_downdate_cmplx", & "The input matrix is singular.", LA_SINGULAR_MATRIX_ERROR) end if + + ! Formatting +100 format(A, I0, A) end subroutine ! ****************************************************************************** @@ -1996,7 +2068,7 @@ module subroutine rz_factor_dbl(a, tau, work, olwork, err) end if if (flag /= 0) then ! ERROR: One of the input arrays is not sized correctly - write(errmsg, '(AI0A)') "Input number ", flag, & + write(errmsg, 100) "Input number ", flag, & " is not sized correctly." call errmgr%report_error("rz_factor", trim(errmsg), & LA_ARRAY_SIZE_ERROR) @@ -2035,6 +2107,9 @@ module subroutine rz_factor_dbl(a, tau, work, olwork, err) ! Call DTZRZF call DTZRZF(m, n, a, m, tau, wptr, lwork, flag) + + ! Formatting +100 format(A, I0, A) end subroutine ! ------------------------------------------------------------------------------ @@ -2071,7 +2146,7 @@ module subroutine rz_factor_cmplx(a, tau, work, olwork, err) end if if (flag /= 0) then ! ERROR: One of the input arrays is not sized correctly - write(errmsg, '(AI0A)') "Input number ", flag, & + write(errmsg, 100) "Input number ", flag, & " is not sized correctly." call errmgr%report_error("rz_factor_cmplx", trim(errmsg), & LA_ARRAY_SIZE_ERROR) @@ -2110,6 +2185,9 @@ module subroutine rz_factor_cmplx(a, tau, work, olwork, err) ! Call ZTZRZF call ZTZRZF(m, n, a, m, tau, wptr, lwork, flag) + + ! Formatting +100 format(A, I0, A) end subroutine ! ------------------------------------------------------------------------------ @@ -2175,7 +2253,7 @@ module subroutine mult_rz_mtx(lside, trans, l, a, tau, c, work, olwork, err) end if if (flag /= 0) then ! ERROR: One of the input arrays is not sized correctly - write(errmsg, '(AI0A)') "Input number ", flag, & + write(errmsg, 100) "Input number ", flag, & " is not sized correctly." call errmgr%report_error("mult_rz_mtx", trim(errmsg), & LA_ARRAY_SIZE_ERROR) @@ -2214,6 +2292,9 @@ module subroutine mult_rz_mtx(lside, trans, l, a, tau, c, work, olwork, err) ! Call DORMRZ call DORMRZ(side, t, m, n, k, l, a, lda, tau, c, m, wptr, lwork, flag) + + ! Formatting +100 format(A, I0, A) end subroutine ! ------------------------------------------------------------------------------ @@ -2279,7 +2360,7 @@ module subroutine mult_rz_mtx_cmplx(lside, trans, l, a, tau, c, work, olwork, er end if if (flag /= 0) then ! ERROR: One of the input arrays is not sized correctly - write(errmsg, '(AI0A)') "Input number ", flag, & + write(errmsg, 100) "Input number ", flag, & " is not sized correctly." call errmgr%report_error("mult_rz_mtx_cmplx", trim(errmsg), & LA_ARRAY_SIZE_ERROR) @@ -2318,6 +2399,9 @@ module subroutine mult_rz_mtx_cmplx(lside, trans, l, a, tau, c, work, olwork, er ! Call ZUNMRZ call ZUNMRZ(side, t, m, n, k, l, a, lda, tau, c, m, wptr, lwork, flag) + + ! Formatting +100 format(A, I0, A) end subroutine ! ------------------------------------------------------------------------------ @@ -2369,7 +2453,7 @@ module subroutine mult_rz_vec(trans, l, a, tau, c, work, olwork, err) end if if (flag /= 0) then ! ERROR: One of the input arrays is not sized correctly - write(errmsg, '(AI0A)') "Input number ", flag, & + write(errmsg, 100) "Input number ", flag, & " is not sized correctly." call errmgr%report_error("mult_rz_vec", trim(errmsg), & LA_ARRAY_SIZE_ERROR) @@ -2408,6 +2492,9 @@ module subroutine mult_rz_vec(trans, l, a, tau, c, work, olwork, err) ! Call DORMRZ call DORMRZ(side, t, m, 1, k, l, a, lda, tau, c, m, wptr, lwork, flag) + + ! Formatting +100 format(A, I0, A) end subroutine ! ------------------------------------------------------------------------------ @@ -2459,7 +2546,7 @@ module subroutine mult_rz_vec_cmplx(trans, l, a, tau, c, work, olwork, err) end if if (flag /= 0) then ! ERROR: One of the input arrays is not sized correctly - write(errmsg, '(AI0A)') "Input number ", flag, & + write(errmsg, 100) "Input number ", flag, & " is not sized correctly." call errmgr%report_error("mult_rz_vec_cmplx", trim(errmsg), & LA_ARRAY_SIZE_ERROR) @@ -2498,6 +2585,9 @@ module subroutine mult_rz_vec_cmplx(trans, l, a, tau, c, work, olwork, err) ! Call ZUNMRZ call ZUNMRZ(side, t, m, 1, k, l, a, lda, tau, c, m, wptr, lwork, flag) + + ! Formatting +100 format(A, I0, A) end subroutine ! ****************************************************************************** @@ -2558,7 +2648,7 @@ module subroutine svd_dbl(a, s, u, vt, work, olwork, err) end if if (flag /= 0) then ! ERROR: One of the input arrays is not sized correctly - write(errmsg, '(AI0A)') "Input number ", flag, & + write(errmsg, 100) "Input number ", flag, & " is not sized correctly." call errmgr%report_error("svd", trim(errmsg), & LA_ARRAY_SIZE_ERROR) @@ -2613,10 +2703,14 @@ module subroutine svd_dbl(a, s, u, vt, work, olwork, err) ! Check for convergence if (flag > 0) then - write(errmsg, '(I0A)') flag, " superdiagonals could not " // & + write(errmsg, 101) flag, " superdiagonals could not " // & "converge to zero as part of the QR iteration process." call errmgr%report_warning("svd", errmsg, LA_CONVERGENCE_ERROR) end if + + ! Formatting +100 format(A, I0, A) +101 format(I0, A) end subroutine ! ------------------------------------------------------------------------------ @@ -2680,7 +2774,7 @@ module subroutine svd_cmplx(a, s, u, vt, work, olwork, rwork, err) end if if (flag /= 0) then ! ERROR: One of the input arrays is not sized correctly - write(errmsg, '(AI0A)') "Input number ", flag, & + write(errmsg, 100) "Input number ", flag, & " is not sized correctly." call errmgr%report_error("svd_cmplx", trim(errmsg), & LA_ARRAY_SIZE_ERROR) @@ -2755,11 +2849,15 @@ module subroutine svd_cmplx(a, s, u, vt, work, olwork, rwork, err) ! Check for convergence if (flag > 0) then - write(errmsg, '(I0A)') flag, " superdiagonals could not " // & + write(errmsg, 101) flag, " superdiagonals could not " // & "converge to zero as part of the QR iteration process." call errmgr%report_warning("svd_cmplx", errmsg, & LA_CONVERGENCE_ERROR) end if + + ! Formatting +100 format(A, I0, A) +101 format(I0, A) end subroutine end submodule diff --git a/src/linalg_solve.f90 b/src/linalg_solve.f90 index 3fbf5c38..d7b105a8 100644 --- a/src/linalg_solve.f90 +++ b/src/linalg_solve.f90 @@ -280,7 +280,7 @@ module subroutine solve_lu_mtx(a, ipvt, b, err) end if if (flag /= 0) then ! One of the input arrays is not sized correctly - write(errmsg, '(AI0A)') "Input number ", flag, & + write(errmsg, 100) "Input number ", flag, & " is not sized correctly." call errmgr%report_error("solve_lu_mtx", trim(errmsg), & LA_ARRAY_SIZE_ERROR) @@ -289,6 +289,9 @@ module subroutine solve_lu_mtx(a, ipvt, b, err) ! Call DGETRS call DGETRS("N", n, nrhs, a, n, ipvt, b, n, flag) + + ! Formatting +100 format(A, I0, A) end subroutine ! ------------------------------------------------------------------------------ @@ -325,7 +328,7 @@ module subroutine solve_lu_mtx_cmplx(a, ipvt, b, err) end if if (flag /= 0) then ! One of the input arrays is not sized correctly - write(errmsg, '(AI0A)') "Input number ", flag, & + write(errmsg, 100) "Input number ", flag, & " is not sized correctly." call errmgr%report_error("solve_lu_mtx_cmplx", trim(errmsg), & LA_ARRAY_SIZE_ERROR) @@ -334,6 +337,9 @@ module subroutine solve_lu_mtx_cmplx(a, ipvt, b, err) ! Call ZGETRS call ZGETRS("N", n, nrhs, a, n, ipvt, b, n, flag) + + ! Formatting +100 format(A, I0, A) end subroutine ! ------------------------------------------------------------------------------ @@ -369,7 +375,7 @@ module subroutine solve_lu_vec(a, ipvt, b, err) end if if (flag /= 0) then ! One of the input arrays is not sized correctly - write(errmsg, '(AI0A)') "Input number ", flag, & + write(errmsg, 100) "Input number ", flag, & " is not sized correctly." call errmgr%report_error("solve_lu_vec", trim(errmsg), & LA_ARRAY_SIZE_ERROR) @@ -378,6 +384,9 @@ module subroutine solve_lu_vec(a, ipvt, b, err) ! Call DGETRS call DGETRS("N", n, 1, a, n, ipvt, b, n, flag) + + ! Formatting +100 format(A, I0, A) end subroutine ! ------------------------------------------------------------------------------ @@ -413,7 +422,7 @@ module subroutine solve_lu_vec_cmplx(a, ipvt, b, err) end if if (flag /= 0) then ! One of the input arrays is not sized correctly - write(errmsg, '(AI0A)') "Input number ", flag, & + write(errmsg, 100) "Input number ", flag, & " is not sized correctly." call errmgr%report_error("solve_lu_vec_cmplx", trim(errmsg), & LA_ARRAY_SIZE_ERROR) @@ -422,6 +431,9 @@ module subroutine solve_lu_vec_cmplx(a, ipvt, b, err) ! Call ZGETRS call ZGETRS("N", n, 1, a, n, ipvt, b, n, flag) + + ! Formatting +100 format(A, I0, A) end subroutine ! ****************************************************************************** @@ -468,7 +480,7 @@ module subroutine solve_qr_no_pivot_mtx(a, tau, b, work, olwork, err) end if if (flag /= 0) then ! ERROR: One of the input arrays is not sized correctly - write(errmsg, '(AI0A)') "Input number ", flag, & + write(errmsg, 100) "Input number ", flag, & " is not sized correctly." call errmgr%report_error("solve_qr_no_pivot_mtx", trim(errmsg), & LA_ARRAY_SIZE_ERROR) @@ -510,6 +522,9 @@ module subroutine solve_qr_no_pivot_mtx(a, tau, b, work, olwork, err) ! Solve the triangular system: A(1:N,1:N)*X = B(1:N,:) call solve_triangular_system(.true., .true., .false., .true., one, & a(1:n,1:n), b(1:n,:)) + + ! Formatting +100 format(A, I0, A) end subroutine ! ------------------------------------------------------------------------------ @@ -554,7 +569,7 @@ module subroutine solve_qr_no_pivot_mtx_cmplx(a, tau, b, work, olwork, err) end if if (flag /= 0) then ! ERROR: One of the input arrays is not sized correctly - write(errmsg, '(AI0A)') "Input number ", flag, & + write(errmsg, 100) "Input number ", flag, & " is not sized correctly." call errmgr%report_error("solve_qr_no_pivot_mtx_cmplx", & trim(errmsg), LA_ARRAY_SIZE_ERROR) @@ -596,6 +611,9 @@ module subroutine solve_qr_no_pivot_mtx_cmplx(a, tau, b, work, olwork, err) ! Solve the triangular system: A(1:N,1:N)*X = B(1:N,:) call solve_triangular_system(.true., .true., .false., .true., one, & a(1:n,1:n), b(1:n,:)) + + ! Formatting +100 format(A, I0, A) end subroutine ! ------------------------------------------------------------------------------ @@ -637,7 +655,7 @@ module subroutine solve_qr_no_pivot_vec(a, tau, b, work, olwork, err) end if if (flag /= 0) then ! ERROR: One of the input arrays is not sized correctly - write(errmsg, '(AI0A)') "Input number ", flag, & + write(errmsg, 100) "Input number ", flag, & " is not sized correctly." call errmgr%report_error("solve_qr_no_pivot_vec", trim(errmsg), & LA_ARRAY_SIZE_ERROR) @@ -678,6 +696,9 @@ module subroutine solve_qr_no_pivot_vec(a, tau, b, work, olwork, err) ! Solve the triangular system: A(1:N,1:N)*X = B(1:N) call solve_triangular_system(.true., .false., .true., a(1:n,1:n), b) + + ! Formatting +100 format(A, I0, A) end subroutine ! ------------------------------------------------------------------------------ @@ -719,7 +740,7 @@ module subroutine solve_qr_no_pivot_vec_cmplx(a, tau, b, work, olwork, err) end if if (flag /= 0) then ! ERROR: One of the input arrays is not sized correctly - write(errmsg, '(AI0A)') "Input number ", flag, & + write(errmsg, 100) "Input number ", flag, & " is not sized correctly." call errmgr%report_error("solve_qr_no_pivot_vec_cmplx", & trim(errmsg), LA_ARRAY_SIZE_ERROR) @@ -760,6 +781,9 @@ module subroutine solve_qr_no_pivot_vec_cmplx(a, tau, b, work, olwork, err) ! Solve the triangular system: A(1:N,1:N)*X = B(1:N) call solve_triangular_system(.true., .false., .true., a(1:n,1:n), b) + + ! Formatting +100 format(A, I0, A) end subroutine ! ------------------------------------------------------------------------------ @@ -815,7 +839,7 @@ module subroutine solve_qr_pivot_mtx(a, tau, jpvt, b, work, olwork, err) end if if (flag /= 0) then ! ERROR: One of the input arrays is not sized correctly - write(errmsg, '(AI0A)') "Input number ", flag, & + write(errmsg, 100) "Input number ", flag, & " is not sized correctly." call errmgr%report_error("solve_qr_pivot_mtx", trim(errmsg), & LA_ARRAY_SIZE_ERROR) @@ -916,6 +940,9 @@ module subroutine solve_qr_pivot_mtx(a, tau, jpvt, b, work, olwork, err) end do b(:,j) = wptr(1:n) end do + + ! Formatting +100 format(A, I0, A) end subroutine ! ------------------------------------------------------------------------------ @@ -972,7 +999,7 @@ module subroutine solve_qr_pivot_mtx_cmplx(a, tau, jpvt, b, work, olwork, err) end if if (flag /= 0) then ! ERROR: One of the input arrays is not sized correctly - write(errmsg, '(AI0A)') "Input number ", flag, & + write(errmsg, 100) "Input number ", flag, & " is not sized correctly." call errmgr%report_error("solve_qr_pivot_mtx_cmplx", & trim(errmsg), LA_ARRAY_SIZE_ERROR) @@ -1073,6 +1100,9 @@ module subroutine solve_qr_pivot_mtx_cmplx(a, tau, jpvt, b, work, olwork, err) end do b(:,j) = wptr(1:n) end do + + ! Formatting +100 format(A, I0, A) end subroutine ! ------------------------------------------------------------------------------ @@ -1127,7 +1157,7 @@ module subroutine solve_qr_pivot_vec(a, tau, jpvt, b, work, olwork, err) end if if (flag /= 0) then ! ERROR: One of the input arrays is not sized correctly - write(errmsg, '(AI0A)') "Input number ", flag, & + write(errmsg, 100) "Input number ", flag, & " is not sized correctly." call errmgr%report_error("solve_qr_pivot_vec", trim(errmsg), & LA_ARRAY_SIZE_ERROR) @@ -1224,6 +1254,9 @@ module subroutine solve_qr_pivot_vec(a, tau, jpvt, b, work, olwork, err) wptr(jpvt(i)) = b(i) end do b = wptr(1:n) + + ! Formatting +100 format(A, I0, A) end subroutine ! ------------------------------------------------------------------------------ @@ -1279,7 +1312,7 @@ module subroutine solve_qr_pivot_vec_cmplx(a, tau, jpvt, b, work, olwork, err) end if if (flag /= 0) then ! ERROR: One of the input arrays is not sized correctly - write(errmsg, '(AI0A)') "Input number ", flag, & + write(errmsg, 100) "Input number ", flag, & " is not sized correctly." call errmgr%report_error("solve_qr_pivot_vec_cmplx", trim(errmsg), & LA_ARRAY_SIZE_ERROR) @@ -1376,6 +1409,9 @@ module subroutine solve_qr_pivot_vec_cmplx(a, tau, jpvt, b, work, olwork, err) wptr(jpvt(i)) = b(i) end do b = wptr(1:n) + + ! Formatting +100 format(A, I0, A) end subroutine ! ****************************************************************************** @@ -1417,7 +1453,7 @@ module subroutine solve_cholesky_mtx(upper, a, b, err) flag = 3 end if if (flag /= 0) then - write(errmsg, '(AI0A)') "Input number ", flag, & + write(errmsg, 100) "Input number ", flag, & " is not sized correctly." call errmgr%report_error("solve_cholesky_mtx", trim(errmsg), & LA_ARRAY_SIZE_ERROR) @@ -1426,6 +1462,9 @@ module subroutine solve_cholesky_mtx(upper, a, b, err) ! Process call DPOTRS(uplo, n, nrhs, a, n, b, n, flag) + + ! Formatting +100 format(A, I0, A) end subroutine ! ------------------------------------------------------------------------------ @@ -1465,7 +1504,7 @@ module subroutine solve_cholesky_mtx_cmplx(upper, a, b, err) flag = 3 end if if (flag /= 0) then - write(errmsg, '(AI0A)') "Input number ", flag, & + write(errmsg, 100) "Input number ", flag, & " is not sized correctly." call errmgr%report_error("solve_cholesky_mtx_cmplx", trim(errmsg), & LA_ARRAY_SIZE_ERROR) @@ -1474,6 +1513,9 @@ module subroutine solve_cholesky_mtx_cmplx(upper, a, b, err) ! Process call ZPOTRS(uplo, n, nrhs, a, n, b, n, flag) + + ! Formatting +100 format(A, I0, A) end subroutine ! ------------------------------------------------------------------------------ @@ -1512,7 +1554,7 @@ module subroutine solve_cholesky_vec(upper, a, b, err) flag = 3 end if if (flag /= 0) then - write(errmsg, '(AI0A)') "Input number ", flag, & + write(errmsg, 100) "Input number ", flag, & " is not sized correctly." call errmgr%report_error("solve_cholesky_vec", trim(errmsg), & LA_ARRAY_SIZE_ERROR) @@ -1521,6 +1563,9 @@ module subroutine solve_cholesky_vec(upper, a, b, err) ! Process call DPOTRS(uplo, n, 1, a, n, b, n, flag) + + ! Formatting +100 format(A, I0, A) end subroutine ! ------------------------------------------------------------------------------ @@ -1559,7 +1604,7 @@ module subroutine solve_cholesky_vec_cmplx(upper, a, b, err) flag = 3 end if if (flag /= 0) then - write(errmsg, '(AI0A)') "Input number ", flag, & + write(errmsg, 100) "Input number ", flag, & " is not sized correctly." call errmgr%report_error("solve_cholesky_vec_cmplx", trim(errmsg), & LA_ARRAY_SIZE_ERROR) @@ -1568,6 +1613,9 @@ module subroutine solve_cholesky_vec_cmplx(upper, a, b, err) ! Process call ZPOTRS(uplo, n, 1, a, n, b, n, flag) + + ! Formatting +100 format(A, I0, A) end subroutine ! ****************************************************************************** @@ -1828,7 +1876,7 @@ function DLAMCH(cmach) result(x) ! Input Check if (size(ainv, 1) /= n .or. size(ainv, 2) /= m) then - write(errmsg, '(AI0AI0A)') & + write(errmsg, 100) & "The output matrix AINV is not sized appropriately. " // & "It is expected to be ", n, "-by-", m, "." call errmgr%report_error("mtx_pinverse", errmsg, & @@ -1876,7 +1924,7 @@ function DLAMCH(cmach) result(x) ! Check for convergence if (flag > 0) then - write(errmsg, '(I0A)') flag, " superdiagonals could not " // & + write(errmsg, 101) flag, " superdiagonals could not " // & "converge to zero as part of the QR iteration process." call errmgr%report_warning("mtx_pinverse", errmsg, & LA_CONVERGENCE_ERROR) @@ -1916,6 +1964,10 @@ function DLAMCH(cmach) result(x) ! Compute (VT**T * inv(S)) * U**T call mtx_mult(.true., .true., one, vt(1:mn,:), u, zero, ainv) + + ! Formatting +100 format(A, I0, A, I0, A) +101 format(I0, A) end subroutine ! ------------------------------------------------------------------------------ @@ -1974,7 +2026,7 @@ function DLAMCH(cmach) result(x) ! Input Check if (size(ainv, 1) /= n .or. size(ainv, 2) /= m) then - write(errmsg, '(AI0AI0A)') & + write(errmsg, 100) & "The output matrix AINV is not sized appropriately. " // & "It is expected to be ", n, "-by-", m, "." call errmgr%report_error("mtx_pinverse_cmplx", errmsg, & @@ -2045,7 +2097,7 @@ function DLAMCH(cmach) result(x) ! Check for convergence if (flag > 0) then - write(errmsg, '(I0A)') flag, " superdiagonals could not " // & + write(errmsg, 101) flag, " superdiagonals could not " // & "converge to zero as part of the QR iteration process." call errmgr%report_warning("mtx_pinverse_cmplx", errmsg, & LA_CONVERGENCE_ERROR) @@ -2098,6 +2150,10 @@ function DLAMCH(cmach) result(x) ainv(i,j) = val end do end do + + ! Formatting +100 format(A, I0, A, I0, A) +101 format(I0, A) end subroutine ! ****************************************************************************** @@ -2444,7 +2500,7 @@ module subroutine solve_least_squares_mtx_pvt(a, b, ipvt, arnk, work, olwork, er flag = 2 end if if (flag /= 0) then - write(errmsg, '(AI0A)') "Input number ", flag, & + write(errmsg, 100) "Input number ", flag, & " is not sized correctly." call errmgr%report_error("solve_least_squares_mtx_pvt", & trim(errmsg), LA_ARRAY_SIZE_ERROR) @@ -2507,6 +2563,9 @@ module subroutine solve_least_squares_mtx_pvt(a, b, ipvt, arnk, work, olwork, er call DGELSY(m, n, nrhs, a, m, b, maxmn, iptr, rc, rnk, wptr, lwork, & flag) if (present(arnk)) arnk = rnk + + ! Formatting +100 format(A, I0, A) end subroutine ! ------------------------------------------------------------------------------ @@ -2557,7 +2616,7 @@ module subroutine solve_least_squares_mtx_pvt_cmplx(a, b, ipvt, arnk, & flag = 2 end if if (flag /= 0) then - write(errmsg, '(AI0A)') "Input number ", flag, & + write(errmsg, 100) "Input number ", flag, & " is not sized correctly." call errmgr%report_error("solve_least_squares_mtx_pvt_cmplx", & trim(errmsg), LA_ARRAY_SIZE_ERROR) @@ -2642,6 +2701,9 @@ module subroutine solve_least_squares_mtx_pvt_cmplx(a, b, ipvt, arnk, & call ZGELSY(m, n, nrhs, a, m, b, maxmn, iptr, rc, rnk, wptr, lwork, & rwptr, flag) if (present(arnk)) arnk = rnk + + ! Formatting +100 format(A, I0, A) end subroutine ! ------------------------------------------------------------------------------ @@ -2686,7 +2748,7 @@ module subroutine solve_least_squares_vec_pvt(a, b, ipvt, arnk, work, olwork, er flag = 2 end if if (flag /= 0) then - write(errmsg, '(AI0A)') "Input number ", flag, & + write(errmsg, 100) "Input number ", flag, & " is not sized correctly." call errmgr%report_error("solve_least_squares_vec_pvt", & trim(errmsg), LA_ARRAY_SIZE_ERROR) @@ -2748,6 +2810,9 @@ module subroutine solve_least_squares_vec_pvt(a, b, ipvt, arnk, work, olwork, er ! Process call DGELSY(m, n, 1, a, m, b, maxmn, iptr, rc, rnk, wptr, lwork, flag) if (present(arnk)) arnk = rnk + + ! Formatting +100 format(A, I0, A) end subroutine ! ------------------------------------------------------------------------------ @@ -2798,7 +2863,7 @@ module subroutine solve_least_squares_vec_pvt_cmplx(a, b, ipvt, arnk, & flag = 2 end if if (flag /= 0) then - write(errmsg, '(AI0A)') "Input number ", flag, & + write(errmsg, 100) "Input number ", flag, & " is not sized correctly." call errmgr%report_error("solve_least_squares_vec_pvt_cmplx", & trim(errmsg), LA_ARRAY_SIZE_ERROR) @@ -2883,6 +2948,9 @@ module subroutine solve_least_squares_vec_pvt_cmplx(a, b, ipvt, arnk, & call ZGELSY(m, n, 1, a, m, b, maxmn, iptr, rc, rnk, wptr, lwork, & rwptr, flag) if (present(arnk)) arnk = rnk + + ! Formatting +100 format(A, I0, A) end subroutine ! ------------------------------------------------------------------------------ @@ -2925,7 +2993,7 @@ module subroutine solve_least_squares_mtx_svd(a, b, s, arnk, work, olwork, err) end if if (flag /= 0) then ! ERROR: One of the input arrays is not sized correctly - write(errmsg, '(AI0A)') "Input number ", flag, & + write(errmsg, 100) "Input number ", flag, & " is not sized correctly." call errmgr%report_error("solve_least_squares_mtx_svd", & trim(errmsg), LA_ARRAY_SIZE_ERROR) @@ -2989,11 +3057,15 @@ module subroutine solve_least_squares_mtx_svd(a, b, s, arnk, work, olwork, err) flag) if (present(arnk)) arnk = rnk if (flag > 0) then - write(errmsg, '(I0A)') flag, " superdiagonals could not " // & + write(errmsg, 101) flag, " superdiagonals could not " // & "converge to zero as part of the QR iteration process." call errmgr%report_warning("solve_least_squares_mtx_svd", errmsg, & LA_CONVERGENCE_ERROR) end if + + ! Formatting +100 format(A, I0, A) +101 format(I0, A) end subroutine ! ------------------------------------------------------------------------------ @@ -3042,7 +3114,7 @@ module subroutine solve_least_squares_mtx_svd_cmplx(a, b, s, arnk, work, & end if if (flag /= 0) then ! ERROR: One of the input arrays is not sized correctly - write(errmsg, '(AI0A)') "Input number ", flag, & + write(errmsg, 100) "Input number ", flag, & " is not sized correctly." call errmgr%report_error("solve_least_squares_mtx_svd_cmplx", & trim(errmsg), LA_ARRAY_SIZE_ERROR) @@ -3127,11 +3199,15 @@ module subroutine solve_least_squares_mtx_svd_cmplx(a, b, s, arnk, work, & rwptr, flag) if (present(arnk)) arnk = rnk if (flag > 0) then - write(errmsg, '(I0A)') flag, " superdiagonals could not " // & + write(errmsg, 101) flag, " superdiagonals could not " // & "converge to zero as part of the QR iteration process." call errmgr%report_warning("solve_least_squares_mtx_svd_cmplx", & errmsg, LA_CONVERGENCE_ERROR) end if + + ! Formatting +100 format(A, I0, A) +101 format(I0, A) end subroutine ! ------------------------------------------------------------------------------ @@ -3174,7 +3250,7 @@ module subroutine solve_least_squares_vec_svd(a, b, s, arnk, work, olwork, err) end if if (flag /= 0) then ! ERROR: One of the input arrays is not sized correctly - write(errmsg, '(AI0A)') "Input number ", flag, & + write(errmsg, 100) "Input number ", flag, & " is not sized correctly." call errmgr%report_error("solve_least_squares_vec_svd", & trim(errmsg), LA_ARRAY_SIZE_ERROR) @@ -3237,11 +3313,15 @@ module subroutine solve_least_squares_vec_svd(a, b, s, arnk, work, olwork, err) flag) if (present(arnk)) arnk = rnk if (flag > 0) then - write(errmsg, '(I0A)') flag, " superdiagonals could not " // & + write(errmsg, 101) flag, " superdiagonals could not " // & "converge to zero as part of the QR iteration process." call errmgr%report_warning("solve_least_squares_vec_svd", errmsg, & LA_CONVERGENCE_ERROR) end if + + ! Formatting +100 format(A, I0, A) +101 format(I0, A) end subroutine ! ------------------------------------------------------------------------------ @@ -3290,7 +3370,7 @@ module subroutine solve_least_squares_vec_svd_cmplx(a, b, s, arnk, work, & end if if (flag /= 0) then ! ERROR: One of the input arrays is not sized correctly - write(errmsg, '(AI0A)') "Input number ", flag, & + write(errmsg, 100) "Input number ", flag, & " is not sized correctly." call errmgr%report_error("solve_least_squares_vec_svd_cmplx", & trim(errmsg), LA_ARRAY_SIZE_ERROR) @@ -3375,11 +3455,15 @@ module subroutine solve_least_squares_vec_svd_cmplx(a, b, s, arnk, work, & rwptr, flag) if (present(arnk)) arnk = rnk if (flag > 0) then - write(errmsg, '(I0A)') flag, " superdiagonals could not " // & + write(errmsg, 101) flag, " superdiagonals could not " // & "converge to zero as part of the QR iteration process." call errmgr%report_warning("solve_least_squares_vec_svd_cmplx", & errmsg, LA_CONVERGENCE_ERROR) end if + + ! Formatting +100 format(A, I0, A) +101 format(I0, A) end subroutine end submodule diff --git a/src/linalg_sorting.f90 b/src/linalg_sorting.f90 index df827ea7..e6308368 100644 --- a/src/linalg_sorting.f90 +++ b/src/linalg_sorting.f90 @@ -64,7 +64,7 @@ module subroutine sort_dbl_array_ind(x, ind, ascend, err) ! Input Check if (size(ind) /= n) then - write(errmsg, "(AI0AI0A)") & + write(errmsg, 100) & "Expected the tracking array to be of size ", n, & ", but found an array of size ", size(ind), "." call errmgr%report_error("sort_dbl_array_ind", trim(errmsg), & @@ -75,6 +75,9 @@ module subroutine sort_dbl_array_ind(x, ind, ascend, err) ! Process call qsort_dbl_ind(dir, x, ind) + + ! Formatting +100 format(A, I0, A, I0, A) end subroutine ! ------------------------------------------------------------------------------ @@ -127,7 +130,7 @@ module subroutine sort_cmplx_array_ind(x, ind, ascend, err) ! Input Check if (size(ind) /= n) then - write(errmsg, "(AI0AI0A)") & + write(errmsg, 100) & "Expected the tracking array to be of size ", n, & ", but found an array of size ", size(ind), "." call errmgr%report_error("sort_cmplx_array_ind", trim(errmsg), & @@ -138,6 +141,9 @@ module subroutine sort_cmplx_array_ind(x, ind, ascend, err) ! Process call qsort_cmplx_ind(dir, x, ind) + + ! Formatting +100 format(A, I0, A, I0, A) end subroutine ! ------------------------------------------------------------------------------ @@ -172,7 +178,7 @@ module subroutine sort_eigen_cmplx(vals, vecs, ascend, err) n = size(vals) if (size(vecs, 1) /= n .or. size(vecs, 2) /= n) then ! ARRAY SIZE ERROR - write(errmsg, '(AI0AI0AI0AI0A)') & + write(errmsg, 100) & "Expected the eigenvector matrix to be of size ", n, & "-by-", n, ", but found a matrix of size ", size(vecs, 1), & "-by-", size(vecs, 2), "." @@ -197,6 +203,9 @@ module subroutine sort_eigen_cmplx(vals, vecs, ascend, err) ! Shift the eigenvectors around to keep them associated with the ! appropriate eigenvalue vecs = vecs(:,ind) + + ! Formatting +100 format(A, I0, A, I0, A, I0, A, I0, A) end subroutine ! ------------------------------------------------------------------------------ @@ -231,7 +240,7 @@ module subroutine sort_eigen_dbl(vals, vecs, ascend, err) n = size(vals) if (size(vecs, 1) /= n .or. size(vecs, 2) /= n) then ! ARRAY SIZE ERROR - write(errmsg, '(AI0AI0AI0AI0A)') & + write(errmsg, 100) & "Expected the eigenvector matrix to be of size ", n, & "-by-", n, ", but found a matrix of size ", size(vecs, 1), & "-by-", size(vecs, 2), "." @@ -256,6 +265,9 @@ module subroutine sort_eigen_dbl(vals, vecs, ascend, err) ! Shift the eigenvectors around to keep them associated with the ! appropriate eigenvalue vecs = vecs(:,ind) + + ! Formatting +100 format(A, I0, A, I0, A, I0, A, I0, A) end subroutine ! ****************************************************************************** From f203e227e2d21123d393488c0371bb48704dc4aa Mon Sep 17 00:00:00 2001 From: jchristopherson Date: Fri, 16 Dec 2022 07:17:49 -0600 Subject: [PATCH 28/65] Comment clean up --- src/linalg.f90 | 42 +++++++++++++++++++++--------------------- 1 file changed, 21 insertions(+), 21 deletions(-) diff --git a/src/linalg.f90 b/src/linalg.f90 index acc0ff5a..86db3f2f 100644 --- a/src/linalg.f90 +++ b/src/linalg.f90 @@ -269,7 +269,7 @@ module linalg !! @code{.f90} !! program example !! use iso_fortran_env, only : int32, real64 -!! use linalg_core +!! use linalg !! implicit none !! !! ! Variables @@ -548,7 +548,7 @@ module linalg !! @code{.f90} !! program example !! use iso_fortran_env -!! use linalg_core +!! use linalg !! implicit none !! !! ! Local Variables @@ -659,7 +659,7 @@ module linalg !! @code{.f90} !! program example !! use iso_fortran_env, only : real64, int32 -!! use linalg_core +!! use linalg !! implicit none !! !! ! Variables @@ -814,7 +814,7 @@ module linalg !! @code{.f90} !! program example !! use iso_fortran_env, only : real64, int32 -!! use linalg_core +!! use linalg !! implicit none !! !! ! Local Variables @@ -963,7 +963,7 @@ module linalg !! @code{.f90} !! program example !! use iso_fortran_env, only : real64, int32 -!! use linalg_core +!! use linalg !! implicit none !! !! ! Variables @@ -1123,7 +1123,7 @@ module linalg !! @code{.f90} !! program example !! use iso_fortran_env, only : real64, int32 -!! use linalg_core +!! use linalg !! implicit none !! !! ! Variables @@ -1247,7 +1247,7 @@ module linalg !! @code{.f90} !! program example !! use iso_fortran_env -!! use linalg_core +!! use linalg !! implicit none !! !! ! Variables @@ -1370,7 +1370,7 @@ module linalg !! @code{.f90} !! program example !! use iso_fortran_env, only : real64, int32 -!! use linalg_core +!! use linalg !! implicit none !! !! ! Variables @@ -1476,7 +1476,7 @@ module linalg !! @code{.f90} !! program example !! use iso_fortran_env, only : real64, int32 -!! use linalg_core +!! use linalg !! implicit none !! !! ! Variables @@ -1580,7 +1580,7 @@ module linalg !! program example !! use iso_fortran_env, only : real64, int32 !! use linalg_factor, only : cholesky_factor, cholesky_rank1_downdate -!! use linalg_core, only : rank1_update +!! use linalg, only : rank1_update !! implicit none !! !! ! Variables @@ -1867,7 +1867,7 @@ module linalg !! @code{.f90} !! program example !! use iso_fortran_env, only : int32, real64 -!! use linalg_core +!! use linalg !! implicit none !! !! ! Variables @@ -2003,7 +2003,7 @@ module linalg !! @code{.f90} !! program example !! use iso_fortran_env, only : real64, int32 -!! use linalg_core +!! use linalg !! implicit none !! !! ! Variables @@ -2098,7 +2098,7 @@ module linalg !! @code{.f90} !! program example !! use iso_fortran_env -!! use linalg_core +!! use linalg !! implicit none !! !! ! Local Variables @@ -2228,7 +2228,7 @@ module linalg !! @code{.f90} !! program example !! use iso_fortran_env, only : real64, int32 -!! use linalg_core +!! use linalg !! implicit none !! !! ! Local Variables @@ -2327,7 +2327,7 @@ module linalg !! @code{.f90} !! program example !! use iso_fortran_env, only : real64, int32 -!! use linalg_core +!! use linalg !! implicit none !! !! ! Variables @@ -2440,7 +2440,7 @@ module linalg !! @code{.f90} !! program example !! use iso_fortran_env, only : real64, int32 -!! use linalg_core +!! use linalg !! implicit none !! !! ! Local Variables @@ -2541,7 +2541,7 @@ module linalg !! @code{.f90} !! program example !! use iso_fortran_env, only : real64, int32 -!! use linalg_core +!! use linalg !! implicit none !! !! ! Local Variables @@ -2643,7 +2643,7 @@ module linalg !! @code{.f90} !! program example !! use iso_fortran_env, only : real64, int32 -!! use linalg_core +!! use linalg !! implicit none !! !! ! Local Variables @@ -2729,7 +2729,7 @@ module linalg !! @code{.f90} !! program example !! use iso_fortran_env, only : real64, int32 -!! use linalg_core +!! use linalg !! implicit none !! !! ! Variables @@ -2835,7 +2835,7 @@ module linalg !! @code{.f90} !! program example !! use iso_fortran_env, only : int32, real64 -!! use linalg_core +!! use linalg !! implicit none !! !! ! Variables @@ -3033,7 +3033,7 @@ module linalg !! ! Notice: x1" = the second time derivative of x1. !! program example !! use iso_fortran_env, only : int32, real64 -!! use linalg_core +!! use linalg !! implicit none !! !! ! Define the model parameters From 8315c0f1078b74fda2e0d586f57015807ee4e701 Mon Sep 17 00:00:00 2001 From: jchristopherson Date: Fri, 16 Dec 2022 07:17:55 -0600 Subject: [PATCH 29/65] Update documentation --- .../interfacelinalg_1_1cholesky__factor.html | 14 +- ...celinalg_1_1cholesky__rank1__downdate.html | 14 +- ...facelinalg_1_1cholesky__rank1__update.html | 14 +- .../interfacelinalg_1_1diag__mtx__mult.html | 9 +- doc/html/interfacelinalg_1_1eigen.html | 6 +- doc/html/interfacelinalg_1_1form__lu.html | 14 +- doc/html/interfacelinalg_1_1form__qr.html | 12 +- doc/html/interfacelinalg_1_1lu__factor.html | 9 +- doc/html/interfacelinalg_1_1mtx__inverse.html | 6 +- .../interfacelinalg_1_1mtx__pinverse.html | 6 +- doc/html/interfacelinalg_1_1mult__qr.html | 12 +- doc/html/interfacelinalg_1_1qr__factor.html | 9 +- .../interfacelinalg_1_1qr__rank1__update.html | 19 +- .../interfacelinalg_1_1solve__cholesky.html | 14 +- ...erfacelinalg_1_1solve__least__squares.html | 6 +- ...linalg_1_1solve__least__squares__full.html | 6 +- ...elinalg_1_1solve__least__squares__svd.html | 6 +- doc/html/interfacelinalg_1_1solve__lu.html | 9 +- doc/html/interfacelinalg_1_1solve__qr.html | 9 +- ...celinalg_1_1solve__triangular__system.html | 14 +- doc/html/interfacelinalg_1_1svd.html | 9 +- doc/html/linalg__factor_8f90_source.html | 5430 +++++++------- doc/html/linalg__solve_8f90_source.html | 6206 +++++++++-------- doc/html/linalg__sorting_8f90_source.html | 952 +-- 24 files changed, 6533 insertions(+), 6272 deletions(-) diff --git a/doc/html/interfacelinalg_1_1cholesky__factor.html b/doc/html/interfacelinalg_1_1cholesky__factor.html index ed6e6bf5..d1566a59 100644 --- a/doc/html/interfacelinalg_1_1cholesky__factor.html +++ b/doc/html/interfacelinalg_1_1cholesky__factor.html @@ -125,7 +125,7 @@
    Notes
    This routine utilizes the LAPACK routine DPOTRF (ZPOTRF in the complex case).
    Usage
    The following example illustrates the solution of a positive-definite system of equations via Cholesky factorization.
    program example
    use iso_fortran_env, only : real64, int32
    -
    use linalg_core
    +
    use linalg
    implicit none
    ! Variables
    @@ -151,10 +151,10 @@
    ! Compute the Cholesky factorization of A considering only the upper
    ! triangular portion of A (the default configuration).
    -
    call cholesky_factor(a)
    +
    ! Compute the solution
    -
    call solve_cholesky(.true., a, b)
    +
    call solve_cholesky(.true., a, b)
    ! Display the results
    print '(A)', "Cholesky Solution: X = "
    @@ -164,15 +164,19 @@
    ! factorization causes A = U**T * U. Then U**T * U * X = B.
    ! Step 1 would then be to solve the problem U**T * Y = B, for Y.
    -
    call solve_triangular_system(.true., .true., .true., a, bu)
    +
    call solve_triangular_system(.true., .true., .true., a, bu)
    ! Now, solve the problem U * X = Y, for X
    -
    call solve_triangular_system(.true., .false., .true., a, bu)
    +
    call solve_triangular_system(.true., .false., .true., a, bu)
    ! Display the results
    print '(A)', "Cholesky Solution (Manual Approach): X = "
    print '(F8.4)', (bu(i), i = 1, size(bu))
    end program
    +
    Computes the Cholesky factorization of a symmetric, positive definite matrix.
    Definition: linalg.f90:1433
    +
    Solves a system of Cholesky factored equations.
    Definition: linalg.f90:2390
    +
    Solves a triangular system of equations.
    Definition: linalg.f90:2061
    +
    Provides a set of common linear algebra routines.
    Definition: linalg.f90:15
    The above program produces the following output.
    Cholesky Solution: X =
    239.5833
    -65.6667
    diff --git a/doc/html/interfacelinalg_1_1cholesky__rank1__downdate.html b/doc/html/interfacelinalg_1_1cholesky__rank1__downdate.html index 3e3f11a8..d3438bd8 100644 --- a/doc/html/interfacelinalg_1_1cholesky__rank1__downdate.html +++ b/doc/html/interfacelinalg_1_1cholesky__rank1__downdate.html @@ -130,7 +130,7 @@
    Usage
    The following example illustrates the use of the rank 1 Cholesky downdate, and compares the results to factoring the original rank 1 downdated matrix.
    program example
    use iso_fortran_env, only : real64, int32
    use linalg_factor, only : cholesky_factor, cholesky_rank1_downdate
    -
    use linalg_core, only : rank1_update
    +
    use linalg, only : rank1_update
    implicit none
    ! Variables
    @@ -152,16 +152,16 @@
    ! Compute the rank 1 downdate of A
    ad = a
    -
    call rank1_update(-1.0d0, u, u, ad)
    +
    call rank1_update(-1.0d0, u, u, ad)
    ! Compute the Cholesky factorization of the original matrix
    -
    call cholesky_factor(a)
    +
    ! Apply the rank 1 downdate to the factored matrix
    -
    call cholesky_rank1_downdate(a, u)
    +
    ! Compute the Cholesky factorization of the downdate to the original matrix
    -
    call cholesky_factor(ad)
    +
    call cholesky_factor(ad)
    ! Display the matrices
    print '(A)', "Downdating the Factored Form:"
    @@ -174,6 +174,10 @@
    print *, ad(i,:)
    end do
    end program
    +
    Computes the Cholesky factorization of a symmetric, positive definite matrix.
    Definition: linalg.f90:1433
    +
    Computes the rank 1 downdate to a Cholesky factored matrix (upper triangular).
    Definition: linalg.f90:1639
    +
    Performs the rank-1 update to matrix A such that: , where is an M-by-N matrix, is a scalar,...
    Definition: linalg.f90:194
    +
    Provides a set of common linear algebra routines.
    Definition: linalg.f90:15
    The above program produces the following output.
    Downdating the Factored Form:
    2.0000000000000000 6.0000000000000000 -8.0000000000000000
    0.0000000000000000 1.0000000000000000 4.9999999999999973
    diff --git a/doc/html/interfacelinalg_1_1cholesky__rank1__update.html b/doc/html/interfacelinalg_1_1cholesky__rank1__update.html index 0b7cd9bd..f2ede644 100644 --- a/doc/html/interfacelinalg_1_1cholesky__rank1__update.html +++ b/doc/html/interfacelinalg_1_1cholesky__rank1__update.html @@ -127,7 +127,7 @@
    See Also
    Source
    Usage
    The following example illustrates the use of the rank 1 Cholesky update, and compares the results to factoring the original rank 1 updated matrix.
    program example
    use iso_fortran_env, only : real64, int32
    -
    use linalg_core
    +
    use linalg
    implicit none
    ! Variables
    @@ -146,16 +146,16 @@
    ! Compute the rank 1 update of A
    au = a
    -
    call rank1_update(1.0d0, u, u, au)
    +
    call rank1_update(1.0d0, u, u, au)
    ! Compute the Cholesky factorization of the original matrix
    -
    call cholesky_factor(a)
    +
    ! Apply the rank 1 update to the factored matrix
    -
    call cholesky_rank1_update(a, u)
    +
    ! Compute the Cholesky factorization of the update of the original matrix
    -
    call cholesky_factor(au)
    +
    call cholesky_factor(au)
    ! Display the matrices
    print '(A)', "Updating the Factored Form:"
    @@ -168,6 +168,10 @@
    print *, au(i,:)
    end do
    end program
    +
    Computes the Cholesky factorization of a symmetric, positive definite matrix.
    Definition: linalg.f90:1433
    +
    Computes the rank 1 update to a Cholesky factored matrix (upper triangular).
    Definition: linalg.f90:1532
    +
    Performs the rank-1 update to matrix A such that: , where is an M-by-N matrix, is a scalar,...
    Definition: linalg.f90:194
    +
    Provides a set of common linear algebra routines.
    Definition: linalg.f90:15
    The above program produces the following output.
    Updating the Factored Form:
    2.0615528128088303 5.4570515633174921 -7.2760687510899889
    0.0000000000000000 3.0774320845949008 -2.0452498947307731
    diff --git a/doc/html/interfacelinalg_1_1diag__mtx__mult.html b/doc/html/interfacelinalg_1_1diag__mtx__mult.html index 5ff7b0e7..978eaf7b 100644 --- a/doc/html/interfacelinalg_1_1diag__mtx__mult.html +++ b/doc/html/interfacelinalg_1_1diag__mtx__mult.html @@ -154,7 +154,7 @@
    Usage
    The following example illustrates the use of the diagonal matrix multiplication routine to compute the \( S V^T \) component of a singular value decomposition.
    program example
    use iso_fortran_env, only : int32, real64
    -
    use linalg_core
    +
    use linalg
    implicit none
    ! Variables
    @@ -169,7 +169,7 @@
    ! Compute the singular value decomposition of A. Notice, V**T is returned
    ! instead of V. Also note, A is overwritten.
    -
    call svd(a, s, u, vt)
    +
    call svd(a, s, u, vt)
    ! Display the results
    print '(A)', "U ="
    @@ -186,13 +186,16 @@
    end do
    ! Compute U * S * V**T
    -
    call diag_mtx_mult(.true., 1.0d0, s, vt) ! Compute: VT = S * V**T
    +
    call diag_mtx_mult(.true., 1.0d0, s, vt) ! Compute: VT = S * V**T
    ac = matmul(u(:,1:2), vt)
    print '(A)', "U * S * V**T ="
    do i = 1, size(ac, 1)
    print *, ac(i,:)
    end do
    end program
    +
    Multiplies a diagonal matrix with another matrix or array.
    Definition: linalg.f90:329
    +
    Computes the singular value decomposition of a matrix A. The SVD is defined as: , where is an M-by-M...
    Definition: linalg.f90:1927
    +
    Provides a set of common linear algebra routines.
    Definition: linalg.f90:15
    The above program produces the following output.
    U =
    -0.47411577501825380 -0.81850539032073777 -0.32444284226152509
    0.82566838523833064 -0.28535874325972488 -0.48666426339228758
    diff --git a/doc/html/interfacelinalg_1_1eigen.html b/doc/html/interfacelinalg_1_1eigen.html index 147478e2..586dcd53 100644 --- a/doc/html/interfacelinalg_1_1eigen.html +++ b/doc/html/interfacelinalg_1_1eigen.html @@ -185,7 +185,7 @@
    ! Notice: x1" = the second time derivative of x1.
    program example
    use iso_fortran_env, only : int32, real64
    -
    use linalg_core
    +
    use linalg
    implicit none
    ! Define the model parameters
    @@ -211,7 +211,7 @@
    [3, 3])
    ! Compute the eigenvalues and eigenvectors.
    -
    call eigen(k, m, vals, vecs = modeshapes)
    +
    call eigen(k, m, vals, vecs = modeshapes)
    ! Compute the natural frequency values, and return them with units of Hz.
    ! Notice, all eigenvalues and eigenvectors are real for this example.
    @@ -225,6 +225,8 @@
    print '(F10.3)', (real(modeshapes(j,i)), j = 1, size(natfreq))
    end do
    end program
    +
    Computes the eigenvalues, and optionally the eigenvectors, of a matrix.
    Definition: linalg.f90:3098
    +
    Provides a set of common linear algebra routines.
    Definition: linalg.f90:15
    The above program produces the following output.
    Modal Information:
    Mode 1: (232.9225 Hz)
    -0.718
    diff --git a/doc/html/interfacelinalg_1_1form__lu.html b/doc/html/interfacelinalg_1_1form__lu.html index 124e3e74..6bb3acc5 100644 --- a/doc/html/interfacelinalg_1_1form__lu.html +++ b/doc/html/interfacelinalg_1_1form__lu.html @@ -150,7 +150,7 @@
    Usage
    The following example illustrates how to extract the L, U, and P matrices in order to solve a system of LU factored equations.
    program example
    use iso_fortran_env, only : real64, int32
    -
    use linalg_core
    +
    use linalg
    implicit none
    ! Variables
    @@ -177,10 +177,10 @@
    ! | 0 |
    ! Compute the LU factorization
    -
    call lu_factor(a, pvt)
    +
    call lu_factor(a, pvt)
    ! Extract the L and U matrices. A is overwritten with L.
    -
    call form_lu(a, pvt, u, p)
    +
    call form_lu(a, pvt, u, p)
    ! Solve the lower triangular system L * Y = P * B for Y, but first compute
    ! P * B, and store the results in B
    @@ -188,15 +188,19 @@
    ! Now, compute the solution to the lower triangular system. Store the
    ! result in B. Remember, L is unit diagonal (ones on its diagonal)
    -
    call solve_triangular_system(.false., .false., .false., a, b)
    +
    call solve_triangular_system(.false., .false., .false., a, b)
    ! Solve the upper triangular system U * X = Y for X.
    -
    call solve_triangular_system(.true., .false., .true., u, b)
    +
    call solve_triangular_system(.true., .false., .true., u, b)
    ! Display the results.
    print '(A)', "LU Solution: X = "
    print '(F8.4)', (b(i), i = 1, size(b))
    end program
    +
    Extracts the L and U matrices from the condensed [L\U] storage format used by the lu_factor.
    Definition: linalg.f90:717
    +
    Computes the LU factorization of an M-by-N matrix.
    Definition: linalg.f90:595
    +
    Solves a triangular system of equations.
    Definition: linalg.f90:2061
    +
    Provides a set of common linear algebra routines.
    Definition: linalg.f90:15
    The above program produces the following output.
    LU Solution: X =
    0.3333
    -0.6667
    diff --git a/doc/html/interfacelinalg_1_1form__qr.html b/doc/html/interfacelinalg_1_1form__qr.html index 706689e9..280aa722 100644 --- a/doc/html/interfacelinalg_1_1form__qr.html +++ b/doc/html/interfacelinalg_1_1form__qr.html @@ -149,7 +149,7 @@
    Notes
    This routine utilizes the LAPACK routine DORGQR (ZUNQR in the complex case).
    Usage
    The following example illustrates how to explicitly form the Q and R matrices from the output of qr_factor, and then use the resulting matrices to solve a system of linear equations.
    program example
    use iso_fortran_env, only : real64, int32
    -
    use linalg_core
    +
    use linalg
    implicit none
    ! Variables
    @@ -176,10 +176,10 @@
    ! | 0 |
    ! Compute the QR factorization without column pivoting
    -
    call qr_factor(a, tau)
    +
    call qr_factor(a, tau)
    ! Build Q and R. A is overwritten with R
    -
    call form_qr(a, tau, q)
    +
    call form_qr(a, tau, q)
    ! As this system is square, matrix R is upper triangular. Also, Q is
    ! always orthogonal such that it's inverse and transpose are equal. As the
    @@ -191,7 +191,7 @@
    b = matmul(transpose(q), b)
    ! Solve the upper triangular system R * X = Q**T * B for X
    -
    call solve_triangular_system(.true., .false., .true., a, b)
    +
    call solve_triangular_system(.true., .false., .true., a, b)
    ! Display the results
    print '(A)', "QR Solution: X = "
    @@ -202,6 +202,10 @@
    ! for by noting that Q * R = A * P, where P is an N-by-N matrix describing
    ! the column pivoting operations.
    end program
    +
    Forms the full M-by-M orthogonal matrix Q from the elementary reflectors returned by the base QR fact...
    Definition: linalg.f90:1031
    +
    Computes the QR factorization of an M-by-N matrix.
    Definition: linalg.f90:871
    +
    Solves a triangular system of equations.
    Definition: linalg.f90:2061
    +
    Provides a set of common linear algebra routines.
    Definition: linalg.f90:15
    The above program produces the following output.
    QR Solution: X =
    0.3333
    -0.6667
    diff --git a/doc/html/interfacelinalg_1_1lu__factor.html b/doc/html/interfacelinalg_1_1lu__factor.html index a57eb38b..03723a01 100644 --- a/doc/html/interfacelinalg_1_1lu__factor.html +++ b/doc/html/interfacelinalg_1_1lu__factor.html @@ -130,7 +130,7 @@
    Usage
    To solve a system of 3 equations of 3 unknowns using LU factorization, the following code will suffice.
    program example
    use iso_fortran_env
    -
    use linalg_core
    +
    use linalg
    implicit none
    ! Local Variables
    @@ -157,15 +157,18 @@
    ! | 0 |
    ! Compute the LU factorization
    -
    call lu_factor(a, pvt)
    +
    call lu_factor(a, pvt)
    ! Compute the solution. The results overwrite b.
    -
    call solve_lu(a, pvt, b)
    +
    call solve_lu(a, pvt, b)
    ! Display the results.
    print '(A)', "LU Solution: X = "
    print '(F8.4)', (b(i), i = 1, size(b))
    end program
    +
    Computes the LU factorization of an M-by-N matrix.
    Definition: linalg.f90:595
    +
    Solves a system of LU-factored equations.
    Definition: linalg.f90:2149
    +
    Provides a set of common linear algebra routines.
    Definition: linalg.f90:15
    The program generates the following output.
    LU Solution: X =
    0.3333
    -0.6667
    diff --git a/doc/html/interfacelinalg_1_1mtx__inverse.html b/doc/html/interfacelinalg_1_1mtx__inverse.html index 5bbe00b4..534bffdf 100644 --- a/doc/html/interfacelinalg_1_1mtx__inverse.html +++ b/doc/html/interfacelinalg_1_1mtx__inverse.html @@ -133,7 +133,7 @@
    Usage
    The following example illustrates the inversion of a 3-by-3 matrix.
    program example
    use iso_fortran_env, only : real64, int32
    -
    use linalg_core
    +
    use linalg
    implicit none
    ! Variables
    @@ -150,7 +150,7 @@
    ! Compute the inverse of A. Notice, the original matrix is overwritten
    ! with it's inverse.
    ai = a
    -
    call mtx_inverse(ai)
    +
    call mtx_inverse(ai)
    ! Show that A * inv(A) = I
    c = matmul(a, ai)
    @@ -167,6 +167,8 @@
    print *, c(i,:)
    end do
    end program
    +
    Computes the inverse of a square matrix.
    Definition: linalg.f90:2778
    +
    Provides a set of common linear algebra routines.
    Definition: linalg.f90:15
    The above program produces the following output.
    Inverse:
    -1.7777777777777777 0.88888888888888884 -0.11111111111111110
    1.5555555555555556 -0.77777777777777779 0.22222222222222221
    diff --git a/doc/html/interfacelinalg_1_1mtx__pinverse.html b/doc/html/interfacelinalg_1_1mtx__pinverse.html index c984ec17..c0f4f1c5 100644 --- a/doc/html/interfacelinalg_1_1mtx__pinverse.html +++ b/doc/html/interfacelinalg_1_1mtx__pinverse.html @@ -135,7 +135,7 @@
    Usage
    The following example illustrates how to compute the Moore-Penrose pseudo-inverse of a matrix.
    program example
    use iso_fortran_env, only : int32, real64
    -
    use linalg_core
    +
    use linalg
    implicit none
    ! Variables
    @@ -154,7 +154,7 @@
    ! | 1 0 0 |
    ! A**-1 = | |
    ! | 0 1/2 1/2 |
    -
    call mtx_pinverse(a, ai)
    +
    call mtx_pinverse(a, ai)
    ! Notice, A**-1 * A is an identity matrix.
    c = matmul(ai, ao)
    @@ -171,6 +171,8 @@
    print *, c(i,:)
    end do
    end program
    +
    Computes the Moore-Penrose pseudo-inverse of a M-by-N matrix using the singular value decomposition o...
    Definition: linalg.f90:2884
    +
    Provides a set of common linear algebra routines.
    Definition: linalg.f90:15
    The above program produces the following output.
    Inverse:
    1.0000000000000000 0.0000000000000000 0.0000000000000000
    0.0000000000000000 0.49999999999999978 0.49999999999999989
    diff --git a/doc/html/interfacelinalg_1_1mult__qr.html b/doc/html/interfacelinalg_1_1mult__qr.html index fc7a037e..7a7d468a 100644 --- a/doc/html/interfacelinalg_1_1mult__qr.html +++ b/doc/html/interfacelinalg_1_1mult__qr.html @@ -150,7 +150,7 @@
    Notes
    This routine utilizes the LAPACK routine DORMQR (ZUNMQR in the complex case).
    Usage
    The following example illustrates how to perform the multiplication \( Q^T B \) when solving a system of QR factored equations without explicitly forming the matrix \( Q \).
    program example
    use iso_fortran_env, only : real64, int32
    -
    use linalg_core
    +
    use linalg
    implicit none
    ! Variables
    @@ -177,7 +177,7 @@
    ! | 0 |
    ! Compute the QR factorization without column pivoting
    -
    call qr_factor(a, tau)
    +
    call qr_factor(a, tau)
    ! As this system is square, matrix R is upper triangular. Also, Q is
    ! always orthogonal such that it's inverse and transpose are equal. As the
    @@ -187,10 +187,10 @@
    ! Compute Q**T * B, and store the results in B. Notice, using mult_qr
    ! avoids direct construction of the full Q and R matrices.
    -
    call mult_qr(.true., a, tau, b)
    +
    call mult_qr(.true., a, tau, b)
    ! Solve the upper triangular system R * X = Q**T * B for X
    -
    call solve_triangular_system(.true., .false., .true., a, b)
    +
    call solve_triangular_system(.true., .false., .true., a, b)
    ! Display the results
    print '(A)', "QR Solution: X = "
    @@ -201,6 +201,10 @@
    ! for by noting that Q * R = A * P, where P is an N-by-N matrix describing
    ! the column pivoting operations.
    end program
    +
    Multiplies a general matrix by the orthogonal matrix Q from a QR factorization.
    Definition: linalg.f90:1185
    +
    Computes the QR factorization of an M-by-N matrix.
    Definition: linalg.f90:871
    +
    Solves a triangular system of equations.
    Definition: linalg.f90:2061
    +
    Provides a set of common linear algebra routines.
    Definition: linalg.f90:15
    The above program produces the following output.
    QR Solution: X =
    0.3333
    -0.6667
    diff --git a/doc/html/interfacelinalg_1_1qr__factor.html b/doc/html/interfacelinalg_1_1qr__factor.html index 62b455ab..1e43ecfd 100644 --- a/doc/html/interfacelinalg_1_1qr__factor.html +++ b/doc/html/interfacelinalg_1_1qr__factor.html @@ -148,7 +148,7 @@
    Notes
    This routine utilizes the LAPACK routine DGEQP3 (ZGEQP3 for the complex case).
    Usage
    The following example illustrates the solution of a system of equations using QR factorization.
    program example
    use iso_fortran_env, only : real64, int32
    -
    use linalg_core
    +
    use linalg
    implicit none
    ! Local Variables
    @@ -176,10 +176,10 @@
    ! Compute the QR factorization, using pivoting
    pvt = 0 ! Zero every entry in order not to lock any column in place
    -
    call qr_factor(a, tau, pvt)
    +
    call qr_factor(a, tau, pvt)
    ! Compute the solution. The results overwrite b.
    -
    call solve_qr(a, tau, pvt, b)
    +
    call solve_qr(a, tau, pvt, b)
    ! Display the results.
    print '(A)', "QR Solution: X = "
    @@ -189,6 +189,9 @@
    ! same manner. The only difference is to omit the PVT array (column pivot
    ! tracking array).
    end program
    +
    Computes the QR factorization of an M-by-N matrix.
    Definition: linalg.f90:871
    +
    Solves a system of M QR-factored equations of N unknowns.
    Definition: linalg.f90:2284
    +
    Provides a set of common linear algebra routines.
    Definition: linalg.f90:15
    The above program produces the following output.
    QR Solution: X =
    0.3333
    -0.6667
    diff --git a/doc/html/interfacelinalg_1_1qr__rank1__update.html b/doc/html/interfacelinalg_1_1qr__rank1__update.html index df972f9c..1d305795 100644 --- a/doc/html/interfacelinalg_1_1qr__rank1__update.html +++ b/doc/html/interfacelinalg_1_1qr__rank1__update.html @@ -132,7 +132,7 @@
    See Also
    Source
    Usage
    The following example illustrates a rank 1 update to a QR factored system. The results are compared to updating the original matrix, and then performing the factorization.
    program example
    use iso_fortran_env
    -
    use linalg_core
    +
    use linalg
    implicit none
    ! Variables
    @@ -156,22 +156,22 @@
    ! Compute the QR factorization of the original matrix
    r = a ! Making a copy as the matrix will be overwritten by qr_factor
    -
    call qr_factor(r, tau)
    +
    call qr_factor(r, tau)
    ! Form Q & R
    -
    call form_qr(r, tau, q)
    +
    call form_qr(r, tau, q)
    ! Compute the rank 1 update to the original matrix such that:
    ! A = A + u * v**T
    -
    call rank1_update(1.0d0, u, v, a)
    +
    call rank1_update(1.0d0, u, v, a)
    ! Compute the rank 1 update to the factorization. Notice, the contents
    ! of U & V are destroyed as part of this process.
    -
    call qr_rank1_update(q, r, u, v)
    +
    call qr_rank1_update(q, r, u, v)
    ! As comparison, compute the QR factorization of the rank 1 updated matrix
    -
    call qr_factor(a, tau)
    -
    call form_qr(a, tau, qu)
    +
    call qr_factor(a, tau)
    +
    call form_qr(a, tau, qu)
    ! Display the matrices
    print '(A)', "Updating the Factored Form:"
    @@ -194,6 +194,11 @@
    print *, a(i,:)
    end do
    end program
    +
    Forms the full M-by-M orthogonal matrix Q from the elementary reflectors returned by the base QR fact...
    Definition: linalg.f90:1031
    +
    Computes the QR factorization of an M-by-N matrix.
    Definition: linalg.f90:871
    +
    Computes the rank 1 update to an M-by-N QR factored matrix A (M >= N) where , and such that .
    Definition: linalg.f90:1334
    +
    Performs the rank-1 update to matrix A such that: , where is an M-by-N matrix, is a scalar,...
    Definition: linalg.f90:194
    +
    Provides a set of common linear algebra routines.
    Definition: linalg.f90:15
    The above program produces the following output.
    Updating the Factored Form:
    Q =
    -0.13031167282892092 0.98380249683206911 -0.12309149097933236
    diff --git a/doc/html/interfacelinalg_1_1solve__cholesky.html b/doc/html/interfacelinalg_1_1solve__cholesky.html index dab536e0..249a5320 100644 --- a/doc/html/interfacelinalg_1_1solve__cholesky.html +++ b/doc/html/interfacelinalg_1_1solve__cholesky.html @@ -127,7 +127,7 @@
    Notes
    This routine utilizes the LAPACK routine DPOTRS (ZPOTRS in the complex case).
    Usage
    The following example illustrates the solution of a positive-definite system of equations via Cholesky factorization.
    program example
    use iso_fortran_env, only : real64, int32
    -
    use linalg_core
    +
    use linalg
    implicit none
    ! Variables
    @@ -153,10 +153,10 @@
    ! Compute the Cholesky factorization of A considering only the upper
    ! triangular portion of A (the default configuration).
    -
    call cholesky_factor(a)
    +
    ! Compute the solution
    -
    call solve_cholesky(.true., a, b)
    +
    call solve_cholesky(.true., a, b)
    ! Display the results
    print '(A)', "Cholesky Solution: X = "
    @@ -166,15 +166,19 @@
    ! factorization causes A = U**T * U. Then U**T * U * X = B.
    ! Step 1 would then be to solve the problem U**T * Y = B, for Y.
    -
    call solve_triangular_system(.true., .true., .true., a, bu)
    +
    call solve_triangular_system(.true., .true., .true., a, bu)
    ! Now, solve the problem U * X = Y, for X
    -
    call solve_triangular_system(.true., .false., .true., a, bu)
    +
    call solve_triangular_system(.true., .false., .true., a, bu)
    ! Display the results
    print '(A)', "Cholesky Solution (Manual Approach): X = "
    print '(F8.4)', (bu(i), i = 1, size(bu))
    end program
    +
    Computes the Cholesky factorization of a symmetric, positive definite matrix.
    Definition: linalg.f90:1433
    +
    Solves a system of Cholesky factored equations.
    Definition: linalg.f90:2390
    +
    Solves a triangular system of equations.
    Definition: linalg.f90:2061
    +
    Provides a set of common linear algebra routines.
    Definition: linalg.f90:15
    The above program produces the following output.
    Cholesky Solution: X =
    239.5833
    -65.6667
    diff --git a/doc/html/interfacelinalg_1_1solve__least__squares.html b/doc/html/interfacelinalg_1_1solve__least__squares.html index cb6f85b1..778e1c31 100644 --- a/doc/html/interfacelinalg_1_1solve__least__squares.html +++ b/doc/html/interfacelinalg_1_1solve__least__squares.html @@ -130,7 +130,7 @@
    Notes
    This routine utilizes the LAPACK routine DGELS (ZGELS in the complex case).
    Usage
    The following example illustrates the least squares solution of an overdetermined system of linear equations.
    program example
    use iso_fortran_env, only : real64, int32
    -
    use linalg_core
    +
    use linalg
    implicit none
    ! Local Variables
    @@ -154,12 +154,14 @@
    ! Compute the solution via a least-squares approach. The results overwrite
    ! the first 2 elements in b.
    -
    call solve_least_squares(a, b)
    +
    ! Display the results
    print '(A)', "Least Squares Solution: X = "
    print '(F9.5)', (b(i), i = 1, size(a, 2))
    end program
    +
    Solves the overdetermined or underdetermined system of M equations of N unknowns....
    Definition: linalg.f90:2480
    +
    Provides a set of common linear algebra routines.
    Definition: linalg.f90:15
    The above program produces the following output.
    Least Squares Solution: X =
    0.13158
    -0.57895
    diff --git a/doc/html/interfacelinalg_1_1solve__least__squares__full.html b/doc/html/interfacelinalg_1_1solve__least__squares__full.html index a05d17d3..9ec2eba9 100644 --- a/doc/html/interfacelinalg_1_1solve__least__squares__full.html +++ b/doc/html/interfacelinalg_1_1solve__least__squares__full.html @@ -132,7 +132,7 @@
    Notes
    This routine utilizes the LAPACK routine DGELSY (ZGELSY in the complex case).
    Usage
    The following example illustrates the least squares solution of an overdetermined system of linear equations.
    program example
    use iso_fortran_env, only : real64, int32
    -
    use linalg_core
    +
    use linalg
    implicit none
    ! Local Variables
    @@ -156,12 +156,14 @@
    ! Compute the solution via a least-squares approach. The results overwrite
    ! the first 2 elements in b.
    -
    call solve_least_squares_full(a, b)
    +
    ! Display the results
    print '(A)', "Least Squares Solution: X = "
    print '(F9.5)', (b(i), i = 1, size(a, 2))
    end program
    +
    Solves the overdetermined or underdetermined system of M equations of N unknowns,...
    Definition: linalg.f90:2581
    +
    Provides a set of common linear algebra routines.
    Definition: linalg.f90:15
    The above program produces the following output.
    Least Squares Solution: X =
    0.13158
    -0.57895
    diff --git a/doc/html/interfacelinalg_1_1solve__least__squares__svd.html b/doc/html/interfacelinalg_1_1solve__least__squares__svd.html index 119485b6..6a04cec4 100644 --- a/doc/html/interfacelinalg_1_1solve__least__squares__svd.html +++ b/doc/html/interfacelinalg_1_1solve__least__squares__svd.html @@ -134,7 +134,7 @@
    Notes
    This routine utilizes the LAPACK routine DGELSS (ZGELSS in the complex case).
    Usage
    The following example illustrates the least squares solution of an overdetermined system of linear equations.
    program example
    use iso_fortran_env, only : real64, int32
    -
    use linalg_core
    +
    use linalg
    implicit none
    ! Local Variables
    @@ -158,12 +158,14 @@
    ! Compute the solution via a least-squares approach. The results overwrite
    ! the first 2 elements in b.
    -
    call solve_least_squares_svd(a, b)
    +
    ! Display the results
    print '(A)', "Least Squares Solution: X = "
    print '(F9.5)', (b(i), i = 1, size(a, 2))
    end program
    +
    Solves the overdetermined or underdetermined system of M equations of N unknowns using a singular va...
    Definition: linalg.f90:2683
    +
    Provides a set of common linear algebra routines.
    Definition: linalg.f90:15
    The above program produces the following output.
    Least Squares Solution: X =
    0.13158
    -0.57895
    diff --git a/doc/html/interfacelinalg_1_1solve__lu.html b/doc/html/interfacelinalg_1_1solve__lu.html index e66d92b6..8f39bdc5 100644 --- a/doc/html/interfacelinalg_1_1solve__lu.html +++ b/doc/html/interfacelinalg_1_1solve__lu.html @@ -127,7 +127,7 @@
    Notes
    The routine is based upon the LAPACK routine DGETRS (ZGETRS in the complex case).
    Usage
    To solve a system of 3 equations of 3 unknowns using LU factorization, the following code will suffice.
    program example
    use iso_fortran_env
    -
    use linalg_core
    +
    use linalg
    implicit none
    ! Local Variables
    @@ -154,15 +154,18 @@
    ! | 0 |
    ! Compute the LU factorization
    -
    call lu_factor(a, pvt)
    +
    call lu_factor(a, pvt)
    ! Compute the solution. The results overwrite b.
    -
    call solve_lu(a, pvt, b)
    +
    call solve_lu(a, pvt, b)
    ! Display the results.
    print '(A)', "LU Solution: X = "
    print '(F8.4)', (b(i), i = 1, size(b))
    end program
    +
    Computes the LU factorization of an M-by-N matrix.
    Definition: linalg.f90:595
    +
    Solves a system of LU-factored equations.
    Definition: linalg.f90:2149
    +
    Provides a set of common linear algebra routines.
    Definition: linalg.f90:15
    The program generates the following output.
    LU Solution: X =
    0.3333
    -0.6667
    diff --git a/doc/html/interfacelinalg_1_1solve__qr.html b/doc/html/interfacelinalg_1_1solve__qr.html index ee023a5e..f03c1c53 100644 --- a/doc/html/interfacelinalg_1_1solve__qr.html +++ b/doc/html/interfacelinalg_1_1solve__qr.html @@ -150,7 +150,7 @@
    Usage
    The following example illustrates the solution of a system of equations using QR factorization.
    program example
    use iso_fortran_env, only : real64, int32
    -
    use linalg_core
    +
    use linalg
    implicit none
    ! Local Variables
    @@ -178,10 +178,10 @@
    ! Compute the QR factorization, using pivoting
    pvt = 0 ! Zero every entry in order not to lock any column in place
    -
    call qr_factor(a, tau, pvt)
    +
    call qr_factor(a, tau, pvt)
    ! Compute the solution. The results overwrite b.
    -
    call solve_qr(a, tau, pvt, b)
    +
    call solve_qr(a, tau, pvt, b)
    ! Display the results.
    print '(A)', "QR Solution: X = "
    @@ -191,6 +191,9 @@
    ! same manner. The only difference is to omit the PVT array (column pivot
    ! tracking array).
    end program
    +
    Computes the QR factorization of an M-by-N matrix.
    Definition: linalg.f90:871
    +
    Solves a system of M QR-factored equations of N unknowns.
    Definition: linalg.f90:2284
    +
    Provides a set of common linear algebra routines.
    Definition: linalg.f90:15
    The above program produces the following output.
    QR Solution: X =
    0.3333
    -0.6667
    diff --git a/doc/html/interfacelinalg_1_1solve__triangular__system.html b/doc/html/interfacelinalg_1_1solve__triangular__system.html index c8d3cf84..e9d1de84 100644 --- a/doc/html/interfacelinalg_1_1solve__triangular__system.html +++ b/doc/html/interfacelinalg_1_1solve__triangular__system.html @@ -147,7 +147,7 @@
    Notes
    This routine is based upon the BLAS routine DTRSV (ZTRSV in the complex case).
    Usage
    The following example illustrates the solution of two triangular systems to solve a system of LU factored equations.
    program example
    use iso_fortran_env, only : real64, int32
    -
    use linalg_core
    +
    use linalg
    implicit none
    ! Variables
    @@ -174,10 +174,10 @@
    ! | 0 |
    ! Compute the LU factorization
    -
    call lu_factor(a, pvt)
    +
    call lu_factor(a, pvt)
    ! Extract the L and U matrices. A is overwritten with L.
    -
    call form_lu(a, pvt, u, p)
    +
    call form_lu(a, pvt, u, p)
    ! Solve the lower triangular system L * Y = P * B for Y, but first compute
    ! P * B, and store the results in B
    @@ -185,15 +185,19 @@
    ! Now, compute the solution to the lower triangular system. Store the
    ! result in B. Remember, L is unit diagonal (ones on its diagonal)
    -
    call solve_triangular_system(.false., .false., .false., a, b)
    +
    call solve_triangular_system(.false., .false., .false., a, b)
    ! Solve the upper triangular system U * X = Y for X.
    -
    call solve_triangular_system(.true., .false., .true., u, b)
    +
    call solve_triangular_system(.true., .false., .true., u, b)
    ! Display the results.
    print '(A)', "LU Solution: X = "
    print '(F8.4)', (b(i), i = 1, size(b))
    end program
    +
    Extracts the L and U matrices from the condensed [L\U] storage format used by the lu_factor.
    Definition: linalg.f90:717
    +
    Computes the LU factorization of an M-by-N matrix.
    Definition: linalg.f90:595
    +
    Solves a triangular system of equations.
    Definition: linalg.f90:2061
    +
    Provides a set of common linear algebra routines.
    Definition: linalg.f90:15
    The above program produces the following output.
    LU Solution: X =
    0.3333
    -0.6667
    diff --git a/doc/html/interfacelinalg_1_1svd.html b/doc/html/interfacelinalg_1_1svd.html index 4e3b80cd..4fd0a468 100644 --- a/doc/html/interfacelinalg_1_1svd.html +++ b/doc/html/interfacelinalg_1_1svd.html @@ -136,7 +136,7 @@
    Usage
    The following example illustrates the calculation of the singular value decomposition of an overdetermined system.
    program example
    use iso_fortran_env, only : int32, real64
    -
    use linalg_core
    +
    use linalg
    implicit none
    ! Variables
    @@ -151,7 +151,7 @@
    ! Compute the singular value decomposition of A. Notice, V**T is returned
    ! instead of V. Also note, A is overwritten.
    -
    call svd(a, s, u, vt)
    +
    call svd(a, s, u, vt)
    ! Display the results
    print '(A)', "U ="
    @@ -168,13 +168,16 @@
    end do
    ! Compute U * S * V**T
    -
    call diag_mtx_mult(.true., 1.0d0, s, vt) ! Compute: VT = S * V**T
    +
    call diag_mtx_mult(.true., 1.0d0, s, vt) ! Compute: VT = S * V**T
    ac = matmul(u(:,1:2), vt)
    print '(A)', "U * S * V**T ="
    do i = 1, size(ac, 1)
    print *, ac(i,:)
    end do
    end program
    +
    Multiplies a diagonal matrix with another matrix or array.
    Definition: linalg.f90:329
    +
    Computes the singular value decomposition of a matrix A. The SVD is defined as: , where is an M-by-M...
    Definition: linalg.f90:1927
    +
    Provides a set of common linear algebra routines.
    Definition: linalg.f90:15
    The above program produces the following output.
    U =
    -0.47411577501825380 -0.81850539032073777 -0.32444284226152509
    0.82566838523833064 -0.28535874325972488 -0.48666426339228758
    diff --git a/doc/html/linalg__factor_8f90_source.html b/doc/html/linalg__factor_8f90_source.html index cb2549bb..ef095415 100644 --- a/doc/html/linalg__factor_8f90_source.html +++ b/doc/html/linalg__factor_8f90_source.html @@ -147,1654 +147,1654 @@
    49 ! call to LAPACK
    50 if (flag > 0) then
    51 ! WARNING: Singular matrix
    -
    52 write(errmsg, '(AI0A)') &
    +
    52 write(errmsg, 100) &
    53 "Singular matrix encountered (row ", flag, ")"
    54 call errmgr%report_warning("lu_factor_dbl", trim(errmsg), &
    55 la_singular_matrix_error)
    56 end if
    -
    57 end subroutine
    -
    58
    -
    59! ------------------------------------------------------------------------------
    -
    60 module subroutine lu_factor_cmplx(a, ipvt, err)
    -
    61 ! Arguments
    -
    62 complex(real64), intent(inout), dimension(:,:) :: a
    -
    63 integer(int32), intent(out), dimension(:) :: ipvt
    -
    64 class(errors), intent(inout), optional, target :: err
    -
    65
    -
    66 ! Local Variables
    -
    67 integer(int32) :: m, n, mn, flag
    -
    68 class(errors), pointer :: errmgr
    -
    69 type(errors), target :: deferr
    -
    70 character(len = 128) :: errmsg
    -
    71
    -
    72 ! Initialization
    -
    73 m = size(a, 1)
    -
    74 n = size(a, 2)
    -
    75 mn = min(m, n)
    -
    76 if (present(err)) then
    -
    77 errmgr => err
    -
    78 else
    -
    79 errmgr => deferr
    -
    80 end if
    -
    81
    -
    82 ! Input Check
    -
    83 flag = 0
    -
    84 if (size(ipvt) /= mn) then
    -
    85 ! ERROR: IPVT not sized correctly
    -
    86 call errmgr%report_error("lu_factor_cmplx", &
    -
    87 "Incorrectly sized input array IPVT, argument 2.", &
    -
    88 la_array_size_error)
    -
    89 return
    -
    90 end if
    -
    91
    -
    92 ! Compute the LU factorization by calling the LAPACK routine ZGETRF
    -
    93 call zgetrf(m, n, a, m, ipvt, flag)
    +
    57
    +
    58 ! Formatting
    +
    59100 format(a, i0, a)
    +
    60 end subroutine
    +
    61
    +
    62! ------------------------------------------------------------------------------
    +
    63 module subroutine lu_factor_cmplx(a, ipvt, err)
    +
    64 ! Arguments
    +
    65 complex(real64), intent(inout), dimension(:,:) :: a
    +
    66 integer(int32), intent(out), dimension(:) :: ipvt
    +
    67 class(errors), intent(inout), optional, target :: err
    +
    68
    +
    69 ! Local Variables
    +
    70 integer(int32) :: m, n, mn, flag
    +
    71 class(errors), pointer :: errmgr
    +
    72 type(errors), target :: deferr
    +
    73 character(len = 128) :: errmsg
    +
    74
    +
    75 ! Initialization
    +
    76 m = size(a, 1)
    +
    77 n = size(a, 2)
    +
    78 mn = min(m, n)
    +
    79 if (present(err)) then
    +
    80 errmgr => err
    +
    81 else
    +
    82 errmgr => deferr
    +
    83 end if
    +
    84
    +
    85 ! Input Check
    +
    86 flag = 0
    +
    87 if (size(ipvt) /= mn) then
    +
    88 ! ERROR: IPVT not sized correctly
    +
    89 call errmgr%report_error("lu_factor_cmplx", &
    +
    90 "Incorrectly sized input array IPVT, argument 2.", &
    +
    91 la_array_size_error)
    +
    92 return
    +
    93 end if
    94
    -
    95 ! If flag > 0, the matrix is singular. Notice, flag should not be
    -
    96 ! able to be < 0 as we've already verrified inputs prior to making the
    -
    97 ! call to LAPACK
    -
    98 if (flag > 0) then
    -
    99 ! WARNING: Singular matrix
    -
    100 write(errmsg, '(AI0A)') &
    -
    101 "Singular matrix encountered (row ", flag, ")"
    -
    102 call errmgr%report_warning("lu_factor_cmplx", trim(errmsg), &
    -
    103 la_singular_matrix_error)
    -
    104 end if
    -
    105 end subroutine
    -
    106
    -
    107! ------------------------------------------------------------------------------
    -
    108 module subroutine form_lu_all(lu, ipvt, u, p, err)
    -
    109 ! Arguments
    -
    110 real(real64), intent(inout), dimension(:,:) :: lu
    -
    111 integer(int32), intent(in), dimension(:) :: ipvt
    -
    112 real(real64), intent(out), dimension(:,:) :: u, p
    -
    113 class(errors), intent(inout), optional, target :: err
    -
    114
    -
    115 ! Local Variables
    -
    116 integer(int32) :: j, jp, n, flag
    -
    117 class(errors), pointer :: errmgr
    -
    118 type(errors), target :: deferr
    -
    119 character(len = 128) :: errmsg
    +
    95 ! Compute the LU factorization by calling the LAPACK routine ZGETRF
    +
    96 call zgetrf(m, n, a, m, ipvt, flag)
    +
    97
    +
    98 ! If flag > 0, the matrix is singular. Notice, flag should not be
    +
    99 ! able to be < 0 as we've already verrified inputs prior to making the
    +
    100 ! call to LAPACK
    +
    101 if (flag > 0) then
    +
    102 ! WARNING: Singular matrix
    +
    103 write(errmsg, 100) &
    +
    104 "Singular matrix encountered (row ", flag, ")"
    +
    105 call errmgr%report_warning("lu_factor_cmplx", trim(errmsg), &
    +
    106 la_singular_matrix_error)
    +
    107 end if
    +
    108
    +
    109 ! Formatting
    +
    110100 format(a, i0, a)
    +
    111 end subroutine
    +
    112
    +
    113! ------------------------------------------------------------------------------
    +
    114 module subroutine form_lu_all(lu, ipvt, u, p, err)
    +
    115 ! Arguments
    +
    116 real(real64), intent(inout), dimension(:,:) :: lu
    +
    117 integer(int32), intent(in), dimension(:) :: ipvt
    +
    118 real(real64), intent(out), dimension(:,:) :: u, p
    +
    119 class(errors), intent(inout), optional, target :: err
    120
    -
    121 ! Parameters
    -
    122 real(real64), parameter :: zero = 0.0d0
    -
    123 real(real64), parameter :: one = 1.0d0
    -
    124
    -
    125 ! Initialization
    -
    126 n = size(lu, 1)
    -
    127 if (present(err)) then
    -
    128 errmgr => err
    -
    129 else
    -
    130 errmgr => deferr
    -
    131 end if
    -
    132
    -
    133 ! Input Check
    -
    134 flag = 0
    -
    135 if (size(lu, 2) /= n) then
    -
    136 flag = 1
    -
    137 else if (size(ipvt) /= n) then
    -
    138 flag = 2
    -
    139 else if (size(u, 1) /= n .or. size(u, 2) /= n) then
    -
    140 flag = 3
    -
    141 else if (size(p, 1) /= n .or. size(p, 2) /= n) then
    -
    142 flag = 4
    -
    143 end if
    -
    144 if (flag /= 0) then
    -
    145 ! One of the input arrays is not sized correctly
    -
    146 write(errmsg, '(AI0A)') "Input number ", flag, &
    -
    147 " is not sized correctly."
    -
    148 call errmgr%report_error("form_lu_all", trim(errmsg), &
    -
    149 la_array_size_error)
    -
    150 return
    -
    151 end if
    -
    152
    -
    153 ! Ensure P starts off as an identity matrix
    -
    154 call dlaset('A', n, n, zero, one, p, n)
    -
    155
    -
    156 ! Process
    -
    157 do j = 1, n
    -
    158 ! Define the pivot matrix
    -
    159 jp = ipvt(j)
    -
    160 if (j /= jp) call swap(p(j,1:n), p(jp,1:n))
    +
    121 ! Local Variables
    +
    122 integer(int32) :: j, jp, n, flag
    +
    123 class(errors), pointer :: errmgr
    +
    124 type(errors), target :: deferr
    +
    125 character(len = 128) :: errmsg
    +
    126
    +
    127 ! Parameters
    +
    128 real(real64), parameter :: zero = 0.0d0
    +
    129 real(real64), parameter :: one = 1.0d0
    +
    130
    +
    131 ! Initialization
    +
    132 n = size(lu, 1)
    +
    133 if (present(err)) then
    +
    134 errmgr => err
    +
    135 else
    +
    136 errmgr => deferr
    +
    137 end if
    +
    138
    +
    139 ! Input Check
    +
    140 flag = 0
    +
    141 if (size(lu, 2) /= n) then
    +
    142 flag = 1
    +
    143 else if (size(ipvt) /= n) then
    +
    144 flag = 2
    +
    145 else if (size(u, 1) /= n .or. size(u, 2) /= n) then
    +
    146 flag = 3
    +
    147 else if (size(p, 1) /= n .or. size(p, 2) /= n) then
    +
    148 flag = 4
    +
    149 end if
    +
    150 if (flag /= 0) then
    +
    151 ! One of the input arrays is not sized correctly
    +
    152 write(errmsg, 100) "Input number ", flag, &
    +
    153 " is not sized correctly."
    +
    154 call errmgr%report_error("form_lu_all", trim(errmsg), &
    +
    155 la_array_size_error)
    +
    156 return
    +
    157 end if
    +
    158
    +
    159 ! Ensure P starts off as an identity matrix
    +
    160 call dlaset('A', n, n, zero, one, p, n)
    161
    -
    162 ! Build L and U
    -
    163 u(1:j,j) = lu(1:j,j)
    -
    164 u(j+1:n,j) = zero
    -
    165
    -
    166 if (j > 1) lu(1:j-1,j) = zero
    -
    167 lu(j,j) = one
    -
    168 end do
    -
    169 end subroutine
    -
    170
    -
    171! ------------------------------------------------------------------------------
    -
    172 module subroutine form_lu_all_cmplx(lu, ipvt, u, p, err)
    -
    173 ! Arguments
    -
    174 complex(real64), intent(inout), dimension(:,:) :: lu
    -
    175 integer(int32), intent(in), dimension(:) :: ipvt
    -
    176 complex(real64), intent(out), dimension(:,:) :: u
    -
    177 real(real64), intent(out), dimension(:,:) :: p
    -
    178 class(errors), intent(inout), optional, target :: err
    +
    162 ! Process
    +
    163 do j = 1, n
    +
    164 ! Define the pivot matrix
    +
    165 jp = ipvt(j)
    +
    166 if (j /= jp) call swap(p(j,1:n), p(jp,1:n))
    +
    167
    +
    168 ! Build L and U
    +
    169 u(1:j,j) = lu(1:j,j)
    +
    170 u(j+1:n,j) = zero
    +
    171
    +
    172 if (j > 1) lu(1:j-1,j) = zero
    +
    173 lu(j,j) = one
    +
    174 end do
    +
    175
    +
    176 ! Formatting
    +
    177100 format(a, i0, a)
    +
    178 end subroutine
    179
    -
    180 ! Local Variables
    -
    181 integer(int32) :: j, jp, n, flag
    -
    182 class(errors), pointer :: errmgr
    -
    183 type(errors), target :: deferr
    -
    184 character(len = 128) :: errmsg
    -
    185
    -
    186 ! Parameters
    -
    187 real(real64), parameter :: zero = 0.0d0
    -
    188 real(real64), parameter :: one = 1.0d0
    -
    189 complex(real64), parameter :: c_zero = (0.0d0, 0.0d0)
    -
    190 complex(real64), parameter :: c_one = (1.0d0, 0.0d0)
    -
    191
    -
    192 ! Initialization
    -
    193 n = size(lu, 1)
    -
    194 if (present(err)) then
    -
    195 errmgr => err
    -
    196 else
    -
    197 errmgr => deferr
    -
    198 end if
    -
    199
    -
    200 ! Input Check
    -
    201 flag = 0
    -
    202 if (size(lu, 2) /= n) then
    -
    203 flag = 1
    -
    204 else if (size(ipvt) /= n) then
    -
    205 flag = 2
    -
    206 else if (size(u, 1) /= n .or. size(u, 2) /= n) then
    -
    207 flag = 3
    -
    208 else if (size(p, 1) /= n .or. size(p, 2) /= n) then
    -
    209 flag = 4
    -
    210 end if
    -
    211 if (flag /= 0) then
    -
    212 ! One of the input arrays is not sized correctly
    -
    213 write(errmsg, '(AI0A)') "Input number ", flag, &
    -
    214 " is not sized correctly."
    -
    215 call errmgr%report_error("form_lu_all_cmplx", trim(errmsg), &
    -
    216 la_array_size_error)
    -
    217 return
    -
    218 end if
    -
    219
    -
    220 ! Ensure P starts off as an identity matrix
    -
    221 call dlaset('A', n, n, zero, one, p, n)
    -
    222
    -
    223 ! Process
    -
    224 do j = 1, n
    -
    225 ! Define the pivot matrix
    -
    226 jp = ipvt(j)
    -
    227 if (j /= jp) call swap(p(j,1:n), p(jp,1:n))
    +
    180! ------------------------------------------------------------------------------
    +
    181 module subroutine form_lu_all_cmplx(lu, ipvt, u, p, err)
    +
    182 ! Arguments
    +
    183 complex(real64), intent(inout), dimension(:,:) :: lu
    +
    184 integer(int32), intent(in), dimension(:) :: ipvt
    +
    185 complex(real64), intent(out), dimension(:,:) :: u
    +
    186 real(real64), intent(out), dimension(:,:) :: p
    +
    187 class(errors), intent(inout), optional, target :: err
    +
    188
    +
    189 ! Local Variables
    +
    190 integer(int32) :: j, jp, n, flag
    +
    191 class(errors), pointer :: errmgr
    +
    192 type(errors), target :: deferr
    +
    193 character(len = 128) :: errmsg
    +
    194
    +
    195 ! Parameters
    +
    196 real(real64), parameter :: zero = 0.0d0
    +
    197 real(real64), parameter :: one = 1.0d0
    +
    198 complex(real64), parameter :: c_zero = (0.0d0, 0.0d0)
    +
    199 complex(real64), parameter :: c_one = (1.0d0, 0.0d0)
    +
    200
    +
    201 ! Initialization
    +
    202 n = size(lu, 1)
    +
    203 if (present(err)) then
    +
    204 errmgr => err
    +
    205 else
    +
    206 errmgr => deferr
    +
    207 end if
    +
    208
    +
    209 ! Input Check
    +
    210 flag = 0
    +
    211 if (size(lu, 2) /= n) then
    +
    212 flag = 1
    +
    213 else if (size(ipvt) /= n) then
    +
    214 flag = 2
    +
    215 else if (size(u, 1) /= n .or. size(u, 2) /= n) then
    +
    216 flag = 3
    +
    217 else if (size(p, 1) /= n .or. size(p, 2) /= n) then
    +
    218 flag = 4
    +
    219 end if
    +
    220 if (flag /= 0) then
    +
    221 ! One of the input arrays is not sized correctly
    +
    222 write(errmsg, 100) "Input number ", flag, &
    +
    223 " is not sized correctly."
    +
    224 call errmgr%report_error("form_lu_all_cmplx", trim(errmsg), &
    +
    225 la_array_size_error)
    +
    226 return
    +
    227 end if
    228
    -
    229 ! Build L and U
    -
    230 u(1:j,j) = lu(1:j,j)
    -
    231 u(j+1:n,j) = c_zero
    -
    232
    -
    233 if (j > 1) lu(1:j-1,j) = c_zero
    -
    234 lu(j,j) = c_one
    -
    235 end do
    -
    236 end subroutine
    +
    229 ! Ensure P starts off as an identity matrix
    +
    230 call dlaset('A', n, n, zero, one, p, n)
    +
    231
    +
    232 ! Process
    +
    233 do j = 1, n
    +
    234 ! Define the pivot matrix
    +
    235 jp = ipvt(j)
    +
    236 if (j /= jp) call swap(p(j,1:n), p(jp,1:n))
    237
    -
    238! ------------------------------------------------------------------------------
    -
    239 module subroutine form_lu_only(lu, u, err)
    -
    240 ! Arguments
    -
    241 real(real64), intent(inout), dimension(:,:) :: lu
    -
    242 real(real64), intent(out), dimension(:,:) :: u
    -
    243 class(errors), intent(inout), optional, target :: err
    -
    244
    -
    245 ! Local Variables
    -
    246 integer(int32) :: j, n, flag
    -
    247 class(errors), pointer :: errmgr
    -
    248 type(errors), target :: deferr
    -
    249 character(len = 128) :: errmsg
    -
    250
    -
    251 ! Parameters
    -
    252 real(real64), parameter :: zero = 0.0d0
    -
    253 real(real64), parameter :: one = 1.0d0
    -
    254
    -
    255 ! Initialization
    -
    256 n = size(lu, 1)
    -
    257 if (present(err)) then
    -
    258 errmgr => err
    -
    259 else
    -
    260 errmgr => deferr
    -
    261 end if
    +
    238 ! Build L and U
    +
    239 u(1:j,j) = lu(1:j,j)
    +
    240 u(j+1:n,j) = c_zero
    +
    241
    +
    242 if (j > 1) lu(1:j-1,j) = c_zero
    +
    243 lu(j,j) = c_one
    +
    244 end do
    +
    245
    +
    246 ! Formatting
    +
    247100 format(a, i0, a)
    +
    248 end subroutine
    +
    249
    +
    250! ------------------------------------------------------------------------------
    +
    251 module subroutine form_lu_only(lu, u, err)
    +
    252 ! Arguments
    +
    253 real(real64), intent(inout), dimension(:,:) :: lu
    +
    254 real(real64), intent(out), dimension(:,:) :: u
    +
    255 class(errors), intent(inout), optional, target :: err
    +
    256
    +
    257 ! Local Variables
    +
    258 integer(int32) :: j, n, flag
    +
    259 class(errors), pointer :: errmgr
    +
    260 type(errors), target :: deferr
    +
    261 character(len = 128) :: errmsg
    262
    -
    263 ! Input Check
    -
    264 flag = 0
    -
    265 if (size(lu, 2) /= n) then
    -
    266 flag = 2
    -
    267 else if (size(u, 1) /= n .or. size(u, 2) /= n) then
    -
    268 flag = 3
    -
    269 end if
    -
    270 if (flag /= 0) then
    -
    271 ! One of the input arrays is not sized correctly
    -
    272 write(errmsg, '(AI0A)') "Input number ", flag, &
    -
    273 " is not sized correctly."
    -
    274 call errmgr%report_error("form_lu_only", trim(errmsg), &
    -
    275 la_array_size_error)
    -
    276 return
    -
    277 end if
    -
    278
    -
    279 ! Process
    -
    280 do j = 1, n
    -
    281 ! Build L and U
    -
    282 u(1:j,j) = lu(1:j,j)
    -
    283 u(j+1:n,j) = zero
    -
    284
    -
    285 if (j > 1) lu(1:j-1,j) = zero
    -
    286 lu(j,j) = one
    -
    287 end do
    -
    288 end subroutine
    -
    289
    -
    290! ------------------------------------------------------------------------------
    -
    291 module subroutine form_lu_only_cmplx(lu, u, err)
    -
    292 ! Arguments
    -
    293 complex(real64), intent(inout), dimension(:,:) :: lu
    -
    294 complex(real64), intent(out), dimension(:,:) :: u
    -
    295 class(errors), intent(inout), optional, target :: err
    +
    263 ! Parameters
    +
    264 real(real64), parameter :: zero = 0.0d0
    +
    265 real(real64), parameter :: one = 1.0d0
    +
    266
    +
    267 ! Initialization
    +
    268 n = size(lu, 1)
    +
    269 if (present(err)) then
    +
    270 errmgr => err
    +
    271 else
    +
    272 errmgr => deferr
    +
    273 end if
    +
    274
    +
    275 ! Input Check
    +
    276 flag = 0
    +
    277 if (size(lu, 2) /= n) then
    +
    278 flag = 2
    +
    279 else if (size(u, 1) /= n .or. size(u, 2) /= n) then
    +
    280 flag = 3
    +
    281 end if
    +
    282 if (flag /= 0) then
    +
    283 ! One of the input arrays is not sized correctly
    +
    284 write(errmsg, 100) "Input number ", flag, &
    +
    285 " is not sized correctly."
    +
    286 call errmgr%report_error("form_lu_only", trim(errmsg), &
    +
    287 la_array_size_error)
    +
    288 return
    +
    289 end if
    +
    290
    +
    291 ! Process
    +
    292 do j = 1, n
    +
    293 ! Build L and U
    +
    294 u(1:j,j) = lu(1:j,j)
    +
    295 u(j+1:n,j) = zero
    296
    -
    297 ! Local Variables
    -
    298 integer(int32) :: j, n, flag
    -
    299 class(errors), pointer :: errmgr
    -
    300 type(errors), target :: deferr
    -
    301 character(len = 128) :: errmsg
    -
    302
    -
    303 ! Parameters
    -
    304 complex(real64), parameter :: zero = (0.0d0, 0.0d0)
    -
    305 complex(real64), parameter :: one = (1.0d0, 0.0d0)
    -
    306
    -
    307 ! Initialization
    -
    308 n = size(lu, 1)
    -
    309 if (present(err)) then
    -
    310 errmgr => err
    -
    311 else
    -
    312 errmgr => deferr
    -
    313 end if
    -
    314
    -
    315 ! Input Check
    -
    316 flag = 0
    -
    317 if (size(lu, 2) /= n) then
    -
    318 flag = 2
    -
    319 else if (size(u, 1) /= n .or. size(u, 2) /= n) then
    -
    320 flag = 3
    -
    321 end if
    -
    322 if (flag /= 0) then
    -
    323 ! One of the input arrays is not sized correctly
    -
    324 write(errmsg, '(AI0A)') "Input number ", flag, &
    -
    325 " is not sized correctly."
    -
    326 call errmgr%report_error("form_lu_only_cmplx", trim(errmsg), &
    -
    327 la_array_size_error)
    -
    328 return
    -
    329 end if
    -
    330
    -
    331 ! Process
    -
    332 do j = 1, n
    -
    333 ! Build L and U
    -
    334 u(1:j,j) = lu(1:j,j)
    -
    335 u(j+1:n,j) = zero
    -
    336
    -
    337 if (j > 1) lu(1:j-1,j) = zero
    -
    338 lu(j,j) = one
    -
    339 end do
    -
    340 end subroutine
    -
    341
    -
    342! ******************************************************************************
    -
    343! QR FACTORIZATION
    -
    344! ------------------------------------------------------------------------------
    -
    345 module subroutine qr_factor_no_pivot(a, tau, work, olwork, err)
    -
    346 ! Arguments
    -
    347 real(real64), intent(inout), dimension(:,:) :: a
    -
    348 real(real64), intent(out), dimension(:) :: tau
    -
    349 real(real64), intent(out), target, dimension(:), optional :: work
    -
    350 integer(int32), intent(out), optional :: olwork
    -
    351 class(errors), intent(inout), optional, target :: err
    -
    352
    -
    353 ! Local Variables
    -
    354 integer(int32) :: m, n, mn, istat, lwork, flag
    -
    355 real(real64), dimension(1) :: temp
    -
    356 real(real64), pointer, dimension(:) :: wptr
    -
    357 real(real64), allocatable, target, dimension(:) :: wrk
    -
    358 class(errors), pointer :: errmgr
    -
    359 type(errors), target :: deferr
    -
    360
    -
    361 ! Initialization
    -
    362 m = size(a, 1)
    -
    363 n = size(a, 2)
    -
    364 mn = min(m, n)
    -
    365 if (present(err)) then
    -
    366 errmgr => err
    -
    367 else
    -
    368 errmgr => deferr
    -
    369 end if
    +
    297 if (j > 1) lu(1:j-1,j) = zero
    +
    298 lu(j,j) = one
    +
    299 end do
    +
    300
    +
    301 ! Formatting
    +
    302100 format(a, i0, a)
    +
    303 end subroutine
    +
    304
    +
    305! ------------------------------------------------------------------------------
    +
    306 module subroutine form_lu_only_cmplx(lu, u, err)
    +
    307 ! Arguments
    +
    308 complex(real64), intent(inout), dimension(:,:) :: lu
    +
    309 complex(real64), intent(out), dimension(:,:) :: u
    +
    310 class(errors), intent(inout), optional, target :: err
    +
    311
    +
    312 ! Local Variables
    +
    313 integer(int32) :: j, n, flag
    +
    314 class(errors), pointer :: errmgr
    +
    315 type(errors), target :: deferr
    +
    316 character(len = 128) :: errmsg
    +
    317
    +
    318 ! Parameters
    +
    319 complex(real64), parameter :: zero = (0.0d0, 0.0d0)
    +
    320 complex(real64), parameter :: one = (1.0d0, 0.0d0)
    +
    321
    +
    322 ! Initialization
    +
    323 n = size(lu, 1)
    +
    324 if (present(err)) then
    +
    325 errmgr => err
    +
    326 else
    +
    327 errmgr => deferr
    +
    328 end if
    +
    329
    +
    330 ! Input Check
    +
    331 flag = 0
    +
    332 if (size(lu, 2) /= n) then
    +
    333 flag = 2
    +
    334 else if (size(u, 1) /= n .or. size(u, 2) /= n) then
    +
    335 flag = 3
    +
    336 end if
    +
    337 if (flag /= 0) then
    +
    338 ! One of the input arrays is not sized correctly
    +
    339 write(errmsg, 100) "Input number ", flag, &
    +
    340 " is not sized correctly."
    +
    341 call errmgr%report_error("form_lu_only_cmplx", trim(errmsg), &
    +
    342 la_array_size_error)
    +
    343 return
    +
    344 end if
    +
    345
    +
    346 ! Process
    +
    347 do j = 1, n
    +
    348 ! Build L and U
    +
    349 u(1:j,j) = lu(1:j,j)
    +
    350 u(j+1:n,j) = zero
    +
    351
    +
    352 if (j > 1) lu(1:j-1,j) = zero
    +
    353 lu(j,j) = one
    +
    354 end do
    +
    355
    +
    356 ! Formatting
    +
    357100 format(a, i0, a)
    +
    358 end subroutine
    +
    359
    +
    360! ******************************************************************************
    +
    361! QR FACTORIZATION
    +
    362! ------------------------------------------------------------------------------
    +
    363 module subroutine qr_factor_no_pivot(a, tau, work, olwork, err)
    +
    364 ! Arguments
    +
    365 real(real64), intent(inout), dimension(:,:) :: a
    +
    366 real(real64), intent(out), dimension(:) :: tau
    +
    367 real(real64), intent(out), target, dimension(:), optional :: work
    +
    368 integer(int32), intent(out), optional :: olwork
    +
    369 class(errors), intent(inout), optional, target :: err
    370
    -
    371 ! Input Check
    -
    372 if (size(tau) /= mn) then
    -
    373 ! ERROR: TAU not sized correctly
    -
    374 call errmgr%report_error("qr_factor_no_pivot", &
    -
    375 "Incorrectly sized input array TAU, argument 2.", &
    -
    376 la_array_size_error)
    -
    377 return
    -
    378 end if
    -
    379
    -
    380 ! Workspace Query
    -
    381 call dgeqrf(m, n, a, m, tau, temp, -1, flag)
    -
    382 lwork = int(temp(1), int32)
    -
    383 if (present(olwork)) then
    -
    384 olwork = lwork
    -
    385 return
    -
    386 end if
    -
    387
    -
    388 ! Local Memory Allocation
    -
    389 if (present(work)) then
    -
    390 if (size(work) < lwork) then
    -
    391 ! ERROR: WORK not sized correctly
    -
    392 call errmgr%report_error("qr_factor_no_pivot", &
    -
    393 "Incorrectly sized input array WORK, argument 3.", &
    -
    394 la_array_size_error)
    -
    395 return
    -
    396 end if
    -
    397 wptr => work(1:lwork)
    -
    398 else
    -
    399 allocate(wrk(lwork), stat = istat)
    -
    400 if (istat /= 0) then
    -
    401 ! ERROR: Out of memory
    -
    402 call errmgr%report_error("qr_factor_no_pivot", &
    -
    403 "Insufficient memory available.", &
    -
    404 la_out_of_memory_error)
    -
    405 return
    -
    406 end if
    -
    407 wptr => wrk
    -
    408 end if
    -
    409
    -
    410 ! Call DGEQRF
    -
    411 call dgeqrf(m, n, a, m, tau, wptr, lwork, flag)
    -
    412 end subroutine
    -
    413
    -
    414! ------------------------------------------------------------------------------
    -
    415 module subroutine qr_factor_no_pivot_cmplx(a, tau, work, olwork, err)
    -
    416 ! Arguments
    -
    417 complex(real64), intent(inout), dimension(:,:) :: a
    -
    418 complex(real64), intent(out), dimension(:) :: tau
    -
    419 complex(real64), intent(out), target, dimension(:), optional :: work
    -
    420 integer(int32), intent(out), optional :: olwork
    -
    421 class(errors), intent(inout), optional, target :: err
    -
    422
    -
    423 ! Local Variables
    -
    424 integer(int32) :: m, n, mn, istat, lwork, flag
    -
    425 complex(real64), dimension(1) :: temp
    -
    426 complex(real64), pointer, dimension(:) :: wptr
    -
    427 complex(real64), allocatable, target, dimension(:) :: wrk
    -
    428 class(errors), pointer :: errmgr
    -
    429 type(errors), target :: deferr
    -
    430
    -
    431 ! Initialization
    -
    432 m = size(a, 1)
    -
    433 n = size(a, 2)
    -
    434 mn = min(m, n)
    -
    435 if (present(err)) then
    -
    436 errmgr => err
    -
    437 else
    -
    438 errmgr => deferr
    -
    439 end if
    +
    371 ! Local Variables
    +
    372 integer(int32) :: m, n, mn, istat, lwork, flag
    +
    373 real(real64), dimension(1) :: temp
    +
    374 real(real64), pointer, dimension(:) :: wptr
    +
    375 real(real64), allocatable, target, dimension(:) :: wrk
    +
    376 class(errors), pointer :: errmgr
    +
    377 type(errors), target :: deferr
    +
    378
    +
    379 ! Initialization
    +
    380 m = size(a, 1)
    +
    381 n = size(a, 2)
    +
    382 mn = min(m, n)
    +
    383 if (present(err)) then
    +
    384 errmgr => err
    +
    385 else
    +
    386 errmgr => deferr
    +
    387 end if
    +
    388
    +
    389 ! Input Check
    +
    390 if (size(tau) /= mn) then
    +
    391 ! ERROR: TAU not sized correctly
    +
    392 call errmgr%report_error("qr_factor_no_pivot", &
    +
    393 "Incorrectly sized input array TAU, argument 2.", &
    +
    394 la_array_size_error)
    +
    395 return
    +
    396 end if
    +
    397
    +
    398 ! Workspace Query
    +
    399 call dgeqrf(m, n, a, m, tau, temp, -1, flag)
    +
    400 lwork = int(temp(1), int32)
    +
    401 if (present(olwork)) then
    +
    402 olwork = lwork
    +
    403 return
    +
    404 end if
    +
    405
    +
    406 ! Local Memory Allocation
    +
    407 if (present(work)) then
    +
    408 if (size(work) < lwork) then
    +
    409 ! ERROR: WORK not sized correctly
    +
    410 call errmgr%report_error("qr_factor_no_pivot", &
    +
    411 "Incorrectly sized input array WORK, argument 3.", &
    +
    412 la_array_size_error)
    +
    413 return
    +
    414 end if
    +
    415 wptr => work(1:lwork)
    +
    416 else
    +
    417 allocate(wrk(lwork), stat = istat)
    +
    418 if (istat /= 0) then
    +
    419 ! ERROR: Out of memory
    +
    420 call errmgr%report_error("qr_factor_no_pivot", &
    +
    421 "Insufficient memory available.", &
    +
    422 la_out_of_memory_error)
    +
    423 return
    +
    424 end if
    +
    425 wptr => wrk
    +
    426 end if
    +
    427
    +
    428 ! Call DGEQRF
    +
    429 call dgeqrf(m, n, a, m, tau, wptr, lwork, flag)
    +
    430 end subroutine
    +
    431
    +
    432! ------------------------------------------------------------------------------
    +
    433 module subroutine qr_factor_no_pivot_cmplx(a, tau, work, olwork, err)
    +
    434 ! Arguments
    +
    435 complex(real64), intent(inout), dimension(:,:) :: a
    +
    436 complex(real64), intent(out), dimension(:) :: tau
    +
    437 complex(real64), intent(out), target, dimension(:), optional :: work
    +
    438 integer(int32), intent(out), optional :: olwork
    +
    439 class(errors), intent(inout), optional, target :: err
    440
    -
    441 ! Input Check
    -
    442 if (size(tau) /= mn) then
    -
    443 ! ERROR: TAU not sized correctly
    -
    444 call errmgr%report_error("qr_factor_no_pivot_cmplx", &
    -
    445 "Incorrectly sized input array TAU, argument 2.", &
    -
    446 la_array_size_error)
    -
    447 return
    -
    448 end if
    -
    449
    -
    450 ! Workspace Query
    -
    451 call zgeqrf(m, n, a, m, tau, temp, -1, flag)
    -
    452 lwork = int(temp(1), int32)
    -
    453 if (present(olwork)) then
    -
    454 olwork = lwork
    -
    455 return
    -
    456 end if
    -
    457
    -
    458 ! Local Memory Allocation
    -
    459 if (present(work)) then
    -
    460 if (size(work) < lwork) then
    -
    461 ! ERROR: WORK not sized correctly
    -
    462 call errmgr%report_error("qr_factor_no_pivot_cmplx", &
    -
    463 "Incorrectly sized input array WORK, argument 3.", &
    -
    464 la_array_size_error)
    -
    465 return
    -
    466 end if
    -
    467 wptr => work(1:lwork)
    -
    468 else
    -
    469 allocate(wrk(lwork), stat = istat)
    -
    470 if (istat /= 0) then
    -
    471 ! ERROR: Out of memory
    -
    472 call errmgr%report_error("qr_factor_no_pivot_cmplx", &
    -
    473 "Insufficient memory available.", &
    -
    474 la_out_of_memory_error)
    -
    475 return
    -
    476 end if
    -
    477 wptr => wrk
    -
    478 end if
    -
    479
    -
    480 ! Call ZGEQRF
    -
    481 call zgeqrf(m, n, a, m, tau, wptr, lwork, flag)
    -
    482 end subroutine
    -
    483
    -
    484! ------------------------------------------------------------------------------
    -
    485 module subroutine qr_factor_pivot(a, tau, jpvt, work, olwork, err)
    -
    486 ! Arguments
    -
    487 real(real64), intent(inout), dimension(:,:) :: a
    -
    488 real(real64), intent(out), dimension(:) :: tau
    -
    489 integer(int32), intent(inout), dimension(:) :: jpvt
    -
    490 real(real64), intent(out), target, dimension(:), optional :: work
    -
    491 integer(int32), intent(out), optional :: olwork
    -
    492 class(errors), intent(inout), optional, target :: err
    -
    493
    -
    494 ! Local Variables
    -
    495 integer(int32) :: m, n, mn, istat, lwork, flag
    -
    496 real(real64), dimension(1) :: temp
    -
    497 real(real64), pointer, dimension(:) :: wptr
    -
    498 real(real64), allocatable, target, dimension(:) :: wrk
    -
    499 class(errors), pointer :: errmgr
    -
    500 type(errors), target :: deferr
    -
    501 character(len = 128) :: errmsg
    -
    502
    -
    503 ! Initialization
    -
    504 m = size(a, 1)
    -
    505 n = size(a, 2)
    -
    506 mn = min(m, n)
    -
    507 if (present(err)) then
    -
    508 errmgr => err
    -
    509 else
    -
    510 errmgr => deferr
    -
    511 end if
    -
    512
    -
    513 ! Input Check
    -
    514 flag = 0
    -
    515 if (size(tau) /= mn) then
    -
    516 flag = 2
    -
    517 else if (size(jpvt) /= n) then
    -
    518 flag = 3
    -
    519 end if
    -
    520 if (flag /= 0) then
    -
    521 ! ERROR: One of the input arrays is not sized correctly
    -
    522 write(errmsg, '(AI0A)') "Input number ", flag, &
    -
    523 " is not sized correctly."
    -
    524 call errmgr%report_error("qr_factor_pivot", trim(errmsg), &
    -
    525 la_array_size_error)
    -
    526 return
    -
    527 end if
    -
    528
    -
    529 ! Workspace Query
    -
    530 call dgeqp3(m, n, a, m, jpvt, tau, temp, -1, flag)
    -
    531 lwork = int(temp(1), int32)
    -
    532 if (present(olwork)) then
    -
    533 olwork = lwork
    -
    534 return
    -
    535 end if
    -
    536
    -
    537 ! Local Memory Allocation
    -
    538 if (present(work)) then
    -
    539 if (size(work) < lwork) then
    -
    540 ! ERROR: WORK not sized correctly
    -
    541 call errmgr%report_error("qr_factor_pivot", &
    -
    542 "Incorrectly sized input array WORK, argument 4.", &
    -
    543 la_array_size_error)
    -
    544 return
    -
    545 end if
    -
    546 wptr => work(1:lwork)
    -
    547 else
    -
    548 allocate(wrk(lwork), stat = istat)
    -
    549 if (istat /= 0) then
    -
    550 ! ERROR: Out of memory
    -
    551 call errmgr%report_error("qr_factor_pivot", &
    -
    552 "Insufficient memory available.", &
    -
    553 la_out_of_memory_error)
    -
    554 return
    -
    555 end if
    -
    556 wptr => wrk
    -
    557 end if
    -
    558
    -
    559 ! Call DGEQP3
    -
    560 call dgeqp3(m, n, a, m, jpvt, tau, wptr, lwork, flag)
    -
    561
    -
    562 ! End
    -
    563 if (allocated(wrk)) deallocate(wrk)
    -
    564 end subroutine
    -
    565
    -
    566! ------------------------------------------------------------------------------
    -
    567 module subroutine qr_factor_pivot_cmplx(a, tau, jpvt, work, olwork, rwork, &
    -
    568 err)
    -
    569 ! Arguments
    -
    570 complex(real64), intent(inout), dimension(:,:) :: a
    -
    571 complex(real64), intent(out), dimension(:) :: tau
    -
    572 integer(int32), intent(inout), dimension(:) :: jpvt
    -
    573 complex(real64), intent(out), target, dimension(:), optional :: work
    -
    574 integer(int32), intent(out), optional :: olwork
    -
    575 real(real64), intent(out), target, dimension(:), optional :: rwork
    -
    576 class(errors), intent(inout), optional, target :: err
    -
    577
    -
    578 ! Local Variables
    -
    579 integer(int32) :: m, n, mn, istat, lwork, flag
    -
    580 complex(real64), dimension(1) :: temp
    -
    581 complex(real64), pointer, dimension(:) :: wptr
    -
    582 complex(real64), allocatable, target, dimension(:) :: wrk
    -
    583 real(real64), pointer, dimension(:) :: rptr
    -
    584 real(real64), allocatable, target, dimension(:) :: rwrk
    -
    585 class(errors), pointer :: errmgr
    -
    586 type(errors), target :: deferr
    -
    587 character(len = 128) :: errmsg
    -
    588
    -
    589 ! Initialization
    -
    590 m = size(a, 1)
    -
    591 n = size(a, 2)
    -
    592 mn = min(m, n)
    -
    593 if (present(err)) then
    -
    594 errmgr => err
    -
    595 else
    -
    596 errmgr => deferr
    -
    597 end if
    +
    441 ! Local Variables
    +
    442 integer(int32) :: m, n, mn, istat, lwork, flag
    +
    443 complex(real64), dimension(1) :: temp
    +
    444 complex(real64), pointer, dimension(:) :: wptr
    +
    445 complex(real64), allocatable, target, dimension(:) :: wrk
    +
    446 class(errors), pointer :: errmgr
    +
    447 type(errors), target :: deferr
    +
    448
    +
    449 ! Initialization
    +
    450 m = size(a, 1)
    +
    451 n = size(a, 2)
    +
    452 mn = min(m, n)
    +
    453 if (present(err)) then
    +
    454 errmgr => err
    +
    455 else
    +
    456 errmgr => deferr
    +
    457 end if
    +
    458
    +
    459 ! Input Check
    +
    460 if (size(tau) /= mn) then
    +
    461 ! ERROR: TAU not sized correctly
    +
    462 call errmgr%report_error("qr_factor_no_pivot_cmplx", &
    +
    463 "Incorrectly sized input array TAU, argument 2.", &
    +
    464 la_array_size_error)
    +
    465 return
    +
    466 end if
    +
    467
    +
    468 ! Workspace Query
    +
    469 call zgeqrf(m, n, a, m, tau, temp, -1, flag)
    +
    470 lwork = int(temp(1), int32)
    +
    471 if (present(olwork)) then
    +
    472 olwork = lwork
    +
    473 return
    +
    474 end if
    +
    475
    +
    476 ! Local Memory Allocation
    +
    477 if (present(work)) then
    +
    478 if (size(work) < lwork) then
    +
    479 ! ERROR: WORK not sized correctly
    +
    480 call errmgr%report_error("qr_factor_no_pivot_cmplx", &
    +
    481 "Incorrectly sized input array WORK, argument 3.", &
    +
    482 la_array_size_error)
    +
    483 return
    +
    484 end if
    +
    485 wptr => work(1:lwork)
    +
    486 else
    +
    487 allocate(wrk(lwork), stat = istat)
    +
    488 if (istat /= 0) then
    +
    489 ! ERROR: Out of memory
    +
    490 call errmgr%report_error("qr_factor_no_pivot_cmplx", &
    +
    491 "Insufficient memory available.", &
    +
    492 la_out_of_memory_error)
    +
    493 return
    +
    494 end if
    +
    495 wptr => wrk
    +
    496 end if
    +
    497
    +
    498 ! Call ZGEQRF
    +
    499 call zgeqrf(m, n, a, m, tau, wptr, lwork, flag)
    +
    500 end subroutine
    +
    501
    +
    502! ------------------------------------------------------------------------------
    +
    503 module subroutine qr_factor_pivot(a, tau, jpvt, work, olwork, err)
    +
    504 ! Arguments
    +
    505 real(real64), intent(inout), dimension(:,:) :: a
    +
    506 real(real64), intent(out), dimension(:) :: tau
    +
    507 integer(int32), intent(inout), dimension(:) :: jpvt
    +
    508 real(real64), intent(out), target, dimension(:), optional :: work
    +
    509 integer(int32), intent(out), optional :: olwork
    +
    510 class(errors), intent(inout), optional, target :: err
    +
    511
    +
    512 ! Local Variables
    +
    513 integer(int32) :: m, n, mn, istat, lwork, flag
    +
    514 real(real64), dimension(1) :: temp
    +
    515 real(real64), pointer, dimension(:) :: wptr
    +
    516 real(real64), allocatable, target, dimension(:) :: wrk
    +
    517 class(errors), pointer :: errmgr
    +
    518 type(errors), target :: deferr
    +
    519 character(len = 128) :: errmsg
    +
    520
    +
    521 ! Initialization
    +
    522 m = size(a, 1)
    +
    523 n = size(a, 2)
    +
    524 mn = min(m, n)
    +
    525 if (present(err)) then
    +
    526 errmgr => err
    +
    527 else
    +
    528 errmgr => deferr
    +
    529 end if
    +
    530
    +
    531 ! Input Check
    +
    532 flag = 0
    +
    533 if (size(tau) /= mn) then
    +
    534 flag = 2
    +
    535 else if (size(jpvt) /= n) then
    +
    536 flag = 3
    +
    537 end if
    +
    538 if (flag /= 0) then
    +
    539 ! ERROR: One of the input arrays is not sized correctly
    +
    540 write(errmsg, 100) "Input number ", flag, &
    +
    541 " is not sized correctly."
    +
    542 call errmgr%report_error("qr_factor_pivot", trim(errmsg), &
    +
    543 la_array_size_error)
    +
    544 return
    +
    545 end if
    +
    546
    +
    547 ! Workspace Query
    +
    548 call dgeqp3(m, n, a, m, jpvt, tau, temp, -1, flag)
    +
    549 lwork = int(temp(1), int32)
    +
    550 if (present(olwork)) then
    +
    551 olwork = lwork
    +
    552 return
    +
    553 end if
    +
    554
    +
    555 ! Local Memory Allocation
    +
    556 if (present(work)) then
    +
    557 if (size(work) < lwork) then
    +
    558 ! ERROR: WORK not sized correctly
    +
    559 call errmgr%report_error("qr_factor_pivot", &
    +
    560 "Incorrectly sized input array WORK, argument 4.", &
    +
    561 la_array_size_error)
    +
    562 return
    +
    563 end if
    +
    564 wptr => work(1:lwork)
    +
    565 else
    +
    566 allocate(wrk(lwork), stat = istat)
    +
    567 if (istat /= 0) then
    +
    568 ! ERROR: Out of memory
    +
    569 call errmgr%report_error("qr_factor_pivot", &
    +
    570 "Insufficient memory available.", &
    +
    571 la_out_of_memory_error)
    +
    572 return
    +
    573 end if
    +
    574 wptr => wrk
    +
    575 end if
    +
    576
    +
    577 ! Call DGEQP3
    +
    578 call dgeqp3(m, n, a, m, jpvt, tau, wptr, lwork, flag)
    +
    579
    +
    580 ! End
    +
    581 if (allocated(wrk)) deallocate(wrk)
    +
    582
    +
    583 ! Formatting
    +
    584100 format(a, i0, a)
    +
    585 end subroutine
    +
    586
    +
    587! ------------------------------------------------------------------------------
    +
    588 module subroutine qr_factor_pivot_cmplx(a, tau, jpvt, work, olwork, rwork, &
    +
    589 err)
    +
    590 ! Arguments
    +
    591 complex(real64), intent(inout), dimension(:,:) :: a
    +
    592 complex(real64), intent(out), dimension(:) :: tau
    +
    593 integer(int32), intent(inout), dimension(:) :: jpvt
    +
    594 complex(real64), intent(out), target, dimension(:), optional :: work
    +
    595 integer(int32), intent(out), optional :: olwork
    +
    596 real(real64), intent(out), target, dimension(:), optional :: rwork
    +
    597 class(errors), intent(inout), optional, target :: err
    598
    -
    599 ! Input Check
    -
    600 flag = 0
    -
    601 if (size(tau) /= mn) then
    -
    602 flag = 2
    -
    603 else if (size(jpvt) /= n) then
    -
    604 flag = 3
    -
    605 end if
    -
    606 if (flag /= 0) then
    -
    607 ! ERROR: One of the input arrays is not sized correctly
    -
    608 write(errmsg, '(AI0A)') "Input number ", flag, &
    -
    609 " is not sized correctly."
    -
    610 call errmgr%report_error("qr_factor_pivot_cmplx", trim(errmsg), &
    -
    611 la_array_size_error)
    -
    612 return
    -
    613 end if
    -
    614 if (present(rwork)) then
    -
    615 if (size(rwork) < 2 * n) then
    -
    616 call errmgr%report_error("qr_factor_pivot_cmplx", &
    -
    617 "Incorrectly sized input array RWORK, argument 6.", &
    -
    618 la_array_size_error)
    -
    619 return
    -
    620 end if
    -
    621 rptr => rwork(1:2*n)
    -
    622 else
    -
    623 allocate(rwrk(2 * n), stat = flag)
    -
    624 if (flag /= 0) then
    -
    625 call errmgr%report_error("qr_factor_pivot_cmplx", &
    -
    626 "Insufficient memory available.", &
    -
    627 la_out_of_memory_error)
    -
    628 return
    -
    629 end if
    -
    630 rptr => rwrk
    -
    631 end if
    -
    632
    -
    633 ! Workspace Query
    -
    634 call zgeqp3(m, n, a, m, jpvt, tau, temp, -1, rptr, flag)
    -
    635 lwork = int(temp(1), int32)
    -
    636 if (present(olwork)) then
    -
    637 olwork = lwork
    -
    638 return
    -
    639 end if
    -
    640
    -
    641 ! Local Memory Allocation
    -
    642 if (present(work)) then
    -
    643 if (size(work) < lwork) then
    -
    644 ! ERROR: WORK not sized correctly
    -
    645 call errmgr%report_error("qr_factor_pivot_cmplx", &
    -
    646 "Incorrectly sized input array WORK, argument 4.", &
    -
    647 la_array_size_error)
    -
    648 return
    -
    649 end if
    -
    650 wptr => work(1:lwork)
    -
    651 else
    -
    652 allocate(wrk(lwork), stat = istat)
    -
    653 if (istat /= 0) then
    -
    654 ! ERROR: Out of memory
    -
    655 call errmgr%report_error("qr_factor_pivot_cmplx", &
    -
    656 "Insufficient memory available.", &
    -
    657 la_out_of_memory_error)
    -
    658 return
    -
    659 end if
    -
    660 wptr => wrk
    -
    661 end if
    -
    662
    -
    663 ! Call ZGEQP3
    -
    664 call zgeqp3(m, n, a, m, jpvt, tau, wptr, lwork, rptr, flag)
    -
    665
    -
    666 ! End
    -
    667 if (allocated(wrk)) deallocate(wrk)
    -
    668 end subroutine
    -
    669
    -
    670! ------------------------------------------------------------------------------
    -
    671 module subroutine form_qr_no_pivot(r, tau, q, work, olwork, err)
    -
    672 ! Arguments
    -
    673 real(real64), intent(inout), dimension(:,:) :: r
    -
    674 real(real64), intent(in), dimension(:) :: tau
    -
    675 real(real64), intent(out), dimension(:,:) :: q
    -
    676 real(real64), intent(out), target, dimension(:), optional :: work
    -
    677 integer(int32), intent(out), optional :: olwork
    -
    678 class(errors), intent(inout), optional, target :: err
    -
    679
    -
    680 ! Parameters
    -
    681 real(real64), parameter :: zero = 0.0d0
    -
    682
    -
    683 ! Local Variables
    -
    684 integer(int32) :: j, m, n, mn, qcol, istat, flag, lwork
    -
    685 real(real64), pointer, dimension(:) :: wptr
    -
    686 real(real64), allocatable, target, dimension(:) :: wrk
    -
    687 real(real64), dimension(1) :: temp
    -
    688 class(errors), pointer :: errmgr
    -
    689 type(errors), target :: deferr
    -
    690 character(len = 128) :: errmsg
    -
    691
    -
    692 ! Initialization
    -
    693 m = size(r, 1)
    -
    694 n = size(r, 2)
    -
    695 mn = min(m, n)
    -
    696 qcol = size(q, 2)
    -
    697 if (present(err)) then
    -
    698 errmgr => err
    -
    699 else
    -
    700 errmgr => deferr
    -
    701 end if
    -
    702
    -
    703 ! Input Check
    -
    704 flag = 0
    -
    705 if (size(tau) /= mn) then
    -
    706 flag = 2
    -
    707 else if (size(q, 1) /= m .or. (qcol /= m .and. qcol /= n)) then
    -
    708 flag = 3
    -
    709 else if (qcol == n .and. m < n) then
    -
    710 flag = 3
    -
    711 end if
    -
    712 if (flag /= 0) then
    -
    713 ! ERROR: One of the input arrays is not sized correctly
    -
    714 write(errmsg, '(AI0A)') "Input number ", flag, &
    -
    715 " is not sized correctly."
    -
    716 call errmgr%report_error("form_qr_no_pivot", trim(errmsg), &
    -
    717 la_array_size_error)
    -
    718 return
    -
    719 end if
    -
    720
    -
    721 ! Workspace Query
    -
    722 call dorgqr(m, qcol, mn, q, m, tau, temp, -1, flag)
    -
    723 lwork = int(temp(1), int32)
    -
    724 if (present(olwork)) then
    -
    725 olwork = lwork
    -
    726 return
    -
    727 end if
    -
    728
    -
    729 ! Local Memory Allocation
    -
    730 if (present(work)) then
    -
    731 if (size(work) < lwork) then
    -
    732 ! ERROR: WORK not sized correctly
    -
    733 call errmgr%report_error("form_qr_no_pivot", &
    -
    734 "Incorrectly sized input array WORK, argument 4.", &
    -
    735 la_array_size_error)
    -
    736 return
    -
    737 end if
    -
    738 wptr => work(1:lwork)
    -
    739 else
    -
    740 allocate(wrk(lwork), stat = istat)
    -
    741 if (istat /= 0) then
    -
    742 ! ERROR: Out of memory
    -
    743 call errmgr%report_error("form_qr_no_pivot", &
    -
    744 "Insufficient memory available.", &
    -
    745 la_out_of_memory_error)
    -
    746 return
    -
    747 end if
    -
    748 wptr => wrk
    -
    749 end if
    -
    750
    -
    751 ! Copy the sub-diagonal portion of R to Q, and then zero out the
    -
    752 ! sub-diagonal portion of R
    -
    753 do j = 1, mn
    -
    754 q(j+1:m,j) = r(j+1:m,j)
    -
    755 r(j+1:m,j) = zero
    -
    756 end do
    -
    757
    -
    758 ! Build Q - Build M-by-M or M-by-N, but M-by-N only for M >= N
    -
    759 call dorgqr(m, qcol, mn, q, m, tau, wptr, lwork, flag)
    -
    760
    -
    761 ! End
    -
    762 if (allocated(wrk)) deallocate(wrk)
    -
    763 end subroutine
    -
    764
    -
    765! ------------------------------------------------------------------------------
    -
    766 module subroutine form_qr_no_pivot_cmplx(r, tau, q, work, olwork, err)
    -
    767 ! Arguments
    -
    768 complex(real64), intent(inout), dimension(:,:) :: r
    -
    769 complex(real64), intent(in), dimension(:) :: tau
    -
    770 complex(real64), intent(out), dimension(:,:) :: q
    -
    771 complex(real64), intent(out), target, dimension(:), optional :: work
    -
    772 integer(int32), intent(out), optional :: olwork
    -
    773 class(errors), intent(inout), optional, target :: err
    +
    599 ! Local Variables
    +
    600 integer(int32) :: m, n, mn, istat, lwork, flag
    +
    601 complex(real64), dimension(1) :: temp
    +
    602 complex(real64), pointer, dimension(:) :: wptr
    +
    603 complex(real64), allocatable, target, dimension(:) :: wrk
    +
    604 real(real64), pointer, dimension(:) :: rptr
    +
    605 real(real64), allocatable, target, dimension(:) :: rwrk
    +
    606 class(errors), pointer :: errmgr
    +
    607 type(errors), target :: deferr
    +
    608 character(len = 128) :: errmsg
    +
    609
    +
    610 ! Initialization
    +
    611 m = size(a, 1)
    +
    612 n = size(a, 2)
    +
    613 mn = min(m, n)
    +
    614 if (present(err)) then
    +
    615 errmgr => err
    +
    616 else
    +
    617 errmgr => deferr
    +
    618 end if
    +
    619
    +
    620 ! Input Check
    +
    621 flag = 0
    +
    622 if (size(tau) /= mn) then
    +
    623 flag = 2
    +
    624 else if (size(jpvt) /= n) then
    +
    625 flag = 3
    +
    626 end if
    +
    627 if (flag /= 0) then
    +
    628 ! ERROR: One of the input arrays is not sized correctly
    +
    629 write(errmsg, 100) "Input number ", flag, &
    +
    630 " is not sized correctly."
    +
    631 call errmgr%report_error("qr_factor_pivot_cmplx", trim(errmsg), &
    +
    632 la_array_size_error)
    +
    633 return
    +
    634 end if
    +
    635 if (present(rwork)) then
    +
    636 if (size(rwork) < 2 * n) then
    +
    637 call errmgr%report_error("qr_factor_pivot_cmplx", &
    +
    638 "Incorrectly sized input array RWORK, argument 6.", &
    +
    639 la_array_size_error)
    +
    640 return
    +
    641 end if
    +
    642 rptr => rwork(1:2*n)
    +
    643 else
    +
    644 allocate(rwrk(2 * n), stat = flag)
    +
    645 if (flag /= 0) then
    +
    646 call errmgr%report_error("qr_factor_pivot_cmplx", &
    +
    647 "Insufficient memory available.", &
    +
    648 la_out_of_memory_error)
    +
    649 return
    +
    650 end if
    +
    651 rptr => rwrk
    +
    652 end if
    +
    653
    +
    654 ! Workspace Query
    +
    655 call zgeqp3(m, n, a, m, jpvt, tau, temp, -1, rptr, flag)
    +
    656 lwork = int(temp(1), int32)
    +
    657 if (present(olwork)) then
    +
    658 olwork = lwork
    +
    659 return
    +
    660 end if
    +
    661
    +
    662 ! Local Memory Allocation
    +
    663 if (present(work)) then
    +
    664 if (size(work) < lwork) then
    +
    665 ! ERROR: WORK not sized correctly
    +
    666 call errmgr%report_error("qr_factor_pivot_cmplx", &
    +
    667 "Incorrectly sized input array WORK, argument 4.", &
    +
    668 la_array_size_error)
    +
    669 return
    +
    670 end if
    +
    671 wptr => work(1:lwork)
    +
    672 else
    +
    673 allocate(wrk(lwork), stat = istat)
    +
    674 if (istat /= 0) then
    +
    675 ! ERROR: Out of memory
    +
    676 call errmgr%report_error("qr_factor_pivot_cmplx", &
    +
    677 "Insufficient memory available.", &
    +
    678 la_out_of_memory_error)
    +
    679 return
    +
    680 end if
    +
    681 wptr => wrk
    +
    682 end if
    +
    683
    +
    684 ! Call ZGEQP3
    +
    685 call zgeqp3(m, n, a, m, jpvt, tau, wptr, lwork, rptr, flag)
    +
    686
    +
    687 ! End
    +
    688 if (allocated(wrk)) deallocate(wrk)
    +
    689
    +
    690 ! Formatting
    +
    691100 format(a, i0, a)
    +
    692 end subroutine
    +
    693
    +
    694! ------------------------------------------------------------------------------
    +
    695 module subroutine form_qr_no_pivot(r, tau, q, work, olwork, err)
    +
    696 ! Arguments
    +
    697 real(real64), intent(inout), dimension(:,:) :: r
    +
    698 real(real64), intent(in), dimension(:) :: tau
    +
    699 real(real64), intent(out), dimension(:,:) :: q
    +
    700 real(real64), intent(out), target, dimension(:), optional :: work
    +
    701 integer(int32), intent(out), optional :: olwork
    +
    702 class(errors), intent(inout), optional, target :: err
    +
    703
    +
    704 ! Parameters
    +
    705 real(real64), parameter :: zero = 0.0d0
    +
    706
    +
    707 ! Local Variables
    +
    708 integer(int32) :: j, m, n, mn, qcol, istat, flag, lwork
    +
    709 real(real64), pointer, dimension(:) :: wptr
    +
    710 real(real64), allocatable, target, dimension(:) :: wrk
    +
    711 real(real64), dimension(1) :: temp
    +
    712 class(errors), pointer :: errmgr
    +
    713 type(errors), target :: deferr
    +
    714 character(len = 128) :: errmsg
    +
    715
    +
    716 ! Initialization
    +
    717 m = size(r, 1)
    +
    718 n = size(r, 2)
    +
    719 mn = min(m, n)
    +
    720 qcol = size(q, 2)
    +
    721 if (present(err)) then
    +
    722 errmgr => err
    +
    723 else
    +
    724 errmgr => deferr
    +
    725 end if
    +
    726
    +
    727 ! Input Check
    +
    728 flag = 0
    +
    729 if (size(tau) /= mn) then
    +
    730 flag = 2
    +
    731 else if (size(q, 1) /= m .or. (qcol /= m .and. qcol /= n)) then
    +
    732 flag = 3
    +
    733 else if (qcol == n .and. m < n) then
    +
    734 flag = 3
    +
    735 end if
    +
    736 if (flag /= 0) then
    +
    737 ! ERROR: One of the input arrays is not sized correctly
    +
    738 write(errmsg, 100) "Input number ", flag, &
    +
    739 " is not sized correctly."
    +
    740 call errmgr%report_error("form_qr_no_pivot", trim(errmsg), &
    +
    741 la_array_size_error)
    +
    742 return
    +
    743 end if
    +
    744
    +
    745 ! Workspace Query
    +
    746 call dorgqr(m, qcol, mn, q, m, tau, temp, -1, flag)
    +
    747 lwork = int(temp(1), int32)
    +
    748 if (present(olwork)) then
    +
    749 olwork = lwork
    +
    750 return
    +
    751 end if
    +
    752
    +
    753 ! Local Memory Allocation
    +
    754 if (present(work)) then
    +
    755 if (size(work) < lwork) then
    +
    756 ! ERROR: WORK not sized correctly
    +
    757 call errmgr%report_error("form_qr_no_pivot", &
    +
    758 "Incorrectly sized input array WORK, argument 4.", &
    +
    759 la_array_size_error)
    +
    760 return
    +
    761 end if
    +
    762 wptr => work(1:lwork)
    +
    763 else
    +
    764 allocate(wrk(lwork), stat = istat)
    +
    765 if (istat /= 0) then
    +
    766 ! ERROR: Out of memory
    +
    767 call errmgr%report_error("form_qr_no_pivot", &
    +
    768 "Insufficient memory available.", &
    +
    769 la_out_of_memory_error)
    +
    770 return
    +
    771 end if
    +
    772 wptr => wrk
    +
    773 end if
    774
    -
    775 ! Parameters
    -
    776 complex(real64), parameter :: zero = (0.0d0, 0.0d0)
    -
    777
    -
    778 ! Local Variables
    -
    779 integer(int32) :: j, m, n, mn, qcol, istat, flag, lwork
    -
    780 complex(real64), pointer, dimension(:) :: wptr
    -
    781 complex(real64), allocatable, target, dimension(:) :: wrk
    -
    782 complex(real64), dimension(1) :: temp
    -
    783 class(errors), pointer :: errmgr
    -
    784 type(errors), target :: deferr
    -
    785 character(len = 128) :: errmsg
    -
    786
    -
    787 ! Initialization
    -
    788 m = size(r, 1)
    -
    789 n = size(r, 2)
    -
    790 mn = min(m, n)
    -
    791 qcol = size(q, 2)
    -
    792 if (present(err)) then
    -
    793 errmgr => err
    -
    794 else
    -
    795 errmgr => deferr
    -
    796 end if
    -
    797
    -
    798 ! Input Check
    -
    799 flag = 0
    -
    800 if (size(tau) /= mn) then
    -
    801 flag = 2
    -
    802 else if (size(q, 1) /= m .or. (qcol /= m .and. qcol /= n)) then
    -
    803 flag = 3
    -
    804 else if (qcol == n .and. m < n) then
    -
    805 flag = 3
    -
    806 end if
    -
    807 if (flag /= 0) then
    -
    808 ! ERROR: One of the input arrays is not sized correctly
    -
    809 write(errmsg, '(AI0A)') "Input number ", flag, &
    -
    810 " is not sized correctly."
    -
    811 call errmgr%report_error("form_qr_no_pivot_cmplx", trim(errmsg), &
    -
    812 la_array_size_error)
    -
    813 return
    -
    814 end if
    -
    815
    -
    816 ! Workspace Query
    -
    817 call zungqr(m, qcol, mn, q, m, tau, temp, -1, flag)
    -
    818 lwork = int(temp(1), int32)
    -
    819 if (present(olwork)) then
    -
    820 olwork = lwork
    -
    821 return
    -
    822 end if
    -
    823
    -
    824 ! Local Memory Allocation
    -
    825 if (present(work)) then
    -
    826 if (size(work) < lwork) then
    -
    827 ! ERROR: WORK not sized correctly
    -
    828 call errmgr%report_error("form_qr_no_pivot_cmplx", &
    -
    829 "Incorrectly sized input array WORK, argument 4.", &
    -
    830 la_array_size_error)
    -
    831 return
    -
    832 end if
    -
    833 wptr => work(1:lwork)
    -
    834 else
    -
    835 allocate(wrk(lwork), stat = istat)
    -
    836 if (istat /= 0) then
    -
    837 ! ERROR: Out of memory
    -
    838 call errmgr%report_error("form_qr_no_pivot_cmplx", &
    -
    839 "Insufficient memory available.", &
    -
    840 la_out_of_memory_error)
    -
    841 return
    -
    842 end if
    -
    843 wptr => wrk
    -
    844 end if
    -
    845
    -
    846 ! Copy the sub-diagonal portion of R to Q, and then zero out the
    -
    847 ! sub-diagonal portion of R
    -
    848 do j = 1, mn
    -
    849 q(j+1:m,j) = r(j+1:m,j)
    -
    850 r(j+1:m,j) = zero
    -
    851 end do
    -
    852
    -
    853 ! Build Q - Build M-by-M or M-by-N, but M-by-N only for M >= N
    -
    854 call zungqr(m, qcol, mn, q, m, tau, wptr, lwork, flag)
    -
    855
    -
    856 ! End
    -
    857 if (allocated(wrk)) deallocate(wrk)
    -
    858 end subroutine
    -
    859
    -
    860! ------------------------------------------------------------------------------
    -
    861 module subroutine form_qr_pivot(r, tau, pvt, q, p, work, olwork, err)
    -
    862 ! Arguments
    -
    863 real(real64), intent(inout), dimension(:,:) :: r
    -
    864 real(real64), intent(in), dimension(:) :: tau
    -
    865 integer(int32), intent(in), dimension(:) :: pvt
    -
    866 real(real64), intent(out), dimension(:,:) :: q, p
    -
    867 real(real64), intent(out), target, dimension(:), optional :: work
    -
    868 integer(int32), intent(out), optional :: olwork
    -
    869 class(errors), intent(inout), optional, target :: err
    -
    870
    -
    871 ! Parameters
    -
    872 real(real64), parameter :: zero = 0.0d0
    -
    873 real(real64), parameter :: one = 1.0d0
    -
    874
    -
    875 ! Local Variables
    -
    876 integer(int32) :: j, jp, m, n, mn, flag
    -
    877 class(errors), pointer :: errmgr
    -
    878 type(errors), target :: deferr
    -
    879 character(len = 128) :: errmsg
    -
    880
    -
    881 ! Initialization
    -
    882 m = size(r, 1)
    -
    883 n = size(r, 2)
    -
    884 mn = min(m, n)
    -
    885 if (present(err)) then
    -
    886 errmgr => err
    -
    887 else
    -
    888 errmgr => deferr
    -
    889 end if
    -
    890
    -
    891 ! Input Check
    -
    892 flag = 0
    -
    893 if (size(tau) /= mn) then
    -
    894 flag = 2
    -
    895 else if (size(pvt) /= n) then
    -
    896 flag = 3
    -
    897 else if (size(q, 1) /= m .or. &
    -
    898 (size(q, 2) /= m .and. size(q, 2) /= n)) then
    -
    899 flag = 4
    -
    900 else if (size(q, 2) == n .and. m < n) then
    -
    901 flag = 4
    -
    902 else if (size(p, 1) /= n .or. size(p, 2) /= n) then
    -
    903 flag = 5
    -
    904 end if
    -
    905 if (flag /= 0) then
    -
    906 ! ERROR: One of the input arrays is not sized correctly
    -
    907 write(errmsg, '(AI0A)') "Input number ", flag, &
    -
    908 " is not sized correctly."
    -
    909 call errmgr%report_error("form_qr_pivot", trim(errmsg), &
    -
    910 la_array_size_error)
    -
    911 return
    -
    912 end if
    -
    913
    -
    914 ! Generate Q and R
    -
    915 call form_qr_no_pivot(r, tau, q, work = work, olwork = olwork, &
    -
    916 err = errmgr)
    -
    917 if (present(olwork)) return ! Just a workspace query
    -
    918 if (errmgr%has_error_occurred()) return
    -
    919
    -
    920 ! Form P
    -
    921 do j = 1, n
    -
    922 jp = pvt(j)
    -
    923 p(:,j) = zero
    -
    924 p(jp,j) = one
    -
    925 end do
    -
    926 end subroutine
    -
    927
    -
    928! ------------------------------------------------------------------------------
    -
    929 module subroutine form_qr_pivot_cmplx(r, tau, pvt, q, p, work, olwork, err)
    -
    930 ! Arguments
    -
    931 complex(real64), intent(inout), dimension(:,:) :: r
    -
    932 complex(real64), intent(in), dimension(:) :: tau
    -
    933 integer(int32), intent(in), dimension(:) :: pvt
    -
    934 complex(real64), intent(out), dimension(:,:) :: q, p
    -
    935 complex(real64), intent(out), target, dimension(:), optional :: work
    -
    936 integer(int32), intent(out), optional :: olwork
    -
    937 class(errors), intent(inout), optional, target :: err
    -
    938
    -
    939 ! Parameters
    -
    940 complex(real64), parameter :: zero = (0.0d0, 0.0d0)
    -
    941 complex(real64), parameter :: one = (1.0d0, 0.0d0)
    -
    942
    -
    943 ! Local Variables
    -
    944 integer(int32) :: j, jp, m, n, mn, flag
    -
    945 class(errors), pointer :: errmgr
    -
    946 type(errors), target :: deferr
    -
    947 character(len = 128) :: errmsg
    -
    948
    -
    949 ! Initialization
    -
    950 m = size(r, 1)
    -
    951 n = size(r, 2)
    -
    952 mn = min(m, n)
    -
    953 if (present(err)) then
    -
    954 errmgr => err
    -
    955 else
    -
    956 errmgr => deferr
    -
    957 end if
    -
    958
    -
    959 ! Input Check
    -
    960 flag = 0
    -
    961 if (size(tau) /= mn) then
    -
    962 flag = 2
    -
    963 else if (size(pvt) /= n) then
    -
    964 flag = 3
    -
    965 else if (size(q, 1) /= m .or. &
    -
    966 (size(q, 2) /= m .and. size(q, 2) /= n)) then
    -
    967 flag = 4
    -
    968 else if (size(q, 2) == n .and. m < n) then
    -
    969 flag = 4
    -
    970 else if (size(p, 1) /= n .or. size(p, 2) /= n) then
    -
    971 flag = 5
    -
    972 end if
    -
    973 if (flag /= 0) then
    -
    974 ! ERROR: One of the input arrays is not sized correctly
    -
    975 write(errmsg, '(AI0A)') "Input number ", flag, &
    -
    976 " is not sized correctly."
    -
    977 call errmgr%report_error("form_qr_pivot_cmplx", trim(errmsg), &
    -
    978 la_array_size_error)
    -
    979 return
    -
    980 end if
    +
    775 ! Copy the sub-diagonal portion of R to Q, and then zero out the
    +
    776 ! sub-diagonal portion of R
    +
    777 do j = 1, mn
    +
    778 q(j+1:m,j) = r(j+1:m,j)
    +
    779 r(j+1:m,j) = zero
    +
    780 end do
    +
    781
    +
    782 ! Build Q - Build M-by-M or M-by-N, but M-by-N only for M >= N
    +
    783 call dorgqr(m, qcol, mn, q, m, tau, wptr, lwork, flag)
    +
    784
    +
    785 ! End
    +
    786 if (allocated(wrk)) deallocate(wrk)
    +
    787
    +
    788 ! Formatting
    +
    789100 format(a, i0, a)
    +
    790 end subroutine
    +
    791
    +
    792! ------------------------------------------------------------------------------
    +
    793 module subroutine form_qr_no_pivot_cmplx(r, tau, q, work, olwork, err)
    +
    794 ! Arguments
    +
    795 complex(real64), intent(inout), dimension(:,:) :: r
    +
    796 complex(real64), intent(in), dimension(:) :: tau
    +
    797 complex(real64), intent(out), dimension(:,:) :: q
    +
    798 complex(real64), intent(out), target, dimension(:), optional :: work
    +
    799 integer(int32), intent(out), optional :: olwork
    +
    800 class(errors), intent(inout), optional, target :: err
    +
    801
    +
    802 ! Parameters
    +
    803 complex(real64), parameter :: zero = (0.0d0, 0.0d0)
    +
    804
    +
    805 ! Local Variables
    +
    806 integer(int32) :: j, m, n, mn, qcol, istat, flag, lwork
    +
    807 complex(real64), pointer, dimension(:) :: wptr
    +
    808 complex(real64), allocatable, target, dimension(:) :: wrk
    +
    809 complex(real64), dimension(1) :: temp
    +
    810 class(errors), pointer :: errmgr
    +
    811 type(errors), target :: deferr
    +
    812 character(len = 128) :: errmsg
    +
    813
    +
    814 ! Initialization
    +
    815 m = size(r, 1)
    +
    816 n = size(r, 2)
    +
    817 mn = min(m, n)
    +
    818 qcol = size(q, 2)
    +
    819 if (present(err)) then
    +
    820 errmgr => err
    +
    821 else
    +
    822 errmgr => deferr
    +
    823 end if
    +
    824
    +
    825 ! Input Check
    +
    826 flag = 0
    +
    827 if (size(tau) /= mn) then
    +
    828 flag = 2
    +
    829 else if (size(q, 1) /= m .or. (qcol /= m .and. qcol /= n)) then
    +
    830 flag = 3
    +
    831 else if (qcol == n .and. m < n) then
    +
    832 flag = 3
    +
    833 end if
    +
    834 if (flag /= 0) then
    +
    835 ! ERROR: One of the input arrays is not sized correctly
    +
    836 write(errmsg, 100) "Input number ", flag, &
    +
    837 " is not sized correctly."
    +
    838 call errmgr%report_error("form_qr_no_pivot_cmplx", trim(errmsg), &
    +
    839 la_array_size_error)
    +
    840 return
    +
    841 end if
    +
    842
    +
    843 ! Workspace Query
    +
    844 call zungqr(m, qcol, mn, q, m, tau, temp, -1, flag)
    +
    845 lwork = int(temp(1), int32)
    +
    846 if (present(olwork)) then
    +
    847 olwork = lwork
    +
    848 return
    +
    849 end if
    +
    850
    +
    851 ! Local Memory Allocation
    +
    852 if (present(work)) then
    +
    853 if (size(work) < lwork) then
    +
    854 ! ERROR: WORK not sized correctly
    +
    855 call errmgr%report_error("form_qr_no_pivot_cmplx", &
    +
    856 "Incorrectly sized input array WORK, argument 4.", &
    +
    857 la_array_size_error)
    +
    858 return
    +
    859 end if
    +
    860 wptr => work(1:lwork)
    +
    861 else
    +
    862 allocate(wrk(lwork), stat = istat)
    +
    863 if (istat /= 0) then
    +
    864 ! ERROR: Out of memory
    +
    865 call errmgr%report_error("form_qr_no_pivot_cmplx", &
    +
    866 "Insufficient memory available.", &
    +
    867 la_out_of_memory_error)
    +
    868 return
    +
    869 end if
    +
    870 wptr => wrk
    +
    871 end if
    +
    872
    +
    873 ! Copy the sub-diagonal portion of R to Q, and then zero out the
    +
    874 ! sub-diagonal portion of R
    +
    875 do j = 1, mn
    +
    876 q(j+1:m,j) = r(j+1:m,j)
    +
    877 r(j+1:m,j) = zero
    +
    878 end do
    +
    879
    +
    880 ! Build Q - Build M-by-M or M-by-N, but M-by-N only for M >= N
    +
    881 call zungqr(m, qcol, mn, q, m, tau, wptr, lwork, flag)
    +
    882
    +
    883 ! End
    +
    884 if (allocated(wrk)) deallocate(wrk)
    +
    885
    +
    886 ! Formatting
    +
    887100 format(a, i0, a)
    +
    888 end subroutine
    +
    889
    +
    890! ------------------------------------------------------------------------------
    +
    891 module subroutine form_qr_pivot(r, tau, pvt, q, p, work, olwork, err)
    +
    892 ! Arguments
    +
    893 real(real64), intent(inout), dimension(:,:) :: r
    +
    894 real(real64), intent(in), dimension(:) :: tau
    +
    895 integer(int32), intent(in), dimension(:) :: pvt
    +
    896 real(real64), intent(out), dimension(:,:) :: q, p
    +
    897 real(real64), intent(out), target, dimension(:), optional :: work
    +
    898 integer(int32), intent(out), optional :: olwork
    +
    899 class(errors), intent(inout), optional, target :: err
    +
    900
    +
    901 ! Parameters
    +
    902 real(real64), parameter :: zero = 0.0d0
    +
    903 real(real64), parameter :: one = 1.0d0
    +
    904
    +
    905 ! Local Variables
    +
    906 integer(int32) :: j, jp, m, n, mn, flag
    +
    907 class(errors), pointer :: errmgr
    +
    908 type(errors), target :: deferr
    +
    909 character(len = 128) :: errmsg
    +
    910
    +
    911 ! Initialization
    +
    912 m = size(r, 1)
    +
    913 n = size(r, 2)
    +
    914 mn = min(m, n)
    +
    915 if (present(err)) then
    +
    916 errmgr => err
    +
    917 else
    +
    918 errmgr => deferr
    +
    919 end if
    +
    920
    +
    921 ! Input Check
    +
    922 flag = 0
    +
    923 if (size(tau) /= mn) then
    +
    924 flag = 2
    +
    925 else if (size(pvt) /= n) then
    +
    926 flag = 3
    +
    927 else if (size(q, 1) /= m .or. &
    +
    928 (size(q, 2) /= m .and. size(q, 2) /= n)) then
    +
    929 flag = 4
    +
    930 else if (size(q, 2) == n .and. m < n) then
    +
    931 flag = 4
    +
    932 else if (size(p, 1) /= n .or. size(p, 2) /= n) then
    +
    933 flag = 5
    +
    934 end if
    +
    935 if (flag /= 0) then
    +
    936 ! ERROR: One of the input arrays is not sized correctly
    +
    937 write(errmsg, 100) "Input number ", flag, &
    +
    938 " is not sized correctly."
    +
    939 call errmgr%report_error("form_qr_pivot", trim(errmsg), &
    +
    940 la_array_size_error)
    +
    941 return
    +
    942 end if
    +
    943
    +
    944 ! Generate Q and R
    +
    945 call form_qr_no_pivot(r, tau, q, work = work, olwork = olwork, &
    +
    946 err = errmgr)
    +
    947 if (present(olwork)) return ! Just a workspace query
    +
    948 if (errmgr%has_error_occurred()) return
    +
    949
    +
    950 ! Form P
    +
    951 do j = 1, n
    +
    952 jp = pvt(j)
    +
    953 p(:,j) = zero
    +
    954 p(jp,j) = one
    +
    955 end do
    +
    956
    +
    957 ! Formatting
    +
    958100 format(a, i0, a)
    +
    959 end subroutine
    +
    960
    +
    961! ------------------------------------------------------------------------------
    +
    962 module subroutine form_qr_pivot_cmplx(r, tau, pvt, q, p, work, olwork, err)
    +
    963 ! Arguments
    +
    964 complex(real64), intent(inout), dimension(:,:) :: r
    +
    965 complex(real64), intent(in), dimension(:) :: tau
    +
    966 integer(int32), intent(in), dimension(:) :: pvt
    +
    967 complex(real64), intent(out), dimension(:,:) :: q, p
    +
    968 complex(real64), intent(out), target, dimension(:), optional :: work
    +
    969 integer(int32), intent(out), optional :: olwork
    +
    970 class(errors), intent(inout), optional, target :: err
    +
    971
    +
    972 ! Parameters
    +
    973 complex(real64), parameter :: zero = (0.0d0, 0.0d0)
    +
    974 complex(real64), parameter :: one = (1.0d0, 0.0d0)
    +
    975
    +
    976 ! Local Variables
    +
    977 integer(int32) :: j, jp, m, n, mn, flag
    +
    978 class(errors), pointer :: errmgr
    +
    979 type(errors), target :: deferr
    +
    980 character(len = 128) :: errmsg
    981
    -
    982 ! Generate Q and R
    -
    983 call form_qr_no_pivot_cmplx(r, tau, q, work = work, olwork = olwork, &
    -
    984 err = errmgr)
    -
    985 if (present(olwork)) return ! Just a workspace query
    -
    986 if (errmgr%has_error_occurred()) return
    -
    987
    -
    988 ! Form P
    -
    989 do j = 1, n
    -
    990 jp = pvt(j)
    -
    991 p(:,j) = zero
    -
    992 p(jp,j) = one
    -
    993 end do
    -
    994 end subroutine
    -
    995
    -
    996! ------------------------------------------------------------------------------
    -
    997 module subroutine mult_qr_mtx(lside, trans, a, tau, c, work, olwork, err)
    -
    998 ! Arguments
    -
    999 logical, intent(in) :: lside, trans
    -
    1000 real(real64), intent(in), dimension(:) :: tau
    -
    1001 real(real64), intent(inout), dimension(:,:) :: a, c
    -
    1002 real(real64), intent(out), target, dimension(:), optional :: work
    -
    1003 integer(int32), intent(out), optional :: olwork
    -
    1004 class(errors), intent(inout), optional, target :: err
    -
    1005
    -
    1006 ! Parameters
    -
    1007 real(real64), parameter :: one = 1.0d0
    -
    1008
    -
    1009 ! Local Variables
    -
    1010 character :: side, t
    -
    1011 integer(int32) :: m, n, k, nrowa, istat, flag, lwork
    -
    1012 real(real64), pointer, dimension(:) :: wptr
    -
    1013 real(real64), allocatable, target, dimension(:) :: wrk
    -
    1014 real(real64), dimension(1) :: temp
    -
    1015 class(errors), pointer :: errmgr
    -
    1016 type(errors), target :: deferr
    -
    1017 character(len = 128) :: errmsg
    -
    1018
    -
    1019 ! Initialization
    -
    1020 m = size(c, 1)
    -
    1021 n = size(c, 2)
    -
    1022 k = size(tau)
    -
    1023 if (lside) then
    -
    1024 side = 'L'
    -
    1025 nrowa = m
    -
    1026 else
    -
    1027 side = 'R'
    -
    1028 nrowa = n
    -
    1029 end if
    -
    1030 if (trans) then
    -
    1031 t = 'T'
    -
    1032 else
    -
    1033 t = 'N'
    -
    1034 end if
    -
    1035 if (present(err)) then
    -
    1036 errmgr => err
    -
    1037 else
    -
    1038 errmgr => deferr
    -
    1039 end if
    -
    1040
    -
    1041 ! Input Check
    -
    1042 flag = 0
    -
    1043 if (lside) then
    -
    1044 ! A is M-by-K, M >= K >= 0
    -
    1045 if (size(a, 1) /= m .or. size(a, 2) < k) flag = 3
    -
    1046 else
    -
    1047 ! A is N-by-K, N >= K >= 0
    -
    1048 if (size(a, 1) /= n .or. size(a, 2) < k) flag = 3
    -
    1049 end if
    -
    1050 if (flag /= 0) then
    -
    1051 ! ERROR: One of the input arrays is not sized correctly
    -
    1052 write(errmsg, '(AI0A)') "Input number ", flag, &
    -
    1053 " is not sized correctly."
    -
    1054 call errmgr%report_error("mult_qr_mtx", trim(errmsg), &
    -
    1055 la_array_size_error)
    -
    1056 return
    -
    1057 end if
    -
    1058
    -
    1059 ! Workspace Query
    -
    1060 call dormqr(side, t, m, n, k, a, nrowa, tau, c, m, temp, -1, flag)
    -
    1061 lwork = int(temp(1), int32)
    -
    1062 if (present(olwork)) then
    -
    1063 olwork = lwork
    -
    1064 return
    +
    982 ! Initialization
    +
    983 m = size(r, 1)
    +
    984 n = size(r, 2)
    +
    985 mn = min(m, n)
    +
    986 if (present(err)) then
    +
    987 errmgr => err
    +
    988 else
    +
    989 errmgr => deferr
    +
    990 end if
    +
    991
    +
    992 ! Input Check
    +
    993 flag = 0
    +
    994 if (size(tau) /= mn) then
    +
    995 flag = 2
    +
    996 else if (size(pvt) /= n) then
    +
    997 flag = 3
    +
    998 else if (size(q, 1) /= m .or. &
    +
    999 (size(q, 2) /= m .and. size(q, 2) /= n)) then
    +
    1000 flag = 4
    +
    1001 else if (size(q, 2) == n .and. m < n) then
    +
    1002 flag = 4
    +
    1003 else if (size(p, 1) /= n .or. size(p, 2) /= n) then
    +
    1004 flag = 5
    +
    1005 end if
    +
    1006 if (flag /= 0) then
    +
    1007 ! ERROR: One of the input arrays is not sized correctly
    +
    1008 write(errmsg, 100) "Input number ", flag, &
    +
    1009 " is not sized correctly."
    +
    1010 call errmgr%report_error("form_qr_pivot_cmplx", trim(errmsg), &
    +
    1011 la_array_size_error)
    +
    1012 return
    +
    1013 end if
    +
    1014
    +
    1015 ! Generate Q and R
    +
    1016 call form_qr_no_pivot_cmplx(r, tau, q, work = work, olwork = olwork, &
    +
    1017 err = errmgr)
    +
    1018 if (present(olwork)) return ! Just a workspace query
    +
    1019 if (errmgr%has_error_occurred()) return
    +
    1020
    +
    1021 ! Form P
    +
    1022 do j = 1, n
    +
    1023 jp = pvt(j)
    +
    1024 p(:,j) = zero
    +
    1025 p(jp,j) = one
    +
    1026 end do
    +
    1027
    +
    1028 ! Formatting
    +
    1029100 format(a, i0, a)
    +
    1030 end subroutine
    +
    1031
    +
    1032! ------------------------------------------------------------------------------
    +
    1033 module subroutine mult_qr_mtx(lside, trans, a, tau, c, work, olwork, err)
    +
    1034 ! Arguments
    +
    1035 logical, intent(in) :: lside, trans
    +
    1036 real(real64), intent(in), dimension(:) :: tau
    +
    1037 real(real64), intent(inout), dimension(:,:) :: a, c
    +
    1038 real(real64), intent(out), target, dimension(:), optional :: work
    +
    1039 integer(int32), intent(out), optional :: olwork
    +
    1040 class(errors), intent(inout), optional, target :: err
    +
    1041
    +
    1042 ! Parameters
    +
    1043 real(real64), parameter :: one = 1.0d0
    +
    1044
    +
    1045 ! Local Variables
    +
    1046 character :: side, t
    +
    1047 integer(int32) :: m, n, k, nrowa, istat, flag, lwork
    +
    1048 real(real64), pointer, dimension(:) :: wptr
    +
    1049 real(real64), allocatable, target, dimension(:) :: wrk
    +
    1050 real(real64), dimension(1) :: temp
    +
    1051 class(errors), pointer :: errmgr
    +
    1052 type(errors), target :: deferr
    +
    1053 character(len = 128) :: errmsg
    +
    1054
    +
    1055 ! Initialization
    +
    1056 m = size(c, 1)
    +
    1057 n = size(c, 2)
    +
    1058 k = size(tau)
    +
    1059 if (lside) then
    +
    1060 side = 'L'
    +
    1061 nrowa = m
    +
    1062 else
    +
    1063 side = 'R'
    +
    1064 nrowa = n
    1065 end if
    -
    1066
    -
    1067 ! Local Memory Allocation
    -
    1068 if (present(work)) then
    -
    1069 if (size(work) < lwork) then
    -
    1070 ! ERROR: WORK not sized correctly
    -
    1071 call errmgr%report_error("mult_qr_mtx", &
    -
    1072 "Incorrectly sized input array WORK, argument 6.", &
    -
    1073 la_array_size_error)
    -
    1074 return
    -
    1075 end if
    -
    1076 wptr => work(1:lwork)
    -
    1077 else
    -
    1078 allocate(wrk(lwork), stat = istat)
    -
    1079 if (istat /= 0) then
    -
    1080 ! ERROR: Out of memory
    -
    1081 call errmgr%report_error("mult_qr_mtx", &
    -
    1082 "Insufficient memory available.", &
    -
    1083 la_out_of_memory_error)
    -
    1084 return
    -
    1085 end if
    -
    1086 wptr => wrk
    -
    1087 end if
    -
    1088
    -
    1089 ! Call DORMQR
    -
    1090 call dormqr(side, t, m, n, k, a, nrowa, tau, c, m, wptr, lwork, flag)
    -
    1091 end subroutine
    -
    1092
    -
    1093! ------------------------------------------------------------------------------
    -
    1094 module subroutine mult_qr_mtx_cmplx(lside, trans, a, tau, c, work, olwork, err)
    -
    1095 ! Arguments
    -
    1096 logical, intent(in) :: lside, trans
    -
    1097 complex(real64), intent(in), dimension(:) :: tau
    -
    1098 complex(real64), intent(inout), dimension(:,:) :: a, c
    -
    1099 complex(real64), intent(out), target, dimension(:), optional :: work
    -
    1100 integer(int32), intent(out), optional :: olwork
    -
    1101 class(errors), intent(inout), optional, target :: err
    +
    1066 if (trans) then
    +
    1067 t = 'T'
    +
    1068 else
    +
    1069 t = 'N'
    +
    1070 end if
    +
    1071 if (present(err)) then
    +
    1072 errmgr => err
    +
    1073 else
    +
    1074 errmgr => deferr
    +
    1075 end if
    +
    1076
    +
    1077 ! Input Check
    +
    1078 flag = 0
    +
    1079 if (lside) then
    +
    1080 ! A is M-by-K, M >= K >= 0
    +
    1081 if (size(a, 1) /= m .or. size(a, 2) < k) flag = 3
    +
    1082 else
    +
    1083 ! A is N-by-K, N >= K >= 0
    +
    1084 if (size(a, 1) /= n .or. size(a, 2) < k) flag = 3
    +
    1085 end if
    +
    1086 if (flag /= 0) then
    +
    1087 ! ERROR: One of the input arrays is not sized correctly
    +
    1088 write(errmsg, 100) "Input number ", flag, &
    +
    1089 " is not sized correctly."
    +
    1090 call errmgr%report_error("mult_qr_mtx", trim(errmsg), &
    +
    1091 la_array_size_error)
    +
    1092 return
    +
    1093 end if
    +
    1094
    +
    1095 ! Workspace Query
    +
    1096 call dormqr(side, t, m, n, k, a, nrowa, tau, c, m, temp, -1, flag)
    +
    1097 lwork = int(temp(1), int32)
    +
    1098 if (present(olwork)) then
    +
    1099 olwork = lwork
    +
    1100 return
    +
    1101 end if
    1102
    -
    1103 ! Parameters
    -
    1104 complex(real64), parameter :: one = (1.0d0, 0.0d0)
    -
    1105
    -
    1106 ! Local Variables
    -
    1107 character :: side, t
    -
    1108 integer(int32) :: m, n, k, nrowa, istat, flag, lwork
    -
    1109 complex(real64), pointer, dimension(:) :: wptr
    -
    1110 complex(real64), allocatable, target, dimension(:) :: wrk
    -
    1111 complex(real64), dimension(1) :: temp
    -
    1112 class(errors), pointer :: errmgr
    -
    1113 type(errors), target :: deferr
    -
    1114 character(len = 128) :: errmsg
    -
    1115
    -
    1116 ! Initialization
    -
    1117 m = size(c, 1)
    -
    1118 n = size(c, 2)
    -
    1119 k = size(tau)
    -
    1120 if (lside) then
    -
    1121 side = 'L'
    -
    1122 nrowa = m
    -
    1123 else
    -
    1124 side = 'R'
    -
    1125 nrowa = n
    -
    1126 end if
    -
    1127 if (trans) then
    -
    1128 t = 'C'
    -
    1129 else
    -
    1130 t = 'N'
    -
    1131 end if
    -
    1132 if (present(err)) then
    -
    1133 errmgr => err
    -
    1134 else
    -
    1135 errmgr => deferr
    -
    1136 end if
    -
    1137
    -
    1138 ! Input Check
    -
    1139 flag = 0
    -
    1140 if (lside) then
    -
    1141 ! A is M-by-K, M >= K >= 0
    -
    1142 if (size(a, 1) /= m .or. size(a, 2) < k) flag = 3
    -
    1143 else
    -
    1144 ! A is N-by-K, N >= K >= 0
    -
    1145 if (size(a, 1) /= n .or. size(a, 2) < k) flag = 3
    -
    1146 end if
    -
    1147 if (flag /= 0) then
    -
    1148 ! ERROR: One of the input arrays is not sized correctly
    -
    1149 write(errmsg, '(AI0A)') "Input number ", flag, &
    -
    1150 " is not sized correctly."
    -
    1151 call errmgr%report_error("mult_qr_mtx_cmplx", trim(errmsg), &
    -
    1152 la_array_size_error)
    -
    1153 return
    -
    1154 end if
    -
    1155
    -
    1156 ! Workspace Query
    -
    1157 call zunmqr(side, t, m, n, k, a, nrowa, tau, c, m, temp, -1, flag)
    -
    1158 lwork = int(temp(1), int32)
    -
    1159 if (present(olwork)) then
    -
    1160 olwork = lwork
    -
    1161 return
    -
    1162 end if
    -
    1163
    -
    1164 ! Local Memory Allocation
    -
    1165 if (present(work)) then
    -
    1166 if (size(work) < lwork) then
    -
    1167 ! ERROR: WORK not sized correctly
    -
    1168 call errmgr%report_error("mult_qr_mtx_cmplx", &
    -
    1169 "Incorrectly sized input array WORK, argument 6.", &
    -
    1170 la_array_size_error)
    -
    1171 return
    -
    1172 end if
    -
    1173 wptr => work(1:lwork)
    -
    1174 else
    -
    1175 allocate(wrk(lwork), stat = istat)
    -
    1176 if (istat /= 0) then
    -
    1177 ! ERROR: Out of memory
    -
    1178 call errmgr%report_error("mult_qr_mtx_cmplx", &
    -
    1179 "Insufficient memory available.", &
    -
    1180 la_out_of_memory_error)
    -
    1181 return
    -
    1182 end if
    -
    1183 wptr => wrk
    -
    1184 end if
    -
    1185
    -
    1186 ! Call ZUNMQR
    -
    1187 call zunmqr(side, t, m, n, k, a, nrowa, tau, c, m, wptr, lwork, flag)
    -
    1188 end subroutine
    -
    1189
    -
    1190! ------------------------------------------------------------------------------
    -
    1191 module subroutine mult_qr_vec(trans, a, tau, c, work, olwork, err)
    -
    1192 ! Arguments
    -
    1193 logical, intent(in) :: trans
    -
    1194 real(real64), intent(inout), dimension(:,:) :: a
    -
    1195 real(real64), intent(in), dimension(:) :: tau
    -
    1196 real(real64), intent(inout), dimension(:) :: c
    -
    1197 real(real64), intent(out), target, dimension(:), optional :: work
    -
    1198 integer(int32), intent(out), optional :: olwork
    -
    1199 class(errors), intent(inout), optional, target :: err
    -
    1200
    -
    1201 ! Parameters
    -
    1202 real(real64), parameter :: one = 1.0d0
    -
    1203
    -
    1204 ! Local Variables
    -
    1205 character :: side, t
    -
    1206 integer(int32) :: m, k, nrowa, istat, flag, lwork
    -
    1207 real(real64), pointer, dimension(:) :: wptr
    -
    1208 real(real64), allocatable, target, dimension(:) :: wrk
    -
    1209 real(real64), dimension(1) :: temp
    -
    1210 class(errors), pointer :: errmgr
    -
    1211 type(errors), target :: deferr
    -
    1212 character(len = 128) :: errmsg
    -
    1213
    -
    1214 ! Initialization
    -
    1215 m = size(c)
    -
    1216 k = size(tau)
    -
    1217 side = 'L'
    -
    1218 nrowa = m
    -
    1219 if (trans) then
    -
    1220 t = 'T'
    -
    1221 else
    -
    1222 t = 'N'
    +
    1103 ! Local Memory Allocation
    +
    1104 if (present(work)) then
    +
    1105 if (size(work) < lwork) then
    +
    1106 ! ERROR: WORK not sized correctly
    +
    1107 call errmgr%report_error("mult_qr_mtx", &
    +
    1108 "Incorrectly sized input array WORK, argument 6.", &
    +
    1109 la_array_size_error)
    +
    1110 return
    +
    1111 end if
    +
    1112 wptr => work(1:lwork)
    +
    1113 else
    +
    1114 allocate(wrk(lwork), stat = istat)
    +
    1115 if (istat /= 0) then
    +
    1116 ! ERROR: Out of memory
    +
    1117 call errmgr%report_error("mult_qr_mtx", &
    +
    1118 "Insufficient memory available.", &
    +
    1119 la_out_of_memory_error)
    +
    1120 return
    +
    1121 end if
    +
    1122 wptr => wrk
    +
    1123 end if
    +
    1124
    +
    1125 ! Call DORMQR
    +
    1126 call dormqr(side, t, m, n, k, a, nrowa, tau, c, m, wptr, lwork, flag)
    +
    1127
    +
    1128 ! Formatting
    +
    1129100 format(a, i0, a)
    +
    1130 end subroutine
    +
    1131
    +
    1132! ------------------------------------------------------------------------------
    +
    1133 module subroutine mult_qr_mtx_cmplx(lside, trans, a, tau, c, work, olwork, err)
    +
    1134 ! Arguments
    +
    1135 logical, intent(in) :: lside, trans
    +
    1136 complex(real64), intent(in), dimension(:) :: tau
    +
    1137 complex(real64), intent(inout), dimension(:,:) :: a, c
    +
    1138 complex(real64), intent(out), target, dimension(:), optional :: work
    +
    1139 integer(int32), intent(out), optional :: olwork
    +
    1140 class(errors), intent(inout), optional, target :: err
    +
    1141
    +
    1142 ! Parameters
    +
    1143 complex(real64), parameter :: one = (1.0d0, 0.0d0)
    +
    1144
    +
    1145 ! Local Variables
    +
    1146 character :: side, t
    +
    1147 integer(int32) :: m, n, k, nrowa, istat, flag, lwork
    +
    1148 complex(real64), pointer, dimension(:) :: wptr
    +
    1149 complex(real64), allocatable, target, dimension(:) :: wrk
    +
    1150 complex(real64), dimension(1) :: temp
    +
    1151 class(errors), pointer :: errmgr
    +
    1152 type(errors), target :: deferr
    +
    1153 character(len = 128) :: errmsg
    +
    1154
    +
    1155 ! Initialization
    +
    1156 m = size(c, 1)
    +
    1157 n = size(c, 2)
    +
    1158 k = size(tau)
    +
    1159 if (lside) then
    +
    1160 side = 'L'
    +
    1161 nrowa = m
    +
    1162 else
    +
    1163 side = 'R'
    +
    1164 nrowa = n
    +
    1165 end if
    +
    1166 if (trans) then
    +
    1167 t = 'C'
    +
    1168 else
    +
    1169 t = 'N'
    +
    1170 end if
    +
    1171 if (present(err)) then
    +
    1172 errmgr => err
    +
    1173 else
    +
    1174 errmgr => deferr
    +
    1175 end if
    +
    1176
    +
    1177 ! Input Check
    +
    1178 flag = 0
    +
    1179 if (lside) then
    +
    1180 ! A is M-by-K, M >= K >= 0
    +
    1181 if (size(a, 1) /= m .or. size(a, 2) < k) flag = 3
    +
    1182 else
    +
    1183 ! A is N-by-K, N >= K >= 0
    +
    1184 if (size(a, 1) /= n .or. size(a, 2) < k) flag = 3
    +
    1185 end if
    +
    1186 if (flag /= 0) then
    +
    1187 ! ERROR: One of the input arrays is not sized correctly
    +
    1188 write(errmsg, 100) "Input number ", flag, &
    +
    1189 " is not sized correctly."
    +
    1190 call errmgr%report_error("mult_qr_mtx_cmplx", trim(errmsg), &
    +
    1191 la_array_size_error)
    +
    1192 return
    +
    1193 end if
    +
    1194
    +
    1195 ! Workspace Query
    +
    1196 call zunmqr(side, t, m, n, k, a, nrowa, tau, c, m, temp, -1, flag)
    +
    1197 lwork = int(temp(1), int32)
    +
    1198 if (present(olwork)) then
    +
    1199 olwork = lwork
    +
    1200 return
    +
    1201 end if
    +
    1202
    +
    1203 ! Local Memory Allocation
    +
    1204 if (present(work)) then
    +
    1205 if (size(work) < lwork) then
    +
    1206 ! ERROR: WORK not sized correctly
    +
    1207 call errmgr%report_error("mult_qr_mtx_cmplx", &
    +
    1208 "Incorrectly sized input array WORK, argument 6.", &
    +
    1209 la_array_size_error)
    +
    1210 return
    +
    1211 end if
    +
    1212 wptr => work(1:lwork)
    +
    1213 else
    +
    1214 allocate(wrk(lwork), stat = istat)
    +
    1215 if (istat /= 0) then
    +
    1216 ! ERROR: Out of memory
    +
    1217 call errmgr%report_error("mult_qr_mtx_cmplx", &
    +
    1218 "Insufficient memory available.", &
    +
    1219 la_out_of_memory_error)
    +
    1220 return
    +
    1221 end if
    +
    1222 wptr => wrk
    1223 end if
    -
    1224 if (present(err)) then
    -
    1225 errmgr => err
    -
    1226 else
    -
    1227 errmgr => deferr
    -
    1228 end if
    -
    1229
    -
    1230 ! Input Check
    -
    1231 flag = 0
    -
    1232 if (size(a, 1) /= m .or. size(a, 2) < k) flag = 3
    -
    1233 if (flag /= 0) then
    -
    1234 ! ERROR: One of the input arrays is not sized correctly
    -
    1235 write(errmsg, '(AI0A)') "Input number ", flag, &
    -
    1236 " is not sized correctly."
    -
    1237 call errmgr%report_error("mult_qr_vec", trim(errmsg), &
    -
    1238 la_array_size_error)
    -
    1239 return
    -
    1240 end if
    -
    1241
    -
    1242 ! Workspace Query
    -
    1243 call dormqr(side, t, m, 1, k, a, nrowa, tau, c, m, temp, -1, flag)
    -
    1244 lwork = int(temp(1), int32)
    -
    1245 if (present(olwork)) then
    -
    1246 olwork = lwork
    -
    1247 return
    -
    1248 end if
    -
    1249
    -
    1250 ! Local Memory Allocation
    -
    1251 if (present(work)) then
    -
    1252 if (size(work) < lwork) then
    -
    1253 ! ERROR: WORK not sized correctly
    -
    1254 call errmgr%report_error("mult_qr_vec", &
    -
    1255 "Incorrectly sized input array WORK, argument 6.", &
    -
    1256 la_array_size_error)
    -
    1257 return
    -
    1258 end if
    -
    1259 wptr => work(1:lwork)
    -
    1260 else
    -
    1261 allocate(wrk(lwork), stat = istat)
    -
    1262 if (istat /= 0) then
    -
    1263 ! ERROR: Out of memory
    -
    1264 call errmgr%report_error("mult_qr_vec", &
    -
    1265 "Insufficient memory available.", &
    -
    1266 la_out_of_memory_error)
    -
    1267 return
    -
    1268 end if
    -
    1269 wptr => wrk
    +
    1224
    +
    1225 ! Call ZUNMQR
    +
    1226 call zunmqr(side, t, m, n, k, a, nrowa, tau, c, m, wptr, lwork, flag)
    +
    1227
    +
    1228 ! Formatting
    +
    1229100 format(a, i0, a)
    +
    1230 end subroutine
    +
    1231
    +
    1232! ------------------------------------------------------------------------------
    +
    1233 module subroutine mult_qr_vec(trans, a, tau, c, work, olwork, err)
    +
    1234 ! Arguments
    +
    1235 logical, intent(in) :: trans
    +
    1236 real(real64), intent(inout), dimension(:,:) :: a
    +
    1237 real(real64), intent(in), dimension(:) :: tau
    +
    1238 real(real64), intent(inout), dimension(:) :: c
    +
    1239 real(real64), intent(out), target, dimension(:), optional :: work
    +
    1240 integer(int32), intent(out), optional :: olwork
    +
    1241 class(errors), intent(inout), optional, target :: err
    +
    1242
    +
    1243 ! Parameters
    +
    1244 real(real64), parameter :: one = 1.0d0
    +
    1245
    +
    1246 ! Local Variables
    +
    1247 character :: side, t
    +
    1248 integer(int32) :: m, k, nrowa, istat, flag, lwork
    +
    1249 real(real64), pointer, dimension(:) :: wptr
    +
    1250 real(real64), allocatable, target, dimension(:) :: wrk
    +
    1251 real(real64), dimension(1) :: temp
    +
    1252 class(errors), pointer :: errmgr
    +
    1253 type(errors), target :: deferr
    +
    1254 character(len = 128) :: errmsg
    +
    1255
    +
    1256 ! Initialization
    +
    1257 m = size(c)
    +
    1258 k = size(tau)
    +
    1259 side = 'L'
    +
    1260 nrowa = m
    +
    1261 if (trans) then
    +
    1262 t = 'T'
    +
    1263 else
    +
    1264 t = 'N'
    +
    1265 end if
    +
    1266 if (present(err)) then
    +
    1267 errmgr => err
    +
    1268 else
    +
    1269 errmgr => deferr
    1270 end if
    1271
    -
    1272 ! Call DORMQR
    -
    1273 call dormqr(side, t, m, 1, k, a, nrowa, tau, c, m, wptr, lwork, flag)
    -
    1274 end subroutine
    -
    1275
    -
    1276! ------------------------------------------------------------------------------
    -
    1277 module subroutine mult_qr_vec_cmplx(trans, a, tau, c, work, olwork, err)
    -
    1278 ! Arguments
    -
    1279 logical, intent(in) :: trans
    -
    1280 complex(real64), intent(inout), dimension(:,:) :: a
    -
    1281 complex(real64), intent(in), dimension(:) :: tau
    -
    1282 complex(real64), intent(inout), dimension(:) :: c
    -
    1283 complex(real64), intent(out), target, dimension(:), optional :: work
    -
    1284 integer(int32), intent(out), optional :: olwork
    -
    1285 class(errors), intent(inout), optional, target :: err
    -
    1286
    -
    1287 ! Parameters
    -
    1288 complex(real64), parameter :: one = (1.0d0, 0.0d0)
    -
    1289
    -
    1290 ! Local Variables
    -
    1291 character :: side, t
    -
    1292 integer(int32) :: m, k, nrowa, istat, flag, lwork
    -
    1293 complex(real64), pointer, dimension(:) :: wptr
    -
    1294 complex(real64), allocatable, target, dimension(:) :: wrk
    -
    1295 complex(real64), dimension(1) :: temp
    -
    1296 class(errors), pointer :: errmgr
    -
    1297 type(errors), target :: deferr
    -
    1298 character(len = 128) :: errmsg
    -
    1299
    -
    1300 ! Initialization
    -
    1301 m = size(c)
    -
    1302 k = size(tau)
    -
    1303 side = 'L'
    -
    1304 nrowa = m
    -
    1305 if (trans) then
    -
    1306 t = 'C'
    -
    1307 else
    -
    1308 t = 'N'
    -
    1309 end if
    -
    1310 if (present(err)) then
    -
    1311 errmgr => err
    -
    1312 else
    -
    1313 errmgr => deferr
    -
    1314 end if
    -
    1315
    -
    1316 ! Input Check
    -
    1317 flag = 0
    -
    1318 if (size(a, 1) /= m .or. size(a, 2) < k) flag = 3
    -
    1319 if (flag /= 0) then
    -
    1320 ! ERROR: One of the input arrays is not sized correctly
    -
    1321 write(errmsg, '(AI0A)') "Input number ", flag, &
    -
    1322 " is not sized correctly."
    -
    1323 call errmgr%report_error("mult_qr_vec", trim(errmsg), &
    -
    1324 la_array_size_error)
    -
    1325 return
    -
    1326 end if
    -
    1327
    -
    1328 ! Workspace Query
    -
    1329 call zunmqr(side, t, m, 1, k, a, nrowa, tau, c, m, temp, -1, flag)
    -
    1330 lwork = int(temp(1), int32)
    -
    1331 if (present(olwork)) then
    -
    1332 olwork = lwork
    -
    1333 return
    -
    1334 end if
    -
    1335
    -
    1336 ! Local Memory Allocation
    -
    1337 if (present(work)) then
    -
    1338 if (size(work) < lwork) then
    -
    1339 ! ERROR: WORK not sized correctly
    -
    1340 call errmgr%report_error("mult_qr_vec", &
    -
    1341 "Incorrectly sized input array WORK, argument 6.", &
    -
    1342 la_array_size_error)
    -
    1343 return
    -
    1344 end if
    -
    1345 wptr => work(1:lwork)
    -
    1346 else
    -
    1347 allocate(wrk(lwork), stat = istat)
    -
    1348 if (istat /= 0) then
    -
    1349 ! ERROR: Out of memory
    -
    1350 call errmgr%report_error("mult_qr_vec", &
    -
    1351 "Insufficient memory available.", &
    -
    1352 la_out_of_memory_error)
    -
    1353 return
    -
    1354 end if
    -
    1355 wptr => wrk
    -
    1356 end if
    -
    1357
    -
    1358 ! Call ZUNMQR
    -
    1359 call zunmqr(side, t, m, 1, k, a, nrowa, tau, c, m, wptr, lwork, flag)
    -
    1360 end subroutine
    -
    1361
    -
    1362! ------------------------------------------------------------------------------
    -
    1363 module subroutine qr_rank1_update_dbl(q, r, u, v, work, err)
    -
    1364 ! Arguments
    -
    1365 real(real64), intent(inout), dimension(:,:) :: q, r
    -
    1366 real(real64), intent(inout), dimension(:) :: u, v
    -
    1367 real(real64), intent(out), target, optional, dimension(:) :: work
    -
    1368 class(errors), intent(inout), optional, target :: err
    -
    1369
    -
    1370 ! Local Variables
    -
    1371 logical :: full
    -
    1372 integer(int32) :: m, n, k, lwork, istat, flag
    -
    1373 real(real64), pointer, dimension(:) :: wptr
    -
    1374 real(real64), allocatable, target, dimension(:) :: wrk
    -
    1375 class(errors), pointer :: errmgr
    -
    1376 type(errors), target :: deferr
    -
    1377 character(len = 128) :: errmsg
    -
    1378
    -
    1379 ! Initialization
    -
    1380 m = size(u, 1)
    -
    1381 n = size(r, 2)
    -
    1382 k = min(m, n)
    -
    1383 full = size(q, 2) == m
    -
    1384 lwork = 2 * k
    -
    1385 if (present(err)) then
    -
    1386 errmgr => err
    -
    1387 else
    -
    1388 errmgr => deferr
    -
    1389 end if
    -
    1390
    -
    1391 ! Input Check
    -
    1392 flag = 0
    -
    1393 if (m < n) then
    -
    1394 flag = 1
    -
    1395 else if (.not.full .and. size(q, 2) /= k) then
    -
    1396 flag = 1
    -
    1397 else if (size(r, 1) /= m) then
    -
    1398 flag = 2
    -
    1399 else if (size(u) /= m) then
    -
    1400 flag = 3
    -
    1401 else if (size(v) /= n) then
    -
    1402 flag = 4
    -
    1403 end if
    -
    1404 if (flag /= 0) then
    -
    1405 ! ERROR: One of the input arrays is not sized correctly
    -
    1406 write(errmsg, '(AI0A)') "Input number ", flag, &
    -
    1407 " is not sized correctly."
    -
    1408 call errmgr%report_error("qr_rank1_update", trim(errmsg), &
    -
    1409 la_array_size_error)
    -
    1410 return
    -
    1411 end if
    -
    1412
    -
    1413 ! Local Memory Allocation
    -
    1414 if (present(work)) then
    -
    1415 if (size(work) < lwork) then
    -
    1416 ! ERROR: WORK not sized correctly
    -
    1417 call errmgr%report_error("qr_rank1_update", &
    -
    1418 "Incorrectly sized input array WORK, argument 5.", &
    -
    1419 la_array_size_error)
    -
    1420 return
    -
    1421 end if
    -
    1422 wptr => work(1:lwork)
    -
    1423 else
    -
    1424 allocate(wrk(lwork), stat = istat)
    -
    1425 if (istat /= 0) then
    -
    1426 ! ERROR: Out of memory
    -
    1427 call errmgr%report_error("qr_rank1_update", &
    -
    1428 "Insufficient memory available.", &
    -
    1429 la_out_of_memory_error)
    -
    1430 return
    -
    1431 end if
    -
    1432 wptr => wrk
    -
    1433 end if
    -
    1434
    -
    1435 ! Process
    -
    1436 call dqr1up(m, n, k, q, m, r, m, u, v, wptr)
    -
    1437
    -
    1438 ! End
    -
    1439 if (allocated(wrk)) deallocate(wrk)
    -
    1440 end subroutine
    -
    1441
    -
    1442! ------------------------------------------------------------------------------
    -
    1443 module subroutine qr_rank1_update_cmplx(q, r, u, v, work, rwork, err)
    -
    1444 ! Arguments
    -
    1445 complex(real64), intent(inout), dimension(:,:) :: q, r
    -
    1446 complex(real64), intent(inout), dimension(:) :: u, v
    -
    1447 complex(real64), intent(out), target, optional, dimension(:) :: work
    -
    1448 real(real64), intent(out), target, optional, dimension(:) :: rwork
    -
    1449 class(errors), intent(inout), optional, target :: err
    -
    1450
    -
    1451 ! Local Variables
    -
    1452 logical :: full
    -
    1453 integer(int32) :: m, n, k, lwork, istat, flag, lrwork
    -
    1454 complex(real64), pointer, dimension(:) :: wptr
    -
    1455 complex(real64), allocatable, target, dimension(:) :: wrk
    -
    1456 real(real64), pointer, dimension(:) :: rwptr
    -
    1457 real(real64), allocatable, target, dimension(:) :: rwrk
    -
    1458 class(errors), pointer :: errmgr
    -
    1459 type(errors), target :: deferr
    -
    1460 character(len = 128) :: errmsg
    -
    1461
    -
    1462 ! Initialization
    -
    1463 m = size(u, 1)
    -
    1464 n = size(r, 2)
    -
    1465 k = min(m, n)
    -
    1466 full = size(q, 2) == m
    -
    1467 lwork = k
    -
    1468 lrwork = k
    -
    1469 if (present(err)) then
    -
    1470 errmgr => err
    +
    1272 ! Input Check
    +
    1273 flag = 0
    +
    1274 if (size(a, 1) /= m .or. size(a, 2) < k) flag = 3
    +
    1275 if (flag /= 0) then
    +
    1276 ! ERROR: One of the input arrays is not sized correctly
    +
    1277 write(errmsg, 100) "Input number ", flag, &
    +
    1278 " is not sized correctly."
    +
    1279 call errmgr%report_error("mult_qr_vec", trim(errmsg), &
    +
    1280 la_array_size_error)
    +
    1281 return
    +
    1282 end if
    +
    1283
    +
    1284 ! Workspace Query
    +
    1285 call dormqr(side, t, m, 1, k, a, nrowa, tau, c, m, temp, -1, flag)
    +
    1286 lwork = int(temp(1), int32)
    +
    1287 if (present(olwork)) then
    +
    1288 olwork = lwork
    +
    1289 return
    +
    1290 end if
    +
    1291
    +
    1292 ! Local Memory Allocation
    +
    1293 if (present(work)) then
    +
    1294 if (size(work) < lwork) then
    +
    1295 ! ERROR: WORK not sized correctly
    +
    1296 call errmgr%report_error("mult_qr_vec", &
    +
    1297 "Incorrectly sized input array WORK, argument 6.", &
    +
    1298 la_array_size_error)
    +
    1299 return
    +
    1300 end if
    +
    1301 wptr => work(1:lwork)
    +
    1302 else
    +
    1303 allocate(wrk(lwork), stat = istat)
    +
    1304 if (istat /= 0) then
    +
    1305 ! ERROR: Out of memory
    +
    1306 call errmgr%report_error("mult_qr_vec", &
    +
    1307 "Insufficient memory available.", &
    +
    1308 la_out_of_memory_error)
    +
    1309 return
    +
    1310 end if
    +
    1311 wptr => wrk
    +
    1312 end if
    +
    1313
    +
    1314 ! Call DORMQR
    +
    1315 call dormqr(side, t, m, 1, k, a, nrowa, tau, c, m, wptr, lwork, flag)
    +
    1316
    +
    1317 ! Formatting
    +
    1318100 format(a, i0, a)
    +
    1319 end subroutine
    +
    1320
    +
    1321! ------------------------------------------------------------------------------
    +
    1322 module subroutine mult_qr_vec_cmplx(trans, a, tau, c, work, olwork, err)
    +
    1323 ! Arguments
    +
    1324 logical, intent(in) :: trans
    +
    1325 complex(real64), intent(inout), dimension(:,:) :: a
    +
    1326 complex(real64), intent(in), dimension(:) :: tau
    +
    1327 complex(real64), intent(inout), dimension(:) :: c
    +
    1328 complex(real64), intent(out), target, dimension(:), optional :: work
    +
    1329 integer(int32), intent(out), optional :: olwork
    +
    1330 class(errors), intent(inout), optional, target :: err
    +
    1331
    +
    1332 ! Parameters
    +
    1333 complex(real64), parameter :: one = (1.0d0, 0.0d0)
    +
    1334
    +
    1335 ! Local Variables
    +
    1336 character :: side, t
    +
    1337 integer(int32) :: m, k, nrowa, istat, flag, lwork
    +
    1338 complex(real64), pointer, dimension(:) :: wptr
    +
    1339 complex(real64), allocatable, target, dimension(:) :: wrk
    +
    1340 complex(real64), dimension(1) :: temp
    +
    1341 class(errors), pointer :: errmgr
    +
    1342 type(errors), target :: deferr
    +
    1343 character(len = 128) :: errmsg
    +
    1344
    +
    1345 ! Initialization
    +
    1346 m = size(c)
    +
    1347 k = size(tau)
    +
    1348 side = 'L'
    +
    1349 nrowa = m
    +
    1350 if (trans) then
    +
    1351 t = 'C'
    +
    1352 else
    +
    1353 t = 'N'
    +
    1354 end if
    +
    1355 if (present(err)) then
    +
    1356 errmgr => err
    +
    1357 else
    +
    1358 errmgr => deferr
    +
    1359 end if
    +
    1360
    +
    1361 ! Input Check
    +
    1362 flag = 0
    +
    1363 if (size(a, 1) /= m .or. size(a, 2) < k) flag = 3
    +
    1364 if (flag /= 0) then
    +
    1365 ! ERROR: One of the input arrays is not sized correctly
    +
    1366 write(errmsg, 100) "Input number ", flag, &
    +
    1367 " is not sized correctly."
    +
    1368 call errmgr%report_error("mult_qr_vec", trim(errmsg), &
    +
    1369 la_array_size_error)
    +
    1370 return
    +
    1371 end if
    +
    1372
    +
    1373 ! Workspace Query
    +
    1374 call zunmqr(side, t, m, 1, k, a, nrowa, tau, c, m, temp, -1, flag)
    +
    1375 lwork = int(temp(1), int32)
    +
    1376 if (present(olwork)) then
    +
    1377 olwork = lwork
    +
    1378 return
    +
    1379 end if
    +
    1380
    +
    1381 ! Local Memory Allocation
    +
    1382 if (present(work)) then
    +
    1383 if (size(work) < lwork) then
    +
    1384 ! ERROR: WORK not sized correctly
    +
    1385 call errmgr%report_error("mult_qr_vec", &
    +
    1386 "Incorrectly sized input array WORK, argument 6.", &
    +
    1387 la_array_size_error)
    +
    1388 return
    +
    1389 end if
    +
    1390 wptr => work(1:lwork)
    +
    1391 else
    +
    1392 allocate(wrk(lwork), stat = istat)
    +
    1393 if (istat /= 0) then
    +
    1394 ! ERROR: Out of memory
    +
    1395 call errmgr%report_error("mult_qr_vec", &
    +
    1396 "Insufficient memory available.", &
    +
    1397 la_out_of_memory_error)
    +
    1398 return
    +
    1399 end if
    +
    1400 wptr => wrk
    +
    1401 end if
    +
    1402
    +
    1403 ! Call ZUNMQR
    +
    1404 call zunmqr(side, t, m, 1, k, a, nrowa, tau, c, m, wptr, lwork, flag)
    +
    1405
    +
    1406 ! Formatting
    +
    1407100 format(a, i0, a)
    +
    1408 end subroutine
    +
    1409
    +
    1410! ------------------------------------------------------------------------------
    +
    1411 module subroutine qr_rank1_update_dbl(q, r, u, v, work, err)
    +
    1412 ! Arguments
    +
    1413 real(real64), intent(inout), dimension(:,:) :: q, r
    +
    1414 real(real64), intent(inout), dimension(:) :: u, v
    +
    1415 real(real64), intent(out), target, optional, dimension(:) :: work
    +
    1416 class(errors), intent(inout), optional, target :: err
    +
    1417
    +
    1418 ! Local Variables
    +
    1419 logical :: full
    +
    1420 integer(int32) :: m, n, k, lwork, istat, flag
    +
    1421 real(real64), pointer, dimension(:) :: wptr
    +
    1422 real(real64), allocatable, target, dimension(:) :: wrk
    +
    1423 class(errors), pointer :: errmgr
    +
    1424 type(errors), target :: deferr
    +
    1425 character(len = 128) :: errmsg
    +
    1426
    +
    1427 ! Initialization
    +
    1428 m = size(u, 1)
    +
    1429 n = size(r, 2)
    +
    1430 k = min(m, n)
    +
    1431 full = size(q, 2) == m
    +
    1432 lwork = 2 * k
    +
    1433 if (present(err)) then
    +
    1434 errmgr => err
    +
    1435 else
    +
    1436 errmgr => deferr
    +
    1437 end if
    +
    1438
    +
    1439 ! Input Check
    +
    1440 flag = 0
    +
    1441 if (m < n) then
    +
    1442 flag = 1
    +
    1443 else if (.not.full .and. size(q, 2) /= k) then
    +
    1444 flag = 1
    +
    1445 else if (size(r, 1) /= m) then
    +
    1446 flag = 2
    +
    1447 else if (size(u) /= m) then
    +
    1448 flag = 3
    +
    1449 else if (size(v) /= n) then
    +
    1450 flag = 4
    +
    1451 end if
    +
    1452 if (flag /= 0) then
    +
    1453 ! ERROR: One of the input arrays is not sized correctly
    +
    1454 write(errmsg, 100) "Input number ", flag, &
    +
    1455 " is not sized correctly."
    +
    1456 call errmgr%report_error("qr_rank1_update", trim(errmsg), &
    +
    1457 la_array_size_error)
    +
    1458 return
    +
    1459 end if
    +
    1460
    +
    1461 ! Local Memory Allocation
    +
    1462 if (present(work)) then
    +
    1463 if (size(work) < lwork) then
    +
    1464 ! ERROR: WORK not sized correctly
    +
    1465 call errmgr%report_error("qr_rank1_update", &
    +
    1466 "Incorrectly sized input array WORK, argument 5.", &
    +
    1467 la_array_size_error)
    +
    1468 return
    +
    1469 end if
    +
    1470 wptr => work(1:lwork)
    1471 else
    -
    1472 errmgr => deferr
    -
    1473 end if
    -
    1474
    -
    1475 ! Input Check
    -
    1476 flag = 0
    -
    1477 if (m < n) then
    -
    1478 flag = 1
    -
    1479 else if (.not.full .and. size(q, 2) /= k) then
    -
    1480 flag = 1
    -
    1481 else if (size(r, 1) /= m) then
    -
    1482 flag = 2
    -
    1483 else if (size(u) /= m) then
    -
    1484 flag = 3
    -
    1485 else if (size(v) /= n) then
    -
    1486 flag = 4
    -
    1487 end if
    -
    1488 if (flag /= 0) then
    -
    1489 ! ERROR: One of the input arrays is not sized correctly
    -
    1490 write(errmsg, '(AI0A)') "Input number ", flag, &
    -
    1491 " is not sized correctly."
    -
    1492 call errmgr%report_error("qr_rank1_update_cmplx", trim(errmsg), &
    -
    1493 la_array_size_error)
    -
    1494 return
    -
    1495 end if
    -
    1496
    -
    1497 ! Local Memory Allocation
    -
    1498 if (present(work)) then
    -
    1499 if (size(work) < lwork) then
    -
    1500 ! ERROR: WORK not sized correctly
    -
    1501 call errmgr%report_error("qr_rank1_update_cmplx", &
    -
    1502 "Incorrectly sized input array WORK, argument 5.", &
    -
    1503 la_array_size_error)
    -
    1504 return
    -
    1505 end if
    -
    1506 wptr => work(1:lwork)
    -
    1507 else
    -
    1508 allocate(wrk(lwork), stat = istat)
    -
    1509 if (istat /= 0) then
    -
    1510 ! ERROR: Out of memory
    -
    1511 call errmgr%report_error("qr_rank1_update_cmplx", &
    -
    1512 "Insufficient memory available.", &
    -
    1513 la_out_of_memory_error)
    -
    1514 return
    -
    1515 end if
    -
    1516 wptr => wrk
    -
    1517 end if
    -
    1518
    -
    1519 if (present(rwork)) then
    -
    1520 if (size(rwork) < lrwork) then
    -
    1521 ! ERROR: WORK not sized correctly
    -
    1522 call errmgr%report_error("qr_rank1_update_cmplx", &
    -
    1523 "Incorrectly sized input array RWORK, argument 6.", &
    -
    1524 la_array_size_error)
    -
    1525 return
    -
    1526 end if
    -
    1527 wptr => work(1:lrwork)
    -
    1528 else
    -
    1529 allocate(rwrk(lrwork), stat = istat)
    -
    1530 if (istat /= 0) then
    -
    1531 ! ERROR: Out of memory
    -
    1532 call errmgr%report_error("qr_rank1_update_cmplx", &
    -
    1533 "Insufficient memory available.", &
    -
    1534 la_out_of_memory_error)
    -
    1535 return
    -
    1536 end if
    -
    1537 rwptr => rwrk
    +
    1472 allocate(wrk(lwork), stat = istat)
    +
    1473 if (istat /= 0) then
    +
    1474 ! ERROR: Out of memory
    +
    1475 call errmgr%report_error("qr_rank1_update", &
    +
    1476 "Insufficient memory available.", &
    +
    1477 la_out_of_memory_error)
    +
    1478 return
    +
    1479 end if
    +
    1480 wptr => wrk
    +
    1481 end if
    +
    1482
    +
    1483 ! Process
    +
    1484 call dqr1up(m, n, k, q, m, r, m, u, v, wptr)
    +
    1485
    +
    1486 ! End
    +
    1487 if (allocated(wrk)) deallocate(wrk)
    +
    1488
    +
    1489 ! Formatting
    +
    1490100 format(a, i0, a)
    +
    1491 end subroutine
    +
    1492
    +
    1493! ------------------------------------------------------------------------------
    +
    1494 module subroutine qr_rank1_update_cmplx(q, r, u, v, work, rwork, err)
    +
    1495 ! Arguments
    +
    1496 complex(real64), intent(inout), dimension(:,:) :: q, r
    +
    1497 complex(real64), intent(inout), dimension(:) :: u, v
    +
    1498 complex(real64), intent(out), target, optional, dimension(:) :: work
    +
    1499 real(real64), intent(out), target, optional, dimension(:) :: rwork
    +
    1500 class(errors), intent(inout), optional, target :: err
    +
    1501
    +
    1502 ! Local Variables
    +
    1503 logical :: full
    +
    1504 integer(int32) :: m, n, k, lwork, istat, flag, lrwork
    +
    1505 complex(real64), pointer, dimension(:) :: wptr
    +
    1506 complex(real64), allocatable, target, dimension(:) :: wrk
    +
    1507 real(real64), pointer, dimension(:) :: rwptr
    +
    1508 real(real64), allocatable, target, dimension(:) :: rwrk
    +
    1509 class(errors), pointer :: errmgr
    +
    1510 type(errors), target :: deferr
    +
    1511 character(len = 128) :: errmsg
    +
    1512
    +
    1513 ! Initialization
    +
    1514 m = size(u, 1)
    +
    1515 n = size(r, 2)
    +
    1516 k = min(m, n)
    +
    1517 full = size(q, 2) == m
    +
    1518 lwork = k
    +
    1519 lrwork = k
    +
    1520 if (present(err)) then
    +
    1521 errmgr => err
    +
    1522 else
    +
    1523 errmgr => deferr
    +
    1524 end if
    +
    1525
    +
    1526 ! Input Check
    +
    1527 flag = 0
    +
    1528 if (m < n) then
    +
    1529 flag = 1
    +
    1530 else if (.not.full .and. size(q, 2) /= k) then
    +
    1531 flag = 1
    +
    1532 else if (size(r, 1) /= m) then
    +
    1533 flag = 2
    +
    1534 else if (size(u) /= m) then
    +
    1535 flag = 3
    +
    1536 else if (size(v) /= n) then
    +
    1537 flag = 4
    1538 end if
    -
    1539
    -
    1540 ! Process
    -
    1541 call zqr1up(m, n, k, q, m, r, m, u, v, wptr, rwptr)
    -
    1542
    -
    1543 ! End
    -
    1544 if (allocated(wrk)) deallocate(wrk)
    -
    1545 end subroutine
    -
    1546
    -
    1547! ******************************************************************************
    -
    1548! CHOLESKY FACTORIZATION
    -
    1549! ------------------------------------------------------------------------------
    -
    1550 module subroutine cholesky_factor_dbl(a, upper, err)
    -
    1551 ! Arguments
    -
    1552 real(real64), intent(inout), dimension(:,:) :: a
    -
    1553 logical, intent(in), optional :: upper
    -
    1554 class(errors), intent(inout), optional, target :: err
    -
    1555
    -
    1556 ! Parameters
    -
    1557 real(real64), parameter :: zero = 0.0d0
    -
    1558
    -
    1559 ! Local Variables
    -
    1560 character :: uplo
    -
    1561 integer(int32) :: i, n, flag
    -
    1562 class(errors), pointer :: errmgr
    -
    1563 type(errors), target :: deferr
    -
    1564 character(len = 128) :: errmsg
    -
    1565
    -
    1566 ! Initialization
    -
    1567 n = size(a, 1)
    -
    1568 if (present(upper)) then
    -
    1569 if (upper) then
    -
    1570 uplo = 'U'
    -
    1571 else
    -
    1572 uplo = 'L'
    -
    1573 end if
    -
    1574 else
    -
    1575 uplo = 'U'
    -
    1576 end if
    -
    1577 if (present(err)) then
    -
    1578 errmgr => err
    +
    1539 if (flag /= 0) then
    +
    1540 ! ERROR: One of the input arrays is not sized correctly
    +
    1541 write(errmsg, 100) "Input number ", flag, &
    +
    1542 " is not sized correctly."
    +
    1543 call errmgr%report_error("qr_rank1_update_cmplx", trim(errmsg), &
    +
    1544 la_array_size_error)
    +
    1545 return
    +
    1546 end if
    +
    1547
    +
    1548 ! Local Memory Allocation
    +
    1549 if (present(work)) then
    +
    1550 if (size(work) < lwork) then
    +
    1551 ! ERROR: WORK not sized correctly
    +
    1552 call errmgr%report_error("qr_rank1_update_cmplx", &
    +
    1553 "Incorrectly sized input array WORK, argument 5.", &
    +
    1554 la_array_size_error)
    +
    1555 return
    +
    1556 end if
    +
    1557 wptr => work(1:lwork)
    +
    1558 else
    +
    1559 allocate(wrk(lwork), stat = istat)
    +
    1560 if (istat /= 0) then
    +
    1561 ! ERROR: Out of memory
    +
    1562 call errmgr%report_error("qr_rank1_update_cmplx", &
    +
    1563 "Insufficient memory available.", &
    +
    1564 la_out_of_memory_error)
    +
    1565 return
    +
    1566 end if
    +
    1567 wptr => wrk
    +
    1568 end if
    +
    1569
    +
    1570 if (present(rwork)) then
    +
    1571 if (size(rwork) < lrwork) then
    +
    1572 ! ERROR: WORK not sized correctly
    +
    1573 call errmgr%report_error("qr_rank1_update_cmplx", &
    +
    1574 "Incorrectly sized input array RWORK, argument 6.", &
    +
    1575 la_array_size_error)
    +
    1576 return
    +
    1577 end if
    +
    1578 wptr => work(1:lrwork)
    1579 else
    -
    1580 errmgr => deferr
    -
    1581 end if
    -
    1582
    -
    1583 ! Input Check
    -
    1584 if (size(a, 2) /= n) then
    -
    1585 ! ERROR: A must be square
    -
    1586 call errmgr%report_error("cholesky_factor", &
    -
    1587 "The input matrix must be square.", la_array_size_error)
    -
    1588 return
    +
    1580 allocate(rwrk(lrwork), stat = istat)
    +
    1581 if (istat /= 0) then
    +
    1582 ! ERROR: Out of memory
    +
    1583 call errmgr%report_error("qr_rank1_update_cmplx", &
    +
    1584 "Insufficient memory available.", &
    +
    1585 la_out_of_memory_error)
    +
    1586 return
    +
    1587 end if
    +
    1588 rwptr => rwrk
    1589 end if
    1590
    1591 ! Process
    -
    1592 call dpotrf(uplo, n, a, n, flag)
    -
    1593 if (flag > 0) then
    -
    1594 ! ERROR: Matrix is not positive definite
    -
    1595 write(errmsg, '(AI0A)') "The leading minor of order ", flag, &
    -
    1596 " is not positive definite."
    -
    1597 call errmgr%report_error("cholesky_factor", trim(errmsg), &
    -
    1598 la_matrix_format_error)
    -
    1599 end if
    +
    1592 call zqr1up(m, n, k, q, m, r, m, u, v, wptr, rwptr)
    +
    1593
    +
    1594 ! End
    +
    1595 if (allocated(wrk)) deallocate(wrk)
    +
    1596
    +
    1597 ! Formatting
    +
    1598100 format(a, i0, a)
    +
    1599 end subroutine
    1600
    -
    1601 ! Zero out the non-used upper or lower diagonal
    -
    1602 if (uplo == 'U') then
    -
    1603 ! Zero out the lower
    -
    1604 do i = 1, n - 1
    -
    1605 a(i+1:n,i) = zero
    -
    1606 end do
    -
    1607 else
    -
    1608 ! Zero out the upper
    -
    1609 do i = 2, n
    -
    1610 a(1:i-1,i) = zero
    -
    1611 end do
    -
    1612 end if
    -
    1613 end subroutine
    -
    1614
    -
    1615! ------------------------------------------------------------------------------
    -
    1616 module subroutine cholesky_factor_cmplx(a, upper, err)
    -
    1617 ! Arguments
    -
    1618 complex(real64), intent(inout), dimension(:,:) :: a
    -
    1619 logical, intent(in), optional :: upper
    -
    1620 class(errors), intent(inout), optional, target :: err
    -
    1621
    -
    1622 ! Parameters
    -
    1623 complex(real64), parameter :: zero = (0.0d0, 0.0d0)
    -
    1624
    -
    1625 ! Local Variables
    -
    1626 character :: uplo
    -
    1627 integer(int32) :: i, n, flag
    -
    1628 class(errors), pointer :: errmgr
    -
    1629 type(errors), target :: deferr
    -
    1630 character(len = 128) :: errmsg
    -
    1631
    -
    1632 ! Initialization
    -
    1633 n = size(a, 1)
    -
    1634 if (present(upper)) then
    -
    1635 if (upper) then
    -
    1636 uplo = 'U'
    -
    1637 else
    -
    1638 uplo = 'L'
    -
    1639 end if
    -
    1640 else
    -
    1641 uplo = 'U'
    -
    1642 end if
    -
    1643 if (present(err)) then
    -
    1644 errmgr => err
    -
    1645 else
    -
    1646 errmgr => deferr
    -
    1647 end if
    -
    1648
    -
    1649 ! Input Check
    -
    1650 if (size(a, 2) /= n) then
    -
    1651 ! ERROR: A must be square
    -
    1652 call errmgr%report_error("cholesky_factor_cmplx", &
    -
    1653 "The input matrix must be square.", la_array_size_error)
    -
    1654 return
    -
    1655 end if
    -
    1656
    -
    1657 ! Process
    -
    1658 call zpotrf(uplo, n, a, n, flag)
    -
    1659 if (flag > 0) then
    -
    1660 ! ERROR: Matrix is not positive definite
    -
    1661 write(errmsg, '(AI0A)') "The leading minor of order ", flag, &
    -
    1662 " is not positive definite."
    -
    1663 call errmgr%report_error("cholesky_factor_cmplx", trim(errmsg), &
    -
    1664 la_matrix_format_error)
    -
    1665 end if
    -
    1666
    -
    1667 ! Zero out the non-used upper or lower diagonal
    -
    1668 if (uplo == 'U') then
    -
    1669 ! Zero out the lower
    -
    1670 do i = 1, n - 1
    -
    1671 a(i+1:n,i) = zero
    -
    1672 end do
    -
    1673 else
    -
    1674 ! Zero out the upper
    -
    1675 do i = 2, n
    -
    1676 a(1:i-1,i) = zero
    -
    1677 end do
    -
    1678 end if
    -
    1679 end subroutine
    -
    1680
    -
    1681! ------------------------------------------------------------------------------
    -
    1682 module subroutine cholesky_rank1_update_dbl(r, u, work, err)
    -
    1683 ! Arguments
    -
    1684 real(real64), intent(inout), dimension(:,:) :: r
    -
    1685 real(real64), intent(inout), dimension(:) :: u
    -
    1686 real(real64), intent(out), target, optional, dimension(:) :: work
    -
    1687 class(errors), intent(inout), optional, target :: err
    +
    1601! ******************************************************************************
    +
    1602! CHOLESKY FACTORIZATION
    +
    1603! ------------------------------------------------------------------------------
    +
    1604 module subroutine cholesky_factor_dbl(a, upper, err)
    +
    1605 ! Arguments
    +
    1606 real(real64), intent(inout), dimension(:,:) :: a
    +
    1607 logical, intent(in), optional :: upper
    +
    1608 class(errors), intent(inout), optional, target :: err
    +
    1609
    +
    1610 ! Parameters
    +
    1611 real(real64), parameter :: zero = 0.0d0
    +
    1612
    +
    1613 ! Local Variables
    +
    1614 character :: uplo
    +
    1615 integer(int32) :: i, n, flag
    +
    1616 class(errors), pointer :: errmgr
    +
    1617 type(errors), target :: deferr
    +
    1618 character(len = 128) :: errmsg
    +
    1619
    +
    1620 ! Initialization
    +
    1621 n = size(a, 1)
    +
    1622 if (present(upper)) then
    +
    1623 if (upper) then
    +
    1624 uplo = 'U'
    +
    1625 else
    +
    1626 uplo = 'L'
    +
    1627 end if
    +
    1628 else
    +
    1629 uplo = 'U'
    +
    1630 end if
    +
    1631 if (present(err)) then
    +
    1632 errmgr => err
    +
    1633 else
    +
    1634 errmgr => deferr
    +
    1635 end if
    +
    1636
    +
    1637 ! Input Check
    +
    1638 if (size(a, 2) /= n) then
    +
    1639 ! ERROR: A must be square
    +
    1640 call errmgr%report_error("cholesky_factor", &
    +
    1641 "The input matrix must be square.", la_array_size_error)
    +
    1642 return
    +
    1643 end if
    +
    1644
    +
    1645 ! Process
    +
    1646 call dpotrf(uplo, n, a, n, flag)
    +
    1647 if (flag > 0) then
    +
    1648 ! ERROR: Matrix is not positive definite
    +
    1649 write(errmsg, 100) "The leading minor of order ", flag, &
    +
    1650 " is not positive definite."
    +
    1651 call errmgr%report_error("cholesky_factor", trim(errmsg), &
    +
    1652 la_matrix_format_error)
    +
    1653 end if
    +
    1654
    +
    1655 ! Zero out the non-used upper or lower diagonal
    +
    1656 if (uplo == 'U') then
    +
    1657 ! Zero out the lower
    +
    1658 do i = 1, n - 1
    +
    1659 a(i+1:n,i) = zero
    +
    1660 end do
    +
    1661 else
    +
    1662 ! Zero out the upper
    +
    1663 do i = 2, n
    +
    1664 a(1:i-1,i) = zero
    +
    1665 end do
    +
    1666 end if
    +
    1667
    +
    1668 ! Formatting
    +
    1669100 format(a, i0, a)
    +
    1670 end subroutine
    +
    1671
    +
    1672! ------------------------------------------------------------------------------
    +
    1673 module subroutine cholesky_factor_cmplx(a, upper, err)
    +
    1674 ! Arguments
    +
    1675 complex(real64), intent(inout), dimension(:,:) :: a
    +
    1676 logical, intent(in), optional :: upper
    +
    1677 class(errors), intent(inout), optional, target :: err
    +
    1678
    +
    1679 ! Parameters
    +
    1680 complex(real64), parameter :: zero = (0.0d0, 0.0d0)
    +
    1681
    +
    1682 ! Local Variables
    +
    1683 character :: uplo
    +
    1684 integer(int32) :: i, n, flag
    +
    1685 class(errors), pointer :: errmgr
    +
    1686 type(errors), target :: deferr
    +
    1687 character(len = 128) :: errmsg
    1688
    -
    1689 ! Local Variables
    -
    1690 integer(int32) :: n, lwork, istat, flag
    -
    1691 real(real64), pointer, dimension(:) :: wptr
    -
    1692 real(real64), allocatable, target, dimension(:) :: wrk
    -
    1693 class(errors), pointer :: errmgr
    -
    1694 type(errors), target :: deferr
    -
    1695 character(len = 128) :: errmsg
    -
    1696
    -
    1697 ! Initialization
    -
    1698 n = size(r, 1)
    -
    1699 lwork = n
    +
    1689 ! Initialization
    +
    1690 n = size(a, 1)
    +
    1691 if (present(upper)) then
    +
    1692 if (upper) then
    +
    1693 uplo = 'U'
    +
    1694 else
    +
    1695 uplo = 'L'
    +
    1696 end if
    +
    1697 else
    +
    1698 uplo = 'U'
    +
    1699 end if
    1700 if (present(err)) then
    1701 errmgr => err
    1702 else
    @@ -1802,1065 +1802,1163 @@
    1704 end if
    1705
    1706 ! Input Check
    -
    1707 flag = 0
    -
    1708 if (size(r, 2) /= n) then
    -
    1709 flag = 1
    -
    1710 else if (size(u) /= n) then
    -
    1711 flag = 2
    +
    1707 if (size(a, 2) /= n) then
    +
    1708 ! ERROR: A must be square
    +
    1709 call errmgr%report_error("cholesky_factor_cmplx", &
    +
    1710 "The input matrix must be square.", la_array_size_error)
    +
    1711 return
    1712 end if
    -
    1713 if (flag /= 0) then
    -
    1714 write(errmsg, '(AI0A)') "Input number ", flag, &
    -
    1715 " is not sized correctly."
    -
    1716 call errmgr%report_error("cholesky_rank1_update", trim(errmsg), &
    -
    1717 la_array_size_error)
    -
    1718 return
    -
    1719 end if
    -
    1720
    -
    1721 ! Local Memory Allocation
    -
    1722 if (present(work)) then
    -
    1723 if (size(work) < lwork) then
    -
    1724 ! ERROR: Workspace array is not sized correctly
    -
    1725 call errmgr%report_error("cholesky_rank1_update", &
    -
    1726 "The workspace array is too short.", &
    -
    1727 la_array_size_error)
    -
    1728 return
    -
    1729 end if
    -
    1730 wptr => work(1:lwork)
    -
    1731 else
    -
    1732 allocate(wrk(lwork), stat = istat)
    -
    1733 if (istat /= 0) then
    -
    1734 call errmgr%report_error("cholesky_rank1_update", &
    -
    1735 "Insufficient memory available.", &
    -
    1736 la_out_of_memory_error)
    -
    1737 return
    -
    1738 end if
    -
    1739 wptr => wrk
    -
    1740 end if
    -
    1741
    -
    1742 ! Process
    -
    1743 call dch1up(n, r, n, u, wptr)
    -
    1744 end subroutine
    -
    1745
    -
    1746! ------------------------------------------------------------------------------
    -
    1747 module subroutine cholesky_rank1_update_cmplx(r, u, work, err)
    -
    1748 ! Arguments
    -
    1749 complex(real64), intent(inout), dimension(:,:) :: r
    -
    1750 complex(real64), intent(inout), dimension(:) :: u
    -
    1751 real(real64), intent(out), target, optional, dimension(:) :: work
    -
    1752 class(errors), intent(inout), optional, target :: err
    -
    1753
    -
    1754 ! Local Variables
    -
    1755 integer(int32) :: n, lwork, istat, flag
    -
    1756 real(real64), pointer, dimension(:) :: wptr
    -
    1757 real(real64), allocatable, target, dimension(:) :: wrk
    -
    1758 class(errors), pointer :: errmgr
    -
    1759 type(errors), target :: deferr
    -
    1760 character(len = 128) :: errmsg
    -
    1761
    -
    1762 ! Initialization
    -
    1763 n = size(r, 1)
    -
    1764 lwork = n
    -
    1765 if (present(err)) then
    -
    1766 errmgr => err
    -
    1767 else
    -
    1768 errmgr => deferr
    -
    1769 end if
    -
    1770
    -
    1771 ! Input Check
    -
    1772 flag = 0
    -
    1773 if (size(r, 2) /= n) then
    -
    1774 flag = 1
    -
    1775 else if (size(u) /= n) then
    -
    1776 flag = 2
    -
    1777 end if
    -
    1778 if (flag /= 0) then
    -
    1779 write(errmsg, '(AI0A)') "Input number ", flag, &
    -
    1780 " is not sized correctly."
    -
    1781 call errmgr%report_error("cholesky_rank1_update_cmplx", &
    -
    1782 trim(errmsg), &
    -
    1783 la_array_size_error)
    -
    1784 return
    -
    1785 end if
    -
    1786
    -
    1787 ! Local Memory Allocation
    -
    1788 if (present(work)) then
    -
    1789 if (size(work) < lwork) then
    -
    1790 ! ERROR: Workspace array is not sized correctly
    -
    1791 call errmgr%report_error("cholesky_rank1_update_cmplx", &
    -
    1792 "The workspace array is too short.", &
    -
    1793 la_array_size_error)
    -
    1794 return
    -
    1795 end if
    -
    1796 wptr => work(1:lwork)
    -
    1797 else
    -
    1798 allocate(wrk(lwork), stat = istat)
    -
    1799 if (istat /= 0) then
    -
    1800 call errmgr%report_error("cholesky_rank1_update", &
    -
    1801 "Insufficient memory available.", &
    -
    1802 la_out_of_memory_error)
    -
    1803 return
    -
    1804 end if
    -
    1805 wptr => wrk
    -
    1806 end if
    -
    1807
    -
    1808 ! Process
    -
    1809 call zch1up(n, r, n, u, wptr)
    -
    1810 end subroutine
    -
    1811
    -
    1812! ------------------------------------------------------------------------------
    -
    1813 module subroutine cholesky_rank1_downdate_dbl(r, u, work, err)
    -
    1814 ! Arguments
    -
    1815 real(real64), intent(inout), dimension(:,:) :: r
    -
    1816 real(real64), intent(inout), dimension(:) :: u
    -
    1817 real(real64), intent(out), target, optional, dimension(:) :: work
    -
    1818 class(errors), intent(inout), optional, target :: err
    -
    1819
    -
    1820 ! Local Variables
    -
    1821 integer(int32) :: n, lwork, istat, flag
    -
    1822 real(real64), pointer, dimension(:) :: wptr
    -
    1823 real(real64), allocatable, target, dimension(:) :: wrk
    -
    1824 class(errors), pointer :: errmgr
    -
    1825 type(errors), target :: deferr
    -
    1826 character(len = 128) :: errmsg
    -
    1827
    -
    1828 ! Initialization
    -
    1829 n = size(r, 1)
    -
    1830 lwork = n
    -
    1831 if (present(err)) then
    -
    1832 errmgr => err
    -
    1833 else
    -
    1834 errmgr => deferr
    -
    1835 end if
    -
    1836
    -
    1837 ! Input Check
    -
    1838 flag = 0
    -
    1839 if (size(r, 2) /= n) then
    -
    1840 flag = 1
    -
    1841 else if (size(u) /= n) then
    -
    1842 flag = 2
    -
    1843 end if
    -
    1844 if (flag /= 0) then
    -
    1845 write(errmsg, '(AI0A)') "Input number ", flag, &
    -
    1846 " is not sized correctly."
    -
    1847 call errmgr%report_error("cholesky_rank1_downdate", trim(errmsg), &
    -
    1848 la_array_size_error)
    -
    1849 return
    -
    1850 end if
    -
    1851
    -
    1852 ! Local Memory Allocation
    -
    1853 if (present(work)) then
    -
    1854 if (size(work) < lwork) then
    -
    1855 ! ERROR: Workspace array is not sized correctly
    -
    1856 call errmgr%report_error("cholesky_rank1_downdate", &
    -
    1857 "The workspace array is too short.", &
    -
    1858 la_array_size_error)
    -
    1859 return
    -
    1860 end if
    -
    1861 wptr => work(1:lwork)
    -
    1862 else
    -
    1863 allocate(wrk(lwork), stat = istat)
    -
    1864 if (istat /= 0) then
    -
    1865 call errmgr%report_error("cholesky_rank1_downdate", &
    -
    1866 "Insufficient memory available.", &
    -
    1867 la_out_of_memory_error)
    -
    1868 return
    -
    1869 end if
    -
    1870 wptr => wrk
    -
    1871 end if
    -
    1872
    -
    1873 ! Process
    -
    1874 call dch1dn(n, r, n, u, wptr, flag)
    -
    1875 if (flag == 1) then
    -
    1876 ! ERROR: The matrix is not positive definite
    -
    1877 call errmgr%report_error("cholesky_rank1_downdate", &
    -
    1878 "The downdated matrix is not positive definite.", &
    -
    1879 la_matrix_format_error)
    -
    1880 else if (flag == 2) then
    -
    1881 ! ERROR: The matrix is singular
    -
    1882 call errmgr%report_error("cholesky_rank1_downdate", &
    -
    1883 "The input matrix is singular.", la_singular_matrix_error)
    -
    1884 end if
    -
    1885 end subroutine
    -
    1886
    -
    1887! ------------------------------------------------------------------------------
    -
    1888 module subroutine cholesky_rank1_downdate_cmplx(r, u, work, err)
    -
    1889 ! Arguments
    -
    1890 complex(real64), intent(inout), dimension(:,:) :: r
    -
    1891 complex(real64), intent(inout), dimension(:) :: u
    -
    1892 real(real64), intent(out), target, optional, dimension(:) :: work
    -
    1893 class(errors), intent(inout), optional, target :: err
    -
    1894
    -
    1895 ! Local Variables
    -
    1896 integer(int32) :: n, lwork, istat, flag
    -
    1897 real(real64), pointer, dimension(:) :: wptr
    -
    1898 real(real64), allocatable, target, dimension(:) :: wrk
    -
    1899 class(errors), pointer :: errmgr
    -
    1900 type(errors), target :: deferr
    -
    1901 character(len = 128) :: errmsg
    +
    1713
    +
    1714 ! Process
    +
    1715 call zpotrf(uplo, n, a, n, flag)
    +
    1716 if (flag > 0) then
    +
    1717 ! ERROR: Matrix is not positive definite
    +
    1718 write(errmsg, 100) "The leading minor of order ", flag, &
    +
    1719 " is not positive definite."
    +
    1720 call errmgr%report_error("cholesky_factor_cmplx", trim(errmsg), &
    +
    1721 la_matrix_format_error)
    +
    1722 end if
    +
    1723
    +
    1724 ! Zero out the non-used upper or lower diagonal
    +
    1725 if (uplo == 'U') then
    +
    1726 ! Zero out the lower
    +
    1727 do i = 1, n - 1
    +
    1728 a(i+1:n,i) = zero
    +
    1729 end do
    +
    1730 else
    +
    1731 ! Zero out the upper
    +
    1732 do i = 2, n
    +
    1733 a(1:i-1,i) = zero
    +
    1734 end do
    +
    1735 end if
    +
    1736
    +
    1737 ! Formatting
    +
    1738100 format(a, i0, a)
    +
    1739 end subroutine
    +
    1740
    +
    1741! ------------------------------------------------------------------------------
    +
    1742 module subroutine cholesky_rank1_update_dbl(r, u, work, err)
    +
    1743 ! Arguments
    +
    1744 real(real64), intent(inout), dimension(:,:) :: r
    +
    1745 real(real64), intent(inout), dimension(:) :: u
    +
    1746 real(real64), intent(out), target, optional, dimension(:) :: work
    +
    1747 class(errors), intent(inout), optional, target :: err
    +
    1748
    +
    1749 ! Local Variables
    +
    1750 integer(int32) :: n, lwork, istat, flag
    +
    1751 real(real64), pointer, dimension(:) :: wptr
    +
    1752 real(real64), allocatable, target, dimension(:) :: wrk
    +
    1753 class(errors), pointer :: errmgr
    +
    1754 type(errors), target :: deferr
    +
    1755 character(len = 128) :: errmsg
    +
    1756
    +
    1757 ! Initialization
    +
    1758 n = size(r, 1)
    +
    1759 lwork = n
    +
    1760 if (present(err)) then
    +
    1761 errmgr => err
    +
    1762 else
    +
    1763 errmgr => deferr
    +
    1764 end if
    +
    1765
    +
    1766 ! Input Check
    +
    1767 flag = 0
    +
    1768 if (size(r, 2) /= n) then
    +
    1769 flag = 1
    +
    1770 else if (size(u) /= n) then
    +
    1771 flag = 2
    +
    1772 end if
    +
    1773 if (flag /= 0) then
    +
    1774 write(errmsg, 100) "Input number ", flag, &
    +
    1775 " is not sized correctly."
    +
    1776 call errmgr%report_error("cholesky_rank1_update", trim(errmsg), &
    +
    1777 la_array_size_error)
    +
    1778 return
    +
    1779 end if
    +
    1780
    +
    1781 ! Local Memory Allocation
    +
    1782 if (present(work)) then
    +
    1783 if (size(work) < lwork) then
    +
    1784 ! ERROR: Workspace array is not sized correctly
    +
    1785 call errmgr%report_error("cholesky_rank1_update", &
    +
    1786 "The workspace array is too short.", &
    +
    1787 la_array_size_error)
    +
    1788 return
    +
    1789 end if
    +
    1790 wptr => work(1:lwork)
    +
    1791 else
    +
    1792 allocate(wrk(lwork), stat = istat)
    +
    1793 if (istat /= 0) then
    +
    1794 call errmgr%report_error("cholesky_rank1_update", &
    +
    1795 "Insufficient memory available.", &
    +
    1796 la_out_of_memory_error)
    +
    1797 return
    +
    1798 end if
    +
    1799 wptr => wrk
    +
    1800 end if
    +
    1801
    +
    1802 ! Process
    +
    1803 call dch1up(n, r, n, u, wptr)
    +
    1804
    +
    1805 ! Formatting
    +
    1806100 format(a, i0, a)
    +
    1807 end subroutine
    +
    1808
    +
    1809! ------------------------------------------------------------------------------
    +
    1810 module subroutine cholesky_rank1_update_cmplx(r, u, work, err)
    +
    1811 ! Arguments
    +
    1812 complex(real64), intent(inout), dimension(:,:) :: r
    +
    1813 complex(real64), intent(inout), dimension(:) :: u
    +
    1814 real(real64), intent(out), target, optional, dimension(:) :: work
    +
    1815 class(errors), intent(inout), optional, target :: err
    +
    1816
    +
    1817 ! Local Variables
    +
    1818 integer(int32) :: n, lwork, istat, flag
    +
    1819 real(real64), pointer, dimension(:) :: wptr
    +
    1820 real(real64), allocatable, target, dimension(:) :: wrk
    +
    1821 class(errors), pointer :: errmgr
    +
    1822 type(errors), target :: deferr
    +
    1823 character(len = 128) :: errmsg
    +
    1824
    +
    1825 ! Initialization
    +
    1826 n = size(r, 1)
    +
    1827 lwork = n
    +
    1828 if (present(err)) then
    +
    1829 errmgr => err
    +
    1830 else
    +
    1831 errmgr => deferr
    +
    1832 end if
    +
    1833
    +
    1834 ! Input Check
    +
    1835 flag = 0
    +
    1836 if (size(r, 2) /= n) then
    +
    1837 flag = 1
    +
    1838 else if (size(u) /= n) then
    +
    1839 flag = 2
    +
    1840 end if
    +
    1841 if (flag /= 0) then
    +
    1842 write(errmsg, 100) "Input number ", flag, &
    +
    1843 " is not sized correctly."
    +
    1844 call errmgr%report_error("cholesky_rank1_update_cmplx", &
    +
    1845 trim(errmsg), &
    +
    1846 la_array_size_error)
    +
    1847 return
    +
    1848 end if
    +
    1849
    +
    1850 ! Local Memory Allocation
    +
    1851 if (present(work)) then
    +
    1852 if (size(work) < lwork) then
    +
    1853 ! ERROR: Workspace array is not sized correctly
    +
    1854 call errmgr%report_error("cholesky_rank1_update_cmplx", &
    +
    1855 "The workspace array is too short.", &
    +
    1856 la_array_size_error)
    +
    1857 return
    +
    1858 end if
    +
    1859 wptr => work(1:lwork)
    +
    1860 else
    +
    1861 allocate(wrk(lwork), stat = istat)
    +
    1862 if (istat /= 0) then
    +
    1863 call errmgr%report_error("cholesky_rank1_update", &
    +
    1864 "Insufficient memory available.", &
    +
    1865 la_out_of_memory_error)
    +
    1866 return
    +
    1867 end if
    +
    1868 wptr => wrk
    +
    1869 end if
    +
    1870
    +
    1871 ! Process
    +
    1872 call zch1up(n, r, n, u, wptr)
    +
    1873
    +
    1874 ! Formatting
    +
    1875100 format(a, i0, a)
    +
    1876 end subroutine
    +
    1877
    +
    1878! ------------------------------------------------------------------------------
    +
    1879 module subroutine cholesky_rank1_downdate_dbl(r, u, work, err)
    +
    1880 ! Arguments
    +
    1881 real(real64), intent(inout), dimension(:,:) :: r
    +
    1882 real(real64), intent(inout), dimension(:) :: u
    +
    1883 real(real64), intent(out), target, optional, dimension(:) :: work
    +
    1884 class(errors), intent(inout), optional, target :: err
    +
    1885
    +
    1886 ! Local Variables
    +
    1887 integer(int32) :: n, lwork, istat, flag
    +
    1888 real(real64), pointer, dimension(:) :: wptr
    +
    1889 real(real64), allocatable, target, dimension(:) :: wrk
    +
    1890 class(errors), pointer :: errmgr
    +
    1891 type(errors), target :: deferr
    +
    1892 character(len = 128) :: errmsg
    +
    1893
    +
    1894 ! Initialization
    +
    1895 n = size(r, 1)
    +
    1896 lwork = n
    +
    1897 if (present(err)) then
    +
    1898 errmgr => err
    +
    1899 else
    +
    1900 errmgr => deferr
    +
    1901 end if
    1902
    -
    1903 ! Initialization
    -
    1904 n = size(r, 1)
    -
    1905 lwork = n
    -
    1906 if (present(err)) then
    -
    1907 errmgr => err
    -
    1908 else
    -
    1909 errmgr => deferr
    -
    1910 end if
    -
    1911
    -
    1912 ! Input Check
    -
    1913 flag = 0
    -
    1914 if (size(r, 2) /= n) then
    -
    1915 flag = 1
    -
    1916 else if (size(u) /= n) then
    -
    1917 flag = 2
    -
    1918 end if
    -
    1919 if (flag /= 0) then
    -
    1920 write(errmsg, '(AI0A)') "Input number ", flag, &
    -
    1921 " is not sized correctly."
    -
    1922 call errmgr%report_error("cholesky_rank1_downdate_cmplx", &
    -
    1923 trim(errmsg), &
    -
    1924 la_array_size_error)
    -
    1925 return
    -
    1926 end if
    -
    1927
    -
    1928 ! Local Memory Allocation
    -
    1929 if (present(work)) then
    -
    1930 if (size(work) < lwork) then
    -
    1931 ! ERROR: Workspace array is not sized correctly
    -
    1932 call errmgr%report_error("cholesky_rank1_downdate_cmplx", &
    -
    1933 "The workspace array is too short.", &
    -
    1934 la_array_size_error)
    -
    1935 return
    -
    1936 end if
    -
    1937 wptr => work(1:lwork)
    -
    1938 else
    -
    1939 allocate(wrk(lwork), stat = istat)
    -
    1940 if (istat /= 0) then
    -
    1941 call errmgr%report_error("cholesky_rank1_downdate_cmplx", &
    -
    1942 "Insufficient memory available.", &
    -
    1943 la_out_of_memory_error)
    -
    1944 return
    -
    1945 end if
    -
    1946 wptr => wrk
    -
    1947 end if
    -
    1948
    -
    1949 ! Process
    -
    1950 call zch1dn(n, r, n, u, wptr, flag)
    -
    1951 if (flag == 1) then
    -
    1952 ! ERROR: The matrix is not positive definite
    -
    1953 call errmgr%report_error("cholesky_rank1_downdate_cmplx", &
    -
    1954 "The downdated matrix is not positive definite.", &
    -
    1955 la_matrix_format_error)
    -
    1956 else if (flag == 2) then
    -
    1957 ! ERROR: The matrix is singular
    -
    1958 call errmgr%report_error("cholesky_rank1_downdate_cmplx", &
    -
    1959 "The input matrix is singular.", la_singular_matrix_error)
    -
    1960 end if
    -
    1961 end subroutine
    -
    1962
    -
    1963! ******************************************************************************
    -
    1964! RZ FACTORIZATION ROUTINES
    -
    1965! ------------------------------------------------------------------------------
    -
    1966 module subroutine rz_factor_dbl(a, tau, work, olwork, err)
    -
    1967 ! Arguments
    -
    1968 real(real64), intent(inout), dimension(:,:) :: a
    -
    1969 real(real64), intent(out), dimension(:) :: tau
    -
    1970 real(real64), intent(out), target, optional, dimension(:) :: work
    -
    1971 integer(int32), intent(out), optional :: olwork
    -
    1972 class(errors), intent(inout), optional, target :: err
    -
    1973
    -
    1974 ! Local Variables
    -
    1975 integer(int32) :: m, n, lwork, flag, istat
    -
    1976 real(real64), pointer, dimension(:) :: wptr
    -
    1977 real(real64), allocatable, target, dimension(:) :: wrk
    -
    1978 real(real64), dimension(1) :: temp
    -
    1979 class(errors), pointer :: errmgr
    -
    1980 type(errors), target :: deferr
    -
    1981 character(len = 128) :: errmsg
    -
    1982
    -
    1983 ! Initialization
    -
    1984 m = size(a, 1)
    -
    1985 n = size(a, 2)
    -
    1986 if (present(err)) then
    -
    1987 errmgr => err
    -
    1988 else
    -
    1989 errmgr => deferr
    -
    1990 end if
    -
    1991
    -
    1992 ! Input Check
    -
    1993 flag = 0
    -
    1994 if (size(tau) /= m) then
    -
    1995 flag = 3
    -
    1996 end if
    -
    1997 if (flag /= 0) then
    -
    1998 ! ERROR: One of the input arrays is not sized correctly
    -
    1999 write(errmsg, '(AI0A)') "Input number ", flag, &
    -
    2000 " is not sized correctly."
    -
    2001 call errmgr%report_error("rz_factor", trim(errmsg), &
    -
    2002 la_array_size_error)
    -
    2003 return
    -
    2004 end if
    -
    2005
    -
    2006 ! Workspace Query
    -
    2007 call dtzrzf(m, n, a, m, tau, temp, -1, flag)
    -
    2008 lwork = int(temp(1), int32)
    -
    2009 if (present(olwork)) then
    -
    2010 olwork = lwork
    -
    2011 return
    -
    2012 end if
    -
    2013
    -
    2014 ! Local Memory Allocation
    -
    2015 if (present(work)) then
    -
    2016 if (size(work) < lwork) then
    -
    2017 ! ERROR: WORK not sized correctly
    -
    2018 call errmgr%report_error("rz_factor", &
    -
    2019 "Incorrectly sized input array WORK, argument 3.", &
    -
    2020 la_array_size_error)
    -
    2021 return
    -
    2022 end if
    -
    2023 wptr => work(1:lwork)
    -
    2024 else
    -
    2025 allocate(wrk(lwork), stat = istat)
    -
    2026 if (istat /= 0) then
    -
    2027 ! ERROR: Out of memory
    -
    2028 call errmgr%report_error("rz_factor", &
    -
    2029 "Insufficient memory available.", &
    -
    2030 la_out_of_memory_error)
    -
    2031 return
    -
    2032 end if
    -
    2033 wptr => wrk
    -
    2034 end if
    -
    2035
    -
    2036 ! Call DTZRZF
    -
    2037 call dtzrzf(m, n, a, m, tau, wptr, lwork, flag)
    -
    2038 end subroutine
    -
    2039
    -
    2040! ------------------------------------------------------------------------------
    -
    2041 module subroutine rz_factor_cmplx(a, tau, work, olwork, err)
    -
    2042 ! Arguments
    -
    2043 complex(real64), intent(inout), dimension(:,:) :: a
    -
    2044 complex(real64), intent(out), dimension(:) :: tau
    -
    2045 complex(real64), intent(out), target, optional, dimension(:) :: work
    -
    2046 integer(int32), intent(out), optional :: olwork
    -
    2047 class(errors), intent(inout), optional, target :: err
    -
    2048
    -
    2049 ! Local Variables
    -
    2050 integer(int32) :: m, n, lwork, flag, istat
    -
    2051 complex(real64), pointer, dimension(:) :: wptr
    -
    2052 complex(real64), allocatable, target, dimension(:) :: wrk
    -
    2053 complex(real64), dimension(1) :: temp
    -
    2054 class(errors), pointer :: errmgr
    -
    2055 type(errors), target :: deferr
    -
    2056 character(len = 128) :: errmsg
    -
    2057
    -
    2058 ! Initialization
    -
    2059 m = size(a, 1)
    -
    2060 n = size(a, 2)
    -
    2061 if (present(err)) then
    -
    2062 errmgr => err
    -
    2063 else
    -
    2064 errmgr => deferr
    -
    2065 end if
    -
    2066
    -
    2067 ! Input Check
    -
    2068 flag = 0
    -
    2069 if (size(tau) /= m) then
    -
    2070 flag = 3
    -
    2071 end if
    -
    2072 if (flag /= 0) then
    -
    2073 ! ERROR: One of the input arrays is not sized correctly
    -
    2074 write(errmsg, '(AI0A)') "Input number ", flag, &
    -
    2075 " is not sized correctly."
    -
    2076 call errmgr%report_error("rz_factor_cmplx", trim(errmsg), &
    -
    2077 la_array_size_error)
    -
    2078 return
    -
    2079 end if
    -
    2080
    -
    2081 ! Workspace Query
    -
    2082 call ztzrzf(m, n, a, m, tau, temp, -1, flag)
    -
    2083 lwork = int(temp(1), int32)
    -
    2084 if (present(olwork)) then
    -
    2085 olwork = lwork
    -
    2086 return
    -
    2087 end if
    -
    2088
    -
    2089 ! Local Memory Allocation
    -
    2090 if (present(work)) then
    -
    2091 if (size(work) < lwork) then
    -
    2092 ! ERROR: WORK not sized correctly
    -
    2093 call errmgr%report_error("rz_factor_cmplx", &
    -
    2094 "Incorrectly sized input array WORK, argument 3.", &
    -
    2095 la_array_size_error)
    -
    2096 return
    -
    2097 end if
    -
    2098 wptr => work(1:lwork)
    -
    2099 else
    -
    2100 allocate(wrk(lwork), stat = istat)
    -
    2101 if (istat /= 0) then
    -
    2102 ! ERROR: Out of memory
    -
    2103 call errmgr%report_error("rz_factor_cmplx", &
    -
    2104 "Insufficient memory available.", &
    -
    2105 la_out_of_memory_error)
    -
    2106 return
    -
    2107 end if
    -
    2108 wptr => wrk
    -
    2109 end if
    +
    1903 ! Input Check
    +
    1904 flag = 0
    +
    1905 if (size(r, 2) /= n) then
    +
    1906 flag = 1
    +
    1907 else if (size(u) /= n) then
    +
    1908 flag = 2
    +
    1909 end if
    +
    1910 if (flag /= 0) then
    +
    1911 write(errmsg, 100) "Input number ", flag, &
    +
    1912 " is not sized correctly."
    +
    1913 call errmgr%report_error("cholesky_rank1_downdate", trim(errmsg), &
    +
    1914 la_array_size_error)
    +
    1915 return
    +
    1916 end if
    +
    1917
    +
    1918 ! Local Memory Allocation
    +
    1919 if (present(work)) then
    +
    1920 if (size(work) < lwork) then
    +
    1921 ! ERROR: Workspace array is not sized correctly
    +
    1922 call errmgr%report_error("cholesky_rank1_downdate", &
    +
    1923 "The workspace array is too short.", &
    +
    1924 la_array_size_error)
    +
    1925 return
    +
    1926 end if
    +
    1927 wptr => work(1:lwork)
    +
    1928 else
    +
    1929 allocate(wrk(lwork), stat = istat)
    +
    1930 if (istat /= 0) then
    +
    1931 call errmgr%report_error("cholesky_rank1_downdate", &
    +
    1932 "Insufficient memory available.", &
    +
    1933 la_out_of_memory_error)
    +
    1934 return
    +
    1935 end if
    +
    1936 wptr => wrk
    +
    1937 end if
    +
    1938
    +
    1939 ! Process
    +
    1940 call dch1dn(n, r, n, u, wptr, flag)
    +
    1941 if (flag == 1) then
    +
    1942 ! ERROR: The matrix is not positive definite
    +
    1943 call errmgr%report_error("cholesky_rank1_downdate", &
    +
    1944 "The downdated matrix is not positive definite.", &
    +
    1945 la_matrix_format_error)
    +
    1946 else if (flag == 2) then
    +
    1947 ! ERROR: The matrix is singular
    +
    1948 call errmgr%report_error("cholesky_rank1_downdate", &
    +
    1949 "The input matrix is singular.", la_singular_matrix_error)
    +
    1950 end if
    +
    1951
    +
    1952 ! Formatting
    +
    1953100 format(a, i0, a)
    +
    1954 end subroutine
    +
    1955
    +
    1956! ------------------------------------------------------------------------------
    +
    1957 module subroutine cholesky_rank1_downdate_cmplx(r, u, work, err)
    +
    1958 ! Arguments
    +
    1959 complex(real64), intent(inout), dimension(:,:) :: r
    +
    1960 complex(real64), intent(inout), dimension(:) :: u
    +
    1961 real(real64), intent(out), target, optional, dimension(:) :: work
    +
    1962 class(errors), intent(inout), optional, target :: err
    +
    1963
    +
    1964 ! Local Variables
    +
    1965 integer(int32) :: n, lwork, istat, flag
    +
    1966 real(real64), pointer, dimension(:) :: wptr
    +
    1967 real(real64), allocatable, target, dimension(:) :: wrk
    +
    1968 class(errors), pointer :: errmgr
    +
    1969 type(errors), target :: deferr
    +
    1970 character(len = 128) :: errmsg
    +
    1971
    +
    1972 ! Initialization
    +
    1973 n = size(r, 1)
    +
    1974 lwork = n
    +
    1975 if (present(err)) then
    +
    1976 errmgr => err
    +
    1977 else
    +
    1978 errmgr => deferr
    +
    1979 end if
    +
    1980
    +
    1981 ! Input Check
    +
    1982 flag = 0
    +
    1983 if (size(r, 2) /= n) then
    +
    1984 flag = 1
    +
    1985 else if (size(u) /= n) then
    +
    1986 flag = 2
    +
    1987 end if
    +
    1988 if (flag /= 0) then
    +
    1989 write(errmsg, 100) "Input number ", flag, &
    +
    1990 " is not sized correctly."
    +
    1991 call errmgr%report_error("cholesky_rank1_downdate_cmplx", &
    +
    1992 trim(errmsg), &
    +
    1993 la_array_size_error)
    +
    1994 return
    +
    1995 end if
    +
    1996
    +
    1997 ! Local Memory Allocation
    +
    1998 if (present(work)) then
    +
    1999 if (size(work) < lwork) then
    +
    2000 ! ERROR: Workspace array is not sized correctly
    +
    2001 call errmgr%report_error("cholesky_rank1_downdate_cmplx", &
    +
    2002 "The workspace array is too short.", &
    +
    2003 la_array_size_error)
    +
    2004 return
    +
    2005 end if
    +
    2006 wptr => work(1:lwork)
    +
    2007 else
    +
    2008 allocate(wrk(lwork), stat = istat)
    +
    2009 if (istat /= 0) then
    +
    2010 call errmgr%report_error("cholesky_rank1_downdate_cmplx", &
    +
    2011 "Insufficient memory available.", &
    +
    2012 la_out_of_memory_error)
    +
    2013 return
    +
    2014 end if
    +
    2015 wptr => wrk
    +
    2016 end if
    +
    2017
    +
    2018 ! Process
    +
    2019 call zch1dn(n, r, n, u, wptr, flag)
    +
    2020 if (flag == 1) then
    +
    2021 ! ERROR: The matrix is not positive definite
    +
    2022 call errmgr%report_error("cholesky_rank1_downdate_cmplx", &
    +
    2023 "The downdated matrix is not positive definite.", &
    +
    2024 la_matrix_format_error)
    +
    2025 else if (flag == 2) then
    +
    2026 ! ERROR: The matrix is singular
    +
    2027 call errmgr%report_error("cholesky_rank1_downdate_cmplx", &
    +
    2028 "The input matrix is singular.", la_singular_matrix_error)
    +
    2029 end if
    +
    2030
    +
    2031 ! Formatting
    +
    2032100 format(a, i0, a)
    +
    2033 end subroutine
    +
    2034
    +
    2035! ******************************************************************************
    +
    2036! RZ FACTORIZATION ROUTINES
    +
    2037! ------------------------------------------------------------------------------
    +
    2038 module subroutine rz_factor_dbl(a, tau, work, olwork, err)
    +
    2039 ! Arguments
    +
    2040 real(real64), intent(inout), dimension(:,:) :: a
    +
    2041 real(real64), intent(out), dimension(:) :: tau
    +
    2042 real(real64), intent(out), target, optional, dimension(:) :: work
    +
    2043 integer(int32), intent(out), optional :: olwork
    +
    2044 class(errors), intent(inout), optional, target :: err
    +
    2045
    +
    2046 ! Local Variables
    +
    2047 integer(int32) :: m, n, lwork, flag, istat
    +
    2048 real(real64), pointer, dimension(:) :: wptr
    +
    2049 real(real64), allocatable, target, dimension(:) :: wrk
    +
    2050 real(real64), dimension(1) :: temp
    +
    2051 class(errors), pointer :: errmgr
    +
    2052 type(errors), target :: deferr
    +
    2053 character(len = 128) :: errmsg
    +
    2054
    +
    2055 ! Initialization
    +
    2056 m = size(a, 1)
    +
    2057 n = size(a, 2)
    +
    2058 if (present(err)) then
    +
    2059 errmgr => err
    +
    2060 else
    +
    2061 errmgr => deferr
    +
    2062 end if
    +
    2063
    +
    2064 ! Input Check
    +
    2065 flag = 0
    +
    2066 if (size(tau) /= m) then
    +
    2067 flag = 3
    +
    2068 end if
    +
    2069 if (flag /= 0) then
    +
    2070 ! ERROR: One of the input arrays is not sized correctly
    +
    2071 write(errmsg, 100) "Input number ", flag, &
    +
    2072 " is not sized correctly."
    +
    2073 call errmgr%report_error("rz_factor", trim(errmsg), &
    +
    2074 la_array_size_error)
    +
    2075 return
    +
    2076 end if
    +
    2077
    +
    2078 ! Workspace Query
    +
    2079 call dtzrzf(m, n, a, m, tau, temp, -1, flag)
    +
    2080 lwork = int(temp(1), int32)
    +
    2081 if (present(olwork)) then
    +
    2082 olwork = lwork
    +
    2083 return
    +
    2084 end if
    +
    2085
    +
    2086 ! Local Memory Allocation
    +
    2087 if (present(work)) then
    +
    2088 if (size(work) < lwork) then
    +
    2089 ! ERROR: WORK not sized correctly
    +
    2090 call errmgr%report_error("rz_factor", &
    +
    2091 "Incorrectly sized input array WORK, argument 3.", &
    +
    2092 la_array_size_error)
    +
    2093 return
    +
    2094 end if
    +
    2095 wptr => work(1:lwork)
    +
    2096 else
    +
    2097 allocate(wrk(lwork), stat = istat)
    +
    2098 if (istat /= 0) then
    +
    2099 ! ERROR: Out of memory
    +
    2100 call errmgr%report_error("rz_factor", &
    +
    2101 "Insufficient memory available.", &
    +
    2102 la_out_of_memory_error)
    +
    2103 return
    +
    2104 end if
    +
    2105 wptr => wrk
    +
    2106 end if
    +
    2107
    +
    2108 ! Call DTZRZF
    +
    2109 call dtzrzf(m, n, a, m, tau, wptr, lwork, flag)
    2110
    -
    2111 ! Call ZTZRZF
    -
    2112 call ztzrzf(m, n, a, m, tau, wptr, lwork, flag)
    +
    2111 ! Formatting
    +
    2112100 format(a, i0, a)
    2113 end subroutine
    2114
    2115! ------------------------------------------------------------------------------
    -
    2116 module subroutine mult_rz_mtx(lside, trans, l, a, tau, c, work, olwork, err)
    +
    2116 module subroutine rz_factor_cmplx(a, tau, work, olwork, err)
    2117 ! Arguments
    -
    2118 logical, intent(in) :: lside, trans
    -
    2119 integer(int32), intent(in) :: l
    -
    2120 real(real64), intent(inout), dimension(:,:) :: a, c
    -
    2121 real(real64), intent(in), dimension(:) :: tau
    -
    2122 real(real64), intent(out), target, optional, dimension(:) :: work
    -
    2123 integer(int32), intent(out), optional :: olwork
    -
    2124 class(errors), intent(inout), optional, target :: err
    -
    2125
    -
    2126 ! Local Variables
    -
    2127 character :: side, t
    -
    2128 integer(int32) :: m, n, k, lwork, flag, istat, lda
    -
    2129 real(real64), pointer, dimension(:) :: wptr
    -
    2130 real(real64), allocatable, target, dimension(:) :: wrk
    -
    2131 real(real64), dimension(1) :: temp
    -
    2132 class(errors), pointer :: errmgr
    -
    2133 type(errors), target :: deferr
    -
    2134 character(len = 128) :: errmsg
    -
    2135
    -
    2136 ! Initialization
    -
    2137 m = size(c, 1)
    -
    2138 n = size(c, 2)
    -
    2139 k = size(tau)
    -
    2140 lda = size(a, 1)
    -
    2141 if (lside) then
    -
    2142 side = 'L'
    -
    2143 else
    -
    2144 side = 'R'
    -
    2145 end if
    -
    2146 if (trans) then
    -
    2147 t = 'T'
    -
    2148 else
    -
    2149 t = 'N'
    -
    2150 end if
    -
    2151 if (present(err)) then
    -
    2152 errmgr => err
    -
    2153 else
    -
    2154 errmgr => deferr
    -
    2155 end if
    -
    2156
    -
    2157 ! Input Check
    -
    2158 flag = 0
    -
    2159 if (lside) then
    -
    2160 if (l > m .or. l < 0) then
    -
    2161 flag = 3
    -
    2162 else if (k > m) then
    -
    2163 flag = 5
    -
    2164 else if (size(a, 1) < k .or. size(a, 2) /= m) then
    -
    2165 flag = 4
    -
    2166 end if
    -
    2167 else
    -
    2168 if (l > n .or. l < 0) then
    -
    2169 flag = 3
    -
    2170 else if (k > n) then
    -
    2171 flag = 5
    -
    2172 else if (size(a, 1) < k .or. size(a, 2) /= n) then
    -
    2173 flag = 4
    -
    2174 end if
    -
    2175 end if
    -
    2176 if (flag /= 0) then
    -
    2177 ! ERROR: One of the input arrays is not sized correctly
    -
    2178 write(errmsg, '(AI0A)') "Input number ", flag, &
    -
    2179 " is not sized correctly."
    -
    2180 call errmgr%report_error("mult_rz_mtx", trim(errmsg), &
    -
    2181 la_array_size_error)
    -
    2182 return
    -
    2183 end if
    -
    2184
    -
    2185 ! Workspace Query
    -
    2186 call dormrz(side, t, m, n, k, l, a, lda, tau, c, m, temp, -1, flag)
    -
    2187 lwork = int(temp(1), int32)
    -
    2188 if (present(olwork)) then
    -
    2189 olwork = lwork
    -
    2190 return
    -
    2191 end if
    +
    2118 complex(real64), intent(inout), dimension(:,:) :: a
    +
    2119 complex(real64), intent(out), dimension(:) :: tau
    +
    2120 complex(real64), intent(out), target, optional, dimension(:) :: work
    +
    2121 integer(int32), intent(out), optional :: olwork
    +
    2122 class(errors), intent(inout), optional, target :: err
    +
    2123
    +
    2124 ! Local Variables
    +
    2125 integer(int32) :: m, n, lwork, flag, istat
    +
    2126 complex(real64), pointer, dimension(:) :: wptr
    +
    2127 complex(real64), allocatable, target, dimension(:) :: wrk
    +
    2128 complex(real64), dimension(1) :: temp
    +
    2129 class(errors), pointer :: errmgr
    +
    2130 type(errors), target :: deferr
    +
    2131 character(len = 128) :: errmsg
    +
    2132
    +
    2133 ! Initialization
    +
    2134 m = size(a, 1)
    +
    2135 n = size(a, 2)
    +
    2136 if (present(err)) then
    +
    2137 errmgr => err
    +
    2138 else
    +
    2139 errmgr => deferr
    +
    2140 end if
    +
    2141
    +
    2142 ! Input Check
    +
    2143 flag = 0
    +
    2144 if (size(tau) /= m) then
    +
    2145 flag = 3
    +
    2146 end if
    +
    2147 if (flag /= 0) then
    +
    2148 ! ERROR: One of the input arrays is not sized correctly
    +
    2149 write(errmsg, 100) "Input number ", flag, &
    +
    2150 " is not sized correctly."
    +
    2151 call errmgr%report_error("rz_factor_cmplx", trim(errmsg), &
    +
    2152 la_array_size_error)
    +
    2153 return
    +
    2154 end if
    +
    2155
    +
    2156 ! Workspace Query
    +
    2157 call ztzrzf(m, n, a, m, tau, temp, -1, flag)
    +
    2158 lwork = int(temp(1), int32)
    +
    2159 if (present(olwork)) then
    +
    2160 olwork = lwork
    +
    2161 return
    +
    2162 end if
    +
    2163
    +
    2164 ! Local Memory Allocation
    +
    2165 if (present(work)) then
    +
    2166 if (size(work) < lwork) then
    +
    2167 ! ERROR: WORK not sized correctly
    +
    2168 call errmgr%report_error("rz_factor_cmplx", &
    +
    2169 "Incorrectly sized input array WORK, argument 3.", &
    +
    2170 la_array_size_error)
    +
    2171 return
    +
    2172 end if
    +
    2173 wptr => work(1:lwork)
    +
    2174 else
    +
    2175 allocate(wrk(lwork), stat = istat)
    +
    2176 if (istat /= 0) then
    +
    2177 ! ERROR: Out of memory
    +
    2178 call errmgr%report_error("rz_factor_cmplx", &
    +
    2179 "Insufficient memory available.", &
    +
    2180 la_out_of_memory_error)
    +
    2181 return
    +
    2182 end if
    +
    2183 wptr => wrk
    +
    2184 end if
    +
    2185
    +
    2186 ! Call ZTZRZF
    +
    2187 call ztzrzf(m, n, a, m, tau, wptr, lwork, flag)
    +
    2188
    +
    2189 ! Formatting
    +
    2190100 format(a, i0, a)
    +
    2191 end subroutine
    2192
    -
    2193 ! Local Memory Allocation
    -
    2194 if (present(work)) then
    -
    2195 if (size(work) < lwork) then
    -
    2196 ! ERROR: WORK not sized correctly
    -
    2197 call errmgr%report_error("mult_rz_mtx", &
    -
    2198 "Incorrectly sized input array WORK, argument 7.", &
    -
    2199 la_array_size_error)
    -
    2200 return
    -
    2201 end if
    -
    2202 wptr => work(1:lwork)
    -
    2203 else
    -
    2204 allocate(wrk(lwork), stat = istat)
    -
    2205 if (istat /= 0) then
    -
    2206 ! ERROR: Out of memory
    -
    2207 call errmgr%report_error("mult_rz_mtx", &
    -
    2208 "Insufficient memory available.", &
    -
    2209 la_out_of_memory_error)
    -
    2210 return
    -
    2211 end if
    -
    2212 wptr => wrk
    -
    2213 end if
    -
    2214
    -
    2215 ! Call DORMRZ
    -
    2216 call dormrz(side, t, m, n, k, l, a, lda, tau, c, m, wptr, lwork, flag)
    -
    2217 end subroutine
    -
    2218
    -
    2219! ------------------------------------------------------------------------------
    -
    2220 module subroutine mult_rz_mtx_cmplx(lside, trans, l, a, tau, c, work, olwork, err)
    -
    2221 ! Arguments
    -
    2222 logical, intent(in) :: lside, trans
    -
    2223 integer(int32), intent(in) :: l
    -
    2224 complex(real64), intent(inout), dimension(:,:) :: a, c
    -
    2225 complex(real64), intent(in), dimension(:) :: tau
    -
    2226 complex(real64), intent(out), target, optional, dimension(:) :: work
    -
    2227 integer(int32), intent(out), optional :: olwork
    -
    2228 class(errors), intent(inout), optional, target :: err
    -
    2229
    -
    2230 ! Local Variables
    -
    2231 character :: side, t
    -
    2232 integer(int32) :: m, n, k, lwork, flag, istat, lda
    -
    2233 complex(real64), pointer, dimension(:) :: wptr
    -
    2234 complex(real64), allocatable, target, dimension(:) :: wrk
    -
    2235 complex(real64), dimension(1) :: temp
    -
    2236 class(errors), pointer :: errmgr
    -
    2237 type(errors), target :: deferr
    -
    2238 character(len = 128) :: errmsg
    -
    2239
    -
    2240 ! Initialization
    -
    2241 m = size(c, 1)
    -
    2242 n = size(c, 2)
    -
    2243 k = size(tau)
    -
    2244 lda = size(a, 1)
    -
    2245 if (lside) then
    -
    2246 side = 'L'
    -
    2247 else
    -
    2248 side = 'R'
    -
    2249 end if
    -
    2250 if (trans) then
    -
    2251 t = 'C'
    -
    2252 else
    -
    2253 t = 'N'
    -
    2254 end if
    -
    2255 if (present(err)) then
    -
    2256 errmgr => err
    -
    2257 else
    -
    2258 errmgr => deferr
    -
    2259 end if
    -
    2260
    -
    2261 ! Input Check
    -
    2262 flag = 0
    -
    2263 if (lside) then
    -
    2264 if (l > m .or. l < 0) then
    -
    2265 flag = 3
    -
    2266 else if (k > m) then
    -
    2267 flag = 5
    -
    2268 else if (size(a, 1) < k .or. size(a, 2) /= m) then
    -
    2269 flag = 4
    -
    2270 end if
    -
    2271 else
    -
    2272 if (l > n .or. l < 0) then
    -
    2273 flag = 3
    -
    2274 else if (k > n) then
    -
    2275 flag = 5
    -
    2276 else if (size(a, 1) < k .or. size(a, 2) /= n) then
    -
    2277 flag = 4
    -
    2278 end if
    -
    2279 end if
    -
    2280 if (flag /= 0) then
    -
    2281 ! ERROR: One of the input arrays is not sized correctly
    -
    2282 write(errmsg, '(AI0A)') "Input number ", flag, &
    -
    2283 " is not sized correctly."
    -
    2284 call errmgr%report_error("mult_rz_mtx_cmplx", trim(errmsg), &
    -
    2285 la_array_size_error)
    -
    2286 return
    -
    2287 end if
    -
    2288
    -
    2289 ! Workspace Query
    -
    2290 call zunmrz(side, t, m, n, k, l, a, lda, tau, c, m, temp, -1, flag)
    -
    2291 lwork = int(temp(1), int32)
    -
    2292 if (present(olwork)) then
    -
    2293 olwork = lwork
    -
    2294 return
    -
    2295 end if
    -
    2296
    -
    2297 ! Local Memory Allocation
    -
    2298 if (present(work)) then
    -
    2299 if (size(work) < lwork) then
    -
    2300 ! ERROR: WORK not sized correctly
    -
    2301 call errmgr%report_error("mult_rz_mtx_cmplx", &
    -
    2302 "Incorrectly sized input array WORK, argument 7.", &
    -
    2303 la_array_size_error)
    -
    2304 return
    -
    2305 end if
    -
    2306 wptr => work(1:lwork)
    -
    2307 else
    -
    2308 allocate(wrk(lwork), stat = istat)
    -
    2309 if (istat /= 0) then
    -
    2310 ! ERROR: Out of memory
    -
    2311 call errmgr%report_error("mult_rz_mtx_cmplx", &
    -
    2312 "Insufficient memory available.", &
    -
    2313 la_out_of_memory_error)
    -
    2314 return
    -
    2315 end if
    -
    2316 wptr => wrk
    -
    2317 end if
    -
    2318
    -
    2319 ! Call ZUNMRZ
    -
    2320 call zunmrz(side, t, m, n, k, l, a, lda, tau, c, m, wptr, lwork, flag)
    -
    2321 end subroutine
    -
    2322
    -
    2323! ------------------------------------------------------------------------------
    -
    2324 module subroutine mult_rz_vec(trans, l, a, tau, c, work, olwork, err)
    -
    2325 ! Arguments
    -
    2326 logical, intent(in) :: trans
    -
    2327 integer(int32), intent(in) :: l
    -
    2328 real(real64), intent(inout), dimension(:,:) :: a
    -
    2329 real(real64), intent(in), dimension(:) :: tau
    -
    2330 real(real64), intent(inout), dimension(:) :: c
    -
    2331 real(real64), intent(out), target, optional, dimension(:) :: work
    -
    2332 integer(int32), intent(out), optional :: olwork
    -
    2333 class(errors), intent(inout), optional, target :: err
    -
    2334
    -
    2335 ! Local Variables
    -
    2336 character :: side, t
    -
    2337 integer(int32) :: m, k, lwork, flag, istat, lda
    -
    2338 real(real64), pointer, dimension(:) :: wptr
    -
    2339 real(real64), allocatable, target, dimension(:) :: wrk
    -
    2340 real(real64), dimension(1) :: temp
    -
    2341 class(errors), pointer :: errmgr
    -
    2342 type(errors), target :: deferr
    -
    2343 character(len = 128) :: errmsg
    -
    2344
    -
    2345 ! Initialization
    -
    2346 m = size(c)
    -
    2347 k = size(tau)
    -
    2348 lda = size(a, 1)
    -
    2349 side = 'L'
    -
    2350 if (trans) then
    -
    2351 t = 'T'
    +
    2193! ------------------------------------------------------------------------------
    +
    2194 module subroutine mult_rz_mtx(lside, trans, l, a, tau, c, work, olwork, err)
    +
    2195 ! Arguments
    +
    2196 logical, intent(in) :: lside, trans
    +
    2197 integer(int32), intent(in) :: l
    +
    2198 real(real64), intent(inout), dimension(:,:) :: a, c
    +
    2199 real(real64), intent(in), dimension(:) :: tau
    +
    2200 real(real64), intent(out), target, optional, dimension(:) :: work
    +
    2201 integer(int32), intent(out), optional :: olwork
    +
    2202 class(errors), intent(inout), optional, target :: err
    +
    2203
    +
    2204 ! Local Variables
    +
    2205 character :: side, t
    +
    2206 integer(int32) :: m, n, k, lwork, flag, istat, lda
    +
    2207 real(real64), pointer, dimension(:) :: wptr
    +
    2208 real(real64), allocatable, target, dimension(:) :: wrk
    +
    2209 real(real64), dimension(1) :: temp
    +
    2210 class(errors), pointer :: errmgr
    +
    2211 type(errors), target :: deferr
    +
    2212 character(len = 128) :: errmsg
    +
    2213
    +
    2214 ! Initialization
    +
    2215 m = size(c, 1)
    +
    2216 n = size(c, 2)
    +
    2217 k = size(tau)
    +
    2218 lda = size(a, 1)
    +
    2219 if (lside) then
    +
    2220 side = 'L'
    +
    2221 else
    +
    2222 side = 'R'
    +
    2223 end if
    +
    2224 if (trans) then
    +
    2225 t = 'T'
    +
    2226 else
    +
    2227 t = 'N'
    +
    2228 end if
    +
    2229 if (present(err)) then
    +
    2230 errmgr => err
    +
    2231 else
    +
    2232 errmgr => deferr
    +
    2233 end if
    +
    2234
    +
    2235 ! Input Check
    +
    2236 flag = 0
    +
    2237 if (lside) then
    +
    2238 if (l > m .or. l < 0) then
    +
    2239 flag = 3
    +
    2240 else if (k > m) then
    +
    2241 flag = 5
    +
    2242 else if (size(a, 1) < k .or. size(a, 2) /= m) then
    +
    2243 flag = 4
    +
    2244 end if
    +
    2245 else
    +
    2246 if (l > n .or. l < 0) then
    +
    2247 flag = 3
    +
    2248 else if (k > n) then
    +
    2249 flag = 5
    +
    2250 else if (size(a, 1) < k .or. size(a, 2) /= n) then
    +
    2251 flag = 4
    +
    2252 end if
    +
    2253 end if
    +
    2254 if (flag /= 0) then
    +
    2255 ! ERROR: One of the input arrays is not sized correctly
    +
    2256 write(errmsg, 100) "Input number ", flag, &
    +
    2257 " is not sized correctly."
    +
    2258 call errmgr%report_error("mult_rz_mtx", trim(errmsg), &
    +
    2259 la_array_size_error)
    +
    2260 return
    +
    2261 end if
    +
    2262
    +
    2263 ! Workspace Query
    +
    2264 call dormrz(side, t, m, n, k, l, a, lda, tau, c, m, temp, -1, flag)
    +
    2265 lwork = int(temp(1), int32)
    +
    2266 if (present(olwork)) then
    +
    2267 olwork = lwork
    +
    2268 return
    +
    2269 end if
    +
    2270
    +
    2271 ! Local Memory Allocation
    +
    2272 if (present(work)) then
    +
    2273 if (size(work) < lwork) then
    +
    2274 ! ERROR: WORK not sized correctly
    +
    2275 call errmgr%report_error("mult_rz_mtx", &
    +
    2276 "Incorrectly sized input array WORK, argument 7.", &
    +
    2277 la_array_size_error)
    +
    2278 return
    +
    2279 end if
    +
    2280 wptr => work(1:lwork)
    +
    2281 else
    +
    2282 allocate(wrk(lwork), stat = istat)
    +
    2283 if (istat /= 0) then
    +
    2284 ! ERROR: Out of memory
    +
    2285 call errmgr%report_error("mult_rz_mtx", &
    +
    2286 "Insufficient memory available.", &
    +
    2287 la_out_of_memory_error)
    +
    2288 return
    +
    2289 end if
    +
    2290 wptr => wrk
    +
    2291 end if
    +
    2292
    +
    2293 ! Call DORMRZ
    +
    2294 call dormrz(side, t, m, n, k, l, a, lda, tau, c, m, wptr, lwork, flag)
    +
    2295
    +
    2296 ! Formatting
    +
    2297100 format(a, i0, a)
    +
    2298 end subroutine
    +
    2299
    +
    2300! ------------------------------------------------------------------------------
    +
    2301 module subroutine mult_rz_mtx_cmplx(lside, trans, l, a, tau, c, work, olwork, err)
    +
    2302 ! Arguments
    +
    2303 logical, intent(in) :: lside, trans
    +
    2304 integer(int32), intent(in) :: l
    +
    2305 complex(real64), intent(inout), dimension(:,:) :: a, c
    +
    2306 complex(real64), intent(in), dimension(:) :: tau
    +
    2307 complex(real64), intent(out), target, optional, dimension(:) :: work
    +
    2308 integer(int32), intent(out), optional :: olwork
    +
    2309 class(errors), intent(inout), optional, target :: err
    +
    2310
    +
    2311 ! Local Variables
    +
    2312 character :: side, t
    +
    2313 integer(int32) :: m, n, k, lwork, flag, istat, lda
    +
    2314 complex(real64), pointer, dimension(:) :: wptr
    +
    2315 complex(real64), allocatable, target, dimension(:) :: wrk
    +
    2316 complex(real64), dimension(1) :: temp
    +
    2317 class(errors), pointer :: errmgr
    +
    2318 type(errors), target :: deferr
    +
    2319 character(len = 128) :: errmsg
    +
    2320
    +
    2321 ! Initialization
    +
    2322 m = size(c, 1)
    +
    2323 n = size(c, 2)
    +
    2324 k = size(tau)
    +
    2325 lda = size(a, 1)
    +
    2326 if (lside) then
    +
    2327 side = 'L'
    +
    2328 else
    +
    2329 side = 'R'
    +
    2330 end if
    +
    2331 if (trans) then
    +
    2332 t = 'C'
    +
    2333 else
    +
    2334 t = 'N'
    +
    2335 end if
    +
    2336 if (present(err)) then
    +
    2337 errmgr => err
    +
    2338 else
    +
    2339 errmgr => deferr
    +
    2340 end if
    +
    2341
    +
    2342 ! Input Check
    +
    2343 flag = 0
    +
    2344 if (lside) then
    +
    2345 if (l > m .or. l < 0) then
    +
    2346 flag = 3
    +
    2347 else if (k > m) then
    +
    2348 flag = 5
    +
    2349 else if (size(a, 1) < k .or. size(a, 2) /= m) then
    +
    2350 flag = 4
    +
    2351 end if
    2352 else
    -
    2353 t = 'N'
    -
    2354 end if
    -
    2355 if (present(err)) then
    -
    2356 errmgr => err
    -
    2357 else
    -
    2358 errmgr => deferr
    -
    2359 end if
    -
    2360
    -
    2361 ! Input Check
    -
    2362 flag = 0
    -
    2363 if (l > m .or. l < 0) then
    -
    2364 flag = 2
    -
    2365 else if (k > m) then
    -
    2366 flag = 4
    -
    2367 else if (size(a, 1) < k .or. size(a, 2) /= m) then
    -
    2368 flag = 3
    -
    2369 end if
    -
    2370 if (flag /= 0) then
    -
    2371 ! ERROR: One of the input arrays is not sized correctly
    -
    2372 write(errmsg, '(AI0A)') "Input number ", flag, &
    -
    2373 " is not sized correctly."
    -
    2374 call errmgr%report_error("mult_rz_vec", trim(errmsg), &
    -
    2375 la_array_size_error)
    -
    2376 return
    -
    2377 end if
    -
    2378
    -
    2379 ! Workspace Query
    -
    2380 call dormrz(side, t, m, 1, k, l, a, lda, tau, c, m, temp, -1, flag)
    -
    2381 lwork = int(temp(1), int32)
    -
    2382 if (present(olwork)) then
    -
    2383 olwork = lwork
    -
    2384 return
    -
    2385 end if
    -
    2386
    -
    2387 ! Local Memory Allocation
    -
    2388 if (present(work)) then
    -
    2389 if (size(work) < lwork) then
    -
    2390 ! ERROR: WORK not sized correctly
    -
    2391 call errmgr%report_error("mult_rz_vec", &
    -
    2392 "Incorrectly sized input array WORK, argument 6.", &
    -
    2393 la_array_size_error)
    -
    2394 return
    -
    2395 end if
    -
    2396 wptr => work(1:lwork)
    -
    2397 else
    -
    2398 allocate(wrk(lwork), stat = istat)
    -
    2399 if (istat /= 0) then
    -
    2400 ! ERROR: Out of memory
    -
    2401 call errmgr%report_error("mult_rz_vec", &
    -
    2402 "Insufficient memory available.", &
    -
    2403 la_out_of_memory_error)
    -
    2404 return
    -
    2405 end if
    -
    2406 wptr => wrk
    -
    2407 end if
    -
    2408
    -
    2409 ! Call DORMRZ
    -
    2410 call dormrz(side, t, m, 1, k, l, a, lda, tau, c, m, wptr, lwork, flag)
    -
    2411 end subroutine
    -
    2412
    -
    2413! ------------------------------------------------------------------------------
    -
    2414 module subroutine mult_rz_vec_cmplx(trans, l, a, tau, c, work, olwork, err)
    -
    2415 ! Arguments
    -
    2416 logical, intent(in) :: trans
    -
    2417 integer(int32), intent(in) :: l
    -
    2418 complex(real64), intent(inout), dimension(:,:) :: a
    -
    2419 complex(real64), intent(in), dimension(:) :: tau
    -
    2420 complex(real64), intent(inout), dimension(:) :: c
    -
    2421 complex(real64), intent(out), target, optional, dimension(:) :: work
    -
    2422 integer(int32), intent(out), optional :: olwork
    -
    2423 class(errors), intent(inout), optional, target :: err
    -
    2424
    -
    2425 ! Local Variables
    -
    2426 character :: side, t
    -
    2427 integer(int32) :: m, k, lwork, flag, istat, lda
    -
    2428 complex(real64), pointer, dimension(:) :: wptr
    -
    2429 complex(real64), allocatable, target, dimension(:) :: wrk
    -
    2430 complex(real64), dimension(1) :: temp
    -
    2431 class(errors), pointer :: errmgr
    -
    2432 type(errors), target :: deferr
    -
    2433 character(len = 128) :: errmsg
    -
    2434
    -
    2435 ! Initialization
    -
    2436 m = size(c)
    -
    2437 k = size(tau)
    -
    2438 lda = size(a, 1)
    -
    2439 side = 'L'
    -
    2440 if (trans) then
    -
    2441 t = 'T'
    -
    2442 else
    -
    2443 t = 'N'
    -
    2444 end if
    -
    2445 if (present(err)) then
    -
    2446 errmgr => err
    -
    2447 else
    -
    2448 errmgr => deferr
    -
    2449 end if
    -
    2450
    -
    2451 ! Input Check
    -
    2452 flag = 0
    -
    2453 if (l > m .or. l < 0) then
    -
    2454 flag = 2
    -
    2455 else if (k > m) then
    -
    2456 flag = 4
    -
    2457 else if (size(a, 1) < k .or. size(a, 2) /= m) then
    -
    2458 flag = 3
    -
    2459 end if
    -
    2460 if (flag /= 0) then
    -
    2461 ! ERROR: One of the input arrays is not sized correctly
    -
    2462 write(errmsg, '(AI0A)') "Input number ", flag, &
    -
    2463 " is not sized correctly."
    -
    2464 call errmgr%report_error("mult_rz_vec_cmplx", trim(errmsg), &
    -
    2465 la_array_size_error)
    -
    2466 return
    -
    2467 end if
    -
    2468
    -
    2469 ! Workspace Query
    -
    2470 call zunmrz(side, t, m, 1, k, l, a, lda, tau, c, m, temp, -1, flag)
    -
    2471 lwork = int(temp(1), int32)
    -
    2472 if (present(olwork)) then
    -
    2473 olwork = lwork
    -
    2474 return
    -
    2475 end if
    -
    2476
    -
    2477 ! Local Memory Allocation
    -
    2478 if (present(work)) then
    -
    2479 if (size(work) < lwork) then
    -
    2480 ! ERROR: WORK not sized correctly
    -
    2481 call errmgr%report_error("mult_rz_vec_cmplx", &
    -
    2482 "Incorrectly sized input array WORK, argument 6.", &
    -
    2483 la_array_size_error)
    -
    2484 return
    -
    2485 end if
    -
    2486 wptr => work(1:lwork)
    -
    2487 else
    -
    2488 allocate(wrk(lwork), stat = istat)
    -
    2489 if (istat /= 0) then
    -
    2490 ! ERROR: Out of memory
    -
    2491 call errmgr%report_error("mult_rz_vec_cmplx", &
    -
    2492 "Insufficient memory available.", &
    -
    2493 la_out_of_memory_error)
    -
    2494 return
    -
    2495 end if
    -
    2496 wptr => wrk
    -
    2497 end if
    -
    2498
    -
    2499 ! Call ZUNMRZ
    -
    2500 call zunmrz(side, t, m, 1, k, l, a, lda, tau, c, m, wptr, lwork, flag)
    -
    2501 end subroutine
    -
    2502
    -
    2503! ******************************************************************************
    -
    2504! SVD ROUTINES
    -
    2505! ------------------------------------------------------------------------------
    -
    2506 module subroutine svd_dbl(a, s, u, vt, work, olwork, err)
    -
    2507 ! Arguments
    -
    2508 real(real64), intent(inout), dimension(:,:) :: a
    -
    2509 real(real64), intent(out), dimension(:) :: s
    -
    2510 real(real64), intent(out), optional, dimension(:,:) :: u, vt
    -
    2511 real(real64), intent(out), target, optional, dimension(:) :: work
    -
    2512 integer(int32), intent(out), optional :: olwork
    -
    2513 class(errors), intent(inout), optional, target :: err
    -
    2514
    -
    2515 ! Local Variables
    -
    2516 character :: jobu, jobvt
    -
    2517 integer(int32) :: m, n, mn, istat, lwork, flag
    -
    2518 real(real64), pointer, dimension(:) :: wptr
    -
    2519 real(real64), allocatable, target, dimension(:) :: wrk
    -
    2520 real(real64), dimension(1) :: temp
    -
    2521 class(errors), pointer :: errmgr
    -
    2522 type(errors), target :: deferr
    -
    2523 character(len = 128) :: errmsg
    -
    2524
    -
    2525 ! Initialization
    -
    2526 m = size(a, 1)
    -
    2527 n = size(a, 2)
    -
    2528 mn = min(m, n)
    -
    2529 if (present(u)) then
    -
    2530 if (size(u, 2) == m) then
    -
    2531 jobu = 'A'
    -
    2532 else if (size(u, 2) == mn) then
    -
    2533 jobu = 'S'
    -
    2534 end if
    -
    2535 else
    -
    2536 jobu = 'N'
    -
    2537 end if
    -
    2538 if (present(vt)) then
    -
    2539 jobvt = 'A'
    -
    2540 else
    -
    2541 jobvt = 'N'
    -
    2542 end if
    -
    2543 if (present(err)) then
    -
    2544 errmgr => err
    -
    2545 else
    -
    2546 errmgr => deferr
    -
    2547 end if
    -
    2548
    -
    2549 ! Input Check
    -
    2550 flag = 0
    -
    2551 if (size(s) /= mn) then
    -
    2552 flag = 2
    -
    2553 else if (present(u)) then
    -
    2554 if (size(u, 1) /= m) flag = 3
    -
    2555 if (size(u, 2) /= m .and. size(u, 2) /= mn) flag = 3
    -
    2556 else if (present(vt)) then
    -
    2557 if (size(vt, 1) /= n .or. size(vt, 2) /= n) flag = 4
    -
    2558 end if
    -
    2559 if (flag /= 0) then
    -
    2560 ! ERROR: One of the input arrays is not sized correctly
    -
    2561 write(errmsg, '(AI0A)') "Input number ", flag, &
    -
    2562 " is not sized correctly."
    -
    2563 call errmgr%report_error("svd", trim(errmsg), &
    -
    2564 la_array_size_error)
    -
    2565 return
    -
    2566 end if
    -
    2567
    -
    2568 ! Workspace Query
    -
    2569 call dgesvd(jobu, jobvt, m, n, a, m, s, temp, m, temp, n, temp, -1, &
    -
    2570 flag)
    -
    2571 lwork = int(temp(1), int32)
    -
    2572 if (present(olwork)) then
    -
    2573 olwork = lwork
    -
    2574 return
    -
    2575 end if
    -
    2576
    -
    2577 ! Local Memory Allocation
    -
    2578 if (present(work)) then
    -
    2579 if (size(work) < lwork) then
    -
    2580 ! ERROR: WORK not sized correctly
    -
    2581 call errmgr%report_error("svd", &
    -
    2582 "Incorrectly sized input array WORK, argument 5.", &
    -
    2583 la_array_size_error)
    -
    2584 return
    -
    2585 end if
    -
    2586 wptr => work(1:lwork)
    -
    2587 else
    -
    2588 allocate(wrk(lwork), stat = istat)
    -
    2589 if (istat /= 0) then
    -
    2590 ! ERROR: Out of memory
    -
    2591 call errmgr%report_error("svd", &
    -
    2592 "Insufficient memory available.", &
    -
    2593 la_out_of_memory_error)
    -
    2594 return
    -
    2595 end if
    -
    2596 wptr => wrk
    -
    2597 end if
    -
    2598
    -
    2599 ! Call DGESVD
    -
    2600 if (present(u) .and. present(vt)) then
    -
    2601 call dgesvd(jobu, jobvt, m, n, a, m, s, u, m, vt, n, wptr, lwork, &
    -
    2602 flag)
    -
    2603 else if (present(u) .and. .not.present(vt)) then
    -
    2604 call dgesvd(jobu, jobvt, m, n, a, m, s, u, m, temp, n, wptr, &
    -
    2605 lwork, flag)
    -
    2606 else if (.not.present(u) .and. present(vt)) then
    -
    2607 call dgesvd(jobu, jobvt, m, n, a, m, s, temp, m, vt, n, wptr, &
    -
    2608 lwork, flag)
    -
    2609 else
    -
    2610 call dgesvd(jobu, jobvt, m, n, a, m, s, temp, m, temp, n, wptr, &
    -
    2611 lwork, flag)
    -
    2612 end if
    -
    2613
    -
    2614 ! Check for convergence
    -
    2615 if (flag > 0) then
    -
    2616 write(errmsg, '(I0A)') flag, " superdiagonals could not " // &
    -
    2617 "converge to zero as part of the QR iteration process."
    -
    2618 call errmgr%report_warning("svd", errmsg, la_convergence_error)
    -
    2619 end if
    -
    2620 end subroutine
    -
    2621
    -
    2622! ------------------------------------------------------------------------------
    -
    2623 module subroutine svd_cmplx(a, s, u, vt, work, olwork, rwork, err)
    -
    2624 ! Arguments
    -
    2625 complex(real64), intent(inout), dimension(:,:) :: a
    -
    2626 real(real64), intent(out), dimension(:) :: s
    -
    2627 complex(real64), intent(out), optional, dimension(:,:) :: u, vt
    -
    2628 complex(real64), intent(out), target, optional, dimension(:) :: work
    -
    2629 integer(int32), intent(out), optional :: olwork
    -
    2630 real(real64), intent(out), target, optional, dimension(:) :: rwork
    -
    2631 class(errors), intent(inout), optional, target :: err
    -
    2632
    -
    2633 ! Local Variables
    -
    2634 character :: jobu, jobvt
    -
    2635 integer(int32) :: m, n, mn, istat, lwork, flag, lrwork
    -
    2636 complex(real64), pointer, dimension(:) :: wptr
    -
    2637 complex(real64), allocatable, target, dimension(:) :: wrk
    -
    2638 complex(real64), dimension(1) :: temp
    -
    2639 real(real64), dimension(1) :: rtemp
    -
    2640 real(real64), pointer, dimension(:) :: rwptr
    -
    2641 real(real64), allocatable, target, dimension(:) :: rwrk
    -
    2642 class(errors), pointer :: errmgr
    -
    2643 type(errors), target :: deferr
    -
    2644 character(len = 128) :: errmsg
    -
    2645
    -
    2646 ! Initialization
    -
    2647 m = size(a, 1)
    -
    2648 n = size(a, 2)
    -
    2649 mn = min(m, n)
    -
    2650 lrwork = 5 * mn
    -
    2651 if (present(u)) then
    -
    2652 if (size(u, 2) == m) then
    -
    2653 jobu = 'A'
    -
    2654 else if (size(u, 2) == mn) then
    -
    2655 jobu = 'S'
    -
    2656 end if
    -
    2657 else
    -
    2658 jobu = 'N'
    -
    2659 end if
    -
    2660 if (present(vt)) then
    -
    2661 jobvt = 'A'
    -
    2662 else
    -
    2663 jobvt = 'N'
    -
    2664 end if
    -
    2665 if (present(err)) then
    -
    2666 errmgr => err
    -
    2667 else
    -
    2668 errmgr => deferr
    -
    2669 end if
    -
    2670
    -
    2671 ! Input Check
    -
    2672 flag = 0
    -
    2673 if (size(s) /= mn) then
    -
    2674 flag = 2
    -
    2675 else if (present(u)) then
    -
    2676 if (size(u, 1) /= m) flag = 3
    -
    2677 if (size(u, 2) /= m .and. size(u, 2) /= mn) flag = 3
    -
    2678 else if (present(vt)) then
    -
    2679 if (size(vt, 1) /= n .or. size(vt, 2) /= n) flag = 4
    -
    2680 end if
    -
    2681 if (flag /= 0) then
    -
    2682 ! ERROR: One of the input arrays is not sized correctly
    -
    2683 write(errmsg, '(AI0A)') "Input number ", flag, &
    -
    2684 " is not sized correctly."
    -
    2685 call errmgr%report_error("svd_cmplx", trim(errmsg), &
    -
    2686 la_array_size_error)
    -
    2687 return
    -
    2688 end if
    -
    2689
    -
    2690 ! Workspace Query
    -
    2691 call zgesvd(jobu, jobvt, m, n, a, m, s, temp, m, temp, n, temp, -1, &
    -
    2692 rtemp, flag)
    -
    2693 lwork = int(temp(1), int32)
    -
    2694 if (present(olwork)) then
    -
    2695 olwork = lwork
    -
    2696 return
    -
    2697 end if
    -
    2698
    -
    2699 ! Local Memory Allocation
    -
    2700 if (present(work)) then
    -
    2701 if (size(work) < lwork) then
    -
    2702 ! ERROR: WORK not sized correctly
    -
    2703 call errmgr%report_error("svd_cmplx", &
    -
    2704 "Incorrectly sized input array WORK, argument 5.", &
    -
    2705 la_array_size_error)
    -
    2706 return
    -
    2707 end if
    -
    2708 wptr => work(1:lwork)
    -
    2709 else
    -
    2710 allocate(wrk(lwork), stat = istat)
    -
    2711 if (istat /= 0) then
    -
    2712 ! ERROR: Out of memory
    -
    2713 call errmgr%report_error("svd_cmplx", &
    -
    2714 "Insufficient memory available.", &
    -
    2715 la_out_of_memory_error)
    -
    2716 return
    -
    2717 end if
    -
    2718 wptr => wrk
    -
    2719 end if
    -
    2720
    -
    2721 if (present(rwork)) then
    -
    2722 if (size(rwork) < lrwork) then
    -
    2723 ! ERROR: RWORK not sized correctly
    -
    2724 call errmgr%report_error("svd_cmplx", &
    -
    2725 "Incorrectly sized input array RWORK, argument 7.", &
    -
    2726 la_array_size_error)
    -
    2727 end if
    -
    2728 rwptr => rwork(1:lrwork)
    -
    2729 else
    -
    2730 allocate(rwrk(lrwork), stat = istat)
    -
    2731 if (istat /= 0) then
    -
    2732 ! ERROR: Out of memory
    -
    2733 call errmgr%report_error("svd_cmplx", &
    -
    2734 "Insufficient memory available.", &
    -
    2735 la_out_of_memory_error)
    -
    2736 return
    -
    2737 end if
    -
    2738 rwptr => rwrk
    -
    2739 end if
    -
    2740
    -
    2741 ! Call ZGESVD
    -
    2742 if (present(u) .and. present(vt)) then
    -
    2743 call zgesvd(jobu, jobvt, m, n, a, m, s, u, m, vt, n, wptr, lwork, &
    -
    2744 rwptr, flag)
    -
    2745 else if (present(u) .and. .not.present(vt)) then
    -
    2746 call zgesvd(jobu, jobvt, m, n, a, m, s, u, m, temp, n, wptr, &
    -
    2747 rwptr, lwork, flag)
    -
    2748 else if (.not.present(u) .and. present(vt)) then
    -
    2749 call zgesvd(jobu, jobvt, m, n, a, m, s, temp, m, vt, n, wptr, &
    -
    2750 rwptr, lwork, flag)
    +
    2353 if (l > n .or. l < 0) then
    +
    2354 flag = 3
    +
    2355 else if (k > n) then
    +
    2356 flag = 5
    +
    2357 else if (size(a, 1) < k .or. size(a, 2) /= n) then
    +
    2358 flag = 4
    +
    2359 end if
    +
    2360 end if
    +
    2361 if (flag /= 0) then
    +
    2362 ! ERROR: One of the input arrays is not sized correctly
    +
    2363 write(errmsg, 100) "Input number ", flag, &
    +
    2364 " is not sized correctly."
    +
    2365 call errmgr%report_error("mult_rz_mtx_cmplx", trim(errmsg), &
    +
    2366 la_array_size_error)
    +
    2367 return
    +
    2368 end if
    +
    2369
    +
    2370 ! Workspace Query
    +
    2371 call zunmrz(side, t, m, n, k, l, a, lda, tau, c, m, temp, -1, flag)
    +
    2372 lwork = int(temp(1), int32)
    +
    2373 if (present(olwork)) then
    +
    2374 olwork = lwork
    +
    2375 return
    +
    2376 end if
    +
    2377
    +
    2378 ! Local Memory Allocation
    +
    2379 if (present(work)) then
    +
    2380 if (size(work) < lwork) then
    +
    2381 ! ERROR: WORK not sized correctly
    +
    2382 call errmgr%report_error("mult_rz_mtx_cmplx", &
    +
    2383 "Incorrectly sized input array WORK, argument 7.", &
    +
    2384 la_array_size_error)
    +
    2385 return
    +
    2386 end if
    +
    2387 wptr => work(1:lwork)
    +
    2388 else
    +
    2389 allocate(wrk(lwork), stat = istat)
    +
    2390 if (istat /= 0) then
    +
    2391 ! ERROR: Out of memory
    +
    2392 call errmgr%report_error("mult_rz_mtx_cmplx", &
    +
    2393 "Insufficient memory available.", &
    +
    2394 la_out_of_memory_error)
    +
    2395 return
    +
    2396 end if
    +
    2397 wptr => wrk
    +
    2398 end if
    +
    2399
    +
    2400 ! Call ZUNMRZ
    +
    2401 call zunmrz(side, t, m, n, k, l, a, lda, tau, c, m, wptr, lwork, flag)
    +
    2402
    +
    2403 ! Formatting
    +
    2404100 format(a, i0, a)
    +
    2405 end subroutine
    +
    2406
    +
    2407! ------------------------------------------------------------------------------
    +
    2408 module subroutine mult_rz_vec(trans, l, a, tau, c, work, olwork, err)
    +
    2409 ! Arguments
    +
    2410 logical, intent(in) :: trans
    +
    2411 integer(int32), intent(in) :: l
    +
    2412 real(real64), intent(inout), dimension(:,:) :: a
    +
    2413 real(real64), intent(in), dimension(:) :: tau
    +
    2414 real(real64), intent(inout), dimension(:) :: c
    +
    2415 real(real64), intent(out), target, optional, dimension(:) :: work
    +
    2416 integer(int32), intent(out), optional :: olwork
    +
    2417 class(errors), intent(inout), optional, target :: err
    +
    2418
    +
    2419 ! Local Variables
    +
    2420 character :: side, t
    +
    2421 integer(int32) :: m, k, lwork, flag, istat, lda
    +
    2422 real(real64), pointer, dimension(:) :: wptr
    +
    2423 real(real64), allocatable, target, dimension(:) :: wrk
    +
    2424 real(real64), dimension(1) :: temp
    +
    2425 class(errors), pointer :: errmgr
    +
    2426 type(errors), target :: deferr
    +
    2427 character(len = 128) :: errmsg
    +
    2428
    +
    2429 ! Initialization
    +
    2430 m = size(c)
    +
    2431 k = size(tau)
    +
    2432 lda = size(a, 1)
    +
    2433 side = 'L'
    +
    2434 if (trans) then
    +
    2435 t = 'T'
    +
    2436 else
    +
    2437 t = 'N'
    +
    2438 end if
    +
    2439 if (present(err)) then
    +
    2440 errmgr => err
    +
    2441 else
    +
    2442 errmgr => deferr
    +
    2443 end if
    +
    2444
    +
    2445 ! Input Check
    +
    2446 flag = 0
    +
    2447 if (l > m .or. l < 0) then
    +
    2448 flag = 2
    +
    2449 else if (k > m) then
    +
    2450 flag = 4
    +
    2451 else if (size(a, 1) < k .or. size(a, 2) /= m) then
    +
    2452 flag = 3
    +
    2453 end if
    +
    2454 if (flag /= 0) then
    +
    2455 ! ERROR: One of the input arrays is not sized correctly
    +
    2456 write(errmsg, 100) "Input number ", flag, &
    +
    2457 " is not sized correctly."
    +
    2458 call errmgr%report_error("mult_rz_vec", trim(errmsg), &
    +
    2459 la_array_size_error)
    +
    2460 return
    +
    2461 end if
    +
    2462
    +
    2463 ! Workspace Query
    +
    2464 call dormrz(side, t, m, 1, k, l, a, lda, tau, c, m, temp, -1, flag)
    +
    2465 lwork = int(temp(1), int32)
    +
    2466 if (present(olwork)) then
    +
    2467 olwork = lwork
    +
    2468 return
    +
    2469 end if
    +
    2470
    +
    2471 ! Local Memory Allocation
    +
    2472 if (present(work)) then
    +
    2473 if (size(work) < lwork) then
    +
    2474 ! ERROR: WORK not sized correctly
    +
    2475 call errmgr%report_error("mult_rz_vec", &
    +
    2476 "Incorrectly sized input array WORK, argument 6.", &
    +
    2477 la_array_size_error)
    +
    2478 return
    +
    2479 end if
    +
    2480 wptr => work(1:lwork)
    +
    2481 else
    +
    2482 allocate(wrk(lwork), stat = istat)
    +
    2483 if (istat /= 0) then
    +
    2484 ! ERROR: Out of memory
    +
    2485 call errmgr%report_error("mult_rz_vec", &
    +
    2486 "Insufficient memory available.", &
    +
    2487 la_out_of_memory_error)
    +
    2488 return
    +
    2489 end if
    +
    2490 wptr => wrk
    +
    2491 end if
    +
    2492
    +
    2493 ! Call DORMRZ
    +
    2494 call dormrz(side, t, m, 1, k, l, a, lda, tau, c, m, wptr, lwork, flag)
    +
    2495
    +
    2496 ! Formatting
    +
    2497100 format(a, i0, a)
    +
    2498 end subroutine
    +
    2499
    +
    2500! ------------------------------------------------------------------------------
    +
    2501 module subroutine mult_rz_vec_cmplx(trans, l, a, tau, c, work, olwork, err)
    +
    2502 ! Arguments
    +
    2503 logical, intent(in) :: trans
    +
    2504 integer(int32), intent(in) :: l
    +
    2505 complex(real64), intent(inout), dimension(:,:) :: a
    +
    2506 complex(real64), intent(in), dimension(:) :: tau
    +
    2507 complex(real64), intent(inout), dimension(:) :: c
    +
    2508 complex(real64), intent(out), target, optional, dimension(:) :: work
    +
    2509 integer(int32), intent(out), optional :: olwork
    +
    2510 class(errors), intent(inout), optional, target :: err
    +
    2511
    +
    2512 ! Local Variables
    +
    2513 character :: side, t
    +
    2514 integer(int32) :: m, k, lwork, flag, istat, lda
    +
    2515 complex(real64), pointer, dimension(:) :: wptr
    +
    2516 complex(real64), allocatable, target, dimension(:) :: wrk
    +
    2517 complex(real64), dimension(1) :: temp
    +
    2518 class(errors), pointer :: errmgr
    +
    2519 type(errors), target :: deferr
    +
    2520 character(len = 128) :: errmsg
    +
    2521
    +
    2522 ! Initialization
    +
    2523 m = size(c)
    +
    2524 k = size(tau)
    +
    2525 lda = size(a, 1)
    +
    2526 side = 'L'
    +
    2527 if (trans) then
    +
    2528 t = 'T'
    +
    2529 else
    +
    2530 t = 'N'
    +
    2531 end if
    +
    2532 if (present(err)) then
    +
    2533 errmgr => err
    +
    2534 else
    +
    2535 errmgr => deferr
    +
    2536 end if
    +
    2537
    +
    2538 ! Input Check
    +
    2539 flag = 0
    +
    2540 if (l > m .or. l < 0) then
    +
    2541 flag = 2
    +
    2542 else if (k > m) then
    +
    2543 flag = 4
    +
    2544 else if (size(a, 1) < k .or. size(a, 2) /= m) then
    +
    2545 flag = 3
    +
    2546 end if
    +
    2547 if (flag /= 0) then
    +
    2548 ! ERROR: One of the input arrays is not sized correctly
    +
    2549 write(errmsg, 100) "Input number ", flag, &
    +
    2550 " is not sized correctly."
    +
    2551 call errmgr%report_error("mult_rz_vec_cmplx", trim(errmsg), &
    +
    2552 la_array_size_error)
    +
    2553 return
    +
    2554 end if
    +
    2555
    +
    2556 ! Workspace Query
    +
    2557 call zunmrz(side, t, m, 1, k, l, a, lda, tau, c, m, temp, -1, flag)
    +
    2558 lwork = int(temp(1), int32)
    +
    2559 if (present(olwork)) then
    +
    2560 olwork = lwork
    +
    2561 return
    +
    2562 end if
    +
    2563
    +
    2564 ! Local Memory Allocation
    +
    2565 if (present(work)) then
    +
    2566 if (size(work) < lwork) then
    +
    2567 ! ERROR: WORK not sized correctly
    +
    2568 call errmgr%report_error("mult_rz_vec_cmplx", &
    +
    2569 "Incorrectly sized input array WORK, argument 6.", &
    +
    2570 la_array_size_error)
    +
    2571 return
    +
    2572 end if
    +
    2573 wptr => work(1:lwork)
    +
    2574 else
    +
    2575 allocate(wrk(lwork), stat = istat)
    +
    2576 if (istat /= 0) then
    +
    2577 ! ERROR: Out of memory
    +
    2578 call errmgr%report_error("mult_rz_vec_cmplx", &
    +
    2579 "Insufficient memory available.", &
    +
    2580 la_out_of_memory_error)
    +
    2581 return
    +
    2582 end if
    +
    2583 wptr => wrk
    +
    2584 end if
    +
    2585
    +
    2586 ! Call ZUNMRZ
    +
    2587 call zunmrz(side, t, m, 1, k, l, a, lda, tau, c, m, wptr, lwork, flag)
    +
    2588
    +
    2589 ! Formatting
    +
    2590100 format(a, i0, a)
    +
    2591 end subroutine
    +
    2592
    +
    2593! ******************************************************************************
    +
    2594! SVD ROUTINES
    +
    2595! ------------------------------------------------------------------------------
    +
    2596 module subroutine svd_dbl(a, s, u, vt, work, olwork, err)
    +
    2597 ! Arguments
    +
    2598 real(real64), intent(inout), dimension(:,:) :: a
    +
    2599 real(real64), intent(out), dimension(:) :: s
    +
    2600 real(real64), intent(out), optional, dimension(:,:) :: u, vt
    +
    2601 real(real64), intent(out), target, optional, dimension(:) :: work
    +
    2602 integer(int32), intent(out), optional :: olwork
    +
    2603 class(errors), intent(inout), optional, target :: err
    +
    2604
    +
    2605 ! Local Variables
    +
    2606 character :: jobu, jobvt
    +
    2607 integer(int32) :: m, n, mn, istat, lwork, flag
    +
    2608 real(real64), pointer, dimension(:) :: wptr
    +
    2609 real(real64), allocatable, target, dimension(:) :: wrk
    +
    2610 real(real64), dimension(1) :: temp
    +
    2611 class(errors), pointer :: errmgr
    +
    2612 type(errors), target :: deferr
    +
    2613 character(len = 128) :: errmsg
    +
    2614
    +
    2615 ! Initialization
    +
    2616 m = size(a, 1)
    +
    2617 n = size(a, 2)
    +
    2618 mn = min(m, n)
    +
    2619 if (present(u)) then
    +
    2620 if (size(u, 2) == m) then
    +
    2621 jobu = 'A'
    +
    2622 else if (size(u, 2) == mn) then
    +
    2623 jobu = 'S'
    +
    2624 end if
    +
    2625 else
    +
    2626 jobu = 'N'
    +
    2627 end if
    +
    2628 if (present(vt)) then
    +
    2629 jobvt = 'A'
    +
    2630 else
    +
    2631 jobvt = 'N'
    +
    2632 end if
    +
    2633 if (present(err)) then
    +
    2634 errmgr => err
    +
    2635 else
    +
    2636 errmgr => deferr
    +
    2637 end if
    +
    2638
    +
    2639 ! Input Check
    +
    2640 flag = 0
    +
    2641 if (size(s) /= mn) then
    +
    2642 flag = 2
    +
    2643 else if (present(u)) then
    +
    2644 if (size(u, 1) /= m) flag = 3
    +
    2645 if (size(u, 2) /= m .and. size(u, 2) /= mn) flag = 3
    +
    2646 else if (present(vt)) then
    +
    2647 if (size(vt, 1) /= n .or. size(vt, 2) /= n) flag = 4
    +
    2648 end if
    +
    2649 if (flag /= 0) then
    +
    2650 ! ERROR: One of the input arrays is not sized correctly
    +
    2651 write(errmsg, 100) "Input number ", flag, &
    +
    2652 " is not sized correctly."
    +
    2653 call errmgr%report_error("svd", trim(errmsg), &
    +
    2654 la_array_size_error)
    +
    2655 return
    +
    2656 end if
    +
    2657
    +
    2658 ! Workspace Query
    +
    2659 call dgesvd(jobu, jobvt, m, n, a, m, s, temp, m, temp, n, temp, -1, &
    +
    2660 flag)
    +
    2661 lwork = int(temp(1), int32)
    +
    2662 if (present(olwork)) then
    +
    2663 olwork = lwork
    +
    2664 return
    +
    2665 end if
    +
    2666
    +
    2667 ! Local Memory Allocation
    +
    2668 if (present(work)) then
    +
    2669 if (size(work) < lwork) then
    +
    2670 ! ERROR: WORK not sized correctly
    +
    2671 call errmgr%report_error("svd", &
    +
    2672 "Incorrectly sized input array WORK, argument 5.", &
    +
    2673 la_array_size_error)
    +
    2674 return
    +
    2675 end if
    +
    2676 wptr => work(1:lwork)
    +
    2677 else
    +
    2678 allocate(wrk(lwork), stat = istat)
    +
    2679 if (istat /= 0) then
    +
    2680 ! ERROR: Out of memory
    +
    2681 call errmgr%report_error("svd", &
    +
    2682 "Insufficient memory available.", &
    +
    2683 la_out_of_memory_error)
    +
    2684 return
    +
    2685 end if
    +
    2686 wptr => wrk
    +
    2687 end if
    +
    2688
    +
    2689 ! Call DGESVD
    +
    2690 if (present(u) .and. present(vt)) then
    +
    2691 call dgesvd(jobu, jobvt, m, n, a, m, s, u, m, vt, n, wptr, lwork, &
    +
    2692 flag)
    +
    2693 else if (present(u) .and. .not.present(vt)) then
    +
    2694 call dgesvd(jobu, jobvt, m, n, a, m, s, u, m, temp, n, wptr, &
    +
    2695 lwork, flag)
    +
    2696 else if (.not.present(u) .and. present(vt)) then
    +
    2697 call dgesvd(jobu, jobvt, m, n, a, m, s, temp, m, vt, n, wptr, &
    +
    2698 lwork, flag)
    +
    2699 else
    +
    2700 call dgesvd(jobu, jobvt, m, n, a, m, s, temp, m, temp, n, wptr, &
    +
    2701 lwork, flag)
    +
    2702 end if
    +
    2703
    +
    2704 ! Check for convergence
    +
    2705 if (flag > 0) then
    +
    2706 write(errmsg, 101) flag, " superdiagonals could not " // &
    +
    2707 "converge to zero as part of the QR iteration process."
    +
    2708 call errmgr%report_warning("svd", errmsg, la_convergence_error)
    +
    2709 end if
    +
    2710
    +
    2711 ! Formatting
    +
    2712100 format(a, i0, a)
    +
    2713101 format(i0, a)
    +
    2714 end subroutine
    +
    2715
    +
    2716! ------------------------------------------------------------------------------
    +
    2717 module subroutine svd_cmplx(a, s, u, vt, work, olwork, rwork, err)
    +
    2718 ! Arguments
    +
    2719 complex(real64), intent(inout), dimension(:,:) :: a
    +
    2720 real(real64), intent(out), dimension(:) :: s
    +
    2721 complex(real64), intent(out), optional, dimension(:,:) :: u, vt
    +
    2722 complex(real64), intent(out), target, optional, dimension(:) :: work
    +
    2723 integer(int32), intent(out), optional :: olwork
    +
    2724 real(real64), intent(out), target, optional, dimension(:) :: rwork
    +
    2725 class(errors), intent(inout), optional, target :: err
    +
    2726
    +
    2727 ! Local Variables
    +
    2728 character :: jobu, jobvt
    +
    2729 integer(int32) :: m, n, mn, istat, lwork, flag, lrwork
    +
    2730 complex(real64), pointer, dimension(:) :: wptr
    +
    2731 complex(real64), allocatable, target, dimension(:) :: wrk
    +
    2732 complex(real64), dimension(1) :: temp
    +
    2733 real(real64), dimension(1) :: rtemp
    +
    2734 real(real64), pointer, dimension(:) :: rwptr
    +
    2735 real(real64), allocatable, target, dimension(:) :: rwrk
    +
    2736 class(errors), pointer :: errmgr
    +
    2737 type(errors), target :: deferr
    +
    2738 character(len = 128) :: errmsg
    +
    2739
    +
    2740 ! Initialization
    +
    2741 m = size(a, 1)
    +
    2742 n = size(a, 2)
    +
    2743 mn = min(m, n)
    +
    2744 lrwork = 5 * mn
    +
    2745 if (present(u)) then
    +
    2746 if (size(u, 2) == m) then
    +
    2747 jobu = 'A'
    +
    2748 else if (size(u, 2) == mn) then
    +
    2749 jobu = 'S'
    +
    2750 end if
    2751 else
    -
    2752 call zgesvd(jobu, jobvt, m, n, a, m, s, temp, m, temp, n, wptr, &
    -
    2753 rwptr, lwork, flag)
    -
    2754 end if
    -
    2755
    -
    2756 ! Check for convergence
    -
    2757 if (flag > 0) then
    -
    2758 write(errmsg, '(I0A)') flag, " superdiagonals could not " // &
    -
    2759 "converge to zero as part of the QR iteration process."
    -
    2760 call errmgr%report_warning("svd_cmplx", errmsg, &
    -
    2761 la_convergence_error)
    -
    2762 end if
    -
    2763 end subroutine
    +
    2752 jobu = 'N'
    +
    2753 end if
    +
    2754 if (present(vt)) then
    +
    2755 jobvt = 'A'
    +
    2756 else
    +
    2757 jobvt = 'N'
    +
    2758 end if
    +
    2759 if (present(err)) then
    +
    2760 errmgr => err
    +
    2761 else
    +
    2762 errmgr => deferr
    +
    2763 end if
    2764
    -
    2765end submodule
    +
    2765 ! Input Check
    +
    2766 flag = 0
    +
    2767 if (size(s) /= mn) then
    +
    2768 flag = 2
    +
    2769 else if (present(u)) then
    +
    2770 if (size(u, 1) /= m) flag = 3
    +
    2771 if (size(u, 2) /= m .and. size(u, 2) /= mn) flag = 3
    +
    2772 else if (present(vt)) then
    +
    2773 if (size(vt, 1) /= n .or. size(vt, 2) /= n) flag = 4
    +
    2774 end if
    +
    2775 if (flag /= 0) then
    +
    2776 ! ERROR: One of the input arrays is not sized correctly
    +
    2777 write(errmsg, 100) "Input number ", flag, &
    +
    2778 " is not sized correctly."
    +
    2779 call errmgr%report_error("svd_cmplx", trim(errmsg), &
    +
    2780 la_array_size_error)
    +
    2781 return
    +
    2782 end if
    +
    2783
    +
    2784 ! Workspace Query
    +
    2785 call zgesvd(jobu, jobvt, m, n, a, m, s, temp, m, temp, n, temp, -1, &
    +
    2786 rtemp, flag)
    +
    2787 lwork = int(temp(1), int32)
    +
    2788 if (present(olwork)) then
    +
    2789 olwork = lwork
    +
    2790 return
    +
    2791 end if
    +
    2792
    +
    2793 ! Local Memory Allocation
    +
    2794 if (present(work)) then
    +
    2795 if (size(work) < lwork) then
    +
    2796 ! ERROR: WORK not sized correctly
    +
    2797 call errmgr%report_error("svd_cmplx", &
    +
    2798 "Incorrectly sized input array WORK, argument 5.", &
    +
    2799 la_array_size_error)
    +
    2800 return
    +
    2801 end if
    +
    2802 wptr => work(1:lwork)
    +
    2803 else
    +
    2804 allocate(wrk(lwork), stat = istat)
    +
    2805 if (istat /= 0) then
    +
    2806 ! ERROR: Out of memory
    +
    2807 call errmgr%report_error("svd_cmplx", &
    +
    2808 "Insufficient memory available.", &
    +
    2809 la_out_of_memory_error)
    +
    2810 return
    +
    2811 end if
    +
    2812 wptr => wrk
    +
    2813 end if
    +
    2814
    +
    2815 if (present(rwork)) then
    +
    2816 if (size(rwork) < lrwork) then
    +
    2817 ! ERROR: RWORK not sized correctly
    +
    2818 call errmgr%report_error("svd_cmplx", &
    +
    2819 "Incorrectly sized input array RWORK, argument 7.", &
    +
    2820 la_array_size_error)
    +
    2821 end if
    +
    2822 rwptr => rwork(1:lrwork)
    +
    2823 else
    +
    2824 allocate(rwrk(lrwork), stat = istat)
    +
    2825 if (istat /= 0) then
    +
    2826 ! ERROR: Out of memory
    +
    2827 call errmgr%report_error("svd_cmplx", &
    +
    2828 "Insufficient memory available.", &
    +
    2829 la_out_of_memory_error)
    +
    2830 return
    +
    2831 end if
    +
    2832 rwptr => rwrk
    +
    2833 end if
    +
    2834
    +
    2835 ! Call ZGESVD
    +
    2836 if (present(u) .and. present(vt)) then
    +
    2837 call zgesvd(jobu, jobvt, m, n, a, m, s, u, m, vt, n, wptr, lwork, &
    +
    2838 rwptr, flag)
    +
    2839 else if (present(u) .and. .not.present(vt)) then
    +
    2840 call zgesvd(jobu, jobvt, m, n, a, m, s, u, m, temp, n, wptr, &
    +
    2841 rwptr, lwork, flag)
    +
    2842 else if (.not.present(u) .and. present(vt)) then
    +
    2843 call zgesvd(jobu, jobvt, m, n, a, m, s, temp, m, vt, n, wptr, &
    +
    2844 rwptr, lwork, flag)
    +
    2845 else
    +
    2846 call zgesvd(jobu, jobvt, m, n, a, m, s, temp, m, temp, n, wptr, &
    +
    2847 rwptr, lwork, flag)
    +
    2848 end if
    +
    2849
    +
    2850 ! Check for convergence
    +
    2851 if (flag > 0) then
    +
    2852 write(errmsg, 101) flag, " superdiagonals could not " // &
    +
    2853 "converge to zero as part of the QR iteration process."
    +
    2854 call errmgr%report_warning("svd_cmplx", errmsg, &
    +
    2855 la_convergence_error)
    +
    2856 end if
    +
    2857
    +
    2858 ! Formatting
    +
    2859100 format(a, i0, a)
    +
    2860101 format(i0, a)
    +
    2861 end subroutine
    +
    2862
    +
    2863end submodule
    Provides a set of common linear algebra routines.
    Definition: linalg.f90:15
    diff --git a/doc/html/linalg__solve_8f90_source.html b/doc/html/linalg__solve_8f90_source.html index 8177da91..cf3ec11a 100644 --- a/doc/html/linalg__solve_8f90_source.html +++ b/doc/html/linalg__solve_8f90_source.html @@ -378,7 +378,7 @@
    280 end if
    281 if (flag /= 0) then
    282 ! One of the input arrays is not sized correctly
    -
    283 write(errmsg, '(AI0A)') "Input number ", flag, &
    +
    283 write(errmsg, 100) "Input number ", flag, &
    284 " is not sized correctly."
    285 call errmgr%report_error("solve_lu_mtx", trim(errmsg), &
    286 la_array_size_error)
    @@ -387,3100 +387,3184 @@
    289
    290 ! Call DGETRS
    291 call dgetrs("N", n, nrhs, a, n, ipvt, b, n, flag)
    -
    292 end subroutine
    -
    293
    -
    294! ------------------------------------------------------------------------------
    -
    295 module subroutine solve_lu_mtx_cmplx(a, ipvt, b, err)
    -
    296 ! Arguments
    -
    297 complex(real64), intent(in), dimension(:,:) :: a
    -
    298 integer(int32), intent(in), dimension(:) :: ipvt
    -
    299 complex(real64), intent(inout), dimension(:,:) :: b
    -
    300 class(errors), intent(inout), optional, target :: err
    -
    301
    -
    302 ! Local Variables
    -
    303 integer(int32) :: n, nrhs, flag
    -
    304 class(errors), pointer :: errmgr
    -
    305 type(errors), target :: deferr
    -
    306 character(len = 128) :: errmsg
    -
    307
    -
    308 ! Initialization
    -
    309 n = size(a, 1)
    -
    310 nrhs = size(b, 2)
    -
    311 if (present(err)) then
    -
    312 errmgr => err
    -
    313 else
    -
    314 errmgr => deferr
    -
    315 end if
    -
    316
    -
    317 ! Input Check
    -
    318 flag = 0
    -
    319 if (size(a, 2) /= n) then
    -
    320 flag = 1
    -
    321 else if (size(ipvt) /= n) then
    -
    322 flag = 2
    -
    323 else if (size(b, 1) /= n) then
    -
    324 flag = 3
    -
    325 end if
    -
    326 if (flag /= 0) then
    -
    327 ! One of the input arrays is not sized correctly
    -
    328 write(errmsg, '(AI0A)') "Input number ", flag, &
    -
    329 " is not sized correctly."
    -
    330 call errmgr%report_error("solve_lu_mtx_cmplx", trim(errmsg), &
    -
    331 la_array_size_error)
    -
    332 return
    -
    333 end if
    -
    334
    -
    335 ! Call ZGETRS
    -
    336 call zgetrs("N", n, nrhs, a, n, ipvt, b, n, flag)
    -
    337 end subroutine
    -
    338
    -
    339! ------------------------------------------------------------------------------
    -
    340 module subroutine solve_lu_vec(a, ipvt, b, err)
    -
    341 ! Arguments
    -
    342 real(real64), intent(in), dimension(:,:) :: a
    -
    343 integer(int32), intent(in), dimension(:) :: ipvt
    -
    344 real(real64), intent(inout), dimension(:) :: b
    -
    345 class(errors), intent(inout), optional, target :: err
    -
    346
    -
    347 ! Local Variables
    -
    348 integer(int32) :: n, flag
    -
    349 class(errors), pointer :: errmgr
    -
    350 type(errors), target :: deferr
    -
    351 character(len = 128) :: errmsg
    +
    292
    +
    293 ! Formatting
    +
    294100 format(a, i0, a)
    +
    295 end subroutine
    +
    296
    +
    297! ------------------------------------------------------------------------------
    +
    298 module subroutine solve_lu_mtx_cmplx(a, ipvt, b, err)
    +
    299 ! Arguments
    +
    300 complex(real64), intent(in), dimension(:,:) :: a
    +
    301 integer(int32), intent(in), dimension(:) :: ipvt
    +
    302 complex(real64), intent(inout), dimension(:,:) :: b
    +
    303 class(errors), intent(inout), optional, target :: err
    +
    304
    +
    305 ! Local Variables
    +
    306 integer(int32) :: n, nrhs, flag
    +
    307 class(errors), pointer :: errmgr
    +
    308 type(errors), target :: deferr
    +
    309 character(len = 128) :: errmsg
    +
    310
    +
    311 ! Initialization
    +
    312 n = size(a, 1)
    +
    313 nrhs = size(b, 2)
    +
    314 if (present(err)) then
    +
    315 errmgr => err
    +
    316 else
    +
    317 errmgr => deferr
    +
    318 end if
    +
    319
    +
    320 ! Input Check
    +
    321 flag = 0
    +
    322 if (size(a, 2) /= n) then
    +
    323 flag = 1
    +
    324 else if (size(ipvt) /= n) then
    +
    325 flag = 2
    +
    326 else if (size(b, 1) /= n) then
    +
    327 flag = 3
    +
    328 end if
    +
    329 if (flag /= 0) then
    +
    330 ! One of the input arrays is not sized correctly
    +
    331 write(errmsg, 100) "Input number ", flag, &
    +
    332 " is not sized correctly."
    +
    333 call errmgr%report_error("solve_lu_mtx_cmplx", trim(errmsg), &
    +
    334 la_array_size_error)
    +
    335 return
    +
    336 end if
    +
    337
    +
    338 ! Call ZGETRS
    +
    339 call zgetrs("N", n, nrhs, a, n, ipvt, b, n, flag)
    +
    340
    +
    341 ! Formatting
    +
    342100 format(a, i0, a)
    +
    343 end subroutine
    +
    344
    +
    345! ------------------------------------------------------------------------------
    +
    346 module subroutine solve_lu_vec(a, ipvt, b, err)
    +
    347 ! Arguments
    +
    348 real(real64), intent(in), dimension(:,:) :: a
    +
    349 integer(int32), intent(in), dimension(:) :: ipvt
    +
    350 real(real64), intent(inout), dimension(:) :: b
    +
    351 class(errors), intent(inout), optional, target :: err
    352
    -
    353 ! Initialization
    -
    354 n = size(a, 1)
    -
    355 if (present(err)) then
    -
    356 errmgr => err
    -
    357 else
    -
    358 errmgr => deferr
    -
    359 end if
    -
    360
    -
    361 ! Input Check
    -
    362 flag = 0
    -
    363 if (size(a, 2) /= n) then
    -
    364 flag = 1
    -
    365 else if (size(ipvt) /= n) then
    -
    366 flag = 2
    -
    367 else if (size(b) /= n) then
    -
    368 flag = 3
    -
    369 end if
    -
    370 if (flag /= 0) then
    -
    371 ! One of the input arrays is not sized correctly
    -
    372 write(errmsg, '(AI0A)') "Input number ", flag, &
    -
    373 " is not sized correctly."
    -
    374 call errmgr%report_error("solve_lu_vec", trim(errmsg), &
    -
    375 la_array_size_error)
    -
    376 return
    -
    377 end if
    -
    378
    -
    379 ! Call DGETRS
    -
    380 call dgetrs("N", n, 1, a, n, ipvt, b, n, flag)
    -
    381 end subroutine
    -
    382
    -
    383! ------------------------------------------------------------------------------
    -
    384 module subroutine solve_lu_vec_cmplx(a, ipvt, b, err)
    -
    385 ! Arguments
    -
    386 complex(real64), intent(in), dimension(:,:) :: a
    -
    387 integer(int32), intent(in), dimension(:) :: ipvt
    -
    388 complex(real64), intent(inout), dimension(:) :: b
    -
    389 class(errors), intent(inout), optional, target :: err
    -
    390
    -
    391 ! Local Variables
    -
    392 integer(int32) :: n, flag
    -
    393 class(errors), pointer :: errmgr
    -
    394 type(errors), target :: deferr
    -
    395 character(len = 128) :: errmsg
    -
    396
    -
    397 ! Initialization
    -
    398 n = size(a, 1)
    -
    399 if (present(err)) then
    -
    400 errmgr => err
    -
    401 else
    -
    402 errmgr => deferr
    -
    403 end if
    -
    404
    -
    405 ! Input Check
    -
    406 flag = 0
    -
    407 if (size(a, 2) /= n) then
    -
    408 flag = 1
    -
    409 else if (size(ipvt) /= n) then
    -
    410 flag = 2
    -
    411 else if (size(b) /= n) then
    -
    412 flag = 3
    -
    413 end if
    -
    414 if (flag /= 0) then
    -
    415 ! One of the input arrays is not sized correctly
    -
    416 write(errmsg, '(AI0A)') "Input number ", flag, &
    -
    417 " is not sized correctly."
    -
    418 call errmgr%report_error("solve_lu_vec_cmplx", trim(errmsg), &
    -
    419 la_array_size_error)
    -
    420 return
    -
    421 end if
    -
    422
    -
    423 ! Call ZGETRS
    -
    424 call zgetrs("N", n, 1, a, n, ipvt, b, n, flag)
    -
    425 end subroutine
    -
    426
    -
    427! ******************************************************************************
    -
    428! QR SOLUTION
    -
    429! ------------------------------------------------------------------------------
    -
    430 module subroutine solve_qr_no_pivot_mtx(a, tau, b, work, olwork, err)
    -
    431 ! Arguments
    -
    432 real(real64), intent(inout), dimension(:,:) :: a, b
    -
    433 real(real64), intent(in), dimension(:) :: tau
    -
    434 real(real64), intent(out), target, optional, dimension(:) :: work
    -
    435 integer(int32), intent(out), optional :: olwork
    -
    436 class(errors), intent(inout), optional, target :: err
    -
    437
    -
    438 ! Parameters
    -
    439 real(real64), parameter :: one = 1.0d0
    -
    440
    -
    441 ! Local Variables
    -
    442 integer(int32) :: m, n, nrhs, k, lwork, flag, istat
    -
    443 real(real64), pointer, dimension(:) :: wptr
    -
    444 real(real64), allocatable, target, dimension(:) :: wrk
    -
    445 class(errors), pointer :: errmgr
    -
    446 type(errors), target :: deferr
    -
    447 character(len = 128) :: errmsg
    -
    448
    -
    449 ! Initialization
    -
    450 m = size(a, 1)
    -
    451 n = size(a, 2)
    -
    452 nrhs = size(b, 2)
    -
    453 k = min(m, n)
    -
    454 if (present(err)) then
    -
    455 errmgr => err
    -
    456 else
    -
    457 errmgr => deferr
    -
    458 end if
    -
    459
    -
    460 ! Input Check
    -
    461 flag = 0
    -
    462 if (m < n) then
    -
    463 flag = 1
    -
    464 else if (size(tau) /= k) then
    -
    465 flag = 2
    -
    466 else if (size(b, 1) /= m) then
    -
    467 flag = 3
    -
    468 end if
    -
    469 if (flag /= 0) then
    -
    470 ! ERROR: One of the input arrays is not sized correctly
    -
    471 write(errmsg, '(AI0A)') "Input number ", flag, &
    -
    472 " is not sized correctly."
    -
    473 call errmgr%report_error("solve_qr_no_pivot_mtx", trim(errmsg), &
    -
    474 la_array_size_error)
    -
    475 return
    -
    476 end if
    -
    477
    -
    478 ! Workspace Query
    -
    479 call mult_qr(.true., .true., a, tau, b, olwork = lwork)
    -
    480 if (present(olwork)) then
    -
    481 olwork = lwork
    -
    482 return
    -
    483 end if
    -
    484
    -
    485 ! Local Memory Allocation
    -
    486 if (present(work)) then
    -
    487 if (size(work) < lwork) then
    -
    488 ! ERROR: WORK not sized correctly
    -
    489 call errmgr%report_error("solve_qr_no_pivot_mtx", &
    -
    490 "Incorrectly sized input array WORK, argument 4.", &
    -
    491 la_array_size_error)
    -
    492 return
    -
    493 end if
    -
    494 wptr => work(1:lwork)
    -
    495 else
    -
    496 allocate(wrk(lwork), stat = istat)
    -
    497 if (istat /= 0) then
    -
    498 ! ERROR: Out of memory
    -
    499 call errmgr%report_error("solve_qr_no_pivot_mtx", &
    -
    500 "Insufficient memory available.", &
    -
    501 la_out_of_memory_error)
    -
    502 return
    -
    503 end if
    -
    504 wptr => wrk
    -
    505 end if
    -
    506
    -
    507 ! Compute Q**T * B, and store in B
    -
    508 call mult_qr(.true., .true., a, tau, b, wptr)
    -
    509
    -
    510 ! Solve the triangular system: A(1:N,1:N)*X = B(1:N,:)
    -
    511 call solve_triangular_system(.true., .true., .false., .true., one, &
    -
    512 a(1:n,1:n), b(1:n,:))
    -
    513 end subroutine
    -
    514
    -
    515! ------------------------------------------------------------------------------
    -
    516 module subroutine solve_qr_no_pivot_mtx_cmplx(a, tau, b, work, olwork, err)
    -
    517 ! Arguments
    -
    518 complex(real64), intent(inout), dimension(:,:) :: a, b
    -
    519 complex(real64), intent(in), dimension(:) :: tau
    -
    520 complex(real64), intent(out), target, optional, dimension(:) :: work
    -
    521 integer(int32), intent(out), optional :: olwork
    -
    522 class(errors), intent(inout), optional, target :: err
    -
    523
    -
    524 ! Parameters
    -
    525 complex(real64), parameter :: one = (1.0d0, 0.0d0)
    -
    526
    -
    527 ! Local Variables
    -
    528 integer(int32) :: m, n, nrhs, k, lwork, flag, istat
    -
    529 complex(real64), pointer, dimension(:) :: wptr
    -
    530 complex(real64), allocatable, target, dimension(:) :: wrk
    -
    531 class(errors), pointer :: errmgr
    -
    532 type(errors), target :: deferr
    -
    533 character(len = 128) :: errmsg
    -
    534
    -
    535 ! Initialization
    -
    536 m = size(a, 1)
    -
    537 n = size(a, 2)
    -
    538 nrhs = size(b, 2)
    -
    539 k = min(m, n)
    -
    540 if (present(err)) then
    -
    541 errmgr => err
    -
    542 else
    -
    543 errmgr => deferr
    -
    544 end if
    -
    545
    -
    546 ! Input Check
    -
    547 flag = 0
    -
    548 if (m < n) then
    -
    549 flag = 1
    -
    550 else if (size(tau) /= k) then
    -
    551 flag = 2
    -
    552 else if (size(b, 1) /= m) then
    -
    553 flag = 3
    -
    554 end if
    -
    555 if (flag /= 0) then
    -
    556 ! ERROR: One of the input arrays is not sized correctly
    -
    557 write(errmsg, '(AI0A)') "Input number ", flag, &
    -
    558 " is not sized correctly."
    -
    559 call errmgr%report_error("solve_qr_no_pivot_mtx_cmplx", &
    -
    560 trim(errmsg), la_array_size_error)
    -
    561 return
    -
    562 end if
    -
    563
    -
    564 ! Workspace Query
    -
    565 call mult_qr(.true., .true., a, tau, b, olwork = lwork)
    -
    566 if (present(olwork)) then
    -
    567 olwork = lwork
    -
    568 return
    +
    353 ! Local Variables
    +
    354 integer(int32) :: n, flag
    +
    355 class(errors), pointer :: errmgr
    +
    356 type(errors), target :: deferr
    +
    357 character(len = 128) :: errmsg
    +
    358
    +
    359 ! Initialization
    +
    360 n = size(a, 1)
    +
    361 if (present(err)) then
    +
    362 errmgr => err
    +
    363 else
    +
    364 errmgr => deferr
    +
    365 end if
    +
    366
    +
    367 ! Input Check
    +
    368 flag = 0
    +
    369 if (size(a, 2) /= n) then
    +
    370 flag = 1
    +
    371 else if (size(ipvt) /= n) then
    +
    372 flag = 2
    +
    373 else if (size(b) /= n) then
    +
    374 flag = 3
    +
    375 end if
    +
    376 if (flag /= 0) then
    +
    377 ! One of the input arrays is not sized correctly
    +
    378 write(errmsg, 100) "Input number ", flag, &
    +
    379 " is not sized correctly."
    +
    380 call errmgr%report_error("solve_lu_vec", trim(errmsg), &
    +
    381 la_array_size_error)
    +
    382 return
    +
    383 end if
    +
    384
    +
    385 ! Call DGETRS
    +
    386 call dgetrs("N", n, 1, a, n, ipvt, b, n, flag)
    +
    387
    +
    388 ! Formatting
    +
    389100 format(a, i0, a)
    +
    390 end subroutine
    +
    391
    +
    392! ------------------------------------------------------------------------------
    +
    393 module subroutine solve_lu_vec_cmplx(a, ipvt, b, err)
    +
    394 ! Arguments
    +
    395 complex(real64), intent(in), dimension(:,:) :: a
    +
    396 integer(int32), intent(in), dimension(:) :: ipvt
    +
    397 complex(real64), intent(inout), dimension(:) :: b
    +
    398 class(errors), intent(inout), optional, target :: err
    +
    399
    +
    400 ! Local Variables
    +
    401 integer(int32) :: n, flag
    +
    402 class(errors), pointer :: errmgr
    +
    403 type(errors), target :: deferr
    +
    404 character(len = 128) :: errmsg
    +
    405
    +
    406 ! Initialization
    +
    407 n = size(a, 1)
    +
    408 if (present(err)) then
    +
    409 errmgr => err
    +
    410 else
    +
    411 errmgr => deferr
    +
    412 end if
    +
    413
    +
    414 ! Input Check
    +
    415 flag = 0
    +
    416 if (size(a, 2) /= n) then
    +
    417 flag = 1
    +
    418 else if (size(ipvt) /= n) then
    +
    419 flag = 2
    +
    420 else if (size(b) /= n) then
    +
    421 flag = 3
    +
    422 end if
    +
    423 if (flag /= 0) then
    +
    424 ! One of the input arrays is not sized correctly
    +
    425 write(errmsg, 100) "Input number ", flag, &
    +
    426 " is not sized correctly."
    +
    427 call errmgr%report_error("solve_lu_vec_cmplx", trim(errmsg), &
    +
    428 la_array_size_error)
    +
    429 return
    +
    430 end if
    +
    431
    +
    432 ! Call ZGETRS
    +
    433 call zgetrs("N", n, 1, a, n, ipvt, b, n, flag)
    +
    434
    +
    435 ! Formatting
    +
    436100 format(a, i0, a)
    +
    437 end subroutine
    +
    438
    +
    439! ******************************************************************************
    +
    440! QR SOLUTION
    +
    441! ------------------------------------------------------------------------------
    +
    442 module subroutine solve_qr_no_pivot_mtx(a, tau, b, work, olwork, err)
    +
    443 ! Arguments
    +
    444 real(real64), intent(inout), dimension(:,:) :: a, b
    +
    445 real(real64), intent(in), dimension(:) :: tau
    +
    446 real(real64), intent(out), target, optional, dimension(:) :: work
    +
    447 integer(int32), intent(out), optional :: olwork
    +
    448 class(errors), intent(inout), optional, target :: err
    +
    449
    +
    450 ! Parameters
    +
    451 real(real64), parameter :: one = 1.0d0
    +
    452
    +
    453 ! Local Variables
    +
    454 integer(int32) :: m, n, nrhs, k, lwork, flag, istat
    +
    455 real(real64), pointer, dimension(:) :: wptr
    +
    456 real(real64), allocatable, target, dimension(:) :: wrk
    +
    457 class(errors), pointer :: errmgr
    +
    458 type(errors), target :: deferr
    +
    459 character(len = 128) :: errmsg
    +
    460
    +
    461 ! Initialization
    +
    462 m = size(a, 1)
    +
    463 n = size(a, 2)
    +
    464 nrhs = size(b, 2)
    +
    465 k = min(m, n)
    +
    466 if (present(err)) then
    +
    467 errmgr => err
    +
    468 else
    +
    469 errmgr => deferr
    +
    470 end if
    +
    471
    +
    472 ! Input Check
    +
    473 flag = 0
    +
    474 if (m < n) then
    +
    475 flag = 1
    +
    476 else if (size(tau) /= k) then
    +
    477 flag = 2
    +
    478 else if (size(b, 1) /= m) then
    +
    479 flag = 3
    +
    480 end if
    +
    481 if (flag /= 0) then
    +
    482 ! ERROR: One of the input arrays is not sized correctly
    +
    483 write(errmsg, 100) "Input number ", flag, &
    +
    484 " is not sized correctly."
    +
    485 call errmgr%report_error("solve_qr_no_pivot_mtx", trim(errmsg), &
    +
    486 la_array_size_error)
    +
    487 return
    +
    488 end if
    +
    489
    +
    490 ! Workspace Query
    +
    491 call mult_qr(.true., .true., a, tau, b, olwork = lwork)
    +
    492 if (present(olwork)) then
    +
    493 olwork = lwork
    +
    494 return
    +
    495 end if
    +
    496
    +
    497 ! Local Memory Allocation
    +
    498 if (present(work)) then
    +
    499 if (size(work) < lwork) then
    +
    500 ! ERROR: WORK not sized correctly
    +
    501 call errmgr%report_error("solve_qr_no_pivot_mtx", &
    +
    502 "Incorrectly sized input array WORK, argument 4.", &
    +
    503 la_array_size_error)
    +
    504 return
    +
    505 end if
    +
    506 wptr => work(1:lwork)
    +
    507 else
    +
    508 allocate(wrk(lwork), stat = istat)
    +
    509 if (istat /= 0) then
    +
    510 ! ERROR: Out of memory
    +
    511 call errmgr%report_error("solve_qr_no_pivot_mtx", &
    +
    512 "Insufficient memory available.", &
    +
    513 la_out_of_memory_error)
    +
    514 return
    +
    515 end if
    +
    516 wptr => wrk
    +
    517 end if
    +
    518
    +
    519 ! Compute Q**T * B, and store in B
    +
    520 call mult_qr(.true., .true., a, tau, b, wptr)
    +
    521
    +
    522 ! Solve the triangular system: A(1:N,1:N)*X = B(1:N,:)
    +
    523 call solve_triangular_system(.true., .true., .false., .true., one, &
    +
    524 a(1:n,1:n), b(1:n,:))
    +
    525
    +
    526 ! Formatting
    +
    527100 format(a, i0, a)
    +
    528 end subroutine
    +
    529
    +
    530! ------------------------------------------------------------------------------
    +
    531 module subroutine solve_qr_no_pivot_mtx_cmplx(a, tau, b, work, olwork, err)
    +
    532 ! Arguments
    +
    533 complex(real64), intent(inout), dimension(:,:) :: a, b
    +
    534 complex(real64), intent(in), dimension(:) :: tau
    +
    535 complex(real64), intent(out), target, optional, dimension(:) :: work
    +
    536 integer(int32), intent(out), optional :: olwork
    +
    537 class(errors), intent(inout), optional, target :: err
    +
    538
    +
    539 ! Parameters
    +
    540 complex(real64), parameter :: one = (1.0d0, 0.0d0)
    +
    541
    +
    542 ! Local Variables
    +
    543 integer(int32) :: m, n, nrhs, k, lwork, flag, istat
    +
    544 complex(real64), pointer, dimension(:) :: wptr
    +
    545 complex(real64), allocatable, target, dimension(:) :: wrk
    +
    546 class(errors), pointer :: errmgr
    +
    547 type(errors), target :: deferr
    +
    548 character(len = 128) :: errmsg
    +
    549
    +
    550 ! Initialization
    +
    551 m = size(a, 1)
    +
    552 n = size(a, 2)
    +
    553 nrhs = size(b, 2)
    +
    554 k = min(m, n)
    +
    555 if (present(err)) then
    +
    556 errmgr => err
    +
    557 else
    +
    558 errmgr => deferr
    +
    559 end if
    +
    560
    +
    561 ! Input Check
    +
    562 flag = 0
    +
    563 if (m < n) then
    +
    564 flag = 1
    +
    565 else if (size(tau) /= k) then
    +
    566 flag = 2
    +
    567 else if (size(b, 1) /= m) then
    +
    568 flag = 3
    569 end if
    -
    570
    -
    571 ! Local Memory Allocation
    -
    572 if (present(work)) then
    -
    573 if (size(work) < lwork) then
    -
    574 ! ERROR: WORK not sized correctly
    -
    575 call errmgr%report_error("solve_qr_no_pivot_mtx_cmplx", &
    -
    576 "Incorrectly sized input array WORK, argument 4.", &
    -
    577 la_array_size_error)
    -
    578 return
    -
    579 end if
    -
    580 wptr => work(1:lwork)
    -
    581 else
    -
    582 allocate(wrk(lwork), stat = istat)
    -
    583 if (istat /= 0) then
    -
    584 ! ERROR: Out of memory
    -
    585 call errmgr%report_error("solve_qr_no_pivot_mtx_cmplx", &
    -
    586 "Insufficient memory available.", &
    -
    587 la_out_of_memory_error)
    -
    588 return
    -
    589 end if
    -
    590 wptr => wrk
    -
    591 end if
    -
    592
    -
    593 ! Compute Q**T * B, and store in B
    -
    594 call mult_qr(.true., .true., a, tau, b, wptr)
    -
    595
    -
    596 ! Solve the triangular system: A(1:N,1:N)*X = B(1:N,:)
    -
    597 call solve_triangular_system(.true., .true., .false., .true., one, &
    -
    598 a(1:n,1:n), b(1:n,:))
    -
    599 end subroutine
    -
    600
    -
    601! ------------------------------------------------------------------------------
    -
    602 module subroutine solve_qr_no_pivot_vec(a, tau, b, work, olwork, err)
    -
    603 ! Arguments
    -
    604 real(real64), intent(inout), dimension(:,:) :: a
    -
    605 real(real64), intent(in), dimension(:) :: tau
    -
    606 real(real64), intent(inout), dimension(:) :: b
    -
    607 real(real64), intent(out), target, optional, dimension(:) :: work
    -
    608 integer(int32), intent(out), optional :: olwork
    -
    609 class(errors), intent(inout), optional, target :: err
    +
    570 if (flag /= 0) then
    +
    571 ! ERROR: One of the input arrays is not sized correctly
    +
    572 write(errmsg, 100) "Input number ", flag, &
    +
    573 " is not sized correctly."
    +
    574 call errmgr%report_error("solve_qr_no_pivot_mtx_cmplx", &
    +
    575 trim(errmsg), la_array_size_error)
    +
    576 return
    +
    577 end if
    +
    578
    +
    579 ! Workspace Query
    +
    580 call mult_qr(.true., .true., a, tau, b, olwork = lwork)
    +
    581 if (present(olwork)) then
    +
    582 olwork = lwork
    +
    583 return
    +
    584 end if
    +
    585
    +
    586 ! Local Memory Allocation
    +
    587 if (present(work)) then
    +
    588 if (size(work) < lwork) then
    +
    589 ! ERROR: WORK not sized correctly
    +
    590 call errmgr%report_error("solve_qr_no_pivot_mtx_cmplx", &
    +
    591 "Incorrectly sized input array WORK, argument 4.", &
    +
    592 la_array_size_error)
    +
    593 return
    +
    594 end if
    +
    595 wptr => work(1:lwork)
    +
    596 else
    +
    597 allocate(wrk(lwork), stat = istat)
    +
    598 if (istat /= 0) then
    +
    599 ! ERROR: Out of memory
    +
    600 call errmgr%report_error("solve_qr_no_pivot_mtx_cmplx", &
    +
    601 "Insufficient memory available.", &
    +
    602 la_out_of_memory_error)
    +
    603 return
    +
    604 end if
    +
    605 wptr => wrk
    +
    606 end if
    +
    607
    +
    608 ! Compute Q**T * B, and store in B
    +
    609 call mult_qr(.true., .true., a, tau, b, wptr)
    610
    -
    611 ! Local Variables
    -
    612 integer(int32) :: m, n, k, flag, lwork, istat
    -
    613 real(real64), pointer, dimension(:) :: wptr
    -
    614 real(real64), allocatable, target, dimension(:) :: wrk
    -
    615 class(errors), pointer :: errmgr
    -
    616 type(errors), target :: deferr
    -
    617 character(len = 128) :: errmsg
    +
    611 ! Solve the triangular system: A(1:N,1:N)*X = B(1:N,:)
    +
    612 call solve_triangular_system(.true., .true., .false., .true., one, &
    +
    613 a(1:n,1:n), b(1:n,:))
    +
    614
    +
    615 ! Formatting
    +
    616100 format(a, i0, a)
    +
    617 end subroutine
    618
    -
    619 ! Initialization
    -
    620 m = size(a, 1)
    -
    621 n = size(a, 2)
    -
    622 k = min(m, n)
    -
    623 if (present(err)) then
    -
    624 errmgr => err
    -
    625 else
    -
    626 errmgr => deferr
    -
    627 end if
    +
    619! ------------------------------------------------------------------------------
    +
    620 module subroutine solve_qr_no_pivot_vec(a, tau, b, work, olwork, err)
    +
    621 ! Arguments
    +
    622 real(real64), intent(inout), dimension(:,:) :: a
    +
    623 real(real64), intent(in), dimension(:) :: tau
    +
    624 real(real64), intent(inout), dimension(:) :: b
    +
    625 real(real64), intent(out), target, optional, dimension(:) :: work
    +
    626 integer(int32), intent(out), optional :: olwork
    +
    627 class(errors), intent(inout), optional, target :: err
    628
    -
    629 ! Input Check
    -
    630 flag = 0
    -
    631 if (m < n) then
    -
    632 flag = 1
    -
    633 else if (size(tau) /= k) then
    -
    634 flag = 2
    -
    635 else if (size(b) /= m) then
    -
    636 flag = 3
    -
    637 end if
    -
    638 if (flag /= 0) then
    -
    639 ! ERROR: One of the input arrays is not sized correctly
    -
    640 write(errmsg, '(AI0A)') "Input number ", flag, &
    -
    641 " is not sized correctly."
    -
    642 call errmgr%report_error("solve_qr_no_pivot_vec", trim(errmsg), &
    -
    643 la_array_size_error)
    -
    644 return
    +
    629 ! Local Variables
    +
    630 integer(int32) :: m, n, k, flag, lwork, istat
    +
    631 real(real64), pointer, dimension(:) :: wptr
    +
    632 real(real64), allocatable, target, dimension(:) :: wrk
    +
    633 class(errors), pointer :: errmgr
    +
    634 type(errors), target :: deferr
    +
    635 character(len = 128) :: errmsg
    +
    636
    +
    637 ! Initialization
    +
    638 m = size(a, 1)
    +
    639 n = size(a, 2)
    +
    640 k = min(m, n)
    +
    641 if (present(err)) then
    +
    642 errmgr => err
    +
    643 else
    +
    644 errmgr => deferr
    645 end if
    646
    -
    647 ! Workspace Query
    -
    648 call mult_qr(.true., a, tau, b, olwork = lwork)
    -
    649 if (present(olwork)) then
    -
    650 olwork = lwork
    -
    651 return
    -
    652 end if
    -
    653
    -
    654 ! Local Memory Allocation
    -
    655 if (present(work)) then
    -
    656 if (size(work) < lwork) then
    -
    657 ! ERROR: WORK not sized correctly
    -
    658 call errmgr%report_error("solve_qr_no_pivot_vec", &
    -
    659 "Incorrectly sized input array WORK, argument 4.", &
    -
    660 la_array_size_error)
    -
    661 return
    -
    662 end if
    -
    663 wptr => work(1:lwork)
    -
    664 else
    -
    665 allocate(wrk(lwork), stat = istat)
    -
    666 if (istat /= 0) then
    -
    667 ! ERROR: Out of memory
    -
    668 call errmgr%report_error("solve_qr_no_pivot_vec", &
    -
    669 "Insufficient memory available.", &
    -
    670 la_out_of_memory_error)
    -
    671 return
    -
    672 end if
    -
    673 wptr => wrk
    -
    674 end if
    -
    675
    -
    676 ! Compute Q**T * B, and store in B
    -
    677 call mult_qr(.true., a, tau, b, work = wptr)
    -
    678
    -
    679 ! Solve the triangular system: A(1:N,1:N)*X = B(1:N)
    -
    680 call solve_triangular_system(.true., .false., .true., a(1:n,1:n), b)
    -
    681 end subroutine
    -
    682
    -
    683! ------------------------------------------------------------------------------
    -
    684 module subroutine solve_qr_no_pivot_vec_cmplx(a, tau, b, work, olwork, err)
    -
    685 ! Arguments
    -
    686 complex(real64), intent(inout), dimension(:,:) :: a
    -
    687 complex(real64), intent(in), dimension(:) :: tau
    -
    688 complex(real64), intent(inout), dimension(:) :: b
    -
    689 complex(real64), intent(out), target, optional, dimension(:) :: work
    -
    690 integer(int32), intent(out), optional :: olwork
    -
    691 class(errors), intent(inout), optional, target :: err
    -
    692
    -
    693 ! Local Variables
    -
    694 integer(int32) :: m, n, k, flag, lwork, istat
    -
    695 complex(real64), pointer, dimension(:) :: wptr
    -
    696 complex(real64), allocatable, target, dimension(:) :: wrk
    -
    697 class(errors), pointer :: errmgr
    -
    698 type(errors), target :: deferr
    -
    699 character(len = 128) :: errmsg
    -
    700
    -
    701 ! Initialization
    -
    702 m = size(a, 1)
    -
    703 n = size(a, 2)
    -
    704 k = min(m, n)
    -
    705 if (present(err)) then
    -
    706 errmgr => err
    -
    707 else
    -
    708 errmgr => deferr
    -
    709 end if
    -
    710
    -
    711 ! Input Check
    -
    712 flag = 0
    -
    713 if (m < n) then
    -
    714 flag = 1
    -
    715 else if (size(tau) /= k) then
    -
    716 flag = 2
    -
    717 else if (size(b) /= m) then
    -
    718 flag = 3
    -
    719 end if
    -
    720 if (flag /= 0) then
    -
    721 ! ERROR: One of the input arrays is not sized correctly
    -
    722 write(errmsg, '(AI0A)') "Input number ", flag, &
    -
    723 " is not sized correctly."
    -
    724 call errmgr%report_error("solve_qr_no_pivot_vec_cmplx", &
    -
    725 trim(errmsg), la_array_size_error)
    -
    726 return
    -
    727 end if
    -
    728
    -
    729 ! Workspace Query
    -
    730 call mult_qr(.true., a, tau, b, olwork = lwork)
    -
    731 if (present(olwork)) then
    -
    732 olwork = lwork
    -
    733 return
    -
    734 end if
    -
    735
    -
    736 ! Local Memory Allocation
    -
    737 if (present(work)) then
    -
    738 if (size(work) < lwork) then
    -
    739 ! ERROR: WORK not sized correctly
    -
    740 call errmgr%report_error("solve_qr_no_pivot_vec_cmplx", &
    -
    741 "Incorrectly sized input array WORK, argument 4.", &
    -
    742 la_array_size_error)
    -
    743 return
    -
    744 end if
    -
    745 wptr => work(1:lwork)
    -
    746 else
    -
    747 allocate(wrk(lwork), stat = istat)
    -
    748 if (istat /= 0) then
    -
    749 ! ERROR: Out of memory
    -
    750 call errmgr%report_error("solve_qr_no_pivot_vec_cmplx", &
    -
    751 "Insufficient memory available.", &
    -
    752 la_out_of_memory_error)
    -
    753 return
    -
    754 end if
    -
    755 wptr => wrk
    -
    756 end if
    -
    757
    -
    758 ! Compute Q**T * B, and store in B
    -
    759 call mult_qr(.true., a, tau, b, work = wptr)
    -
    760
    -
    761 ! Solve the triangular system: A(1:N,1:N)*X = B(1:N)
    -
    762 call solve_triangular_system(.true., .false., .true., a(1:n,1:n), b)
    -
    763 end subroutine
    -
    764
    -
    765! ------------------------------------------------------------------------------
    -
    766 module subroutine solve_qr_pivot_mtx(a, tau, jpvt, b, work, olwork, err)
    -
    767 ! Arguments
    -
    768 real(real64), intent(inout), dimension(:,:) :: a
    -
    769 real(real64), intent(in), dimension(:) :: tau
    -
    770 integer(int32), intent(in), dimension(:) :: jpvt
    -
    771 real(real64), intent(inout), dimension(:,:) :: b
    -
    772 real(real64), intent(out), target, optional, dimension(:) :: work
    -
    773 integer(int32), intent(out), optional :: olwork
    -
    774 class(errors), intent(inout), optional, target :: err
    -
    775
    -
    776 ! Parameters
    -
    777 integer(int32), parameter :: imin = 2
    -
    778 integer(int32), parameter :: imax = 1
    -
    779 real(real64), parameter :: zero = 0.0d0
    -
    780 real(real64), parameter :: one = 1.0d0
    +
    647 ! Input Check
    +
    648 flag = 0
    +
    649 if (m < n) then
    +
    650 flag = 1
    +
    651 else if (size(tau) /= k) then
    +
    652 flag = 2
    +
    653 else if (size(b) /= m) then
    +
    654 flag = 3
    +
    655 end if
    +
    656 if (flag /= 0) then
    +
    657 ! ERROR: One of the input arrays is not sized correctly
    +
    658 write(errmsg, 100) "Input number ", flag, &
    +
    659 " is not sized correctly."
    +
    660 call errmgr%report_error("solve_qr_no_pivot_vec", trim(errmsg), &
    +
    661 la_array_size_error)
    +
    662 return
    +
    663 end if
    +
    664
    +
    665 ! Workspace Query
    +
    666 call mult_qr(.true., a, tau, b, olwork = lwork)
    +
    667 if (present(olwork)) then
    +
    668 olwork = lwork
    +
    669 return
    +
    670 end if
    +
    671
    +
    672 ! Local Memory Allocation
    +
    673 if (present(work)) then
    +
    674 if (size(work) < lwork) then
    +
    675 ! ERROR: WORK not sized correctly
    +
    676 call errmgr%report_error("solve_qr_no_pivot_vec", &
    +
    677 "Incorrectly sized input array WORK, argument 4.", &
    +
    678 la_array_size_error)
    +
    679 return
    +
    680 end if
    +
    681 wptr => work(1:lwork)
    +
    682 else
    +
    683 allocate(wrk(lwork), stat = istat)
    +
    684 if (istat /= 0) then
    +
    685 ! ERROR: Out of memory
    +
    686 call errmgr%report_error("solve_qr_no_pivot_vec", &
    +
    687 "Insufficient memory available.", &
    +
    688 la_out_of_memory_error)
    +
    689 return
    +
    690 end if
    +
    691 wptr => wrk
    +
    692 end if
    +
    693
    +
    694 ! Compute Q**T * B, and store in B
    +
    695 call mult_qr(.true., a, tau, b, work = wptr)
    +
    696
    +
    697 ! Solve the triangular system: A(1:N,1:N)*X = B(1:N)
    +
    698 call solve_triangular_system(.true., .false., .true., a(1:n,1:n), b)
    +
    699
    +
    700 ! Formatting
    +
    701100 format(a, i0, a)
    +
    702 end subroutine
    +
    703
    +
    704! ------------------------------------------------------------------------------
    +
    705 module subroutine solve_qr_no_pivot_vec_cmplx(a, tau, b, work, olwork, err)
    +
    706 ! Arguments
    +
    707 complex(real64), intent(inout), dimension(:,:) :: a
    +
    708 complex(real64), intent(in), dimension(:) :: tau
    +
    709 complex(real64), intent(inout), dimension(:) :: b
    +
    710 complex(real64), intent(out), target, optional, dimension(:) :: work
    +
    711 integer(int32), intent(out), optional :: olwork
    +
    712 class(errors), intent(inout), optional, target :: err
    +
    713
    +
    714 ! Local Variables
    +
    715 integer(int32) :: m, n, k, flag, lwork, istat
    +
    716 complex(real64), pointer, dimension(:) :: wptr
    +
    717 complex(real64), allocatable, target, dimension(:) :: wrk
    +
    718 class(errors), pointer :: errmgr
    +
    719 type(errors), target :: deferr
    +
    720 character(len = 128) :: errmsg
    +
    721
    +
    722 ! Initialization
    +
    723 m = size(a, 1)
    +
    724 n = size(a, 2)
    +
    725 k = min(m, n)
    +
    726 if (present(err)) then
    +
    727 errmgr => err
    +
    728 else
    +
    729 errmgr => deferr
    +
    730 end if
    +
    731
    +
    732 ! Input Check
    +
    733 flag = 0
    +
    734 if (m < n) then
    +
    735 flag = 1
    +
    736 else if (size(tau) /= k) then
    +
    737 flag = 2
    +
    738 else if (size(b) /= m) then
    +
    739 flag = 3
    +
    740 end if
    +
    741 if (flag /= 0) then
    +
    742 ! ERROR: One of the input arrays is not sized correctly
    +
    743 write(errmsg, 100) "Input number ", flag, &
    +
    744 " is not sized correctly."
    +
    745 call errmgr%report_error("solve_qr_no_pivot_vec_cmplx", &
    +
    746 trim(errmsg), la_array_size_error)
    +
    747 return
    +
    748 end if
    +
    749
    +
    750 ! Workspace Query
    +
    751 call mult_qr(.true., a, tau, b, olwork = lwork)
    +
    752 if (present(olwork)) then
    +
    753 olwork = lwork
    +
    754 return
    +
    755 end if
    +
    756
    +
    757 ! Local Memory Allocation
    +
    758 if (present(work)) then
    +
    759 if (size(work) < lwork) then
    +
    760 ! ERROR: WORK not sized correctly
    +
    761 call errmgr%report_error("solve_qr_no_pivot_vec_cmplx", &
    +
    762 "Incorrectly sized input array WORK, argument 4.", &
    +
    763 la_array_size_error)
    +
    764 return
    +
    765 end if
    +
    766 wptr => work(1:lwork)
    +
    767 else
    +
    768 allocate(wrk(lwork), stat = istat)
    +
    769 if (istat /= 0) then
    +
    770 ! ERROR: Out of memory
    +
    771 call errmgr%report_error("solve_qr_no_pivot_vec_cmplx", &
    +
    772 "Insufficient memory available.", &
    +
    773 la_out_of_memory_error)
    +
    774 return
    +
    775 end if
    +
    776 wptr => wrk
    +
    777 end if
    +
    778
    +
    779 ! Compute Q**T * B, and store in B
    +
    780 call mult_qr(.true., a, tau, b, work = wptr)
    781
    -
    782 ! Local Variables
    -
    783 integer(int32) :: i, j, m, n, mn, nrhs, lwork, ismin, ismax, &
    -
    784 rnk, maxmn, flag, istat, lwork1, lwork2, lwork3
    -
    785 real(real64) :: rcond, smax, smin, smaxpr, sminpr, s1, c1, s2, c2
    -
    786 real(real64), pointer, dimension(:) :: wptr, w, tau2
    -
    787 real(real64), allocatable, target, dimension(:) :: wrk
    -
    788 class(errors), pointer :: errmgr
    -
    789 type(errors), target :: deferr
    -
    790 character(len = 128) :: errmsg
    -
    791
    -
    792 ! Initialization
    -
    793 m = size(a, 1)
    -
    794 n = size(a, 2)
    -
    795 mn = min(m, n)
    -
    796 maxmn = max(m, n)
    -
    797 nrhs = size(b, 2)
    -
    798 ismin = mn + 1
    -
    799 ismax = 2 * mn + 1
    -
    800 rcond = epsilon(rcond)
    -
    801 if (present(err)) then
    -
    802 errmgr => err
    -
    803 else
    -
    804 errmgr => deferr
    -
    805 end if
    -
    806
    -
    807 ! Input Check
    -
    808 flag = 0
    -
    809 if (size(tau) /= mn) then
    -
    810 flag = 2
    -
    811 else if (size(jpvt) /= n) then
    -
    812 flag = 3
    -
    813 else if (size(b, 1) /= maxmn) then
    -
    814 flag = 4
    -
    815 end if
    -
    816 if (flag /= 0) then
    -
    817 ! ERROR: One of the input arrays is not sized correctly
    -
    818 write(errmsg, '(AI0A)') "Input number ", flag, &
    -
    819 " is not sized correctly."
    -
    820 call errmgr%report_error("solve_qr_pivot_mtx", trim(errmsg), &
    -
    821 la_array_size_error)
    -
    822 return
    -
    823 end if
    -
    824
    -
    825 ! Workspace Query
    -
    826 call rz_factor(a(1:mn,:), a(1:mn,1), olwork = lwork1)
    -
    827 call mult_qr(.true., .true., a, tau, b(1:m,:), olwork = lwork2)
    -
    828 call mult_rz(.true., .true., n, a(1:mn,:), a(1:mn,1), b(1:n,:), &
    -
    829 olwork = lwork3)
    -
    830 lwork = max(lwork1, lwork2, lwork3, 2 * mn + 1) + mn
    -
    831 if (present(olwork)) then
    -
    832 olwork = lwork
    -
    833 return
    -
    834 end if
    -
    835
    -
    836 ! Local Memory Allocation
    -
    837 if (present(work)) then
    -
    838 if (size(work) < lwork) then
    -
    839 ! ERROR: WORK not sized correctly
    -
    840 call errmgr%report_error("solve_qr_no_pivot_mtx", &
    -
    841 "Incorrectly sized input array WORK, argument 5.", &
    -
    842 la_array_size_error)
    -
    843 return
    -
    844 end if
    -
    845 wptr => work(1:lwork)
    -
    846 else
    -
    847 allocate(wrk(lwork), stat = istat)
    -
    848 if (istat /= 0) then
    -
    849 ! ERROR: Out of memory
    -
    850 call errmgr%report_error("solve_qr_pivot_mtx", &
    -
    851 "Insufficient memory available.", &
    -
    852 la_out_of_memory_error)
    -
    853 return
    -
    854 end if
    -
    855 wptr => wrk
    -
    856 end if
    -
    857
    -
    858 ! Determine the rank of R11 using an incremental condition estimation
    -
    859 wptr(ismin) = one
    -
    860 wptr(ismax) = one
    -
    861 smax = abs(a(1,1))
    -
    862 smin = smax
    -
    863 if (abs(a(1,1)) == zero) then
    -
    864 rnk = 0
    -
    865 b(1:maxmn,:) = zero
    -
    866 return
    -
    867 else
    -
    868 rnk = 1
    -
    869 end if
    -
    870 do
    -
    871 if (rnk < mn) then
    -
    872 i = rnk + 1
    -
    873 call dlaic1(imin, rnk, wptr(ismin:ismin+rnk-1), smin, &
    -
    874 a(1:rnk-1,i), a(i,i), sminpr, s1, c1)
    -
    875 call dlaic1(imax, rnk, wptr(ismax:ismax+rnk-1), smax, &
    -
    876 a(1:rnk-1,i), a(i,i), smaxpr, s2, c2)
    -
    877 if (smaxpr * rcond <= sminpr) then
    -
    878 do i = 1, rnk
    -
    879 wptr(ismin+i-1) = s1 * wptr(ismin+i-1)
    -
    880 wptr(ismax+i-1) = s2 * wptr(ismax+i-1)
    -
    881 end do
    -
    882 wptr(ismin+rnk) = c1
    -
    883 wptr(ismax+rnk) = c2
    -
    884 smin = sminpr
    -
    885 smax = smaxpr
    -
    886 rnk = rnk + 1
    -
    887 cycle
    -
    888 end if
    -
    889 end if
    -
    890 exit
    -
    891 end do
    -
    892
    -
    893 ! Partition R = [R11 R12]
    -
    894 ! [ 0 R22]
    -
    895 tau2 => wptr(1:rnk)
    -
    896 w => wptr(rnk+1:lwork)
    -
    897 if (rnk < n) call rz_factor(a(1:rnk,:), tau2, w)
    -
    898
    -
    899 ! Compute B(1:m,1:NRHS) = Q**T * B(1:M,1:NRHS)
    -
    900 call mult_qr(.true., .true., a, tau, b(1:m,:), w)
    -
    901
    -
    902 ! Solve the triangular system T11 * B(1:rnk,1:nrhs) = B(1:rnk,1:nrhs)
    -
    903 call solve_triangular_system(.true., .true., .false., .true., one, &
    -
    904 a(1:rnk,1:rnk), b(1:rnk,:))
    -
    905 if (n > rnk) b(rnk+1:n,:) = zero
    -
    906
    -
    907 ! Compute B(1:n,1:nrhs) = Y**T * B(1:n,1:nrhs)
    -
    908 if (rnk < n) then
    -
    909 call mult_rz(.true., .true., n - rnk, a(1:rnk,:), tau2, b(1:n,:), w)
    -
    910 end if
    -
    911
    -
    912 ! Apply the pivoting: B(1:N,1:NRHS) = P * B(1:N,1:NRHS)
    -
    913 do j = 1, nrhs
    -
    914 do i = 1, n
    -
    915 wptr(jpvt(i)) = b(i,j)
    -
    916 end do
    -
    917 b(:,j) = wptr(1:n)
    -
    918 end do
    -
    919 end subroutine
    -
    920
    -
    921! ------------------------------------------------------------------------------
    -
    922 module subroutine solve_qr_pivot_mtx_cmplx(a, tau, jpvt, b, work, olwork, err)
    -
    923 ! Arguments
    -
    924 complex(real64), intent(inout), dimension(:,:) :: a
    -
    925 complex(real64), intent(in), dimension(:) :: tau
    -
    926 integer(int32), intent(in), dimension(:) :: jpvt
    -
    927 complex(real64), intent(inout), dimension(:,:) :: b
    -
    928 complex(real64), intent(out), target, optional, dimension(:) :: work
    -
    929 integer(int32), intent(out), optional :: olwork
    -
    930 class(errors), intent(inout), optional, target :: err
    -
    931
    -
    932 ! Parameters
    -
    933 integer(int32), parameter :: imin = 2
    -
    934 integer(int32), parameter :: imax = 1
    -
    935 complex(real64), parameter :: zero = (0.0d0, 0.0d0)
    -
    936 complex(real64), parameter :: one = (1.0d0, 0.0d0)
    -
    937
    -
    938 ! Local Variables
    -
    939 integer(int32) :: i, j, m, n, mn, nrhs, lwork, ismin, ismax, &
    -
    940 rnk, maxmn, flag, istat, lwork1, lwork2, lwork3
    -
    941 real(real64) :: rcond, smax, smin, smaxpr, sminpr
    -
    942 complex(real64) :: s1, c1, s2, c2
    -
    943 complex(real64), pointer, dimension(:) :: wptr, w, tau2
    -
    944 complex(real64), allocatable, target, dimension(:) :: wrk
    -
    945 class(errors), pointer :: errmgr
    -
    946 type(errors), target :: deferr
    -
    947 character(len = 128) :: errmsg
    -
    948
    -
    949 ! Initialization
    -
    950 m = size(a, 1)
    -
    951 n = size(a, 2)
    -
    952 mn = min(m, n)
    -
    953 maxmn = max(m, n)
    -
    954 nrhs = size(b, 2)
    -
    955 ismin = mn + 1
    -
    956 ismax = 2 * mn + 1
    -
    957 rcond = epsilon(rcond)
    -
    958 if (present(err)) then
    -
    959 errmgr => err
    -
    960 else
    -
    961 errmgr => deferr
    -
    962 end if
    -
    963
    -
    964 ! Input Check
    -
    965 flag = 0
    -
    966 if (size(tau) /= mn) then
    -
    967 flag = 2
    -
    968 else if (size(jpvt) /= n) then
    -
    969 flag = 3
    -
    970 else if (size(b, 1) /= maxmn) then
    -
    971 flag = 4
    -
    972 end if
    -
    973 if (flag /= 0) then
    -
    974 ! ERROR: One of the input arrays is not sized correctly
    -
    975 write(errmsg, '(AI0A)') "Input number ", flag, &
    -
    976 " is not sized correctly."
    -
    977 call errmgr%report_error("solve_qr_pivot_mtx_cmplx", &
    -
    978 trim(errmsg), la_array_size_error)
    -
    979 return
    -
    980 end if
    -
    981
    -
    982 ! Workspace Query
    -
    983 call rz_factor(a(1:mn,:), a(1:mn,1), olwork = lwork1)
    -
    984 call mult_qr(.true., .true., a, tau, b(1:m,:), olwork = lwork2)
    -
    985 call mult_rz(.true., .true., n, a(1:mn,:), a(1:mn,1), b(1:n,:), &
    -
    986 olwork = lwork3)
    -
    987 lwork = max(lwork1, lwork2, lwork3, 2 * mn + 1) + mn
    -
    988 if (present(olwork)) then
    -
    989 olwork = lwork
    -
    990 return
    -
    991 end if
    -
    992
    -
    993 ! Local Memory Allocation
    -
    994 if (present(work)) then
    -
    995 if (size(work) < lwork) then
    -
    996 ! ERROR: WORK not sized correctly
    -
    997 call errmgr%report_error("solve_qr_no_pivot_mtx_cmplx", &
    -
    998 "Incorrectly sized input array WORK, argument 5.", &
    -
    999 la_array_size_error)
    -
    1000 return
    -
    1001 end if
    -
    1002 wptr => work(1:lwork)
    -
    1003 else
    -
    1004 allocate(wrk(lwork), stat = istat)
    -
    1005 if (istat /= 0) then
    -
    1006 ! ERROR: Out of memory
    -
    1007 call errmgr%report_error("solve_qr_pivot_mtx_cmplx", &
    -
    1008 "Insufficient memory available.", &
    -
    1009 la_out_of_memory_error)
    -
    1010 return
    -
    1011 end if
    -
    1012 wptr => wrk
    -
    1013 end if
    -
    1014
    -
    1015 ! Determine the rank of R11 using an incremental condition estimation
    -
    1016 wptr(ismin) = one
    -
    1017 wptr(ismax) = one
    -
    1018 smax = abs(a(1,1))
    -
    1019 smin = smax
    -
    1020 if (abs(a(1,1)) == zero) then
    -
    1021 rnk = 0
    -
    1022 b(1:maxmn,:) = zero
    -
    1023 return
    -
    1024 else
    -
    1025 rnk = 1
    -
    1026 end if
    -
    1027 do
    -
    1028 if (rnk < mn) then
    -
    1029 i = rnk + 1
    -
    1030 call zlaic1(imin, rnk, wptr(ismin:ismin+rnk-1), smin, &
    -
    1031 a(1:rnk-1,i), a(i,i), sminpr, s1, c1)
    -
    1032 call zlaic1(imax, rnk, wptr(ismax:ismax+rnk-1), smax, &
    -
    1033 a(1:rnk-1,i), a(i,i), smaxpr, s2, c2)
    -
    1034 if (smaxpr * rcond <= sminpr) then
    -
    1035 do i = 1, rnk
    -
    1036 wptr(ismin+i-1) = s1 * wptr(ismin+i-1)
    -
    1037 wptr(ismax+i-1) = s2 * wptr(ismax+i-1)
    -
    1038 end do
    -
    1039 wptr(ismin+rnk) = c1
    -
    1040 wptr(ismax+rnk) = c2
    -
    1041 smin = sminpr
    -
    1042 smax = smaxpr
    -
    1043 rnk = rnk + 1
    -
    1044 cycle
    -
    1045 end if
    -
    1046 end if
    -
    1047 exit
    -
    1048 end do
    -
    1049
    -
    1050 ! Partition R = [R11 R12]
    -
    1051 ! [ 0 R22]
    -
    1052 tau2 => wptr(1:rnk)
    -
    1053 w => wptr(rnk+1:lwork)
    -
    1054 if (rnk < n) call rz_factor(a(1:rnk,:), tau2, w)
    -
    1055
    -
    1056 ! Compute B(1:m,1:NRHS) = Q**T * B(1:M,1:NRHS)
    -
    1057 call mult_qr(.true., .true., a, tau, b(1:m,:), w)
    -
    1058
    -
    1059 ! Solve the triangular system T11 * B(1:rnk,1:nrhs) = B(1:rnk,1:nrhs)
    -
    1060 call solve_triangular_system(.true., .true., .false., .true., one, &
    -
    1061 a(1:rnk,1:rnk), b(1:rnk,:))
    -
    1062 if (n > rnk) b(rnk+1:n,:) = zero
    -
    1063
    -
    1064 ! Compute B(1:n,1:nrhs) = Y**T * B(1:n,1:nrhs)
    -
    1065 if (rnk < n) then
    -
    1066 call mult_rz(.true., .true., n - rnk, a(1:rnk,:), tau2, b(1:n,:), w)
    -
    1067 end if
    -
    1068
    -
    1069 ! Apply the pivoting: B(1:N,1:NRHS) = P * B(1:N,1:NRHS)
    -
    1070 do j = 1, nrhs
    -
    1071 do i = 1, n
    -
    1072 wptr(jpvt(i)) = b(i,j)
    -
    1073 end do
    -
    1074 b(:,j) = wptr(1:n)
    +
    782 ! Solve the triangular system: A(1:N,1:N)*X = B(1:N)
    +
    783 call solve_triangular_system(.true., .false., .true., a(1:n,1:n), b)
    +
    784
    +
    785 ! Formatting
    +
    786100 format(a, i0, a)
    +
    787 end subroutine
    +
    788
    +
    789! ------------------------------------------------------------------------------
    +
    790 module subroutine solve_qr_pivot_mtx(a, tau, jpvt, b, work, olwork, err)
    +
    791 ! Arguments
    +
    792 real(real64), intent(inout), dimension(:,:) :: a
    +
    793 real(real64), intent(in), dimension(:) :: tau
    +
    794 integer(int32), intent(in), dimension(:) :: jpvt
    +
    795 real(real64), intent(inout), dimension(:,:) :: b
    +
    796 real(real64), intent(out), target, optional, dimension(:) :: work
    +
    797 integer(int32), intent(out), optional :: olwork
    +
    798 class(errors), intent(inout), optional, target :: err
    +
    799
    +
    800 ! Parameters
    +
    801 integer(int32), parameter :: imin = 2
    +
    802 integer(int32), parameter :: imax = 1
    +
    803 real(real64), parameter :: zero = 0.0d0
    +
    804 real(real64), parameter :: one = 1.0d0
    +
    805
    +
    806 ! Local Variables
    +
    807 integer(int32) :: i, j, m, n, mn, nrhs, lwork, ismin, ismax, &
    +
    808 rnk, maxmn, flag, istat, lwork1, lwork2, lwork3
    +
    809 real(real64) :: rcond, smax, smin, smaxpr, sminpr, s1, c1, s2, c2
    +
    810 real(real64), pointer, dimension(:) :: wptr, w, tau2
    +
    811 real(real64), allocatable, target, dimension(:) :: wrk
    +
    812 class(errors), pointer :: errmgr
    +
    813 type(errors), target :: deferr
    +
    814 character(len = 128) :: errmsg
    +
    815
    +
    816 ! Initialization
    +
    817 m = size(a, 1)
    +
    818 n = size(a, 2)
    +
    819 mn = min(m, n)
    +
    820 maxmn = max(m, n)
    +
    821 nrhs = size(b, 2)
    +
    822 ismin = mn + 1
    +
    823 ismax = 2 * mn + 1
    +
    824 rcond = epsilon(rcond)
    +
    825 if (present(err)) then
    +
    826 errmgr => err
    +
    827 else
    +
    828 errmgr => deferr
    +
    829 end if
    +
    830
    +
    831 ! Input Check
    +
    832 flag = 0
    +
    833 if (size(tau) /= mn) then
    +
    834 flag = 2
    +
    835 else if (size(jpvt) /= n) then
    +
    836 flag = 3
    +
    837 else if (size(b, 1) /= maxmn) then
    +
    838 flag = 4
    +
    839 end if
    +
    840 if (flag /= 0) then
    +
    841 ! ERROR: One of the input arrays is not sized correctly
    +
    842 write(errmsg, 100) "Input number ", flag, &
    +
    843 " is not sized correctly."
    +
    844 call errmgr%report_error("solve_qr_pivot_mtx", trim(errmsg), &
    +
    845 la_array_size_error)
    +
    846 return
    +
    847 end if
    +
    848
    +
    849 ! Workspace Query
    +
    850 call rz_factor(a(1:mn,:), a(1:mn,1), olwork = lwork1)
    +
    851 call mult_qr(.true., .true., a, tau, b(1:m,:), olwork = lwork2)
    +
    852 call mult_rz(.true., .true., n, a(1:mn,:), a(1:mn,1), b(1:n,:), &
    +
    853 olwork = lwork3)
    +
    854 lwork = max(lwork1, lwork2, lwork3, 2 * mn + 1) + mn
    +
    855 if (present(olwork)) then
    +
    856 olwork = lwork
    +
    857 return
    +
    858 end if
    +
    859
    +
    860 ! Local Memory Allocation
    +
    861 if (present(work)) then
    +
    862 if (size(work) < lwork) then
    +
    863 ! ERROR: WORK not sized correctly
    +
    864 call errmgr%report_error("solve_qr_no_pivot_mtx", &
    +
    865 "Incorrectly sized input array WORK, argument 5.", &
    +
    866 la_array_size_error)
    +
    867 return
    +
    868 end if
    +
    869 wptr => work(1:lwork)
    +
    870 else
    +
    871 allocate(wrk(lwork), stat = istat)
    +
    872 if (istat /= 0) then
    +
    873 ! ERROR: Out of memory
    +
    874 call errmgr%report_error("solve_qr_pivot_mtx", &
    +
    875 "Insufficient memory available.", &
    +
    876 la_out_of_memory_error)
    +
    877 return
    +
    878 end if
    +
    879 wptr => wrk
    +
    880 end if
    +
    881
    +
    882 ! Determine the rank of R11 using an incremental condition estimation
    +
    883 wptr(ismin) = one
    +
    884 wptr(ismax) = one
    +
    885 smax = abs(a(1,1))
    +
    886 smin = smax
    +
    887 if (abs(a(1,1)) == zero) then
    +
    888 rnk = 0
    +
    889 b(1:maxmn,:) = zero
    +
    890 return
    +
    891 else
    +
    892 rnk = 1
    +
    893 end if
    +
    894 do
    +
    895 if (rnk < mn) then
    +
    896 i = rnk + 1
    +
    897 call dlaic1(imin, rnk, wptr(ismin:ismin+rnk-1), smin, &
    +
    898 a(1:rnk-1,i), a(i,i), sminpr, s1, c1)
    +
    899 call dlaic1(imax, rnk, wptr(ismax:ismax+rnk-1), smax, &
    +
    900 a(1:rnk-1,i), a(i,i), smaxpr, s2, c2)
    +
    901 if (smaxpr * rcond <= sminpr) then
    +
    902 do i = 1, rnk
    +
    903 wptr(ismin+i-1) = s1 * wptr(ismin+i-1)
    +
    904 wptr(ismax+i-1) = s2 * wptr(ismax+i-1)
    +
    905 end do
    +
    906 wptr(ismin+rnk) = c1
    +
    907 wptr(ismax+rnk) = c2
    +
    908 smin = sminpr
    +
    909 smax = smaxpr
    +
    910 rnk = rnk + 1
    +
    911 cycle
    +
    912 end if
    +
    913 end if
    +
    914 exit
    +
    915 end do
    +
    916
    +
    917 ! Partition R = [R11 R12]
    +
    918 ! [ 0 R22]
    +
    919 tau2 => wptr(1:rnk)
    +
    920 w => wptr(rnk+1:lwork)
    +
    921 if (rnk < n) call rz_factor(a(1:rnk,:), tau2, w)
    +
    922
    +
    923 ! Compute B(1:m,1:NRHS) = Q**T * B(1:M,1:NRHS)
    +
    924 call mult_qr(.true., .true., a, tau, b(1:m,:), w)
    +
    925
    +
    926 ! Solve the triangular system T11 * B(1:rnk,1:nrhs) = B(1:rnk,1:nrhs)
    +
    927 call solve_triangular_system(.true., .true., .false., .true., one, &
    +
    928 a(1:rnk,1:rnk), b(1:rnk,:))
    +
    929 if (n > rnk) b(rnk+1:n,:) = zero
    +
    930
    +
    931 ! Compute B(1:n,1:nrhs) = Y**T * B(1:n,1:nrhs)
    +
    932 if (rnk < n) then
    +
    933 call mult_rz(.true., .true., n - rnk, a(1:rnk,:), tau2, b(1:n,:), w)
    +
    934 end if
    +
    935
    +
    936 ! Apply the pivoting: B(1:N,1:NRHS) = P * B(1:N,1:NRHS)
    +
    937 do j = 1, nrhs
    +
    938 do i = 1, n
    +
    939 wptr(jpvt(i)) = b(i,j)
    +
    940 end do
    +
    941 b(:,j) = wptr(1:n)
    +
    942 end do
    +
    943
    +
    944 ! Formatting
    +
    945100 format(a, i0, a)
    +
    946 end subroutine
    +
    947
    +
    948! ------------------------------------------------------------------------------
    +
    949 module subroutine solve_qr_pivot_mtx_cmplx(a, tau, jpvt, b, work, olwork, err)
    +
    950 ! Arguments
    +
    951 complex(real64), intent(inout), dimension(:,:) :: a
    +
    952 complex(real64), intent(in), dimension(:) :: tau
    +
    953 integer(int32), intent(in), dimension(:) :: jpvt
    +
    954 complex(real64), intent(inout), dimension(:,:) :: b
    +
    955 complex(real64), intent(out), target, optional, dimension(:) :: work
    +
    956 integer(int32), intent(out), optional :: olwork
    +
    957 class(errors), intent(inout), optional, target :: err
    +
    958
    +
    959 ! Parameters
    +
    960 integer(int32), parameter :: imin = 2
    +
    961 integer(int32), parameter :: imax = 1
    +
    962 complex(real64), parameter :: zero = (0.0d0, 0.0d0)
    +
    963 complex(real64), parameter :: one = (1.0d0, 0.0d0)
    +
    964
    +
    965 ! Local Variables
    +
    966 integer(int32) :: i, j, m, n, mn, nrhs, lwork, ismin, ismax, &
    +
    967 rnk, maxmn, flag, istat, lwork1, lwork2, lwork3
    +
    968 real(real64) :: rcond, smax, smin, smaxpr, sminpr
    +
    969 complex(real64) :: s1, c1, s2, c2
    +
    970 complex(real64), pointer, dimension(:) :: wptr, w, tau2
    +
    971 complex(real64), allocatable, target, dimension(:) :: wrk
    +
    972 class(errors), pointer :: errmgr
    +
    973 type(errors), target :: deferr
    +
    974 character(len = 128) :: errmsg
    +
    975
    +
    976 ! Initialization
    +
    977 m = size(a, 1)
    +
    978 n = size(a, 2)
    +
    979 mn = min(m, n)
    +
    980 maxmn = max(m, n)
    +
    981 nrhs = size(b, 2)
    +
    982 ismin = mn + 1
    +
    983 ismax = 2 * mn + 1
    +
    984 rcond = epsilon(rcond)
    +
    985 if (present(err)) then
    +
    986 errmgr => err
    +
    987 else
    +
    988 errmgr => deferr
    +
    989 end if
    +
    990
    +
    991 ! Input Check
    +
    992 flag = 0
    +
    993 if (size(tau) /= mn) then
    +
    994 flag = 2
    +
    995 else if (size(jpvt) /= n) then
    +
    996 flag = 3
    +
    997 else if (size(b, 1) /= maxmn) then
    +
    998 flag = 4
    +
    999 end if
    +
    1000 if (flag /= 0) then
    +
    1001 ! ERROR: One of the input arrays is not sized correctly
    +
    1002 write(errmsg, 100) "Input number ", flag, &
    +
    1003 " is not sized correctly."
    +
    1004 call errmgr%report_error("solve_qr_pivot_mtx_cmplx", &
    +
    1005 trim(errmsg), la_array_size_error)
    +
    1006 return
    +
    1007 end if
    +
    1008
    +
    1009 ! Workspace Query
    +
    1010 call rz_factor(a(1:mn,:), a(1:mn,1), olwork = lwork1)
    +
    1011 call mult_qr(.true., .true., a, tau, b(1:m,:), olwork = lwork2)
    +
    1012 call mult_rz(.true., .true., n, a(1:mn,:), a(1:mn,1), b(1:n,:), &
    +
    1013 olwork = lwork3)
    +
    1014 lwork = max(lwork1, lwork2, lwork3, 2 * mn + 1) + mn
    +
    1015 if (present(olwork)) then
    +
    1016 olwork = lwork
    +
    1017 return
    +
    1018 end if
    +
    1019
    +
    1020 ! Local Memory Allocation
    +
    1021 if (present(work)) then
    +
    1022 if (size(work) < lwork) then
    +
    1023 ! ERROR: WORK not sized correctly
    +
    1024 call errmgr%report_error("solve_qr_no_pivot_mtx_cmplx", &
    +
    1025 "Incorrectly sized input array WORK, argument 5.", &
    +
    1026 la_array_size_error)
    +
    1027 return
    +
    1028 end if
    +
    1029 wptr => work(1:lwork)
    +
    1030 else
    +
    1031 allocate(wrk(lwork), stat = istat)
    +
    1032 if (istat /= 0) then
    +
    1033 ! ERROR: Out of memory
    +
    1034 call errmgr%report_error("solve_qr_pivot_mtx_cmplx", &
    +
    1035 "Insufficient memory available.", &
    +
    1036 la_out_of_memory_error)
    +
    1037 return
    +
    1038 end if
    +
    1039 wptr => wrk
    +
    1040 end if
    +
    1041
    +
    1042 ! Determine the rank of R11 using an incremental condition estimation
    +
    1043 wptr(ismin) = one
    +
    1044 wptr(ismax) = one
    +
    1045 smax = abs(a(1,1))
    +
    1046 smin = smax
    +
    1047 if (abs(a(1,1)) == zero) then
    +
    1048 rnk = 0
    +
    1049 b(1:maxmn,:) = zero
    +
    1050 return
    +
    1051 else
    +
    1052 rnk = 1
    +
    1053 end if
    +
    1054 do
    +
    1055 if (rnk < mn) then
    +
    1056 i = rnk + 1
    +
    1057 call zlaic1(imin, rnk, wptr(ismin:ismin+rnk-1), smin, &
    +
    1058 a(1:rnk-1,i), a(i,i), sminpr, s1, c1)
    +
    1059 call zlaic1(imax, rnk, wptr(ismax:ismax+rnk-1), smax, &
    +
    1060 a(1:rnk-1,i), a(i,i), smaxpr, s2, c2)
    +
    1061 if (smaxpr * rcond <= sminpr) then
    +
    1062 do i = 1, rnk
    +
    1063 wptr(ismin+i-1) = s1 * wptr(ismin+i-1)
    +
    1064 wptr(ismax+i-1) = s2 * wptr(ismax+i-1)
    +
    1065 end do
    +
    1066 wptr(ismin+rnk) = c1
    +
    1067 wptr(ismax+rnk) = c2
    +
    1068 smin = sminpr
    +
    1069 smax = smaxpr
    +
    1070 rnk = rnk + 1
    +
    1071 cycle
    +
    1072 end if
    +
    1073 end if
    +
    1074 exit
    1075 end do
    -
    1076 end subroutine
    -
    1077
    -
    1078! ------------------------------------------------------------------------------
    -
    1079 module subroutine solve_qr_pivot_vec(a, tau, jpvt, b, work, olwork, err)
    -
    1080 ! Arguments
    -
    1081 real(real64), intent(inout), dimension(:,:) :: a
    -
    1082 real(real64), intent(in), dimension(:) :: tau
    -
    1083 integer(int32), intent(in), dimension(:) :: jpvt
    -
    1084 real(real64), intent(inout), dimension(:) :: b
    -
    1085 real(real64), intent(out), target, optional, dimension(:) :: work
    -
    1086 integer(int32), intent(out), optional :: olwork
    -
    1087 class(errors), intent(inout), optional, target :: err
    -
    1088
    -
    1089 ! Parameters
    -
    1090 integer(int32), parameter :: imin = 2
    -
    1091 integer(int32), parameter :: imax = 1
    -
    1092 real(real64), parameter :: zero = 0.0d0
    -
    1093 real(real64), parameter :: one = 1.0d0
    -
    1094
    -
    1095 ! Local Variables
    -
    1096 integer(int32) :: i, m, n, mn, lwork, ismin, ismax, rnk, maxmn, flag, &
    -
    1097 istat, lwork1, lwork2
    -
    1098 real(real64) :: rcond, smax, smin, smaxpr, sminpr, s1, c1, s2, c2
    -
    1099 real(real64), pointer, dimension(:) :: wptr, w, tau2
    -
    1100 real(real64), allocatable, target, dimension(:) :: wrk
    -
    1101 class(errors), pointer :: errmgr
    -
    1102 type(errors), target :: deferr
    -
    1103 character(len = 128) :: errmsg
    -
    1104
    -
    1105 ! Initialization
    -
    1106 m = size(a, 1)
    -
    1107 n = size(a, 2)
    -
    1108 mn = min(m, n)
    -
    1109 maxmn = max(m, n)
    -
    1110 ismin = mn + 1
    -
    1111 ismax = 2 * mn + 1
    -
    1112 rcond = epsilon(rcond)
    -
    1113 if (present(err)) then
    -
    1114 errmgr => err
    -
    1115 else
    -
    1116 errmgr => deferr
    -
    1117 end if
    +
    1076
    +
    1077 ! Partition R = [R11 R12]
    +
    1078 ! [ 0 R22]
    +
    1079 tau2 => wptr(1:rnk)
    +
    1080 w => wptr(rnk+1:lwork)
    +
    1081 if (rnk < n) call rz_factor(a(1:rnk,:), tau2, w)
    +
    1082
    +
    1083 ! Compute B(1:m,1:NRHS) = Q**T * B(1:M,1:NRHS)
    +
    1084 call mult_qr(.true., .true., a, tau, b(1:m,:), w)
    +
    1085
    +
    1086 ! Solve the triangular system T11 * B(1:rnk,1:nrhs) = B(1:rnk,1:nrhs)
    +
    1087 call solve_triangular_system(.true., .true., .false., .true., one, &
    +
    1088 a(1:rnk,1:rnk), b(1:rnk,:))
    +
    1089 if (n > rnk) b(rnk+1:n,:) = zero
    +
    1090
    +
    1091 ! Compute B(1:n,1:nrhs) = Y**T * B(1:n,1:nrhs)
    +
    1092 if (rnk < n) then
    +
    1093 call mult_rz(.true., .true., n - rnk, a(1:rnk,:), tau2, b(1:n,:), w)
    +
    1094 end if
    +
    1095
    +
    1096 ! Apply the pivoting: B(1:N,1:NRHS) = P * B(1:N,1:NRHS)
    +
    1097 do j = 1, nrhs
    +
    1098 do i = 1, n
    +
    1099 wptr(jpvt(i)) = b(i,j)
    +
    1100 end do
    +
    1101 b(:,j) = wptr(1:n)
    +
    1102 end do
    +
    1103
    +
    1104 ! Formatting
    +
    1105100 format(a, i0, a)
    +
    1106 end subroutine
    +
    1107
    +
    1108! ------------------------------------------------------------------------------
    +
    1109 module subroutine solve_qr_pivot_vec(a, tau, jpvt, b, work, olwork, err)
    +
    1110 ! Arguments
    +
    1111 real(real64), intent(inout), dimension(:,:) :: a
    +
    1112 real(real64), intent(in), dimension(:) :: tau
    +
    1113 integer(int32), intent(in), dimension(:) :: jpvt
    +
    1114 real(real64), intent(inout), dimension(:) :: b
    +
    1115 real(real64), intent(out), target, optional, dimension(:) :: work
    +
    1116 integer(int32), intent(out), optional :: olwork
    +
    1117 class(errors), intent(inout), optional, target :: err
    1118
    -
    1119 ! Input Check
    -
    1120 flag = 0
    -
    1121 if (size(tau) /= mn) then
    -
    1122 flag = 2
    -
    1123 else if (size(jpvt) /= n) then
    -
    1124 flag = 3
    -
    1125 else if (size(b) /= maxmn) then
    -
    1126 flag = 4
    -
    1127 end if
    -
    1128 if (flag /= 0) then
    -
    1129 ! ERROR: One of the input arrays is not sized correctly
    -
    1130 write(errmsg, '(AI0A)') "Input number ", flag, &
    -
    1131 " is not sized correctly."
    -
    1132 call errmgr%report_error("solve_qr_pivot_vec", trim(errmsg), &
    -
    1133 la_array_size_error)
    -
    1134 return
    -
    1135 end if
    -
    1136
    -
    1137 ! Workspace Query
    -
    1138 call rz_factor(a(1:mn,:), a(1:mn,1), olwork = lwork1)
    -
    1139 call mult_rz(.true., n, a(1:mn,:), a(1:mn,1), b(1:n), olwork = lwork2)
    -
    1140 lwork = max(lwork1, lwork2, 2 * mn + 1) + mn
    -
    1141 if (present(olwork)) then
    -
    1142 olwork = lwork
    -
    1143 return
    -
    1144 end if
    -
    1145
    -
    1146 ! Local Memory Allocation
    -
    1147 if (present(work)) then
    -
    1148 if (size(work) < lwork) then
    -
    1149 ! ERROR: WORK not sized correctly
    -
    1150 call errmgr%report_error("solve_qr_no_pivot_mtx", &
    -
    1151 "Incorrectly sized input array WORK, argument 5.", &
    -
    1152 la_array_size_error)
    -
    1153 return
    -
    1154 end if
    -
    1155 wptr => work(1:lwork)
    -
    1156 else
    -
    1157 allocate(wrk(lwork), stat = istat)
    -
    1158 if (istat /= 0) then
    -
    1159 ! ERROR: Out of memory
    -
    1160 call errmgr%report_error("solve_qr_pivot_vec", &
    -
    1161 "Insufficient memory available.", &
    -
    1162 la_out_of_memory_error)
    -
    1163 return
    -
    1164 end if
    -
    1165 wptr => wrk
    -
    1166 end if
    -
    1167
    -
    1168 ! Determine the rank of R11 using an incremental condition estimation
    -
    1169 wptr(ismin) = one
    -
    1170 wptr(ismax) = one
    -
    1171 smax = abs(a(1,1))
    -
    1172 smin = smax
    -
    1173 if (abs(a(1,1)) == zero) then
    -
    1174 rnk = 0
    -
    1175 b(maxmn) = zero
    -
    1176 return
    -
    1177 else
    -
    1178 rnk = 1
    -
    1179 end if
    -
    1180 do
    -
    1181 if (rnk < mn) then
    -
    1182 i = rnk + 1
    -
    1183 call dlaic1(imin, rnk, wptr(ismin:ismin+rnk-1), smin, &
    -
    1184 a(1:rnk-1,i), a(i,i), sminpr, s1, c1)
    -
    1185 call dlaic1(imax, rnk, wptr(ismax:ismax+rnk-1), smax, &
    -
    1186 a(1:rnk-1,i), a(i,i), smaxpr, s2, c2)
    -
    1187 if (smaxpr * rcond <= sminpr) then
    -
    1188 do i = 1, rnk
    -
    1189 wptr(ismin+i-1) = s1 * wptr(ismin+i-1)
    -
    1190 wptr(ismax+i-1) = s2 * wptr(ismax+i-1)
    -
    1191 end do
    -
    1192 wptr(ismin+rnk) = c1
    -
    1193 wptr(ismax+rnk) = c2
    -
    1194 smin = sminpr
    -
    1195 smax = smaxpr
    -
    1196 rnk = rnk + 1
    -
    1197 cycle
    -
    1198 end if
    -
    1199 end if
    -
    1200 exit
    -
    1201 end do
    -
    1202
    -
    1203 ! Partition R = [R11 R12]
    -
    1204 ! [ 0 R22]
    -
    1205 tau2 => wptr(1:rnk)
    -
    1206 w => wptr(rnk+1:lwork)
    -
    1207 if (rnk < n) call rz_factor(a(1:rnk,:), tau2, w)
    -
    1208
    -
    1209 ! Compute B(1:m,1:NRHS) = Q**T * B(1:M,1:NRHS)
    -
    1210 call mult_qr(.true., a, tau, b(1:m))
    -
    1211
    -
    1212 ! Solve the triangular system T11 * B(1:rnk) = B(1:rnk)
    -
    1213 call solve_triangular_system(.true., .false., .true., a(1:rnk,1:rnk), &
    -
    1214 b(1:rnk))
    -
    1215 if (n > rnk) b(rnk+1:n) = zero
    -
    1216
    -
    1217 ! Compute B(1:n) = Y**T * B(1:n)
    -
    1218 if (rnk < n) then
    -
    1219 call mult_rz(.true., n - rnk, a(1:rnk,:), tau2, b(1:n), w)
    -
    1220 end if
    -
    1221
    -
    1222 ! Apply the pivoting: B(1:N) = P * B(1:N)
    -
    1223 do i = 1, n
    -
    1224 wptr(jpvt(i)) = b(i)
    -
    1225 end do
    -
    1226 b = wptr(1:n)
    -
    1227 end subroutine
    -
    1228
    -
    1229! ------------------------------------------------------------------------------
    -
    1230 module subroutine solve_qr_pivot_vec_cmplx(a, tau, jpvt, b, work, olwork, err)
    -
    1231 ! Arguments
    -
    1232 complex(real64), intent(inout), dimension(:,:) :: a
    -
    1233 complex(real64), intent(in), dimension(:) :: tau
    -
    1234 integer(int32), intent(in), dimension(:) :: jpvt
    -
    1235 complex(real64), intent(inout), dimension(:) :: b
    -
    1236 complex(real64), intent(out), target, optional, dimension(:) :: work
    -
    1237 integer(int32), intent(out), optional :: olwork
    -
    1238 class(errors), intent(inout), optional, target :: err
    -
    1239
    -
    1240 ! Parameters
    -
    1241 integer(int32), parameter :: imin = 2
    -
    1242 integer(int32), parameter :: imax = 1
    -
    1243 complex(real64), parameter :: zero = (0.0d0, 0.0d0)
    -
    1244 complex(real64), parameter :: one = (1.0d0, 0.0d0)
    -
    1245
    -
    1246 ! Local Variables
    -
    1247 integer(int32) :: i, m, n, mn, lwork, ismin, ismax, rnk, maxmn, flag, &
    -
    1248 istat, lwork1, lwork2
    -
    1249 real(real64) :: rcond, smax, smin, smaxpr, sminpr
    -
    1250 complex(real64) :: s1, c1, s2, c2
    -
    1251 complex(real64), pointer, dimension(:) :: wptr, w, tau2
    -
    1252 complex(real64), allocatable, target, dimension(:) :: wrk
    -
    1253 class(errors), pointer :: errmgr
    -
    1254 type(errors), target :: deferr
    -
    1255 character(len = 128) :: errmsg
    -
    1256
    -
    1257 ! Initialization
    -
    1258 m = size(a, 1)
    -
    1259 n = size(a, 2)
    -
    1260 mn = min(m, n)
    -
    1261 maxmn = max(m, n)
    -
    1262 ismin = mn + 1
    -
    1263 ismax = 2 * mn + 1
    -
    1264 rcond = epsilon(rcond)
    -
    1265 if (present(err)) then
    -
    1266 errmgr => err
    -
    1267 else
    -
    1268 errmgr => deferr
    -
    1269 end if
    -
    1270
    -
    1271 ! Input Check
    -
    1272 flag = 0
    -
    1273 if (size(tau) /= mn) then
    -
    1274 flag = 2
    -
    1275 else if (size(jpvt) /= n) then
    -
    1276 flag = 3
    -
    1277 else if (size(b) /= maxmn) then
    -
    1278 flag = 4
    -
    1279 end if
    -
    1280 if (flag /= 0) then
    -
    1281 ! ERROR: One of the input arrays is not sized correctly
    -
    1282 write(errmsg, '(AI0A)') "Input number ", flag, &
    -
    1283 " is not sized correctly."
    -
    1284 call errmgr%report_error("solve_qr_pivot_vec_cmplx", trim(errmsg), &
    -
    1285 la_array_size_error)
    -
    1286 return
    -
    1287 end if
    -
    1288
    -
    1289 ! Workspace Query
    -
    1290 call rz_factor(a(1:mn,:), a(1:mn,1), olwork = lwork1)
    -
    1291 call mult_rz(.true., n, a(1:mn,:), a(1:mn,1), b(1:n), olwork = lwork2)
    -
    1292 lwork = max(lwork1, lwork2, 2 * mn + 1) + mn
    -
    1293 if (present(olwork)) then
    -
    1294 olwork = lwork
    -
    1295 return
    -
    1296 end if
    -
    1297
    -
    1298 ! Local Memory Allocation
    -
    1299 if (present(work)) then
    -
    1300 if (size(work) < lwork) then
    -
    1301 ! ERROR: WORK not sized correctly
    -
    1302 call errmgr%report_error("solve_qr_no_pivot_mtx_cmplx", &
    -
    1303 "Incorrectly sized input array WORK, argument 5.", &
    -
    1304 la_array_size_error)
    -
    1305 return
    -
    1306 end if
    -
    1307 wptr => work(1:lwork)
    -
    1308 else
    -
    1309 allocate(wrk(lwork), stat = istat)
    -
    1310 if (istat /= 0) then
    -
    1311 ! ERROR: Out of memory
    -
    1312 call errmgr%report_error("solve_qr_pivot_vec_cmplx", &
    -
    1313 "Insufficient memory available.", &
    -
    1314 la_out_of_memory_error)
    -
    1315 return
    -
    1316 end if
    -
    1317 wptr => wrk
    -
    1318 end if
    -
    1319
    -
    1320 ! Determine the rank of R11 using an incremental condition estimation
    -
    1321 wptr(ismin) = one
    -
    1322 wptr(ismax) = one
    -
    1323 smax = abs(a(1,1))
    -
    1324 smin = smax
    -
    1325 if (abs(a(1,1)) == zero) then
    -
    1326 rnk = 0
    -
    1327 b(maxmn) = zero
    +
    1119 ! Parameters
    +
    1120 integer(int32), parameter :: imin = 2
    +
    1121 integer(int32), parameter :: imax = 1
    +
    1122 real(real64), parameter :: zero = 0.0d0
    +
    1123 real(real64), parameter :: one = 1.0d0
    +
    1124
    +
    1125 ! Local Variables
    +
    1126 integer(int32) :: i, m, n, mn, lwork, ismin, ismax, rnk, maxmn, flag, &
    +
    1127 istat, lwork1, lwork2
    +
    1128 real(real64) :: rcond, smax, smin, smaxpr, sminpr, s1, c1, s2, c2
    +
    1129 real(real64), pointer, dimension(:) :: wptr, w, tau2
    +
    1130 real(real64), allocatable, target, dimension(:) :: wrk
    +
    1131 class(errors), pointer :: errmgr
    +
    1132 type(errors), target :: deferr
    +
    1133 character(len = 128) :: errmsg
    +
    1134
    +
    1135 ! Initialization
    +
    1136 m = size(a, 1)
    +
    1137 n = size(a, 2)
    +
    1138 mn = min(m, n)
    +
    1139 maxmn = max(m, n)
    +
    1140 ismin = mn + 1
    +
    1141 ismax = 2 * mn + 1
    +
    1142 rcond = epsilon(rcond)
    +
    1143 if (present(err)) then
    +
    1144 errmgr => err
    +
    1145 else
    +
    1146 errmgr => deferr
    +
    1147 end if
    +
    1148
    +
    1149 ! Input Check
    +
    1150 flag = 0
    +
    1151 if (size(tau) /= mn) then
    +
    1152 flag = 2
    +
    1153 else if (size(jpvt) /= n) then
    +
    1154 flag = 3
    +
    1155 else if (size(b) /= maxmn) then
    +
    1156 flag = 4
    +
    1157 end if
    +
    1158 if (flag /= 0) then
    +
    1159 ! ERROR: One of the input arrays is not sized correctly
    +
    1160 write(errmsg, 100) "Input number ", flag, &
    +
    1161 " is not sized correctly."
    +
    1162 call errmgr%report_error("solve_qr_pivot_vec", trim(errmsg), &
    +
    1163 la_array_size_error)
    +
    1164 return
    +
    1165 end if
    +
    1166
    +
    1167 ! Workspace Query
    +
    1168 call rz_factor(a(1:mn,:), a(1:mn,1), olwork = lwork1)
    +
    1169 call mult_rz(.true., n, a(1:mn,:), a(1:mn,1), b(1:n), olwork = lwork2)
    +
    1170 lwork = max(lwork1, lwork2, 2 * mn + 1) + mn
    +
    1171 if (present(olwork)) then
    +
    1172 olwork = lwork
    +
    1173 return
    +
    1174 end if
    +
    1175
    +
    1176 ! Local Memory Allocation
    +
    1177 if (present(work)) then
    +
    1178 if (size(work) < lwork) then
    +
    1179 ! ERROR: WORK not sized correctly
    +
    1180 call errmgr%report_error("solve_qr_no_pivot_mtx", &
    +
    1181 "Incorrectly sized input array WORK, argument 5.", &
    +
    1182 la_array_size_error)
    +
    1183 return
    +
    1184 end if
    +
    1185 wptr => work(1:lwork)
    +
    1186 else
    +
    1187 allocate(wrk(lwork), stat = istat)
    +
    1188 if (istat /= 0) then
    +
    1189 ! ERROR: Out of memory
    +
    1190 call errmgr%report_error("solve_qr_pivot_vec", &
    +
    1191 "Insufficient memory available.", &
    +
    1192 la_out_of_memory_error)
    +
    1193 return
    +
    1194 end if
    +
    1195 wptr => wrk
    +
    1196 end if
    +
    1197
    +
    1198 ! Determine the rank of R11 using an incremental condition estimation
    +
    1199 wptr(ismin) = one
    +
    1200 wptr(ismax) = one
    +
    1201 smax = abs(a(1,1))
    +
    1202 smin = smax
    +
    1203 if (abs(a(1,1)) == zero) then
    +
    1204 rnk = 0
    +
    1205 b(maxmn) = zero
    +
    1206 return
    +
    1207 else
    +
    1208 rnk = 1
    +
    1209 end if
    +
    1210 do
    +
    1211 if (rnk < mn) then
    +
    1212 i = rnk + 1
    +
    1213 call dlaic1(imin, rnk, wptr(ismin:ismin+rnk-1), smin, &
    +
    1214 a(1:rnk-1,i), a(i,i), sminpr, s1, c1)
    +
    1215 call dlaic1(imax, rnk, wptr(ismax:ismax+rnk-1), smax, &
    +
    1216 a(1:rnk-1,i), a(i,i), smaxpr, s2, c2)
    +
    1217 if (smaxpr * rcond <= sminpr) then
    +
    1218 do i = 1, rnk
    +
    1219 wptr(ismin+i-1) = s1 * wptr(ismin+i-1)
    +
    1220 wptr(ismax+i-1) = s2 * wptr(ismax+i-1)
    +
    1221 end do
    +
    1222 wptr(ismin+rnk) = c1
    +
    1223 wptr(ismax+rnk) = c2
    +
    1224 smin = sminpr
    +
    1225 smax = smaxpr
    +
    1226 rnk = rnk + 1
    +
    1227 cycle
    +
    1228 end if
    +
    1229 end if
    +
    1230 exit
    +
    1231 end do
    +
    1232
    +
    1233 ! Partition R = [R11 R12]
    +
    1234 ! [ 0 R22]
    +
    1235 tau2 => wptr(1:rnk)
    +
    1236 w => wptr(rnk+1:lwork)
    +
    1237 if (rnk < n) call rz_factor(a(1:rnk,:), tau2, w)
    +
    1238
    +
    1239 ! Compute B(1:m,1:NRHS) = Q**T * B(1:M,1:NRHS)
    +
    1240 call mult_qr(.true., a, tau, b(1:m))
    +
    1241
    +
    1242 ! Solve the triangular system T11 * B(1:rnk) = B(1:rnk)
    +
    1243 call solve_triangular_system(.true., .false., .true., a(1:rnk,1:rnk), &
    +
    1244 b(1:rnk))
    +
    1245 if (n > rnk) b(rnk+1:n) = zero
    +
    1246
    +
    1247 ! Compute B(1:n) = Y**T * B(1:n)
    +
    1248 if (rnk < n) then
    +
    1249 call mult_rz(.true., n - rnk, a(1:rnk,:), tau2, b(1:n), w)
    +
    1250 end if
    +
    1251
    +
    1252 ! Apply the pivoting: B(1:N) = P * B(1:N)
    +
    1253 do i = 1, n
    +
    1254 wptr(jpvt(i)) = b(i)
    +
    1255 end do
    +
    1256 b = wptr(1:n)
    +
    1257
    +
    1258 ! Formatting
    +
    1259100 format(a, i0, a)
    +
    1260 end subroutine
    +
    1261
    +
    1262! ------------------------------------------------------------------------------
    +
    1263 module subroutine solve_qr_pivot_vec_cmplx(a, tau, jpvt, b, work, olwork, err)
    +
    1264 ! Arguments
    +
    1265 complex(real64), intent(inout), dimension(:,:) :: a
    +
    1266 complex(real64), intent(in), dimension(:) :: tau
    +
    1267 integer(int32), intent(in), dimension(:) :: jpvt
    +
    1268 complex(real64), intent(inout), dimension(:) :: b
    +
    1269 complex(real64), intent(out), target, optional, dimension(:) :: work
    +
    1270 integer(int32), intent(out), optional :: olwork
    +
    1271 class(errors), intent(inout), optional, target :: err
    +
    1272
    +
    1273 ! Parameters
    +
    1274 integer(int32), parameter :: imin = 2
    +
    1275 integer(int32), parameter :: imax = 1
    +
    1276 complex(real64), parameter :: zero = (0.0d0, 0.0d0)
    +
    1277 complex(real64), parameter :: one = (1.0d0, 0.0d0)
    +
    1278
    +
    1279 ! Local Variables
    +
    1280 integer(int32) :: i, m, n, mn, lwork, ismin, ismax, rnk, maxmn, flag, &
    +
    1281 istat, lwork1, lwork2
    +
    1282 real(real64) :: rcond, smax, smin, smaxpr, sminpr
    +
    1283 complex(real64) :: s1, c1, s2, c2
    +
    1284 complex(real64), pointer, dimension(:) :: wptr, w, tau2
    +
    1285 complex(real64), allocatable, target, dimension(:) :: wrk
    +
    1286 class(errors), pointer :: errmgr
    +
    1287 type(errors), target :: deferr
    +
    1288 character(len = 128) :: errmsg
    +
    1289
    +
    1290 ! Initialization
    +
    1291 m = size(a, 1)
    +
    1292 n = size(a, 2)
    +
    1293 mn = min(m, n)
    +
    1294 maxmn = max(m, n)
    +
    1295 ismin = mn + 1
    +
    1296 ismax = 2 * mn + 1
    +
    1297 rcond = epsilon(rcond)
    +
    1298 if (present(err)) then
    +
    1299 errmgr => err
    +
    1300 else
    +
    1301 errmgr => deferr
    +
    1302 end if
    +
    1303
    +
    1304 ! Input Check
    +
    1305 flag = 0
    +
    1306 if (size(tau) /= mn) then
    +
    1307 flag = 2
    +
    1308 else if (size(jpvt) /= n) then
    +
    1309 flag = 3
    +
    1310 else if (size(b) /= maxmn) then
    +
    1311 flag = 4
    +
    1312 end if
    +
    1313 if (flag /= 0) then
    +
    1314 ! ERROR: One of the input arrays is not sized correctly
    +
    1315 write(errmsg, 100) "Input number ", flag, &
    +
    1316 " is not sized correctly."
    +
    1317 call errmgr%report_error("solve_qr_pivot_vec_cmplx", trim(errmsg), &
    +
    1318 la_array_size_error)
    +
    1319 return
    +
    1320 end if
    +
    1321
    +
    1322 ! Workspace Query
    +
    1323 call rz_factor(a(1:mn,:), a(1:mn,1), olwork = lwork1)
    +
    1324 call mult_rz(.true., n, a(1:mn,:), a(1:mn,1), b(1:n), olwork = lwork2)
    +
    1325 lwork = max(lwork1, lwork2, 2 * mn + 1) + mn
    +
    1326 if (present(olwork)) then
    +
    1327 olwork = lwork
    1328 return
    -
    1329 else
    -
    1330 rnk = 1
    -
    1331 end if
    -
    1332 do
    -
    1333 if (rnk < mn) then
    -
    1334 i = rnk + 1
    -
    1335 call zlaic1(imin, rnk, wptr(ismin:ismin+rnk-1), smin, &
    -
    1336 a(1:rnk-1,i), a(i,i), sminpr, s1, c1)
    -
    1337 call zlaic1(imax, rnk, wptr(ismax:ismax+rnk-1), smax, &
    -
    1338 a(1:rnk-1,i), a(i,i), smaxpr, s2, c2)
    -
    1339 if (smaxpr * rcond <= sminpr) then
    -
    1340 do i = 1, rnk
    -
    1341 wptr(ismin+i-1) = s1 * wptr(ismin+i-1)
    -
    1342 wptr(ismax+i-1) = s2 * wptr(ismax+i-1)
    -
    1343 end do
    -
    1344 wptr(ismin+rnk) = c1
    -
    1345 wptr(ismax+rnk) = c2
    -
    1346 smin = sminpr
    -
    1347 smax = smaxpr
    -
    1348 rnk = rnk + 1
    -
    1349 cycle
    -
    1350 end if
    -
    1351 end if
    -
    1352 exit
    -
    1353 end do
    -
    1354
    -
    1355 ! Partition R = [R11 R12]
    -
    1356 ! [ 0 R22]
    -
    1357 tau2 => wptr(1:rnk)
    -
    1358 w => wptr(rnk+1:lwork)
    -
    1359 if (rnk < n) call rz_factor(a(1:rnk,:), tau2, w)
    -
    1360
    -
    1361 ! Compute B(1:m,1:NRHS) = Q**T * B(1:M,1:NRHS)
    -
    1362 call mult_qr(.true., a, tau, b(1:m))
    -
    1363
    -
    1364 ! Solve the triangular system T11 * B(1:rnk) = B(1:rnk)
    -
    1365 call solve_triangular_system(.true., .false., .true., a(1:rnk,1:rnk), &
    -
    1366 b(1:rnk))
    -
    1367 if (n > rnk) b(rnk+1:n) = zero
    -
    1368
    -
    1369 ! Compute B(1:n) = Y**T * B(1:n)
    -
    1370 if (rnk < n) then
    -
    1371 call mult_rz(.true., n - rnk, a(1:rnk,:), tau2, b(1:n), w)
    -
    1372 end if
    -
    1373
    -
    1374 ! Apply the pivoting: B(1:N) = P * B(1:N)
    -
    1375 do i = 1, n
    -
    1376 wptr(jpvt(i)) = b(i)
    -
    1377 end do
    -
    1378 b = wptr(1:n)
    -
    1379 end subroutine
    -
    1380
    -
    1381! ******************************************************************************
    -
    1382! CHOLESKY SOLVE
    -
    1383! ------------------------------------------------------------------------------
    -
    1384 module subroutine solve_cholesky_mtx(upper, a, b, err)
    -
    1385 ! Arguments
    -
    1386 logical, intent(in) :: upper
    -
    1387 real(real64), intent(in), dimension(:,:) :: a
    -
    1388 real(real64), intent(inout), dimension(:,:) :: b
    -
    1389 class(errors), intent(inout), optional, target :: err
    -
    1390
    -
    1391 ! Local Variables
    -
    1392 character :: uplo
    -
    1393 integer(int32) :: n, nrhs, flag
    -
    1394 class(errors), pointer :: errmgr
    -
    1395 type(errors), target :: deferr
    -
    1396 character(len = 128) :: errmsg
    -
    1397
    -
    1398 ! Initialization
    -
    1399 n = size(a, 1)
    -
    1400 nrhs = size(b, 2)
    -
    1401 if (upper) then
    -
    1402 uplo = 'U'
    -
    1403 else
    -
    1404 uplo = 'L'
    +
    1329 end if
    +
    1330
    +
    1331 ! Local Memory Allocation
    +
    1332 if (present(work)) then
    +
    1333 if (size(work) < lwork) then
    +
    1334 ! ERROR: WORK not sized correctly
    +
    1335 call errmgr%report_error("solve_qr_no_pivot_mtx_cmplx", &
    +
    1336 "Incorrectly sized input array WORK, argument 5.", &
    +
    1337 la_array_size_error)
    +
    1338 return
    +
    1339 end if
    +
    1340 wptr => work(1:lwork)
    +
    1341 else
    +
    1342 allocate(wrk(lwork), stat = istat)
    +
    1343 if (istat /= 0) then
    +
    1344 ! ERROR: Out of memory
    +
    1345 call errmgr%report_error("solve_qr_pivot_vec_cmplx", &
    +
    1346 "Insufficient memory available.", &
    +
    1347 la_out_of_memory_error)
    +
    1348 return
    +
    1349 end if
    +
    1350 wptr => wrk
    +
    1351 end if
    +
    1352
    +
    1353 ! Determine the rank of R11 using an incremental condition estimation
    +
    1354 wptr(ismin) = one
    +
    1355 wptr(ismax) = one
    +
    1356 smax = abs(a(1,1))
    +
    1357 smin = smax
    +
    1358 if (abs(a(1,1)) == zero) then
    +
    1359 rnk = 0
    +
    1360 b(maxmn) = zero
    +
    1361 return
    +
    1362 else
    +
    1363 rnk = 1
    +
    1364 end if
    +
    1365 do
    +
    1366 if (rnk < mn) then
    +
    1367 i = rnk + 1
    +
    1368 call zlaic1(imin, rnk, wptr(ismin:ismin+rnk-1), smin, &
    +
    1369 a(1:rnk-1,i), a(i,i), sminpr, s1, c1)
    +
    1370 call zlaic1(imax, rnk, wptr(ismax:ismax+rnk-1), smax, &
    +
    1371 a(1:rnk-1,i), a(i,i), smaxpr, s2, c2)
    +
    1372 if (smaxpr * rcond <= sminpr) then
    +
    1373 do i = 1, rnk
    +
    1374 wptr(ismin+i-1) = s1 * wptr(ismin+i-1)
    +
    1375 wptr(ismax+i-1) = s2 * wptr(ismax+i-1)
    +
    1376 end do
    +
    1377 wptr(ismin+rnk) = c1
    +
    1378 wptr(ismax+rnk) = c2
    +
    1379 smin = sminpr
    +
    1380 smax = smaxpr
    +
    1381 rnk = rnk + 1
    +
    1382 cycle
    +
    1383 end if
    +
    1384 end if
    +
    1385 exit
    +
    1386 end do
    +
    1387
    +
    1388 ! Partition R = [R11 R12]
    +
    1389 ! [ 0 R22]
    +
    1390 tau2 => wptr(1:rnk)
    +
    1391 w => wptr(rnk+1:lwork)
    +
    1392 if (rnk < n) call rz_factor(a(1:rnk,:), tau2, w)
    +
    1393
    +
    1394 ! Compute B(1:m,1:NRHS) = Q**T * B(1:M,1:NRHS)
    +
    1395 call mult_qr(.true., a, tau, b(1:m))
    +
    1396
    +
    1397 ! Solve the triangular system T11 * B(1:rnk) = B(1:rnk)
    +
    1398 call solve_triangular_system(.true., .false., .true., a(1:rnk,1:rnk), &
    +
    1399 b(1:rnk))
    +
    1400 if (n > rnk) b(rnk+1:n) = zero
    +
    1401
    +
    1402 ! Compute B(1:n) = Y**T * B(1:n)
    +
    1403 if (rnk < n) then
    +
    1404 call mult_rz(.true., n - rnk, a(1:rnk,:), tau2, b(1:n), w)
    1405 end if
    -
    1406 if (present(err)) then
    -
    1407 errmgr => err
    -
    1408 else
    -
    1409 errmgr => deferr
    -
    1410 end if
    -
    1411
    -
    1412 ! Input Check
    -
    1413 flag = 0
    -
    1414 if (size(a, 2) /= n) then
    -
    1415 flag = 2
    -
    1416 else if (size(b, 1) /= n) then
    -
    1417 flag = 3
    -
    1418 end if
    -
    1419 if (flag /= 0) then
    -
    1420 write(errmsg, '(AI0A)') "Input number ", flag, &
    -
    1421 " is not sized correctly."
    -
    1422 call errmgr%report_error("solve_cholesky_mtx", trim(errmsg), &
    -
    1423 la_array_size_error)
    -
    1424 return
    -
    1425 end if
    +
    1406
    +
    1407 ! Apply the pivoting: B(1:N) = P * B(1:N)
    +
    1408 do i = 1, n
    +
    1409 wptr(jpvt(i)) = b(i)
    +
    1410 end do
    +
    1411 b = wptr(1:n)
    +
    1412
    +
    1413 ! Formatting
    +
    1414100 format(a, i0, a)
    +
    1415 end subroutine
    +
    1416
    +
    1417! ******************************************************************************
    +
    1418! CHOLESKY SOLVE
    +
    1419! ------------------------------------------------------------------------------
    +
    1420 module subroutine solve_cholesky_mtx(upper, a, b, err)
    +
    1421 ! Arguments
    +
    1422 logical, intent(in) :: upper
    +
    1423 real(real64), intent(in), dimension(:,:) :: a
    +
    1424 real(real64), intent(inout), dimension(:,:) :: b
    +
    1425 class(errors), intent(inout), optional, target :: err
    1426
    -
    1427 ! Process
    -
    1428 call dpotrs(uplo, n, nrhs, a, n, b, n, flag)
    -
    1429 end subroutine
    -
    1430
    -
    1431! ------------------------------------------------------------------------------
    -
    1432 module subroutine solve_cholesky_mtx_cmplx(upper, a, b, err)
    -
    1433 ! Arguments
    -
    1434 logical, intent(in) :: upper
    -
    1435 complex(real64), intent(in), dimension(:,:) :: a
    -
    1436 complex(real64), intent(inout), dimension(:,:) :: b
    -
    1437 class(errors), intent(inout), optional, target :: err
    -
    1438
    -
    1439 ! Local Variables
    -
    1440 character :: uplo
    -
    1441 integer(int32) :: n, nrhs, flag
    -
    1442 class(errors), pointer :: errmgr
    -
    1443 type(errors), target :: deferr
    -
    1444 character(len = 128) :: errmsg
    -
    1445
    -
    1446 ! Initialization
    -
    1447 n = size(a, 1)
    -
    1448 nrhs = size(b, 2)
    -
    1449 if (upper) then
    -
    1450 uplo = 'U'
    -
    1451 else
    -
    1452 uplo = 'L'
    -
    1453 end if
    -
    1454 if (present(err)) then
    -
    1455 errmgr => err
    -
    1456 else
    -
    1457 errmgr => deferr
    -
    1458 end if
    -
    1459
    -
    1460 ! Input Check
    -
    1461 flag = 0
    -
    1462 if (size(a, 2) /= n) then
    -
    1463 flag = 2
    -
    1464 else if (size(b, 1) /= n) then
    -
    1465 flag = 3
    -
    1466 end if
    -
    1467 if (flag /= 0) then
    -
    1468 write(errmsg, '(AI0A)') "Input number ", flag, &
    -
    1469 " is not sized correctly."
    -
    1470 call errmgr%report_error("solve_cholesky_mtx_cmplx", trim(errmsg), &
    -
    1471 la_array_size_error)
    -
    1472 return
    -
    1473 end if
    -
    1474
    -
    1475 ! Process
    -
    1476 call zpotrs(uplo, n, nrhs, a, n, b, n, flag)
    -
    1477 end subroutine
    -
    1478
    -
    1479! ------------------------------------------------------------------------------
    -
    1480 module subroutine solve_cholesky_vec(upper, a, b, err)
    -
    1481 ! Arguments
    -
    1482 logical, intent(in) :: upper
    -
    1483 real(real64), intent(in), dimension(:,:) :: a
    -
    1484 real(real64), intent(inout), dimension(:) :: b
    -
    1485 class(errors), intent(inout), optional, target :: err
    -
    1486
    -
    1487 ! Local Variables
    -
    1488 character :: uplo
    -
    1489 integer(int32) :: n, flag
    -
    1490 class(errors), pointer :: errmgr
    -
    1491 type(errors), target :: deferr
    -
    1492 character(len = 128) :: errmsg
    -
    1493
    -
    1494 ! Initialization
    -
    1495 n = size(a, 1)
    -
    1496 if (upper) then
    -
    1497 uplo = 'U'
    -
    1498 else
    -
    1499 uplo = 'L'
    -
    1500 end if
    -
    1501 if (present(err)) then
    -
    1502 errmgr => err
    -
    1503 else
    -
    1504 errmgr => deferr
    +
    1427 ! Local Variables
    +
    1428 character :: uplo
    +
    1429 integer(int32) :: n, nrhs, flag
    +
    1430 class(errors), pointer :: errmgr
    +
    1431 type(errors), target :: deferr
    +
    1432 character(len = 128) :: errmsg
    +
    1433
    +
    1434 ! Initialization
    +
    1435 n = size(a, 1)
    +
    1436 nrhs = size(b, 2)
    +
    1437 if (upper) then
    +
    1438 uplo = 'U'
    +
    1439 else
    +
    1440 uplo = 'L'
    +
    1441 end if
    +
    1442 if (present(err)) then
    +
    1443 errmgr => err
    +
    1444 else
    +
    1445 errmgr => deferr
    +
    1446 end if
    +
    1447
    +
    1448 ! Input Check
    +
    1449 flag = 0
    +
    1450 if (size(a, 2) /= n) then
    +
    1451 flag = 2
    +
    1452 else if (size(b, 1) /= n) then
    +
    1453 flag = 3
    +
    1454 end if
    +
    1455 if (flag /= 0) then
    +
    1456 write(errmsg, 100) "Input number ", flag, &
    +
    1457 " is not sized correctly."
    +
    1458 call errmgr%report_error("solve_cholesky_mtx", trim(errmsg), &
    +
    1459 la_array_size_error)
    +
    1460 return
    +
    1461 end if
    +
    1462
    +
    1463 ! Process
    +
    1464 call dpotrs(uplo, n, nrhs, a, n, b, n, flag)
    +
    1465
    +
    1466 ! Formatting
    +
    1467100 format(a, i0, a)
    +
    1468 end subroutine
    +
    1469
    +
    1470! ------------------------------------------------------------------------------
    +
    1471 module subroutine solve_cholesky_mtx_cmplx(upper, a, b, err)
    +
    1472 ! Arguments
    +
    1473 logical, intent(in) :: upper
    +
    1474 complex(real64), intent(in), dimension(:,:) :: a
    +
    1475 complex(real64), intent(inout), dimension(:,:) :: b
    +
    1476 class(errors), intent(inout), optional, target :: err
    +
    1477
    +
    1478 ! Local Variables
    +
    1479 character :: uplo
    +
    1480 integer(int32) :: n, nrhs, flag
    +
    1481 class(errors), pointer :: errmgr
    +
    1482 type(errors), target :: deferr
    +
    1483 character(len = 128) :: errmsg
    +
    1484
    +
    1485 ! Initialization
    +
    1486 n = size(a, 1)
    +
    1487 nrhs = size(b, 2)
    +
    1488 if (upper) then
    +
    1489 uplo = 'U'
    +
    1490 else
    +
    1491 uplo = 'L'
    +
    1492 end if
    +
    1493 if (present(err)) then
    +
    1494 errmgr => err
    +
    1495 else
    +
    1496 errmgr => deferr
    +
    1497 end if
    +
    1498
    +
    1499 ! Input Check
    +
    1500 flag = 0
    +
    1501 if (size(a, 2) /= n) then
    +
    1502 flag = 2
    +
    1503 else if (size(b, 1) /= n) then
    +
    1504 flag = 3
    1505 end if
    -
    1506
    -
    1507 ! Input Check
    -
    1508 flag = 0
    -
    1509 if (size(a, 2) /= n) then
    -
    1510 flag = 2
    -
    1511 else if (size(b) /= n) then
    -
    1512 flag = 3
    -
    1513 end if
    -
    1514 if (flag /= 0) then
    -
    1515 write(errmsg, '(AI0A)') "Input number ", flag, &
    -
    1516 " is not sized correctly."
    -
    1517 call errmgr%report_error("solve_cholesky_vec", trim(errmsg), &
    -
    1518 la_array_size_error)
    -
    1519 return
    -
    1520 end if
    -
    1521
    -
    1522 ! Process
    -
    1523 call dpotrs(uplo, n, 1, a, n, b, n, flag)
    -
    1524 end subroutine
    -
    1525
    -
    1526! ------------------------------------------------------------------------------
    -
    1527 module subroutine solve_cholesky_vec_cmplx(upper, a, b, err)
    -
    1528 ! Arguments
    -
    1529 logical, intent(in) :: upper
    -
    1530 complex(real64), intent(in), dimension(:,:) :: a
    -
    1531 complex(real64), intent(inout), dimension(:) :: b
    -
    1532 class(errors), intent(inout), optional, target :: err
    -
    1533
    -
    1534 ! Local Variables
    -
    1535 character :: uplo
    -
    1536 integer(int32) :: n, flag
    -
    1537 class(errors), pointer :: errmgr
    -
    1538 type(errors), target :: deferr
    -
    1539 character(len = 128) :: errmsg
    -
    1540
    -
    1541 ! Initialization
    -
    1542 n = size(a, 1)
    -
    1543 if (upper) then
    -
    1544 uplo = 'U'
    +
    1506 if (flag /= 0) then
    +
    1507 write(errmsg, 100) "Input number ", flag, &
    +
    1508 " is not sized correctly."
    +
    1509 call errmgr%report_error("solve_cholesky_mtx_cmplx", trim(errmsg), &
    +
    1510 la_array_size_error)
    +
    1511 return
    +
    1512 end if
    +
    1513
    +
    1514 ! Process
    +
    1515 call zpotrs(uplo, n, nrhs, a, n, b, n, flag)
    +
    1516
    +
    1517 ! Formatting
    +
    1518100 format(a, i0, a)
    +
    1519 end subroutine
    +
    1520
    +
    1521! ------------------------------------------------------------------------------
    +
    1522 module subroutine solve_cholesky_vec(upper, a, b, err)
    +
    1523 ! Arguments
    +
    1524 logical, intent(in) :: upper
    +
    1525 real(real64), intent(in), dimension(:,:) :: a
    +
    1526 real(real64), intent(inout), dimension(:) :: b
    +
    1527 class(errors), intent(inout), optional, target :: err
    +
    1528
    +
    1529 ! Local Variables
    +
    1530 character :: uplo
    +
    1531 integer(int32) :: n, flag
    +
    1532 class(errors), pointer :: errmgr
    +
    1533 type(errors), target :: deferr
    +
    1534 character(len = 128) :: errmsg
    +
    1535
    +
    1536 ! Initialization
    +
    1537 n = size(a, 1)
    +
    1538 if (upper) then
    +
    1539 uplo = 'U'
    +
    1540 else
    +
    1541 uplo = 'L'
    +
    1542 end if
    +
    1543 if (present(err)) then
    +
    1544 errmgr => err
    1545 else
    -
    1546 uplo = 'L'
    +
    1546 errmgr => deferr
    1547 end if
    -
    1548 if (present(err)) then
    -
    1549 errmgr => err
    -
    1550 else
    -
    1551 errmgr => deferr
    -
    1552 end if
    -
    1553
    -
    1554 ! Input Check
    -
    1555 flag = 0
    -
    1556 if (size(a, 2) /= n) then
    -
    1557 flag = 2
    -
    1558 else if (size(b) /= n) then
    -
    1559 flag = 3
    -
    1560 end if
    -
    1561 if (flag /= 0) then
    -
    1562 write(errmsg, '(AI0A)') "Input number ", flag, &
    -
    1563 " is not sized correctly."
    -
    1564 call errmgr%report_error("solve_cholesky_vec_cmplx", trim(errmsg), &
    -
    1565 la_array_size_error)
    -
    1566 return
    -
    1567 end if
    -
    1568
    -
    1569 ! Process
    -
    1570 call zpotrs(uplo, n, 1, a, n, b, n, flag)
    -
    1571 end subroutine
    -
    1572
    -
    1573! ******************************************************************************
    -
    1574! MATRIX INVERSION ROUTINES
    -
    1575! ------------------------------------------------------------------------------
    -
    1576 module subroutine mtx_inverse_dbl(a, iwork, work, olwork, err)
    -
    1577 ! Arguments
    -
    1578 real(real64), intent(inout), dimension(:,:) :: a
    -
    1579 integer(int32), intent(out), target, optional, dimension(:) :: iwork
    -
    1580 real(real64), intent(out), target, optional, dimension(:) :: work
    -
    1581 integer(int32), intent(out), optional :: olwork
    -
    1582 class(errors), intent(inout), optional, target :: err
    -
    1583
    -
    1584 ! Local Variables
    -
    1585 integer(int32) :: n, liwork, lwork, istat, flag
    -
    1586 integer(int32), pointer, dimension(:) :: iptr
    -
    1587 integer(int32), allocatable, target, dimension(:) :: iwrk
    -
    1588 real(real64), pointer, dimension(:) :: wptr
    -
    1589 real(real64), allocatable, target, dimension(:) :: wrk
    -
    1590 real(real64), dimension(1) :: temp
    -
    1591 class(errors), pointer :: errmgr
    -
    1592 type(errors), target :: deferr
    -
    1593
    -
    1594 ! Initialization
    -
    1595 n = size(a, 1)
    -
    1596 liwork = n
    -
    1597 if (present(err)) then
    -
    1598 errmgr => err
    -
    1599 else
    -
    1600 errmgr => deferr
    -
    1601 end if
    -
    1602
    -
    1603 ! Input Check
    -
    1604 if (size(a, 2) /= n) then
    -
    1605 call errmgr%report_error("mtx_inverse", &
    -
    1606 "The matrix must be squre to invert.", la_array_size_error)
    -
    1607 return
    -
    1608 end if
    -
    1609
    -
    1610 ! Workspace Query
    -
    1611 call dgetri(n, a, n, istat, temp, -1, flag)
    -
    1612 lwork = int(temp(1), int32)
    -
    1613 if (present(olwork)) then
    -
    1614 olwork = lwork
    -
    1615 return
    -
    1616 end if
    -
    1617
    -
    1618 ! Workspace Allocation
    -
    1619 if (present(work)) then
    -
    1620 if (size(work) < lwork) then
    -
    1621 ! ERROR: WORK not sized correctly
    -
    1622 call errmgr%report_error("mtx_inverse_dbl", &
    -
    1623 "Incorrectly sized input array WORK, argument 3.", &
    -
    1624 la_array_size_error)
    -
    1625 return
    -
    1626 end if
    -
    1627 wptr => work(1:lwork)
    -
    1628 else
    -
    1629 allocate(wrk(lwork), stat = istat)
    -
    1630 if (istat /= 0) then
    -
    1631 ! ERROR: Out of memory
    -
    1632 call errmgr%report_error("mtx_inverse_dbl", &
    -
    1633 "Insufficient memory available.", &
    -
    1634 la_out_of_memory_error)
    -
    1635 return
    -
    1636 end if
    -
    1637 wptr => wrk
    -
    1638 end if
    -
    1639
    -
    1640 ! Integer Workspace Allocation
    -
    1641 if (present(iwork)) then
    -
    1642 if (size(iwork) < liwork) then
    -
    1643 ! ERROR: IWORK not sized correctly
    -
    1644 call errmgr%report_error("mtx_inverse_dbl", &
    -
    1645 "Incorrectly sized input array IWORK, argument 2.", &
    -
    1646 la_array_size_error)
    -
    1647 return
    -
    1648 end if
    -
    1649 iptr => iwork(1:liwork)
    -
    1650 else
    -
    1651 allocate(iwrk(liwork), stat = istat)
    -
    1652 if (istat /= 0) then
    -
    1653 ! ERROR: Out of memory
    -
    1654 call errmgr%report_error("mtx_inverse_dbl", &
    -
    1655 "Insufficient memory available.", &
    -
    1656 la_out_of_memory_error)
    -
    1657 return
    -
    1658 end if
    -
    1659 iptr => iwrk
    -
    1660 end if
    -
    1661
    -
    1662 ! Compute the LU factorization of A
    -
    1663 call dgetrf(n, n, a, n, iptr, flag)
    -
    1664
    -
    1665 ! Compute the inverse of the LU factored matrix
    -
    1666 call dgetri(n, a, n, iptr, wptr, lwork, flag)
    -
    1667
    -
    1668 ! Check for a singular matrix
    -
    1669 if (flag > 0) then
    -
    1670 call errmgr%report_error("mtx_inverse_dbl", &
    -
    1671 "The matrix is singular; therefore, the inverse could " // &
    -
    1672 "not be computed.", la_singular_matrix_error)
    -
    1673 end if
    -
    1674 end subroutine
    -
    1675
    -
    1676! ------------------------------------------------------------------------------
    -
    1677 module subroutine mtx_inverse_cmplx(a, iwork, work, olwork, err)
    -
    1678 ! Arguments
    -
    1679 complex(real64), intent(inout), dimension(:,:) :: a
    -
    1680 integer(int32), intent(out), target, optional, dimension(:) :: iwork
    -
    1681 complex(real64), intent(out), target, optional, dimension(:) :: work
    -
    1682 integer(int32), intent(out), optional :: olwork
    -
    1683 class(errors), intent(inout), optional, target :: err
    -
    1684
    -
    1685 ! Local Variables
    -
    1686 integer(int32) :: n, liwork, lwork, istat, flag
    -
    1687 integer(int32), pointer, dimension(:) :: iptr
    -
    1688 integer(int32), allocatable, target, dimension(:) :: iwrk
    -
    1689 complex(real64), pointer, dimension(:) :: wptr
    -
    1690 complex(real64), allocatable, target, dimension(:) :: wrk
    -
    1691 complex(real64), dimension(1) :: temp
    -
    1692 class(errors), pointer :: errmgr
    -
    1693 type(errors), target :: deferr
    -
    1694
    -
    1695 ! Initialization
    -
    1696 n = size(a, 1)
    -
    1697 liwork = n
    -
    1698 if (present(err)) then
    -
    1699 errmgr => err
    -
    1700 else
    -
    1701 errmgr => deferr
    -
    1702 end if
    -
    1703
    -
    1704 ! Input Check
    -
    1705 if (size(a, 2) /= n) then
    -
    1706 call errmgr%report_error("mtx_inverse_cmplx", &
    -
    1707 "The matrix must be squre to invert.", la_array_size_error)
    -
    1708 return
    -
    1709 end if
    -
    1710
    -
    1711 ! Workspace Query
    -
    1712 call zgetri(n, a, n, istat, temp, -1, flag)
    -
    1713 lwork = int(temp(1), int32)
    -
    1714 if (present(olwork)) then
    -
    1715 olwork = lwork
    -
    1716 return
    -
    1717 end if
    -
    1718
    -
    1719 ! Workspace Allocation
    -
    1720 if (present(work)) then
    -
    1721 if (size(work) < lwork) then
    -
    1722 ! ERROR: WORK not sized correctly
    -
    1723 call errmgr%report_error("mtx_inverse_cmplx", &
    -
    1724 "Incorrectly sized input array WORK, argument 3.", &
    -
    1725 la_array_size_error)
    -
    1726 return
    -
    1727 end if
    -
    1728 wptr => work(1:lwork)
    -
    1729 else
    -
    1730 allocate(wrk(lwork), stat = istat)
    -
    1731 if (istat /= 0) then
    -
    1732 ! ERROR: Out of memory
    -
    1733 call errmgr%report_error("mtx_inverse_cmplx", &
    -
    1734 "Insufficient memory available.", &
    -
    1735 la_out_of_memory_error)
    -
    1736 return
    -
    1737 end if
    -
    1738 wptr => wrk
    -
    1739 end if
    -
    1740
    -
    1741 ! Integer Workspace Allocation
    -
    1742 if (present(iwork)) then
    -
    1743 if (size(iwork) < liwork) then
    -
    1744 ! ERROR: IWORK not sized correctly
    -
    1745 call errmgr%report_error("mtx_inverse_cmplx", &
    -
    1746 "Incorrectly sized input array IWORK, argument 2.", &
    -
    1747 la_array_size_error)
    -
    1748 return
    -
    1749 end if
    -
    1750 iptr => iwork(1:liwork)
    -
    1751 else
    -
    1752 allocate(iwrk(liwork), stat = istat)
    -
    1753 if (istat /= 0) then
    -
    1754 ! ERROR: Out of memory
    -
    1755 call errmgr%report_error("mtx_inverse_cmplx", &
    -
    1756 "Insufficient memory available.", &
    -
    1757 la_out_of_memory_error)
    -
    1758 return
    -
    1759 end if
    -
    1760 iptr => iwrk
    -
    1761 end if
    -
    1762
    -
    1763 ! Compute the LU factorization of A
    -
    1764 call zgetrf(n, n, a, n, iptr, flag)
    -
    1765
    -
    1766 ! Compute the inverse of the LU factored matrix
    -
    1767 call zgetri(n, a, n, iptr, wptr, lwork, flag)
    -
    1768
    -
    1769 ! Check for a singular matrix
    -
    1770 if (flag > 0) then
    -
    1771 call errmgr%report_error("mtx_inverse_cmplx", &
    -
    1772 "The matrix is singular; therefore, the inverse could " // &
    -
    1773 "not be computed.", la_singular_matrix_error)
    -
    1774 end if
    -
    1775 end subroutine
    -
    1776
    -
    1777! ------------------------------------------------------------------------------
    -
    1778 module subroutine mtx_pinverse_dbl(a, ainv, tol, work, olwork, err)
    -
    1779 ! Arguments
    -
    1780 real(real64), intent(inout), dimension(:,:) :: a
    -
    1781 real(real64), intent(out), dimension(:,:) :: ainv
    -
    1782 real(real64), intent(in), optional :: tol
    -
    1783 real(real64), intent(out), target, dimension(:), optional :: work
    -
    1784 integer(int32), intent(out), optional :: olwork
    -
    1785 class(errors), intent(inout), optional, target :: err
    -
    1786
    -
    1787 ! External Function Interfaces
    -
    1788 interface
    -
    1789 function dlamch(cmach) result(x)
    -
    1790 use, intrinsic :: iso_fortran_env, only : real64
    -
    1791 character, intent(in) :: cmach
    -
    1792 real(real64) :: x
    -
    1793 end function
    -
    1794 end interface
    -
    1795
    -
    1796 ! Parameters
    -
    1797 real(real64), parameter :: zero = 0.0d0
    -
    1798 real(real64), parameter :: one = 1.0d0
    -
    1799
    -
    1800 ! Local Variables
    -
    1801 integer(int32) :: i, m, n, mn, lwork, istat, flag, i1, i2a, i2b, i3a, &
    -
    1802 i3b, i4
    -
    1803 real(real64), pointer, dimension(:) :: s, wptr, w
    -
    1804 real(real64), pointer, dimension(:,:) :: u, vt
    -
    1805 real(real64), allocatable, target, dimension(:) :: wrk
    -
    1806 real(real64), dimension(1) :: temp
    -
    1807 real(real64) :: t, tref, tolcheck
    -
    1808 class(errors), pointer :: errmgr
    -
    1809 type(errors), target :: deferr
    -
    1810 character(len = 128) :: errmsg
    -
    1811
    -
    1812 ! Initialization
    -
    1813 m = size(a, 1)
    -
    1814 n = size(a, 2)
    -
    1815 mn = min(m, n)
    -
    1816 i1 = m * mn
    -
    1817 i2a = i1 + 1
    -
    1818 i2b = i2a + n * n - 1
    -
    1819 i3a = i2b + 1
    -
    1820 i3b = i3a + mn - 1
    -
    1821 i4 = i3b + 1
    -
    1822 tolcheck = dlamch('s')
    -
    1823 if (present(err)) then
    -
    1824 errmgr => err
    -
    1825 else
    -
    1826 errmgr => deferr
    -
    1827 end if
    -
    1828
    -
    1829 ! Input Check
    -
    1830 if (size(ainv, 1) /= n .or. size(ainv, 2) /= m) then
    -
    1831 write(errmsg, '(AI0AI0A)') &
    -
    1832 "The output matrix AINV is not sized appropriately. " // &
    -
    1833 "It is expected to be ", n, "-by-", m, "."
    -
    1834 call errmgr%report_error("mtx_pinverse", errmsg, &
    -
    1835 la_array_size_error)
    -
    1836 return
    -
    1837 end if
    -
    1838
    -
    1839 ! Workspace Query
    -
    1840 call dgesvd('S', 'A', m, n, a, m, a(1:mn,:), a, m, a, n, temp, -1, flag)
    -
    1841 lwork = int(temp(1), int32)
    -
    1842 lwork = lwork + m * mn + n * n + mn
    -
    1843 if (present(olwork)) then
    -
    1844 olwork = lwork
    -
    1845 return
    -
    1846 end if
    +
    1548
    +
    1549 ! Input Check
    +
    1550 flag = 0
    +
    1551 if (size(a, 2) /= n) then
    +
    1552 flag = 2
    +
    1553 else if (size(b) /= n) then
    +
    1554 flag = 3
    +
    1555 end if
    +
    1556 if (flag /= 0) then
    +
    1557 write(errmsg, 100) "Input number ", flag, &
    +
    1558 " is not sized correctly."
    +
    1559 call errmgr%report_error("solve_cholesky_vec", trim(errmsg), &
    +
    1560 la_array_size_error)
    +
    1561 return
    +
    1562 end if
    +
    1563
    +
    1564 ! Process
    +
    1565 call dpotrs(uplo, n, 1, a, n, b, n, flag)
    +
    1566
    +
    1567 ! Formatting
    +
    1568100 format(a, i0, a)
    +
    1569 end subroutine
    +
    1570
    +
    1571! ------------------------------------------------------------------------------
    +
    1572 module subroutine solve_cholesky_vec_cmplx(upper, a, b, err)
    +
    1573 ! Arguments
    +
    1574 logical, intent(in) :: upper
    +
    1575 complex(real64), intent(in), dimension(:,:) :: a
    +
    1576 complex(real64), intent(inout), dimension(:) :: b
    +
    1577 class(errors), intent(inout), optional, target :: err
    +
    1578
    +
    1579 ! Local Variables
    +
    1580 character :: uplo
    +
    1581 integer(int32) :: n, flag
    +
    1582 class(errors), pointer :: errmgr
    +
    1583 type(errors), target :: deferr
    +
    1584 character(len = 128) :: errmsg
    +
    1585
    +
    1586 ! Initialization
    +
    1587 n = size(a, 1)
    +
    1588 if (upper) then
    +
    1589 uplo = 'U'
    +
    1590 else
    +
    1591 uplo = 'L'
    +
    1592 end if
    +
    1593 if (present(err)) then
    +
    1594 errmgr => err
    +
    1595 else
    +
    1596 errmgr => deferr
    +
    1597 end if
    +
    1598
    +
    1599 ! Input Check
    +
    1600 flag = 0
    +
    1601 if (size(a, 2) /= n) then
    +
    1602 flag = 2
    +
    1603 else if (size(b) /= n) then
    +
    1604 flag = 3
    +
    1605 end if
    +
    1606 if (flag /= 0) then
    +
    1607 write(errmsg, 100) "Input number ", flag, &
    +
    1608 " is not sized correctly."
    +
    1609 call errmgr%report_error("solve_cholesky_vec_cmplx", trim(errmsg), &
    +
    1610 la_array_size_error)
    +
    1611 return
    +
    1612 end if
    +
    1613
    +
    1614 ! Process
    +
    1615 call zpotrs(uplo, n, 1, a, n, b, n, flag)
    +
    1616
    +
    1617 ! Formatting
    +
    1618100 format(a, i0, a)
    +
    1619 end subroutine
    +
    1620
    +
    1621! ******************************************************************************
    +
    1622! MATRIX INVERSION ROUTINES
    +
    1623! ------------------------------------------------------------------------------
    +
    1624 module subroutine mtx_inverse_dbl(a, iwork, work, olwork, err)
    +
    1625 ! Arguments
    +
    1626 real(real64), intent(inout), dimension(:,:) :: a
    +
    1627 integer(int32), intent(out), target, optional, dimension(:) :: iwork
    +
    1628 real(real64), intent(out), target, optional, dimension(:) :: work
    +
    1629 integer(int32), intent(out), optional :: olwork
    +
    1630 class(errors), intent(inout), optional, target :: err
    +
    1631
    +
    1632 ! Local Variables
    +
    1633 integer(int32) :: n, liwork, lwork, istat, flag
    +
    1634 integer(int32), pointer, dimension(:) :: iptr
    +
    1635 integer(int32), allocatable, target, dimension(:) :: iwrk
    +
    1636 real(real64), pointer, dimension(:) :: wptr
    +
    1637 real(real64), allocatable, target, dimension(:) :: wrk
    +
    1638 real(real64), dimension(1) :: temp
    +
    1639 class(errors), pointer :: errmgr
    +
    1640 type(errors), target :: deferr
    +
    1641
    +
    1642 ! Initialization
    +
    1643 n = size(a, 1)
    +
    1644 liwork = n
    +
    1645 if (present(err)) then
    +
    1646 errmgr => err
    +
    1647 else
    +
    1648 errmgr => deferr
    +
    1649 end if
    +
    1650
    +
    1651 ! Input Check
    +
    1652 if (size(a, 2) /= n) then
    +
    1653 call errmgr%report_error("mtx_inverse", &
    +
    1654 "The matrix must be squre to invert.", la_array_size_error)
    +
    1655 return
    +
    1656 end if
    +
    1657
    +
    1658 ! Workspace Query
    +
    1659 call dgetri(n, a, n, istat, temp, -1, flag)
    +
    1660 lwork = int(temp(1), int32)
    +
    1661 if (present(olwork)) then
    +
    1662 olwork = lwork
    +
    1663 return
    +
    1664 end if
    +
    1665
    +
    1666 ! Workspace Allocation
    +
    1667 if (present(work)) then
    +
    1668 if (size(work) < lwork) then
    +
    1669 ! ERROR: WORK not sized correctly
    +
    1670 call errmgr%report_error("mtx_inverse_dbl", &
    +
    1671 "Incorrectly sized input array WORK, argument 3.", &
    +
    1672 la_array_size_error)
    +
    1673 return
    +
    1674 end if
    +
    1675 wptr => work(1:lwork)
    +
    1676 else
    +
    1677 allocate(wrk(lwork), stat = istat)
    +
    1678 if (istat /= 0) then
    +
    1679 ! ERROR: Out of memory
    +
    1680 call errmgr%report_error("mtx_inverse_dbl", &
    +
    1681 "Insufficient memory available.", &
    +
    1682 la_out_of_memory_error)
    +
    1683 return
    +
    1684 end if
    +
    1685 wptr => wrk
    +
    1686 end if
    +
    1687
    +
    1688 ! Integer Workspace Allocation
    +
    1689 if (present(iwork)) then
    +
    1690 if (size(iwork) < liwork) then
    +
    1691 ! ERROR: IWORK not sized correctly
    +
    1692 call errmgr%report_error("mtx_inverse_dbl", &
    +
    1693 "Incorrectly sized input array IWORK, argument 2.", &
    +
    1694 la_array_size_error)
    +
    1695 return
    +
    1696 end if
    +
    1697 iptr => iwork(1:liwork)
    +
    1698 else
    +
    1699 allocate(iwrk(liwork), stat = istat)
    +
    1700 if (istat /= 0) then
    +
    1701 ! ERROR: Out of memory
    +
    1702 call errmgr%report_error("mtx_inverse_dbl", &
    +
    1703 "Insufficient memory available.", &
    +
    1704 la_out_of_memory_error)
    +
    1705 return
    +
    1706 end if
    +
    1707 iptr => iwrk
    +
    1708 end if
    +
    1709
    +
    1710 ! Compute the LU factorization of A
    +
    1711 call dgetrf(n, n, a, n, iptr, flag)
    +
    1712
    +
    1713 ! Compute the inverse of the LU factored matrix
    +
    1714 call dgetri(n, a, n, iptr, wptr, lwork, flag)
    +
    1715
    +
    1716 ! Check for a singular matrix
    +
    1717 if (flag > 0) then
    +
    1718 call errmgr%report_error("mtx_inverse_dbl", &
    +
    1719 "The matrix is singular; therefore, the inverse could " // &
    +
    1720 "not be computed.", la_singular_matrix_error)
    +
    1721 end if
    +
    1722 end subroutine
    +
    1723
    +
    1724! ------------------------------------------------------------------------------
    +
    1725 module subroutine mtx_inverse_cmplx(a, iwork, work, olwork, err)
    +
    1726 ! Arguments
    +
    1727 complex(real64), intent(inout), dimension(:,:) :: a
    +
    1728 integer(int32), intent(out), target, optional, dimension(:) :: iwork
    +
    1729 complex(real64), intent(out), target, optional, dimension(:) :: work
    +
    1730 integer(int32), intent(out), optional :: olwork
    +
    1731 class(errors), intent(inout), optional, target :: err
    +
    1732
    +
    1733 ! Local Variables
    +
    1734 integer(int32) :: n, liwork, lwork, istat, flag
    +
    1735 integer(int32), pointer, dimension(:) :: iptr
    +
    1736 integer(int32), allocatable, target, dimension(:) :: iwrk
    +
    1737 complex(real64), pointer, dimension(:) :: wptr
    +
    1738 complex(real64), allocatable, target, dimension(:) :: wrk
    +
    1739 complex(real64), dimension(1) :: temp
    +
    1740 class(errors), pointer :: errmgr
    +
    1741 type(errors), target :: deferr
    +
    1742
    +
    1743 ! Initialization
    +
    1744 n = size(a, 1)
    +
    1745 liwork = n
    +
    1746 if (present(err)) then
    +
    1747 errmgr => err
    +
    1748 else
    +
    1749 errmgr => deferr
    +
    1750 end if
    +
    1751
    +
    1752 ! Input Check
    +
    1753 if (size(a, 2) /= n) then
    +
    1754 call errmgr%report_error("mtx_inverse_cmplx", &
    +
    1755 "The matrix must be squre to invert.", la_array_size_error)
    +
    1756 return
    +
    1757 end if
    +
    1758
    +
    1759 ! Workspace Query
    +
    1760 call zgetri(n, a, n, istat, temp, -1, flag)
    +
    1761 lwork = int(temp(1), int32)
    +
    1762 if (present(olwork)) then
    +
    1763 olwork = lwork
    +
    1764 return
    +
    1765 end if
    +
    1766
    +
    1767 ! Workspace Allocation
    +
    1768 if (present(work)) then
    +
    1769 if (size(work) < lwork) then
    +
    1770 ! ERROR: WORK not sized correctly
    +
    1771 call errmgr%report_error("mtx_inverse_cmplx", &
    +
    1772 "Incorrectly sized input array WORK, argument 3.", &
    +
    1773 la_array_size_error)
    +
    1774 return
    +
    1775 end if
    +
    1776 wptr => work(1:lwork)
    +
    1777 else
    +
    1778 allocate(wrk(lwork), stat = istat)
    +
    1779 if (istat /= 0) then
    +
    1780 ! ERROR: Out of memory
    +
    1781 call errmgr%report_error("mtx_inverse_cmplx", &
    +
    1782 "Insufficient memory available.", &
    +
    1783 la_out_of_memory_error)
    +
    1784 return
    +
    1785 end if
    +
    1786 wptr => wrk
    +
    1787 end if
    +
    1788
    +
    1789 ! Integer Workspace Allocation
    +
    1790 if (present(iwork)) then
    +
    1791 if (size(iwork) < liwork) then
    +
    1792 ! ERROR: IWORK not sized correctly
    +
    1793 call errmgr%report_error("mtx_inverse_cmplx", &
    +
    1794 "Incorrectly sized input array IWORK, argument 2.", &
    +
    1795 la_array_size_error)
    +
    1796 return
    +
    1797 end if
    +
    1798 iptr => iwork(1:liwork)
    +
    1799 else
    +
    1800 allocate(iwrk(liwork), stat = istat)
    +
    1801 if (istat /= 0) then
    +
    1802 ! ERROR: Out of memory
    +
    1803 call errmgr%report_error("mtx_inverse_cmplx", &
    +
    1804 "Insufficient memory available.", &
    +
    1805 la_out_of_memory_error)
    +
    1806 return
    +
    1807 end if
    +
    1808 iptr => iwrk
    +
    1809 end if
    +
    1810
    +
    1811 ! Compute the LU factorization of A
    +
    1812 call zgetrf(n, n, a, n, iptr, flag)
    +
    1813
    +
    1814 ! Compute the inverse of the LU factored matrix
    +
    1815 call zgetri(n, a, n, iptr, wptr, lwork, flag)
    +
    1816
    +
    1817 ! Check for a singular matrix
    +
    1818 if (flag > 0) then
    +
    1819 call errmgr%report_error("mtx_inverse_cmplx", &
    +
    1820 "The matrix is singular; therefore, the inverse could " // &
    +
    1821 "not be computed.", la_singular_matrix_error)
    +
    1822 end if
    +
    1823 end subroutine
    +
    1824
    +
    1825! ------------------------------------------------------------------------------
    +
    1826 module subroutine mtx_pinverse_dbl(a, ainv, tol, work, olwork, err)
    +
    1827 ! Arguments
    +
    1828 real(real64), intent(inout), dimension(:,:) :: a
    +
    1829 real(real64), intent(out), dimension(:,:) :: ainv
    +
    1830 real(real64), intent(in), optional :: tol
    +
    1831 real(real64), intent(out), target, dimension(:), optional :: work
    +
    1832 integer(int32), intent(out), optional :: olwork
    +
    1833 class(errors), intent(inout), optional, target :: err
    +
    1834
    +
    1835 ! External Function Interfaces
    +
    1836 interface
    +
    1837 function dlamch(cmach) result(x)
    +
    1838 use, intrinsic :: iso_fortran_env, only : real64
    +
    1839 character, intent(in) :: cmach
    +
    1840 real(real64) :: x
    +
    1841 end function
    +
    1842 end interface
    +
    1843
    +
    1844 ! Parameters
    +
    1845 real(real64), parameter :: zero = 0.0d0
    +
    1846 real(real64), parameter :: one = 1.0d0
    1847
    -
    1848 ! Local Memory Allocation
    -
    1849 if (present(work)) then
    -
    1850 if (size(work) < lwork) then
    -
    1851 ! ERROR: WORK not sized correctly
    -
    1852 call errmgr%report_error("mtx_pinverse", &
    -
    1853 "Incorrectly sized input array WORK, argument 4.", &
    -
    1854 la_array_size_error)
    -
    1855 return
    -
    1856 end if
    -
    1857 wptr => work(1:lwork)
    -
    1858 else
    -
    1859 allocate(wrk(lwork), stat = istat)
    -
    1860 if (istat /= 0) then
    -
    1861 ! ERROR: Out of memory
    -
    1862 call errmgr%report_error("mtx_pinverse", &
    -
    1863 "Insufficient memory available.", &
    -
    1864 la_out_of_memory_error)
    -
    1865 return
    -
    1866 end if
    -
    1867 wptr => wrk
    -
    1868 end if
    -
    1869 u(1:m,1:mn) => wptr(1:i1)
    -
    1870 vt(1:n,1:n) => wptr(i2a:i2b)
    -
    1871 s => wptr(i3a:i3b)
    -
    1872 w => wptr(i4:lwork)
    -
    1873
    -
    1874 ! Compute the SVD of A
    -
    1875 call dgesvd('S', 'A', m, n, a, m, s, u, m, vt, n, w, size(w), flag)
    +
    1848 ! Local Variables
    +
    1849 integer(int32) :: i, m, n, mn, lwork, istat, flag, i1, i2a, i2b, i3a, &
    +
    1850 i3b, i4
    +
    1851 real(real64), pointer, dimension(:) :: s, wptr, w
    +
    1852 real(real64), pointer, dimension(:,:) :: u, vt
    +
    1853 real(real64), allocatable, target, dimension(:) :: wrk
    +
    1854 real(real64), dimension(1) :: temp
    +
    1855 real(real64) :: t, tref, tolcheck
    +
    1856 class(errors), pointer :: errmgr
    +
    1857 type(errors), target :: deferr
    +
    1858 character(len = 128) :: errmsg
    +
    1859
    +
    1860 ! Initialization
    +
    1861 m = size(a, 1)
    +
    1862 n = size(a, 2)
    +
    1863 mn = min(m, n)
    +
    1864 i1 = m * mn
    +
    1865 i2a = i1 + 1
    +
    1866 i2b = i2a + n * n - 1
    +
    1867 i3a = i2b + 1
    +
    1868 i3b = i3a + mn - 1
    +
    1869 i4 = i3b + 1
    +
    1870 tolcheck = dlamch('s')
    +
    1871 if (present(err)) then
    +
    1872 errmgr => err
    +
    1873 else
    +
    1874 errmgr => deferr
    +
    1875 end if
    1876
    -
    1877 ! Check for convergence
    -
    1878 if (flag > 0) then
    -
    1879 write(errmsg, '(I0A)') flag, " superdiagonals could not " // &
    -
    1880 "converge to zero as part of the QR iteration process."
    -
    1881 call errmgr%report_warning("mtx_pinverse", errmsg, &
    -
    1882 la_convergence_error)
    -
    1883 return
    -
    1884 end if
    -
    1885
    -
    1886 ! Determine the threshold tolerance for the singular values such that
    -
    1887 ! singular values less than the threshold result in zero when inverted.
    -
    1888 tref = max(m, n) * epsilon(t) * s(1)
    -
    1889 if (present(tol)) then
    -
    1890 t = tol
    -
    1891 else
    -
    1892 t = tref
    -
    1893 end if
    -
    1894 !if (t < safe_denom(t)) then
    -
    1895 if (t < tolcheck) then
    -
    1896 ! The supplied tolerance is too small, simply fall back to the
    -
    1897 ! default, but issue a warning to the user
    -
    1898 t = tref
    -
    1899 ! call errmgr%report_warning("pinverse_1", "The supplied tolerance was " // &
    -
    1900 ! "smaller than a value that would result in an overflow " // &
    -
    1901 ! "condition, or is negative; therefore, the tolerance has " // &
    -
    1902 ! "been reset to its default value.")
    -
    1903 end if
    -
    1904
    -
    1905 ! Compute the pseudoinverse such that pinv(A) = V * inv(S) * U**T by
    -
    1906 ! first computing V * inv(S) (result is N-by-M), and store in the first
    -
    1907 ! MN rows of VT in a transposed manner.
    -
    1908 do i = 1, mn
    -
    1909 ! Apply 1 / S(I) to VT(I,:)
    -
    1910 if (s(i) < t) then
    -
    1911 vt(i,:) = zero
    -
    1912 else
    -
    1913 call recip_mult_array(s(i), vt(i,1:n))
    +
    1877 ! Input Check
    +
    1878 if (size(ainv, 1) /= n .or. size(ainv, 2) /= m) then
    +
    1879 write(errmsg, 100) &
    +
    1880 "The output matrix AINV is not sized appropriately. " // &
    +
    1881 "It is expected to be ", n, "-by-", m, "."
    +
    1882 call errmgr%report_error("mtx_pinverse", errmsg, &
    +
    1883 la_array_size_error)
    +
    1884 return
    +
    1885 end if
    +
    1886
    +
    1887 ! Workspace Query
    +
    1888 call dgesvd('S', 'A', m, n, a, m, a(1:mn,:), a, m, a, n, temp, -1, flag)
    +
    1889 lwork = int(temp(1), int32)
    +
    1890 lwork = lwork + m * mn + n * n + mn
    +
    1891 if (present(olwork)) then
    +
    1892 olwork = lwork
    +
    1893 return
    +
    1894 end if
    +
    1895
    +
    1896 ! Local Memory Allocation
    +
    1897 if (present(work)) then
    +
    1898 if (size(work) < lwork) then
    +
    1899 ! ERROR: WORK not sized correctly
    +
    1900 call errmgr%report_error("mtx_pinverse", &
    +
    1901 "Incorrectly sized input array WORK, argument 4.", &
    +
    1902 la_array_size_error)
    +
    1903 return
    +
    1904 end if
    +
    1905 wptr => work(1:lwork)
    +
    1906 else
    +
    1907 allocate(wrk(lwork), stat = istat)
    +
    1908 if (istat /= 0) then
    +
    1909 ! ERROR: Out of memory
    +
    1910 call errmgr%report_error("mtx_pinverse", &
    +
    1911 "Insufficient memory available.", &
    +
    1912 la_out_of_memory_error)
    +
    1913 return
    1914 end if
    -
    1915 end do
    -
    1916
    -
    1917 ! Compute (VT**T * inv(S)) * U**T
    -
    1918 call mtx_mult(.true., .true., one, vt(1:mn,:), u, zero, ainv)
    -
    1919 end subroutine
    -
    1920
    -
    1921! ------------------------------------------------------------------------------
    -
    1922 module subroutine mtx_pinverse_cmplx(a, ainv, tol, work, olwork, rwork, err)
    -
    1923 ! Arguments
    -
    1924 complex(real64), intent(inout), dimension(:,:) :: a
    -
    1925 complex(real64), intent(out), dimension(:,:) :: ainv
    -
    1926 real(real64), intent(in), optional :: tol
    -
    1927 complex(real64), intent(out), target, dimension(:), optional :: work
    -
    1928 integer(int32), intent(out), optional :: olwork
    -
    1929 real(real64), intent(out), target, dimension(:), optional :: rwork
    -
    1930 class(errors), intent(inout), optional, target :: err
    -
    1931
    -
    1932 ! External Function Interfaces
    -
    1933 interface
    -
    1934 function dlamch(cmach) result(x)
    -
    1935 use, intrinsic :: iso_fortran_env, only : real64
    -
    1936 character, intent(in) :: cmach
    -
    1937 real(real64) :: x
    -
    1938 end function
    -
    1939 end interface
    -
    1940
    -
    1941 ! Parameters
    -
    1942 complex(real64), parameter :: zero = (0.0d0, 0.0d0)
    -
    1943 complex(real64), parameter :: one = (1.0d0, 0.0d0)
    -
    1944
    -
    1945 ! Local Variables
    -
    1946 integer(int32) :: i, m, n, mn, lwork, istat, flag, i1, i2a, i2b, i3, &
    -
    1947 lrwork, j, k
    -
    1948 real(real64), pointer, dimension(:) :: s, rwptr, rw
    -
    1949 real(real64), allocatable, target, dimension(:) :: rwrk
    -
    1950 complex(real64), pointer, dimension(:) :: wptr, w
    -
    1951 complex(real64), pointer, dimension(:,:) :: u, vt
    -
    1952 complex(real64), allocatable, target, dimension(:) :: wrk
    -
    1953 complex(real64) :: temp(1), val
    -
    1954 real(real64) :: t, tref, tolcheck, rtemp(1)
    -
    1955 class(errors), pointer :: errmgr
    -
    1956 type(errors), target :: deferr
    -
    1957 character(len = 128) :: errmsg
    -
    1958
    -
    1959 ! Initialization
    -
    1960 m = size(a, 1)
    -
    1961 n = size(a, 2)
    -
    1962 mn = min(m, n)
    -
    1963 lrwork = 6 * mn
    -
    1964 i1 = m * mn
    -
    1965 i2a = i1 + 1
    -
    1966 i2b = i2a + n * n - 1
    -
    1967 i3 = i2b + 1
    -
    1968 tolcheck = dlamch('s')
    -
    1969 if (present(err)) then
    -
    1970 errmgr => err
    -
    1971 else
    -
    1972 errmgr => deferr
    -
    1973 end if
    -
    1974
    -
    1975 ! Input Check
    -
    1976 if (size(ainv, 1) /= n .or. size(ainv, 2) /= m) then
    -
    1977 write(errmsg, '(AI0AI0A)') &
    -
    1978 "The output matrix AINV is not sized appropriately. " // &
    -
    1979 "It is expected to be ", n, "-by-", m, "."
    -
    1980 call errmgr%report_error("mtx_pinverse_cmplx", errmsg, &
    -
    1981 la_array_size_error)
    -
    1982 return
    -
    1983 end if
    -
    1984
    -
    1985 ! Workspace Query
    -
    1986 call zgesvd('S', 'A', m, n, a, m, a(1:mn,:), a, m, a, n, temp, -1, &
    -
    1987 rtemp, flag)
    -
    1988 lwork = int(temp(1), int32)
    -
    1989 lwork = lwork + m * mn + n * n
    -
    1990 if (present(olwork)) then
    -
    1991 olwork = lwork
    -
    1992 return
    -
    1993 end if
    -
    1994
    -
    1995 ! Local Memory Allocation
    -
    1996 if (present(work)) then
    -
    1997 if (size(work) < lwork) then
    -
    1998 ! ERROR: WORK not sized correctly
    -
    1999 call errmgr%report_error("mtx_pinverse_cmplx", &
    -
    2000 "Incorrectly sized input array WORK, argument 4.", &
    -
    2001 la_array_size_error)
    -
    2002 return
    -
    2003 end if
    -
    2004 wptr => work(1:lwork)
    -
    2005 else
    -
    2006 allocate(wrk(lwork), stat = istat)
    -
    2007 if (istat /= 0) then
    -
    2008 ! ERROR: Out of memory
    -
    2009 call errmgr%report_error("mtx_pinverse_cmplx", &
    -
    2010 "Insufficient memory available.", &
    -
    2011 la_out_of_memory_error)
    -
    2012 return
    -
    2013 end if
    -
    2014 wptr => wrk
    -
    2015 end if
    -
    2016
    -
    2017 if (present(rwork)) then
    -
    2018 if (size(rwork) < lrwork) then
    -
    2019 ! ERROR: WORK not sized correctly
    -
    2020 call errmgr%report_error("mtx_pinverse_cmplx", &
    -
    2021 "Incorrectly sized input array RWORK, argument 6.", &
    -
    2022 la_array_size_error)
    -
    2023 return
    -
    2024 end if
    -
    2025 rwptr => rwork(1:lrwork)
    -
    2026 else
    -
    2027 allocate(rwrk(lrwork), stat = istat)
    -
    2028 if (istat /= 0) then
    -
    2029 ! ERROR: Out of memory
    -
    2030 call errmgr%report_error("mtx_pinverse_cmplx", &
    -
    2031 "Insufficient memory available.", &
    -
    2032 la_out_of_memory_error)
    -
    2033 return
    -
    2034 end if
    -
    2035 rwptr => rwrk
    -
    2036 end if
    -
    2037 u(1:m,1:mn) => wptr(1:i1)
    -
    2038 vt(1:n,1:n) => wptr(i2a:i2b)
    -
    2039 w => wptr(i3:lwork)
    -
    2040 s => rwptr(1:mn)
    -
    2041 rw => rwptr(mn+1:lrwork)
    -
    2042
    -
    2043 ! Compute the SVD of A
    -
    2044 call zgesvd('S', 'A', m, n, a, m, s, u, m, vt, n, w, size(w), rw, flag)
    -
    2045
    -
    2046 ! Check for convergence
    -
    2047 if (flag > 0) then
    -
    2048 write(errmsg, '(I0A)') flag, " superdiagonals could not " // &
    -
    2049 "converge to zero as part of the QR iteration process."
    -
    2050 call errmgr%report_warning("mtx_pinverse_cmplx", errmsg, &
    -
    2051 la_convergence_error)
    -
    2052 return
    -
    2053 end if
    -
    2054
    -
    2055 ! Determine the threshold tolerance for the singular values such that
    -
    2056 ! singular values less than the threshold result in zero when inverted.
    -
    2057 tref = max(m, n) * epsilon(t) * s(1)
    -
    2058 if (present(tol)) then
    -
    2059 t = tol
    -
    2060 else
    -
    2061 t = tref
    -
    2062 end if
    -
    2063 !if (t < safe_denom(t)) then
    -
    2064 if (t < tolcheck) then
    -
    2065 ! The supplied tolerance is too small, simply fall back to the
    -
    2066 ! default, but issue a warning to the user
    -
    2067 t = tref
    -
    2068 ! call errmgr%report_warning("pinverse_1", "The supplied tolerance was " // &
    -
    2069 ! "smaller than a value that would result in an overflow " // &
    -
    2070 ! "condition, or is negative; therefore, the tolerance has " // &
    -
    2071 ! "been reset to its default value.")
    -
    2072 end if
    -
    2073
    -
    2074 ! Compute the pseudoinverse such that pinv(A) = V * inv(S) * U**T by
    -
    2075 ! first computing V * inv(S) (result is N-by-M), and store in the first
    -
    2076 ! MN rows of VT in a transposed manner.
    -
    2077 do i = 1, mn
    -
    2078 ! Apply 1 / S(I) to VT(I,:)
    -
    2079 if (s(i) < t) then
    -
    2080 vt(i,:) = zero
    -
    2081 else
    -
    2082 ! call recip_mult_array(s(i), vt(i,1:n))
    -
    2083 vt(i,1:n) = conjg(vt(i,1:n)) / s(i)
    -
    2084 end if
    -
    2085 end do
    -
    2086
    -
    2087 ! Compute (VT**T * inv(S)) * U**H
    -
    2088 ! ainv = n-by-m
    -
    2089 ! vt is n-by-n
    -
    2090 ! u is m-by-mn such that u**H = mn-by-m
    -
    2091 ! Compute ainv = vt**T * u**H
    -
    2092 do j = 1, m
    -
    2093 do i = 1, n
    -
    2094 val = zero
    -
    2095 do k = 1, mn
    -
    2096 val = val + vt(k,i) * conjg(u(j,k))
    -
    2097 end do
    -
    2098 ainv(i,j) = val
    -
    2099 end do
    -
    2100 end do
    -
    2101 end subroutine
    -
    2102
    -
    2103! ******************************************************************************
    -
    2104! LEAST SQUARES SOLUTION ROUTINES
    -
    2105! ------------------------------------------------------------------------------
    -
    2106 module subroutine solve_least_squares_mtx(a, b, work, olwork, err)
    -
    2107 ! Arguments
    -
    2108 real(real64), intent(inout), dimension(:,:) :: a, b
    -
    2109 real(real64), intent(out), target, optional, dimension(:) :: work
    -
    2110 integer(int32), intent(out), optional :: olwork
    -
    2111 class(errors), intent(inout), optional, target :: err
    -
    2112
    -
    2113 ! Local Variables
    -
    2114 integer(int32) :: m, n, maxmn, nrhs, lwork, istat, flag
    -
    2115 real(real64), pointer, dimension(:) :: wptr
    -
    2116 real(real64), allocatable, target, dimension(:) :: wrk
    -
    2117 real(real64), dimension(1) :: temp
    -
    2118 class(errors), pointer :: errmgr
    -
    2119 type(errors), target :: deferr
    -
    2120
    -
    2121 ! Initialization
    -
    2122 m = size(a, 1)
    -
    2123 n = size(a, 2)
    -
    2124 maxmn = max(m, n)
    -
    2125 nrhs = size(b, 2)
    -
    2126 if (present(err)) then
    -
    2127 errmgr => err
    -
    2128 else
    -
    2129 errmgr => deferr
    -
    2130 end if
    -
    2131
    -
    2132 ! Input Check
    -
    2133 if (size(b, 1) /= maxmn) then
    -
    2134 call errmgr%report_error("solve_least_squares_mtx", &
    -
    2135 "Input 2 is not sized correctly.", la_array_size_error)
    -
    2136 return
    -
    2137 end if
    +
    1915 wptr => wrk
    +
    1916 end if
    +
    1917 u(1:m,1:mn) => wptr(1:i1)
    +
    1918 vt(1:n,1:n) => wptr(i2a:i2b)
    +
    1919 s => wptr(i3a:i3b)
    +
    1920 w => wptr(i4:lwork)
    +
    1921
    +
    1922 ! Compute the SVD of A
    +
    1923 call dgesvd('S', 'A', m, n, a, m, s, u, m, vt, n, w, size(w), flag)
    +
    1924
    +
    1925 ! Check for convergence
    +
    1926 if (flag > 0) then
    +
    1927 write(errmsg, 101) flag, " superdiagonals could not " // &
    +
    1928 "converge to zero as part of the QR iteration process."
    +
    1929 call errmgr%report_warning("mtx_pinverse", errmsg, &
    +
    1930 la_convergence_error)
    +
    1931 return
    +
    1932 end if
    +
    1933
    +
    1934 ! Determine the threshold tolerance for the singular values such that
    +
    1935 ! singular values less than the threshold result in zero when inverted.
    +
    1936 tref = max(m, n) * epsilon(t) * s(1)
    +
    1937 if (present(tol)) then
    +
    1938 t = tol
    +
    1939 else
    +
    1940 t = tref
    +
    1941 end if
    +
    1942 !if (t < safe_denom(t)) then
    +
    1943 if (t < tolcheck) then
    +
    1944 ! The supplied tolerance is too small, simply fall back to the
    +
    1945 ! default, but issue a warning to the user
    +
    1946 t = tref
    +
    1947 ! call errmgr%report_warning("pinverse_1", "The supplied tolerance was " // &
    +
    1948 ! "smaller than a value that would result in an overflow " // &
    +
    1949 ! "condition, or is negative; therefore, the tolerance has " // &
    +
    1950 ! "been reset to its default value.")
    +
    1951 end if
    +
    1952
    +
    1953 ! Compute the pseudoinverse such that pinv(A) = V * inv(S) * U**T by
    +
    1954 ! first computing V * inv(S) (result is N-by-M), and store in the first
    +
    1955 ! MN rows of VT in a transposed manner.
    +
    1956 do i = 1, mn
    +
    1957 ! Apply 1 / S(I) to VT(I,:)
    +
    1958 if (s(i) < t) then
    +
    1959 vt(i,:) = zero
    +
    1960 else
    +
    1961 call recip_mult_array(s(i), vt(i,1:n))
    +
    1962 end if
    +
    1963 end do
    +
    1964
    +
    1965 ! Compute (VT**T * inv(S)) * U**T
    +
    1966 call mtx_mult(.true., .true., one, vt(1:mn,:), u, zero, ainv)
    +
    1967
    +
    1968 ! Formatting
    +
    1969100 format(a, i0, a, i0, a)
    +
    1970101 format(i0, a)
    +
    1971 end subroutine
    +
    1972
    +
    1973! ------------------------------------------------------------------------------
    +
    1974 module subroutine mtx_pinverse_cmplx(a, ainv, tol, work, olwork, rwork, err)
    +
    1975 ! Arguments
    +
    1976 complex(real64), intent(inout), dimension(:,:) :: a
    +
    1977 complex(real64), intent(out), dimension(:,:) :: ainv
    +
    1978 real(real64), intent(in), optional :: tol
    +
    1979 complex(real64), intent(out), target, dimension(:), optional :: work
    +
    1980 integer(int32), intent(out), optional :: olwork
    +
    1981 real(real64), intent(out), target, dimension(:), optional :: rwork
    +
    1982 class(errors), intent(inout), optional, target :: err
    +
    1983
    +
    1984 ! External Function Interfaces
    +
    1985 interface
    +
    1986 function dlamch(cmach) result(x)
    +
    1987 use, intrinsic :: iso_fortran_env, only : real64
    +
    1988 character, intent(in) :: cmach
    +
    1989 real(real64) :: x
    +
    1990 end function
    +
    1991 end interface
    +
    1992
    +
    1993 ! Parameters
    +
    1994 complex(real64), parameter :: zero = (0.0d0, 0.0d0)
    +
    1995 complex(real64), parameter :: one = (1.0d0, 0.0d0)
    +
    1996
    +
    1997 ! Local Variables
    +
    1998 integer(int32) :: i, m, n, mn, lwork, istat, flag, i1, i2a, i2b, i3, &
    +
    1999 lrwork, j, k
    +
    2000 real(real64), pointer, dimension(:) :: s, rwptr, rw
    +
    2001 real(real64), allocatable, target, dimension(:) :: rwrk
    +
    2002 complex(real64), pointer, dimension(:) :: wptr, w
    +
    2003 complex(real64), pointer, dimension(:,:) :: u, vt
    +
    2004 complex(real64), allocatable, target, dimension(:) :: wrk
    +
    2005 complex(real64) :: temp(1), val
    +
    2006 real(real64) :: t, tref, tolcheck, rtemp(1)
    +
    2007 class(errors), pointer :: errmgr
    +
    2008 type(errors), target :: deferr
    +
    2009 character(len = 128) :: errmsg
    +
    2010
    +
    2011 ! Initialization
    +
    2012 m = size(a, 1)
    +
    2013 n = size(a, 2)
    +
    2014 mn = min(m, n)
    +
    2015 lrwork = 6 * mn
    +
    2016 i1 = m * mn
    +
    2017 i2a = i1 + 1
    +
    2018 i2b = i2a + n * n - 1
    +
    2019 i3 = i2b + 1
    +
    2020 tolcheck = dlamch('s')
    +
    2021 if (present(err)) then
    +
    2022 errmgr => err
    +
    2023 else
    +
    2024 errmgr => deferr
    +
    2025 end if
    +
    2026
    +
    2027 ! Input Check
    +
    2028 if (size(ainv, 1) /= n .or. size(ainv, 2) /= m) then
    +
    2029 write(errmsg, 100) &
    +
    2030 "The output matrix AINV is not sized appropriately. " // &
    +
    2031 "It is expected to be ", n, "-by-", m, "."
    +
    2032 call errmgr%report_error("mtx_pinverse_cmplx", errmsg, &
    +
    2033 la_array_size_error)
    +
    2034 return
    +
    2035 end if
    +
    2036
    +
    2037 ! Workspace Query
    +
    2038 call zgesvd('S', 'A', m, n, a, m, a(1:mn,:), a, m, a, n, temp, -1, &
    +
    2039 rtemp, flag)
    +
    2040 lwork = int(temp(1), int32)
    +
    2041 lwork = lwork + m * mn + n * n
    +
    2042 if (present(olwork)) then
    +
    2043 olwork = lwork
    +
    2044 return
    +
    2045 end if
    +
    2046
    +
    2047 ! Local Memory Allocation
    +
    2048 if (present(work)) then
    +
    2049 if (size(work) < lwork) then
    +
    2050 ! ERROR: WORK not sized correctly
    +
    2051 call errmgr%report_error("mtx_pinverse_cmplx", &
    +
    2052 "Incorrectly sized input array WORK, argument 4.", &
    +
    2053 la_array_size_error)
    +
    2054 return
    +
    2055 end if
    +
    2056 wptr => work(1:lwork)
    +
    2057 else
    +
    2058 allocate(wrk(lwork), stat = istat)
    +
    2059 if (istat /= 0) then
    +
    2060 ! ERROR: Out of memory
    +
    2061 call errmgr%report_error("mtx_pinverse_cmplx", &
    +
    2062 "Insufficient memory available.", &
    +
    2063 la_out_of_memory_error)
    +
    2064 return
    +
    2065 end if
    +
    2066 wptr => wrk
    +
    2067 end if
    +
    2068
    +
    2069 if (present(rwork)) then
    +
    2070 if (size(rwork) < lrwork) then
    +
    2071 ! ERROR: WORK not sized correctly
    +
    2072 call errmgr%report_error("mtx_pinverse_cmplx", &
    +
    2073 "Incorrectly sized input array RWORK, argument 6.", &
    +
    2074 la_array_size_error)
    +
    2075 return
    +
    2076 end if
    +
    2077 rwptr => rwork(1:lrwork)
    +
    2078 else
    +
    2079 allocate(rwrk(lrwork), stat = istat)
    +
    2080 if (istat /= 0) then
    +
    2081 ! ERROR: Out of memory
    +
    2082 call errmgr%report_error("mtx_pinverse_cmplx", &
    +
    2083 "Insufficient memory available.", &
    +
    2084 la_out_of_memory_error)
    +
    2085 return
    +
    2086 end if
    +
    2087 rwptr => rwrk
    +
    2088 end if
    +
    2089 u(1:m,1:mn) => wptr(1:i1)
    +
    2090 vt(1:n,1:n) => wptr(i2a:i2b)
    +
    2091 w => wptr(i3:lwork)
    +
    2092 s => rwptr(1:mn)
    +
    2093 rw => rwptr(mn+1:lrwork)
    +
    2094
    +
    2095 ! Compute the SVD of A
    +
    2096 call zgesvd('S', 'A', m, n, a, m, s, u, m, vt, n, w, size(w), rw, flag)
    +
    2097
    +
    2098 ! Check for convergence
    +
    2099 if (flag > 0) then
    +
    2100 write(errmsg, 101) flag, " superdiagonals could not " // &
    +
    2101 "converge to zero as part of the QR iteration process."
    +
    2102 call errmgr%report_warning("mtx_pinverse_cmplx", errmsg, &
    +
    2103 la_convergence_error)
    +
    2104 return
    +
    2105 end if
    +
    2106
    +
    2107 ! Determine the threshold tolerance for the singular values such that
    +
    2108 ! singular values less than the threshold result in zero when inverted.
    +
    2109 tref = max(m, n) * epsilon(t) * s(1)
    +
    2110 if (present(tol)) then
    +
    2111 t = tol
    +
    2112 else
    +
    2113 t = tref
    +
    2114 end if
    +
    2115 !if (t < safe_denom(t)) then
    +
    2116 if (t < tolcheck) then
    +
    2117 ! The supplied tolerance is too small, simply fall back to the
    +
    2118 ! default, but issue a warning to the user
    +
    2119 t = tref
    +
    2120 ! call errmgr%report_warning("pinverse_1", "The supplied tolerance was " // &
    +
    2121 ! "smaller than a value that would result in an overflow " // &
    +
    2122 ! "condition, or is negative; therefore, the tolerance has " // &
    +
    2123 ! "been reset to its default value.")
    +
    2124 end if
    +
    2125
    +
    2126 ! Compute the pseudoinverse such that pinv(A) = V * inv(S) * U**T by
    +
    2127 ! first computing V * inv(S) (result is N-by-M), and store in the first
    +
    2128 ! MN rows of VT in a transposed manner.
    +
    2129 do i = 1, mn
    +
    2130 ! Apply 1 / S(I) to VT(I,:)
    +
    2131 if (s(i) < t) then
    +
    2132 vt(i,:) = zero
    +
    2133 else
    +
    2134 ! call recip_mult_array(s(i), vt(i,1:n))
    +
    2135 vt(i,1:n) = conjg(vt(i,1:n)) / s(i)
    +
    2136 end if
    +
    2137 end do
    2138
    -
    2139 ! Workspace Query
    -
    2140 call dgels('N', m, n, nrhs, a, m, b, maxmn, temp, -1, flag)
    -
    2141 lwork = int(temp(1), int32)
    -
    2142 if (present(olwork)) then
    -
    2143 olwork = lwork
    -
    2144 return
    -
    2145 end if
    -
    2146
    -
    2147 ! Local Memory Allocation
    -
    2148 if (present(work)) then
    -
    2149 if (size(work) < lwork) then
    -
    2150 ! ERROR: WORK not sized correctly
    -
    2151 call errmgr%report_error("solve_least_squares_mtx", &
    -
    2152 "Incorrectly sized input array WORK, argument 3.", &
    -
    2153 la_array_size_error)
    -
    2154 return
    -
    2155 end if
    -
    2156 wptr => work(1:lwork)
    -
    2157 else
    -
    2158 allocate(wrk(lwork), stat = istat)
    -
    2159 if (istat /= 0) then
    -
    2160 ! ERROR: Out of memory
    -
    2161 call errmgr%report_error("solve_least_squares_mtx", &
    -
    2162 "Insufficient memory available.", &
    -
    2163 la_out_of_memory_error)
    -
    2164 return
    -
    2165 end if
    -
    2166 wptr => wrk
    -
    2167 end if
    +
    2139 ! Compute (VT**T * inv(S)) * U**H
    +
    2140 ! ainv = n-by-m
    +
    2141 ! vt is n-by-n
    +
    2142 ! u is m-by-mn such that u**H = mn-by-m
    +
    2143 ! Compute ainv = vt**T * u**H
    +
    2144 do j = 1, m
    +
    2145 do i = 1, n
    +
    2146 val = zero
    +
    2147 do k = 1, mn
    +
    2148 val = val + vt(k,i) * conjg(u(j,k))
    +
    2149 end do
    +
    2150 ainv(i,j) = val
    +
    2151 end do
    +
    2152 end do
    +
    2153
    +
    2154 ! Formatting
    +
    2155100 format(a, i0, a, i0, a)
    +
    2156101 format(i0, a)
    +
    2157 end subroutine
    +
    2158
    +
    2159! ******************************************************************************
    +
    2160! LEAST SQUARES SOLUTION ROUTINES
    +
    2161! ------------------------------------------------------------------------------
    +
    2162 module subroutine solve_least_squares_mtx(a, b, work, olwork, err)
    +
    2163 ! Arguments
    +
    2164 real(real64), intent(inout), dimension(:,:) :: a, b
    +
    2165 real(real64), intent(out), target, optional, dimension(:) :: work
    +
    2166 integer(int32), intent(out), optional :: olwork
    +
    2167 class(errors), intent(inout), optional, target :: err
    2168
    -
    2169 ! Process
    -
    2170 call dgels('N', m, n, nrhs, a, m, b, maxmn, wptr, lwork, flag)
    -
    2171 if (flag > 0) then
    -
    2172 call errmgr%report_error("solve_least_squares_mtx", &
    -
    2173 "The supplied matrix is not of full rank; therefore, " // &
    -
    2174 "the solution could not be computed via this routine. " // &
    -
    2175 "Try a routine that utilizes column pivoting.", &
    -
    2176 la_invalid_operation_error)
    -
    2177 end if
    -
    2178 end subroutine
    -
    2179
    -
    2180! ------------------------------------------------------------------------------
    -
    2181 module subroutine solve_least_squares_mtx_cmplx(a, b, work, olwork, err)
    -
    2182 ! Arguments
    -
    2183 complex(real64), intent(inout), dimension(:,:) :: a, b
    -
    2184 complex(real64), intent(out), target, optional, dimension(:) :: work
    -
    2185 integer(int32), intent(out), optional :: olwork
    -
    2186 class(errors), intent(inout), optional, target :: err
    +
    2169 ! Local Variables
    +
    2170 integer(int32) :: m, n, maxmn, nrhs, lwork, istat, flag
    +
    2171 real(real64), pointer, dimension(:) :: wptr
    +
    2172 real(real64), allocatable, target, dimension(:) :: wrk
    +
    2173 real(real64), dimension(1) :: temp
    +
    2174 class(errors), pointer :: errmgr
    +
    2175 type(errors), target :: deferr
    +
    2176
    +
    2177 ! Initialization
    +
    2178 m = size(a, 1)
    +
    2179 n = size(a, 2)
    +
    2180 maxmn = max(m, n)
    +
    2181 nrhs = size(b, 2)
    +
    2182 if (present(err)) then
    +
    2183 errmgr => err
    +
    2184 else
    +
    2185 errmgr => deferr
    +
    2186 end if
    2187
    -
    2188 ! Local Variables
    -
    2189 integer(int32) :: m, n, maxmn, nrhs, lwork, istat, flag
    -
    2190 complex(real64), pointer, dimension(:) :: wptr
    -
    2191 complex(real64), allocatable, target, dimension(:) :: wrk
    -
    2192 complex(real64), dimension(1) :: temp
    -
    2193 class(errors), pointer :: errmgr
    -
    2194 type(errors), target :: deferr
    -
    2195
    -
    2196 ! Initialization
    -
    2197 m = size(a, 1)
    -
    2198 n = size(a, 2)
    -
    2199 maxmn = max(m, n)
    -
    2200 nrhs = size(b, 2)
    -
    2201 if (present(err)) then
    -
    2202 errmgr => err
    -
    2203 else
    -
    2204 errmgr => deferr
    -
    2205 end if
    -
    2206
    -
    2207 ! Input Check
    -
    2208 if (size(b, 1) /= maxmn) then
    -
    2209 call errmgr%report_error("solve_least_squares_mtx_cmplx", &
    -
    2210 "Input 2 is not sized correctly.", la_array_size_error)
    -
    2211 return
    -
    2212 end if
    -
    2213
    -
    2214 ! Workspace Query
    -
    2215 call zgels('N', m, n, nrhs, a, m, b, maxmn, temp, -1, flag)
    -
    2216 lwork = int(temp(1), int32)
    -
    2217 if (present(olwork)) then
    -
    2218 olwork = lwork
    -
    2219 return
    -
    2220 end if
    -
    2221
    -
    2222 ! Local Memory Allocation
    -
    2223 if (present(work)) then
    -
    2224 if (size(work) < lwork) then
    -
    2225 ! ERROR: WORK not sized correctly
    -
    2226 call errmgr%report_error("solve_least_squares_mtx_cmplx", &
    -
    2227 "Incorrectly sized input array WORK, argument 3.", &
    -
    2228 la_array_size_error)
    -
    2229 return
    -
    2230 end if
    -
    2231 wptr => work(1:lwork)
    -
    2232 else
    -
    2233 allocate(wrk(lwork), stat = istat)
    -
    2234 if (istat /= 0) then
    -
    2235 ! ERROR: Out of memory
    -
    2236 call errmgr%report_error("solve_least_squares_mtx_cmplx", &
    -
    2237 "Insufficient memory available.", &
    -
    2238 la_out_of_memory_error)
    -
    2239 return
    -
    2240 end if
    -
    2241 wptr => wrk
    -
    2242 end if
    +
    2188 ! Input Check
    +
    2189 if (size(b, 1) /= maxmn) then
    +
    2190 call errmgr%report_error("solve_least_squares_mtx", &
    +
    2191 "Input 2 is not sized correctly.", la_array_size_error)
    +
    2192 return
    +
    2193 end if
    +
    2194
    +
    2195 ! Workspace Query
    +
    2196 call dgels('N', m, n, nrhs, a, m, b, maxmn, temp, -1, flag)
    +
    2197 lwork = int(temp(1), int32)
    +
    2198 if (present(olwork)) then
    +
    2199 olwork = lwork
    +
    2200 return
    +
    2201 end if
    +
    2202
    +
    2203 ! Local Memory Allocation
    +
    2204 if (present(work)) then
    +
    2205 if (size(work) < lwork) then
    +
    2206 ! ERROR: WORK not sized correctly
    +
    2207 call errmgr%report_error("solve_least_squares_mtx", &
    +
    2208 "Incorrectly sized input array WORK, argument 3.", &
    +
    2209 la_array_size_error)
    +
    2210 return
    +
    2211 end if
    +
    2212 wptr => work(1:lwork)
    +
    2213 else
    +
    2214 allocate(wrk(lwork), stat = istat)
    +
    2215 if (istat /= 0) then
    +
    2216 ! ERROR: Out of memory
    +
    2217 call errmgr%report_error("solve_least_squares_mtx", &
    +
    2218 "Insufficient memory available.", &
    +
    2219 la_out_of_memory_error)
    +
    2220 return
    +
    2221 end if
    +
    2222 wptr => wrk
    +
    2223 end if
    +
    2224
    +
    2225 ! Process
    +
    2226 call dgels('N', m, n, nrhs, a, m, b, maxmn, wptr, lwork, flag)
    +
    2227 if (flag > 0) then
    +
    2228 call errmgr%report_error("solve_least_squares_mtx", &
    +
    2229 "The supplied matrix is not of full rank; therefore, " // &
    +
    2230 "the solution could not be computed via this routine. " // &
    +
    2231 "Try a routine that utilizes column pivoting.", &
    +
    2232 la_invalid_operation_error)
    +
    2233 end if
    +
    2234 end subroutine
    +
    2235
    +
    2236! ------------------------------------------------------------------------------
    +
    2237 module subroutine solve_least_squares_mtx_cmplx(a, b, work, olwork, err)
    +
    2238 ! Arguments
    +
    2239 complex(real64), intent(inout), dimension(:,:) :: a, b
    +
    2240 complex(real64), intent(out), target, optional, dimension(:) :: work
    +
    2241 integer(int32), intent(out), optional :: olwork
    +
    2242 class(errors), intent(inout), optional, target :: err
    2243
    -
    2244 ! Process
    -
    2245 call zgels('N', m, n, nrhs, a, m, b, maxmn, wptr, lwork, flag)
    -
    2246 if (flag > 0) then
    -
    2247 call errmgr%report_error("solve_least_squares_mtx_cmplx", &
    -
    2248 "The supplied matrix is not of full rank; therefore, " // &
    -
    2249 "the solution could not be computed via this routine. " // &
    -
    2250 "Try a routine that utilizes column pivoting.", &
    -
    2251 la_invalid_operation_error)
    -
    2252 end if
    -
    2253 end subroutine
    -
    2254
    -
    2255! ------------------------------------------------------------------------------
    -
    2256 module subroutine solve_least_squares_vec(a, b, work, olwork, err)
    -
    2257 ! Arguments
    -
    2258 real(real64), intent(inout), dimension(:,:) :: a
    -
    2259 real(real64), intent(inout), dimension(:) :: b
    -
    2260 real(real64), intent(out), target, optional, dimension(:) :: work
    -
    2261 integer(int32), intent(out), optional :: olwork
    -
    2262 class(errors), intent(inout), optional, target :: err
    -
    2263
    -
    2264 ! Local Variables
    -
    2265 integer(int32) :: m, n, maxmn, lwork, istat, flag
    -
    2266 real(real64), pointer, dimension(:) :: wptr
    -
    2267 real(real64), allocatable, target, dimension(:) :: wrk
    -
    2268 real(real64), dimension(1) :: temp
    -
    2269 class(errors), pointer :: errmgr
    -
    2270 type(errors), target :: deferr
    -
    2271
    -
    2272 ! Initialization
    -
    2273 m = size(a, 1)
    -
    2274 n = size(a, 2)
    -
    2275 maxmn = max(m, n)
    -
    2276 if (present(err)) then
    -
    2277 errmgr => err
    -
    2278 else
    -
    2279 errmgr => deferr
    -
    2280 end if
    -
    2281
    -
    2282 ! Input Check
    -
    2283 if (size(b) /= maxmn) then
    -
    2284 call errmgr%report_error("solve_least_squares_vec", &
    -
    2285 "Input 2 is not sized correctly.", la_array_size_error)
    -
    2286 return
    -
    2287 end if
    -
    2288
    -
    2289 ! Workspace Query
    -
    2290 call dgels('N', m, n, 1, a, m, b, maxmn, temp, -1, flag)
    -
    2291 lwork = int(temp(1), int32)
    -
    2292 if (present(olwork)) then
    -
    2293 olwork = lwork
    -
    2294 return
    -
    2295 end if
    -
    2296
    -
    2297 ! Local Memory Allocation
    -
    2298 if (present(work)) then
    -
    2299 if (size(work) < lwork) then
    -
    2300 ! ERROR: WORK not sized correctly
    -
    2301 call errmgr%report_error("solve_least_squares_vec", &
    -
    2302 "Incorrectly sized input array WORK, argument 3.", &
    -
    2303 la_array_size_error)
    -
    2304 return
    -
    2305 end if
    -
    2306 wptr => work(1:lwork)
    -
    2307 else
    -
    2308 allocate(wrk(lwork), stat = istat)
    -
    2309 if (istat /= 0) then
    -
    2310 ! ERROR: Out of memory
    -
    2311 call errmgr%report_error("solve_least_squares_vec", &
    -
    2312 "Insufficient memory available.", &
    -
    2313 la_out_of_memory_error)
    -
    2314 return
    -
    2315 end if
    -
    2316 wptr => wrk
    -
    2317 end if
    -
    2318
    -
    2319 ! Process
    -
    2320 call dgels('N', m, n, 1, a, m, b, maxmn, wptr, lwork, flag)
    -
    2321 if (flag > 0) then
    -
    2322 call errmgr%report_error("solve_least_squares_mtx", &
    -
    2323 "The supplied matrix is not of full rank; therefore, " // &
    -
    2324 "the solution could not be computed via this routine. " // &
    -
    2325 "Try a routine that utilizes column pivoting.", &
    -
    2326 la_invalid_operation_error)
    -
    2327 end if
    -
    2328 end subroutine
    -
    2329
    -
    2330! ------------------------------------------------------------------------------
    -
    2331 module subroutine solve_least_squares_vec_cmplx(a, b, work, olwork, err)
    -
    2332 ! Arguments
    -
    2333 complex(real64), intent(inout), dimension(:,:) :: a
    -
    2334 complex(real64), intent(inout), dimension(:) :: b
    -
    2335 complex(real64), intent(out), target, optional, dimension(:) :: work
    -
    2336 integer(int32), intent(out), optional :: olwork
    -
    2337 class(errors), intent(inout), optional, target :: err
    -
    2338
    -
    2339 ! Local Variables
    -
    2340 integer(int32) :: m, n, maxmn, lwork, istat, flag
    -
    2341 complex(real64), pointer, dimension(:) :: wptr
    -
    2342 complex(real64), allocatable, target, dimension(:) :: wrk
    -
    2343 complex(real64), dimension(1) :: temp
    -
    2344 class(errors), pointer :: errmgr
    -
    2345 type(errors), target :: deferr
    -
    2346
    -
    2347 ! Initialization
    -
    2348 m = size(a, 1)
    -
    2349 n = size(a, 2)
    -
    2350 maxmn = max(m, n)
    -
    2351 if (present(err)) then
    -
    2352 errmgr => err
    -
    2353 else
    -
    2354 errmgr => deferr
    -
    2355 end if
    -
    2356
    -
    2357 ! Input Check
    -
    2358 if (size(b) /= maxmn) then
    -
    2359 call errmgr%report_error("solve_least_squares_vec_cmplx", &
    -
    2360 "Input 2 is not sized correctly.", la_array_size_error)
    -
    2361 return
    -
    2362 end if
    -
    2363
    -
    2364 ! Workspace Query
    -
    2365 call zgels('N', m, n, 1, a, m, b, maxmn, temp, -1, flag)
    -
    2366 lwork = int(temp(1), int32)
    -
    2367 if (present(olwork)) then
    -
    2368 olwork = lwork
    -
    2369 return
    -
    2370 end if
    -
    2371
    -
    2372 ! Local Memory Allocation
    -
    2373 if (present(work)) then
    -
    2374 if (size(work) < lwork) then
    -
    2375 ! ERROR: WORK not sized correctly
    -
    2376 call errmgr%report_error("solve_least_squares_vec_cmplx", &
    -
    2377 "Incorrectly sized input array WORK, argument 3.", &
    -
    2378 la_array_size_error)
    -
    2379 return
    -
    2380 end if
    -
    2381 wptr => work(1:lwork)
    -
    2382 else
    -
    2383 allocate(wrk(lwork), stat = istat)
    -
    2384 if (istat /= 0) then
    -
    2385 ! ERROR: Out of memory
    -
    2386 call errmgr%report_error("solve_least_squares_vec_cmplx", &
    -
    2387 "Insufficient memory available.", &
    -
    2388 la_out_of_memory_error)
    -
    2389 return
    -
    2390 end if
    -
    2391 wptr => wrk
    -
    2392 end if
    -
    2393
    -
    2394 ! Process
    -
    2395 call zgels('N', m, n, 1, a, m, b, maxmn, wptr, lwork, flag)
    -
    2396 if (flag > 0) then
    -
    2397 call errmgr%report_error("solve_least_squares_mtx_cmplx", &
    -
    2398 "The supplied matrix is not of full rank; therefore, " // &
    -
    2399 "the solution could not be computed via this routine. " // &
    -
    2400 "Try a routine that utilizes column pivoting.", &
    -
    2401 la_invalid_operation_error)
    -
    2402 end if
    -
    2403 end subroutine
    -
    2404
    -
    2405! ------------------------------------------------------------------------------
    -
    2406 module subroutine solve_least_squares_mtx_pvt(a, b, ipvt, arnk, work, olwork, err)
    -
    2407 ! Arguments
    -
    2408 real(real64), intent(inout), dimension(:,:) :: a, b
    -
    2409 integer(int32), intent(inout), target, optional, dimension(:) :: ipvt
    -
    2410 integer(int32), intent(out), optional :: arnk
    -
    2411 real(real64), intent(out), target, optional, dimension(:) :: work
    -
    2412 integer(int32), intent(out), optional :: olwork
    -
    2413 class(errors), intent(inout), optional, target :: err
    -
    2414
    -
    2415 ! Local Variables
    -
    2416 integer(int32) :: m, n, maxmn, nrhs, lwork, istat, flag, rnk
    -
    2417 real(real64), pointer, dimension(:) :: wptr
    -
    2418 real(real64), allocatable, target, dimension(:) :: wrk
    -
    2419 integer(int32), allocatable, target, dimension(:) :: iwrk
    -
    2420 integer(int32), pointer, dimension(:) :: iptr
    -
    2421 real(real64), dimension(1) :: temp
    -
    2422 integer(int32), dimension(1) :: itemp
    -
    2423 real(real64) :: rc
    -
    2424 class(errors), pointer :: errmgr
    -
    2425 type(errors), target :: deferr
    -
    2426 character(len = 128) :: errmsg
    +
    2244 ! Local Variables
    +
    2245 integer(int32) :: m, n, maxmn, nrhs, lwork, istat, flag
    +
    2246 complex(real64), pointer, dimension(:) :: wptr
    +
    2247 complex(real64), allocatable, target, dimension(:) :: wrk
    +
    2248 complex(real64), dimension(1) :: temp
    +
    2249 class(errors), pointer :: errmgr
    +
    2250 type(errors), target :: deferr
    +
    2251
    +
    2252 ! Initialization
    +
    2253 m = size(a, 1)
    +
    2254 n = size(a, 2)
    +
    2255 maxmn = max(m, n)
    +
    2256 nrhs = size(b, 2)
    +
    2257 if (present(err)) then
    +
    2258 errmgr => err
    +
    2259 else
    +
    2260 errmgr => deferr
    +
    2261 end if
    +
    2262
    +
    2263 ! Input Check
    +
    2264 if (size(b, 1) /= maxmn) then
    +
    2265 call errmgr%report_error("solve_least_squares_mtx_cmplx", &
    +
    2266 "Input 2 is not sized correctly.", la_array_size_error)
    +
    2267 return
    +
    2268 end if
    +
    2269
    +
    2270 ! Workspace Query
    +
    2271 call zgels('N', m, n, nrhs, a, m, b, maxmn, temp, -1, flag)
    +
    2272 lwork = int(temp(1), int32)
    +
    2273 if (present(olwork)) then
    +
    2274 olwork = lwork
    +
    2275 return
    +
    2276 end if
    +
    2277
    +
    2278 ! Local Memory Allocation
    +
    2279 if (present(work)) then
    +
    2280 if (size(work) < lwork) then
    +
    2281 ! ERROR: WORK not sized correctly
    +
    2282 call errmgr%report_error("solve_least_squares_mtx_cmplx", &
    +
    2283 "Incorrectly sized input array WORK, argument 3.", &
    +
    2284 la_array_size_error)
    +
    2285 return
    +
    2286 end if
    +
    2287 wptr => work(1:lwork)
    +
    2288 else
    +
    2289 allocate(wrk(lwork), stat = istat)
    +
    2290 if (istat /= 0) then
    +
    2291 ! ERROR: Out of memory
    +
    2292 call errmgr%report_error("solve_least_squares_mtx_cmplx", &
    +
    2293 "Insufficient memory available.", &
    +
    2294 la_out_of_memory_error)
    +
    2295 return
    +
    2296 end if
    +
    2297 wptr => wrk
    +
    2298 end if
    +
    2299
    +
    2300 ! Process
    +
    2301 call zgels('N', m, n, nrhs, a, m, b, maxmn, wptr, lwork, flag)
    +
    2302 if (flag > 0) then
    +
    2303 call errmgr%report_error("solve_least_squares_mtx_cmplx", &
    +
    2304 "The supplied matrix is not of full rank; therefore, " // &
    +
    2305 "the solution could not be computed via this routine. " // &
    +
    2306 "Try a routine that utilizes column pivoting.", &
    +
    2307 la_invalid_operation_error)
    +
    2308 end if
    +
    2309 end subroutine
    +
    2310
    +
    2311! ------------------------------------------------------------------------------
    +
    2312 module subroutine solve_least_squares_vec(a, b, work, olwork, err)
    +
    2313 ! Arguments
    +
    2314 real(real64), intent(inout), dimension(:,:) :: a
    +
    2315 real(real64), intent(inout), dimension(:) :: b
    +
    2316 real(real64), intent(out), target, optional, dimension(:) :: work
    +
    2317 integer(int32), intent(out), optional :: olwork
    +
    2318 class(errors), intent(inout), optional, target :: err
    +
    2319
    +
    2320 ! Local Variables
    +
    2321 integer(int32) :: m, n, maxmn, lwork, istat, flag
    +
    2322 real(real64), pointer, dimension(:) :: wptr
    +
    2323 real(real64), allocatable, target, dimension(:) :: wrk
    +
    2324 real(real64), dimension(1) :: temp
    +
    2325 class(errors), pointer :: errmgr
    +
    2326 type(errors), target :: deferr
    +
    2327
    +
    2328 ! Initialization
    +
    2329 m = size(a, 1)
    +
    2330 n = size(a, 2)
    +
    2331 maxmn = max(m, n)
    +
    2332 if (present(err)) then
    +
    2333 errmgr => err
    +
    2334 else
    +
    2335 errmgr => deferr
    +
    2336 end if
    +
    2337
    +
    2338 ! Input Check
    +
    2339 if (size(b) /= maxmn) then
    +
    2340 call errmgr%report_error("solve_least_squares_vec", &
    +
    2341 "Input 2 is not sized correctly.", la_array_size_error)
    +
    2342 return
    +
    2343 end if
    +
    2344
    +
    2345 ! Workspace Query
    +
    2346 call dgels('N', m, n, 1, a, m, b, maxmn, temp, -1, flag)
    +
    2347 lwork = int(temp(1), int32)
    +
    2348 if (present(olwork)) then
    +
    2349 olwork = lwork
    +
    2350 return
    +
    2351 end if
    +
    2352
    +
    2353 ! Local Memory Allocation
    +
    2354 if (present(work)) then
    +
    2355 if (size(work) < lwork) then
    +
    2356 ! ERROR: WORK not sized correctly
    +
    2357 call errmgr%report_error("solve_least_squares_vec", &
    +
    2358 "Incorrectly sized input array WORK, argument 3.", &
    +
    2359 la_array_size_error)
    +
    2360 return
    +
    2361 end if
    +
    2362 wptr => work(1:lwork)
    +
    2363 else
    +
    2364 allocate(wrk(lwork), stat = istat)
    +
    2365 if (istat /= 0) then
    +
    2366 ! ERROR: Out of memory
    +
    2367 call errmgr%report_error("solve_least_squares_vec", &
    +
    2368 "Insufficient memory available.", &
    +
    2369 la_out_of_memory_error)
    +
    2370 return
    +
    2371 end if
    +
    2372 wptr => wrk
    +
    2373 end if
    +
    2374
    +
    2375 ! Process
    +
    2376 call dgels('N', m, n, 1, a, m, b, maxmn, wptr, lwork, flag)
    +
    2377 if (flag > 0) then
    +
    2378 call errmgr%report_error("solve_least_squares_mtx", &
    +
    2379 "The supplied matrix is not of full rank; therefore, " // &
    +
    2380 "the solution could not be computed via this routine. " // &
    +
    2381 "Try a routine that utilizes column pivoting.", &
    +
    2382 la_invalid_operation_error)
    +
    2383 end if
    +
    2384 end subroutine
    +
    2385
    +
    2386! ------------------------------------------------------------------------------
    +
    2387 module subroutine solve_least_squares_vec_cmplx(a, b, work, olwork, err)
    +
    2388 ! Arguments
    +
    2389 complex(real64), intent(inout), dimension(:,:) :: a
    +
    2390 complex(real64), intent(inout), dimension(:) :: b
    +
    2391 complex(real64), intent(out), target, optional, dimension(:) :: work
    +
    2392 integer(int32), intent(out), optional :: olwork
    +
    2393 class(errors), intent(inout), optional, target :: err
    +
    2394
    +
    2395 ! Local Variables
    +
    2396 integer(int32) :: m, n, maxmn, lwork, istat, flag
    +
    2397 complex(real64), pointer, dimension(:) :: wptr
    +
    2398 complex(real64), allocatable, target, dimension(:) :: wrk
    +
    2399 complex(real64), dimension(1) :: temp
    +
    2400 class(errors), pointer :: errmgr
    +
    2401 type(errors), target :: deferr
    +
    2402
    +
    2403 ! Initialization
    +
    2404 m = size(a, 1)
    +
    2405 n = size(a, 2)
    +
    2406 maxmn = max(m, n)
    +
    2407 if (present(err)) then
    +
    2408 errmgr => err
    +
    2409 else
    +
    2410 errmgr => deferr
    +
    2411 end if
    +
    2412
    +
    2413 ! Input Check
    +
    2414 if (size(b) /= maxmn) then
    +
    2415 call errmgr%report_error("solve_least_squares_vec_cmplx", &
    +
    2416 "Input 2 is not sized correctly.", la_array_size_error)
    +
    2417 return
    +
    2418 end if
    +
    2419
    +
    2420 ! Workspace Query
    +
    2421 call zgels('N', m, n, 1, a, m, b, maxmn, temp, -1, flag)
    +
    2422 lwork = int(temp(1), int32)
    +
    2423 if (present(olwork)) then
    +
    2424 olwork = lwork
    +
    2425 return
    +
    2426 end if
    2427
    -
    2428 ! Initialization
    -
    2429 m = size(a, 1)
    -
    2430 n = size(a, 2)
    -
    2431 maxmn = max(m, n)
    -
    2432 nrhs = size(b, 2)
    -
    2433 rc = epsilon(rc)
    -
    2434 if (present(arnk)) arnk = 0
    -
    2435 if (present(err)) then
    -
    2436 errmgr => err
    -
    2437 else
    -
    2438 errmgr => deferr
    -
    2439 end if
    -
    2440
    -
    2441 ! Input Check
    -
    2442 flag = 0
    -
    2443 if (size(b, 1) /= maxmn) then
    -
    2444 flag = 2
    -
    2445 end if
    -
    2446 if (flag /= 0) then
    -
    2447 write(errmsg, '(AI0A)') "Input number ", flag, &
    -
    2448 " is not sized correctly."
    -
    2449 call errmgr%report_error("solve_least_squares_mtx_pvt", &
    -
    2450 trim(errmsg), la_array_size_error)
    -
    2451 return
    -
    2452 end if
    -
    2453
    -
    2454 ! Workspace Query
    -
    2455 call dgelsy(m, n, nrhs, a, m, b, maxmn, itemp, rc, rnk, temp, -1, flag)
    -
    2456 lwork = int(temp(1), int32)
    -
    2457 if (present(olwork)) then
    -
    2458 olwork = lwork
    -
    2459 return
    -
    2460 end if
    -
    2461
    -
    2462 ! Local Memory Allocation
    -
    2463 if (present(ipvt)) then
    -
    2464 if (size(ipvt) < n) then
    -
    2465 ! ERROR: IPVT is not big enough
    -
    2466 call errmgr%report_error("solve_least_squares_mtx_pvt", &
    -
    2467 "Incorrectly sized pivot array, argument 3.", &
    -
    2468 la_array_size_error)
    -
    2469 return
    -
    2470 end if
    -
    2471 iptr => ipvt(1:n)
    -
    2472 else
    -
    2473 allocate(iwrk(n), stat = istat)
    -
    2474 if (istat /= 0) then
    -
    2475 ! ERROR: Out of memory
    -
    2476 call errmgr%report_error("solve_least_squares_mtx_pvt", &
    -
    2477 "Insufficient memory available.", &
    -
    2478 la_out_of_memory_error)
    -
    2479 return
    -
    2480 end if
    -
    2481 iptr => iwrk
    -
    2482 iptr = 0
    -
    2483 end if
    -
    2484
    -
    2485 if (present(work)) then
    -
    2486 if (size(work) < lwork) then
    -
    2487 ! ERROR: WORK not sized correctly
    -
    2488 call errmgr%report_error("solve_least_squares_mtx_pvt", &
    -
    2489 "Incorrectly sized input array WORK, argument 5.", &
    -
    2490 la_array_size_error)
    -
    2491 return
    -
    2492 end if
    -
    2493 wptr => work(1:lwork)
    -
    2494 else
    -
    2495 allocate(wrk(lwork), stat = istat)
    -
    2496 if (istat /= 0) then
    -
    2497 ! ERROR: Out of memory
    -
    2498 call errmgr%report_error("solve_least_squares_mtx_pvt", &
    -
    2499 "Insufficient memory available.", &
    -
    2500 la_out_of_memory_error)
    -
    2501 return
    -
    2502 end if
    -
    2503 wptr => wrk
    -
    2504 end if
    -
    2505
    -
    2506 ! Process
    -
    2507 call dgelsy(m, n, nrhs, a, m, b, maxmn, iptr, rc, rnk, wptr, lwork, &
    -
    2508 flag)
    -
    2509 if (present(arnk)) arnk = rnk
    -
    2510 end subroutine
    -
    2511
    -
    2512! ------------------------------------------------------------------------------
    -
    2513 module subroutine solve_least_squares_mtx_pvt_cmplx(a, b, ipvt, arnk, &
    -
    2514 work, olwork, rwork, err)
    -
    2515 ! Arguments
    -
    2516 complex(real64), intent(inout), dimension(:,:) :: a, b
    -
    2517 integer(int32), intent(inout), target, optional, dimension(:) :: ipvt
    -
    2518 integer(int32), intent(out), optional :: arnk
    -
    2519 complex(real64), intent(out), target, optional, dimension(:) :: work
    -
    2520 integer(int32), intent(out), optional :: olwork
    -
    2521 real(real64), intent(out), target, optional, dimension(:) :: rwork
    -
    2522 class(errors), intent(inout), optional, target :: err
    -
    2523
    -
    2524 ! Local Variables
    -
    2525 integer(int32) :: m, n, maxmn, nrhs, lwork, istat, flag, rnk, lrwork
    -
    2526 complex(real64), pointer, dimension(:) :: wptr
    -
    2527 complex(real64), allocatable, target, dimension(:) :: wrk
    -
    2528 real(real64), pointer, dimension(:) :: rwptr
    -
    2529 real(real64), allocatable, target, dimension(:) :: rwrk
    -
    2530 integer(int32), allocatable, target, dimension(:) :: iwrk
    -
    2531 integer(int32), pointer, dimension(:) :: iptr
    -
    2532 complex(real64), dimension(1) :: temp
    -
    2533 real(real64), dimension(1) :: rtemp
    -
    2534 integer(int32), dimension(1) :: itemp
    -
    2535 real(real64) :: rc
    -
    2536 class(errors), pointer :: errmgr
    -
    2537 type(errors), target :: deferr
    -
    2538 character(len = 128) :: errmsg
    -
    2539
    -
    2540 ! Initialization
    -
    2541 m = size(a, 1)
    -
    2542 n = size(a, 2)
    -
    2543 maxmn = max(m, n)
    -
    2544 nrhs = size(b, 2)
    -
    2545 lrwork = 2 * n
    -
    2546 rc = epsilon(rc)
    -
    2547 if (present(arnk)) arnk = 0
    -
    2548 if (present(err)) then
    -
    2549 errmgr => err
    +
    2428 ! Local Memory Allocation
    +
    2429 if (present(work)) then
    +
    2430 if (size(work) < lwork) then
    +
    2431 ! ERROR: WORK not sized correctly
    +
    2432 call errmgr%report_error("solve_least_squares_vec_cmplx", &
    +
    2433 "Incorrectly sized input array WORK, argument 3.", &
    +
    2434 la_array_size_error)
    +
    2435 return
    +
    2436 end if
    +
    2437 wptr => work(1:lwork)
    +
    2438 else
    +
    2439 allocate(wrk(lwork), stat = istat)
    +
    2440 if (istat /= 0) then
    +
    2441 ! ERROR: Out of memory
    +
    2442 call errmgr%report_error("solve_least_squares_vec_cmplx", &
    +
    2443 "Insufficient memory available.", &
    +
    2444 la_out_of_memory_error)
    +
    2445 return
    +
    2446 end if
    +
    2447 wptr => wrk
    +
    2448 end if
    +
    2449
    +
    2450 ! Process
    +
    2451 call zgels('N', m, n, 1, a, m, b, maxmn, wptr, lwork, flag)
    +
    2452 if (flag > 0) then
    +
    2453 call errmgr%report_error("solve_least_squares_mtx_cmplx", &
    +
    2454 "The supplied matrix is not of full rank; therefore, " // &
    +
    2455 "the solution could not be computed via this routine. " // &
    +
    2456 "Try a routine that utilizes column pivoting.", &
    +
    2457 la_invalid_operation_error)
    +
    2458 end if
    +
    2459 end subroutine
    +
    2460
    +
    2461! ------------------------------------------------------------------------------
    +
    2462 module subroutine solve_least_squares_mtx_pvt(a, b, ipvt, arnk, work, olwork, err)
    +
    2463 ! Arguments
    +
    2464 real(real64), intent(inout), dimension(:,:) :: a, b
    +
    2465 integer(int32), intent(inout), target, optional, dimension(:) :: ipvt
    +
    2466 integer(int32), intent(out), optional :: arnk
    +
    2467 real(real64), intent(out), target, optional, dimension(:) :: work
    +
    2468 integer(int32), intent(out), optional :: olwork
    +
    2469 class(errors), intent(inout), optional, target :: err
    +
    2470
    +
    2471 ! Local Variables
    +
    2472 integer(int32) :: m, n, maxmn, nrhs, lwork, istat, flag, rnk
    +
    2473 real(real64), pointer, dimension(:) :: wptr
    +
    2474 real(real64), allocatable, target, dimension(:) :: wrk
    +
    2475 integer(int32), allocatable, target, dimension(:) :: iwrk
    +
    2476 integer(int32), pointer, dimension(:) :: iptr
    +
    2477 real(real64), dimension(1) :: temp
    +
    2478 integer(int32), dimension(1) :: itemp
    +
    2479 real(real64) :: rc
    +
    2480 class(errors), pointer :: errmgr
    +
    2481 type(errors), target :: deferr
    +
    2482 character(len = 128) :: errmsg
    +
    2483
    +
    2484 ! Initialization
    +
    2485 m = size(a, 1)
    +
    2486 n = size(a, 2)
    +
    2487 maxmn = max(m, n)
    +
    2488 nrhs = size(b, 2)
    +
    2489 rc = epsilon(rc)
    +
    2490 if (present(arnk)) arnk = 0
    +
    2491 if (present(err)) then
    +
    2492 errmgr => err
    +
    2493 else
    +
    2494 errmgr => deferr
    +
    2495 end if
    +
    2496
    +
    2497 ! Input Check
    +
    2498 flag = 0
    +
    2499 if (size(b, 1) /= maxmn) then
    +
    2500 flag = 2
    +
    2501 end if
    +
    2502 if (flag /= 0) then
    +
    2503 write(errmsg, 100) "Input number ", flag, &
    +
    2504 " is not sized correctly."
    +
    2505 call errmgr%report_error("solve_least_squares_mtx_pvt", &
    +
    2506 trim(errmsg), la_array_size_error)
    +
    2507 return
    +
    2508 end if
    +
    2509
    +
    2510 ! Workspace Query
    +
    2511 call dgelsy(m, n, nrhs, a, m, b, maxmn, itemp, rc, rnk, temp, -1, flag)
    +
    2512 lwork = int(temp(1), int32)
    +
    2513 if (present(olwork)) then
    +
    2514 olwork = lwork
    +
    2515 return
    +
    2516 end if
    +
    2517
    +
    2518 ! Local Memory Allocation
    +
    2519 if (present(ipvt)) then
    +
    2520 if (size(ipvt) < n) then
    +
    2521 ! ERROR: IPVT is not big enough
    +
    2522 call errmgr%report_error("solve_least_squares_mtx_pvt", &
    +
    2523 "Incorrectly sized pivot array, argument 3.", &
    +
    2524 la_array_size_error)
    +
    2525 return
    +
    2526 end if
    +
    2527 iptr => ipvt(1:n)
    +
    2528 else
    +
    2529 allocate(iwrk(n), stat = istat)
    +
    2530 if (istat /= 0) then
    +
    2531 ! ERROR: Out of memory
    +
    2532 call errmgr%report_error("solve_least_squares_mtx_pvt", &
    +
    2533 "Insufficient memory available.", &
    +
    2534 la_out_of_memory_error)
    +
    2535 return
    +
    2536 end if
    +
    2537 iptr => iwrk
    +
    2538 iptr = 0
    +
    2539 end if
    +
    2540
    +
    2541 if (present(work)) then
    +
    2542 if (size(work) < lwork) then
    +
    2543 ! ERROR: WORK not sized correctly
    +
    2544 call errmgr%report_error("solve_least_squares_mtx_pvt", &
    +
    2545 "Incorrectly sized input array WORK, argument 5.", &
    +
    2546 la_array_size_error)
    +
    2547 return
    +
    2548 end if
    +
    2549 wptr => work(1:lwork)
    2550 else
    -
    2551 errmgr => deferr
    -
    2552 end if
    -
    2553
    -
    2554 ! Input Check
    -
    2555 flag = 0
    -
    2556 if (size(b, 1) /= maxmn) then
    -
    2557 flag = 2
    -
    2558 end if
    -
    2559 if (flag /= 0) then
    -
    2560 write(errmsg, '(AI0A)') "Input number ", flag, &
    -
    2561 " is not sized correctly."
    -
    2562 call errmgr%report_error("solve_least_squares_mtx_pvt_cmplx", &
    -
    2563 trim(errmsg), la_array_size_error)
    -
    2564 return
    -
    2565 end if
    +
    2551 allocate(wrk(lwork), stat = istat)
    +
    2552 if (istat /= 0) then
    +
    2553 ! ERROR: Out of memory
    +
    2554 call errmgr%report_error("solve_least_squares_mtx_pvt", &
    +
    2555 "Insufficient memory available.", &
    +
    2556 la_out_of_memory_error)
    +
    2557 return
    +
    2558 end if
    +
    2559 wptr => wrk
    +
    2560 end if
    +
    2561
    +
    2562 ! Process
    +
    2563 call dgelsy(m, n, nrhs, a, m, b, maxmn, iptr, rc, rnk, wptr, lwork, &
    +
    2564 flag)
    +
    2565 if (present(arnk)) arnk = rnk
    2566
    -
    2567 ! Workspace Query
    -
    2568 call zgelsy(m, n, nrhs, a, m, b, maxmn, itemp, rc, rnk, temp, -1, &
    -
    2569 rtemp, flag)
    -
    2570 lwork = int(temp(1), int32)
    -
    2571 if (present(olwork)) then
    -
    2572 olwork = lwork
    -
    2573 return
    -
    2574 end if
    -
    2575
    -
    2576 ! Local Memory Allocation
    -
    2577 if (present(ipvt)) then
    -
    2578 if (size(ipvt) < n) then
    -
    2579 ! ERROR: IPVT is not big enough
    -
    2580 call errmgr%report_error("solve_least_squares_mtx_pvt", &
    -
    2581 "Incorrectly sized pivot array, argument 3.", &
    -
    2582 la_array_size_error)
    -
    2583 return
    -
    2584 end if
    -
    2585 iptr => ipvt(1:n)
    -
    2586 else
    -
    2587 allocate(iwrk(n), stat = istat)
    -
    2588 if (istat /= 0) then
    -
    2589 ! ERROR: Out of memory
    -
    2590 call errmgr%report_error("solve_least_squares_mtx_pvt", &
    -
    2591 "Insufficient memory available.", &
    -
    2592 la_out_of_memory_error)
    -
    2593 return
    -
    2594 end if
    -
    2595 iptr => iwrk
    -
    2596 iptr = 0
    -
    2597 end if
    +
    2567 ! Formatting
    +
    2568100 format(a, i0, a)
    +
    2569 end subroutine
    +
    2570
    +
    2571! ------------------------------------------------------------------------------
    +
    2572 module subroutine solve_least_squares_mtx_pvt_cmplx(a, b, ipvt, arnk, &
    +
    2573 work, olwork, rwork, err)
    +
    2574 ! Arguments
    +
    2575 complex(real64), intent(inout), dimension(:,:) :: a, b
    +
    2576 integer(int32), intent(inout), target, optional, dimension(:) :: ipvt
    +
    2577 integer(int32), intent(out), optional :: arnk
    +
    2578 complex(real64), intent(out), target, optional, dimension(:) :: work
    +
    2579 integer(int32), intent(out), optional :: olwork
    +
    2580 real(real64), intent(out), target, optional, dimension(:) :: rwork
    +
    2581 class(errors), intent(inout), optional, target :: err
    +
    2582
    +
    2583 ! Local Variables
    +
    2584 integer(int32) :: m, n, maxmn, nrhs, lwork, istat, flag, rnk, lrwork
    +
    2585 complex(real64), pointer, dimension(:) :: wptr
    +
    2586 complex(real64), allocatable, target, dimension(:) :: wrk
    +
    2587 real(real64), pointer, dimension(:) :: rwptr
    +
    2588 real(real64), allocatable, target, dimension(:) :: rwrk
    +
    2589 integer(int32), allocatable, target, dimension(:) :: iwrk
    +
    2590 integer(int32), pointer, dimension(:) :: iptr
    +
    2591 complex(real64), dimension(1) :: temp
    +
    2592 real(real64), dimension(1) :: rtemp
    +
    2593 integer(int32), dimension(1) :: itemp
    +
    2594 real(real64) :: rc
    +
    2595 class(errors), pointer :: errmgr
    +
    2596 type(errors), target :: deferr
    +
    2597 character(len = 128) :: errmsg
    2598
    -
    2599 if (present(work)) then
    -
    2600 if (size(work) < lwork) then
    -
    2601 ! ERROR: WORK not sized correctly
    -
    2602 call errmgr%report_error("solve_least_squares_mtx_pvt", &
    -
    2603 "Incorrectly sized input array WORK, argument 5.", &
    -
    2604 la_array_size_error)
    -
    2605 return
    -
    2606 end if
    -
    2607 wptr => work(1:lwork)
    -
    2608 else
    -
    2609 allocate(wrk(lwork), stat = istat)
    -
    2610 if (istat /= 0) then
    -
    2611 ! ERROR: Out of memory
    -
    2612 call errmgr%report_error("solve_least_squares_mtx_pvt", &
    -
    2613 "Insufficient memory available.", &
    -
    2614 la_out_of_memory_error)
    -
    2615 return
    -
    2616 end if
    -
    2617 wptr => wrk
    -
    2618 end if
    -
    2619
    -
    2620 if (present(rwork)) then
    -
    2621 if (size(rwork) < lrwork) then
    -
    2622 ! ERROR: RWORK not sized correctly
    -
    2623 call errmgr%report_error("solve_least_squares_mtx_pvt_cmplx", &
    -
    2624 "Incorrectly sized input array RWORK, argument 7.", &
    -
    2625 la_array_size_error)
    -
    2626 return
    -
    2627 end if
    -
    2628 rwptr => rwork(1:lrwork)
    -
    2629 else
    -
    2630 allocate(rwrk(lrwork), stat = istat)
    -
    2631 if (istat /= 0) then
    -
    2632 ! ERROR: Out of memory
    -
    2633 call errmgr%report_error("solve_least_squares_mtx_pvt_cmplx", &
    -
    2634 "Insufficient memory available.", &
    -
    2635 la_out_of_memory_error)
    -
    2636 return
    -
    2637 end if
    -
    2638 rwptr => rwrk
    -
    2639 end if
    -
    2640
    -
    2641 ! Process
    -
    2642 call zgelsy(m, n, nrhs, a, m, b, maxmn, iptr, rc, rnk, wptr, lwork, &
    -
    2643 rwptr, flag)
    -
    2644 if (present(arnk)) arnk = rnk
    -
    2645 end subroutine
    -
    2646
    -
    2647! ------------------------------------------------------------------------------
    -
    2648 module subroutine solve_least_squares_vec_pvt(a, b, ipvt, arnk, work, olwork, err)
    -
    2649 ! Arguments
    -
    2650 real(real64), intent(inout), dimension(:,:) :: a
    -
    2651 real(real64), intent(inout), dimension(:) :: b
    -
    2652 integer(int32), intent(inout), target, optional, dimension(:) :: ipvt
    -
    2653 integer(int32), intent(out), optional :: arnk
    -
    2654 real(real64), intent(out), target, optional, dimension(:) :: work
    -
    2655 integer(int32), intent(out), optional :: olwork
    -
    2656 class(errors), intent(inout), optional, target :: err
    +
    2599 ! Initialization
    +
    2600 m = size(a, 1)
    +
    2601 n = size(a, 2)
    +
    2602 maxmn = max(m, n)
    +
    2603 nrhs = size(b, 2)
    +
    2604 lrwork = 2 * n
    +
    2605 rc = epsilon(rc)
    +
    2606 if (present(arnk)) arnk = 0
    +
    2607 if (present(err)) then
    +
    2608 errmgr => err
    +
    2609 else
    +
    2610 errmgr => deferr
    +
    2611 end if
    +
    2612
    +
    2613 ! Input Check
    +
    2614 flag = 0
    +
    2615 if (size(b, 1) /= maxmn) then
    +
    2616 flag = 2
    +
    2617 end if
    +
    2618 if (flag /= 0) then
    +
    2619 write(errmsg, 100) "Input number ", flag, &
    +
    2620 " is not sized correctly."
    +
    2621 call errmgr%report_error("solve_least_squares_mtx_pvt_cmplx", &
    +
    2622 trim(errmsg), la_array_size_error)
    +
    2623 return
    +
    2624 end if
    +
    2625
    +
    2626 ! Workspace Query
    +
    2627 call zgelsy(m, n, nrhs, a, m, b, maxmn, itemp, rc, rnk, temp, -1, &
    +
    2628 rtemp, flag)
    +
    2629 lwork = int(temp(1), int32)
    +
    2630 if (present(olwork)) then
    +
    2631 olwork = lwork
    +
    2632 return
    +
    2633 end if
    +
    2634
    +
    2635 ! Local Memory Allocation
    +
    2636 if (present(ipvt)) then
    +
    2637 if (size(ipvt) < n) then
    +
    2638 ! ERROR: IPVT is not big enough
    +
    2639 call errmgr%report_error("solve_least_squares_mtx_pvt", &
    +
    2640 "Incorrectly sized pivot array, argument 3.", &
    +
    2641 la_array_size_error)
    +
    2642 return
    +
    2643 end if
    +
    2644 iptr => ipvt(1:n)
    +
    2645 else
    +
    2646 allocate(iwrk(n), stat = istat)
    +
    2647 if (istat /= 0) then
    +
    2648 ! ERROR: Out of memory
    +
    2649 call errmgr%report_error("solve_least_squares_mtx_pvt", &
    +
    2650 "Insufficient memory available.", &
    +
    2651 la_out_of_memory_error)
    +
    2652 return
    +
    2653 end if
    +
    2654 iptr => iwrk
    +
    2655 iptr = 0
    +
    2656 end if
    2657
    -
    2658 ! Local Variables
    -
    2659 integer(int32) :: m, n, maxmn, lwork, istat, flag, rnk
    -
    2660 real(real64), pointer, dimension(:) :: wptr
    -
    2661 real(real64), allocatable, target, dimension(:) :: wrk
    -
    2662 integer(int32), allocatable, target, dimension(:) :: iwrk
    -
    2663 integer(int32), pointer, dimension(:) :: iptr
    -
    2664 real(real64), dimension(1) :: temp
    -
    2665 integer(int32), dimension(1) :: itemp
    -
    2666 real(real64) :: rc
    -
    2667 class(errors), pointer :: errmgr
    -
    2668 type(errors), target :: deferr
    -
    2669 character(len = 128) :: errmsg
    -
    2670
    -
    2671 ! Initialization
    -
    2672 m = size(a, 1)
    -
    2673 n = size(a, 2)
    -
    2674 maxmn = max(m, n)
    -
    2675 rc = epsilon(rc)
    -
    2676 if (present(arnk)) arnk = 0
    -
    2677 if (present(err)) then
    -
    2678 errmgr => err
    -
    2679 else
    -
    2680 errmgr => deferr
    -
    2681 end if
    -
    2682
    -
    2683 ! Input Check
    -
    2684 flag = 0
    -
    2685 if (size(b, 1) /= maxmn) then
    -
    2686 flag = 2
    -
    2687 end if
    -
    2688 if (flag /= 0) then
    -
    2689 write(errmsg, '(AI0A)') "Input number ", flag, &
    -
    2690 " is not sized correctly."
    -
    2691 call errmgr%report_error("solve_least_squares_vec_pvt", &
    -
    2692 trim(errmsg), la_array_size_error)
    -
    2693 return
    -
    2694 end if
    -
    2695
    -
    2696 ! Workspace Query
    -
    2697 call dgelsy(m, n, 1, a, m, b, maxmn, itemp, rc, rnk, temp, -1, flag)
    -
    2698 lwork = int(temp(1), int32)
    -
    2699 if (present(olwork)) then
    -
    2700 olwork = lwork
    -
    2701 return
    -
    2702 end if
    -
    2703
    -
    2704 ! Local Memory Allocation
    -
    2705 if (present(ipvt)) then
    -
    2706 if (size(ipvt) < n) then
    -
    2707 ! ERROR: IPVT is not big enough
    -
    2708 call errmgr%report_error("solve_least_squares_mtx_pvt", &
    -
    2709 "Incorrectly sized pivot array, argument 3.", &
    -
    2710 la_array_size_error)
    -
    2711 return
    -
    2712 end if
    -
    2713 iptr => ipvt(1:n)
    -
    2714 else
    -
    2715 allocate(iwrk(n), stat = istat)
    -
    2716 if (istat /= 0) then
    -
    2717 ! ERROR: Out of memory
    -
    2718 call errmgr%report_error("solve_least_squares_mtx_pvt", &
    -
    2719 "Insufficient memory available.", &
    -
    2720 la_out_of_memory_error)
    -
    2721 return
    -
    2722 end if
    -
    2723 iptr => iwrk
    -
    2724 iptr = 0
    -
    2725 end if
    -
    2726
    -
    2727 if (present(work)) then
    -
    2728 if (size(work) < lwork) then
    -
    2729 ! ERROR: WORK not sized correctly
    -
    2730 call errmgr%report_error("solve_least_squares_vec_pvt", &
    -
    2731 "Incorrectly sized input array WORK, argument 5.", &
    -
    2732 la_array_size_error)
    -
    2733 return
    -
    2734 end if
    -
    2735 wptr => work(1:lwork)
    -
    2736 else
    -
    2737 allocate(wrk(lwork), stat = istat)
    -
    2738 if (istat /= 0) then
    -
    2739 ! ERROR: Out of memory
    -
    2740 call errmgr%report_error("solve_least_squares_vec_pvt", &
    -
    2741 "Insufficient memory available.", &
    -
    2742 la_out_of_memory_error)
    -
    2743 return
    -
    2744 end if
    -
    2745 wptr => wrk
    -
    2746 end if
    -
    2747
    -
    2748 ! Process
    -
    2749 call dgelsy(m, n, 1, a, m, b, maxmn, iptr, rc, rnk, wptr, lwork, flag)
    -
    2750 if (present(arnk)) arnk = rnk
    -
    2751 end subroutine
    -
    2752
    -
    2753! ------------------------------------------------------------------------------
    -
    2754 module subroutine solve_least_squares_vec_pvt_cmplx(a, b, ipvt, arnk, &
    -
    2755 work, olwork, rwork, err)
    -
    2756 ! Arguments
    -
    2757 complex(real64), intent(inout), dimension(:,:) :: a
    -
    2758 complex(real64), intent(inout), dimension(:) :: b
    -
    2759 integer(int32), intent(inout), target, optional, dimension(:) :: ipvt
    -
    2760 integer(int32), intent(out), optional :: arnk
    -
    2761 complex(real64), intent(out), target, optional, dimension(:) :: work
    -
    2762 integer(int32), intent(out), optional :: olwork
    -
    2763 real(real64), intent(out), target, optional, dimension(:) :: rwork
    -
    2764 class(errors), intent(inout), optional, target :: err
    +
    2658 if (present(work)) then
    +
    2659 if (size(work) < lwork) then
    +
    2660 ! ERROR: WORK not sized correctly
    +
    2661 call errmgr%report_error("solve_least_squares_mtx_pvt", &
    +
    2662 "Incorrectly sized input array WORK, argument 5.", &
    +
    2663 la_array_size_error)
    +
    2664 return
    +
    2665 end if
    +
    2666 wptr => work(1:lwork)
    +
    2667 else
    +
    2668 allocate(wrk(lwork), stat = istat)
    +
    2669 if (istat /= 0) then
    +
    2670 ! ERROR: Out of memory
    +
    2671 call errmgr%report_error("solve_least_squares_mtx_pvt", &
    +
    2672 "Insufficient memory available.", &
    +
    2673 la_out_of_memory_error)
    +
    2674 return
    +
    2675 end if
    +
    2676 wptr => wrk
    +
    2677 end if
    +
    2678
    +
    2679 if (present(rwork)) then
    +
    2680 if (size(rwork) < lrwork) then
    +
    2681 ! ERROR: RWORK not sized correctly
    +
    2682 call errmgr%report_error("solve_least_squares_mtx_pvt_cmplx", &
    +
    2683 "Incorrectly sized input array RWORK, argument 7.", &
    +
    2684 la_array_size_error)
    +
    2685 return
    +
    2686 end if
    +
    2687 rwptr => rwork(1:lrwork)
    +
    2688 else
    +
    2689 allocate(rwrk(lrwork), stat = istat)
    +
    2690 if (istat /= 0) then
    +
    2691 ! ERROR: Out of memory
    +
    2692 call errmgr%report_error("solve_least_squares_mtx_pvt_cmplx", &
    +
    2693 "Insufficient memory available.", &
    +
    2694 la_out_of_memory_error)
    +
    2695 return
    +
    2696 end if
    +
    2697 rwptr => rwrk
    +
    2698 end if
    +
    2699
    +
    2700 ! Process
    +
    2701 call zgelsy(m, n, nrhs, a, m, b, maxmn, iptr, rc, rnk, wptr, lwork, &
    +
    2702 rwptr, flag)
    +
    2703 if (present(arnk)) arnk = rnk
    +
    2704
    +
    2705 ! Formatting
    +
    2706100 format(a, i0, a)
    +
    2707 end subroutine
    +
    2708
    +
    2709! ------------------------------------------------------------------------------
    +
    2710 module subroutine solve_least_squares_vec_pvt(a, b, ipvt, arnk, work, olwork, err)
    +
    2711 ! Arguments
    +
    2712 real(real64), intent(inout), dimension(:,:) :: a
    +
    2713 real(real64), intent(inout), dimension(:) :: b
    +
    2714 integer(int32), intent(inout), target, optional, dimension(:) :: ipvt
    +
    2715 integer(int32), intent(out), optional :: arnk
    +
    2716 real(real64), intent(out), target, optional, dimension(:) :: work
    +
    2717 integer(int32), intent(out), optional :: olwork
    +
    2718 class(errors), intent(inout), optional, target :: err
    +
    2719
    +
    2720 ! Local Variables
    +
    2721 integer(int32) :: m, n, maxmn, lwork, istat, flag, rnk
    +
    2722 real(real64), pointer, dimension(:) :: wptr
    +
    2723 real(real64), allocatable, target, dimension(:) :: wrk
    +
    2724 integer(int32), allocatable, target, dimension(:) :: iwrk
    +
    2725 integer(int32), pointer, dimension(:) :: iptr
    +
    2726 real(real64), dimension(1) :: temp
    +
    2727 integer(int32), dimension(1) :: itemp
    +
    2728 real(real64) :: rc
    +
    2729 class(errors), pointer :: errmgr
    +
    2730 type(errors), target :: deferr
    +
    2731 character(len = 128) :: errmsg
    +
    2732
    +
    2733 ! Initialization
    +
    2734 m = size(a, 1)
    +
    2735 n = size(a, 2)
    +
    2736 maxmn = max(m, n)
    +
    2737 rc = epsilon(rc)
    +
    2738 if (present(arnk)) arnk = 0
    +
    2739 if (present(err)) then
    +
    2740 errmgr => err
    +
    2741 else
    +
    2742 errmgr => deferr
    +
    2743 end if
    +
    2744
    +
    2745 ! Input Check
    +
    2746 flag = 0
    +
    2747 if (size(b, 1) /= maxmn) then
    +
    2748 flag = 2
    +
    2749 end if
    +
    2750 if (flag /= 0) then
    +
    2751 write(errmsg, 100) "Input number ", flag, &
    +
    2752 " is not sized correctly."
    +
    2753 call errmgr%report_error("solve_least_squares_vec_pvt", &
    +
    2754 trim(errmsg), la_array_size_error)
    +
    2755 return
    +
    2756 end if
    +
    2757
    +
    2758 ! Workspace Query
    +
    2759 call dgelsy(m, n, 1, a, m, b, maxmn, itemp, rc, rnk, temp, -1, flag)
    +
    2760 lwork = int(temp(1), int32)
    +
    2761 if (present(olwork)) then
    +
    2762 olwork = lwork
    +
    2763 return
    +
    2764 end if
    2765
    -
    2766 ! Local Variables
    -
    2767 integer(int32) :: m, n, maxmn, lwork, istat, flag, rnk
    -
    2768 complex(real64), pointer, dimension(:) :: wptr
    -
    2769 complex(real64), allocatable, target, dimension(:) :: wrk
    -
    2770 real(real64), pointer, dimension(:) :: rwptr
    -
    2771 real(real64), allocatable, target, dimension(:) :: rwrk
    -
    2772 integer(int32), allocatable, target, dimension(:) :: iwrk
    -
    2773 integer(int32), pointer, dimension(:) :: iptr
    -
    2774 complex(real64), dimension(1) :: temp
    -
    2775 real(real64), dimension(1) :: rtemp
    -
    2776 integer(int32), dimension(1) :: itemp
    -
    2777 real(real64) :: rc
    -
    2778 class(errors), pointer :: errmgr
    -
    2779 type(errors), target :: deferr
    -
    2780 character(len = 128) :: errmsg
    -
    2781
    -
    2782 ! Initialization
    -
    2783 m = size(a, 1)
    -
    2784 n = size(a, 2)
    -
    2785 maxmn = max(m, n)
    -
    2786 lrwork = 2 * n
    -
    2787 rc = epsilon(rc)
    -
    2788 if (present(arnk)) arnk = 0
    -
    2789 if (present(err)) then
    -
    2790 errmgr => err
    -
    2791 else
    -
    2792 errmgr => deferr
    -
    2793 end if
    -
    2794
    -
    2795 ! Input Check
    -
    2796 flag = 0
    -
    2797 if (size(b, 1) /= maxmn) then
    -
    2798 flag = 2
    -
    2799 end if
    -
    2800 if (flag /= 0) then
    -
    2801 write(errmsg, '(AI0A)') "Input number ", flag, &
    -
    2802 " is not sized correctly."
    -
    2803 call errmgr%report_error("solve_least_squares_vec_pvt_cmplx", &
    -
    2804 trim(errmsg), la_array_size_error)
    -
    2805 return
    -
    2806 end if
    -
    2807
    -
    2808 ! Workspace Query
    -
    2809 call zgelsy(m, n, 1, a, m, b, maxmn, itemp, rc, rnk, temp, -1, rtemp, &
    -
    2810 flag)
    -
    2811 lwork = int(temp(1), int32)
    -
    2812 if (present(olwork)) then
    -
    2813 olwork = lwork
    -
    2814 return
    -
    2815 end if
    -
    2816
    -
    2817 ! Local Memory Allocation
    -
    2818 if (present(ipvt)) then
    -
    2819 if (size(ipvt) < n) then
    -
    2820 ! ERROR: IPVT is not big enough
    -
    2821 call errmgr%report_error("solve_least_squares_mtx_pvt", &
    -
    2822 "Incorrectly sized pivot array, argument 3.", &
    -
    2823 la_array_size_error)
    -
    2824 return
    -
    2825 end if
    -
    2826 iptr => ipvt(1:n)
    -
    2827 else
    -
    2828 allocate(iwrk(n), stat = istat)
    -
    2829 if (istat /= 0) then
    -
    2830 ! ERROR: Out of memory
    -
    2831 call errmgr%report_error("solve_least_squares_mtx_pvt", &
    -
    2832 "Insufficient memory available.", &
    -
    2833 la_out_of_memory_error)
    -
    2834 return
    -
    2835 end if
    -
    2836 iptr => iwrk
    -
    2837 iptr = 0
    -
    2838 end if
    -
    2839
    -
    2840 if (present(work)) then
    -
    2841 if (size(work) < lwork) then
    -
    2842 ! ERROR: WORK not sized correctly
    -
    2843 call errmgr%report_error("solve_least_squares_vec_pvt_cmplx", &
    -
    2844 "Incorrectly sized input array WORK, argument 5.", &
    -
    2845 la_array_size_error)
    -
    2846 return
    -
    2847 end if
    -
    2848 wptr => work(1:lwork)
    -
    2849 else
    -
    2850 allocate(wrk(lwork), stat = istat)
    -
    2851 if (istat /= 0) then
    -
    2852 ! ERROR: Out of memory
    -
    2853 call errmgr%report_error("solve_least_squares_vec_pvt_cmplx", &
    -
    2854 "Insufficient memory available.", &
    -
    2855 la_out_of_memory_error)
    -
    2856 return
    -
    2857 end if
    -
    2858 wptr => wrk
    -
    2859 end if
    -
    2860
    -
    2861 if (present(rwork)) then
    -
    2862 if (size(rwork) < lrwork) then
    -
    2863 ! ERROR: WORK not sized correctly
    -
    2864 call errmgr%report_error("solve_least_squares_vec_pvt_cmplx", &
    -
    2865 "Incorrectly sized input array RWORK, argument 7.", &
    -
    2866 la_array_size_error)
    -
    2867 return
    -
    2868 end if
    -
    2869 rwptr => rwork(1:lrwork)
    -
    2870 else
    -
    2871 allocate(rwrk(lrwork), stat = istat)
    -
    2872 if (istat /= 0) then
    -
    2873 ! ERROR: Out of memory
    -
    2874 call errmgr%report_error("solve_least_squares_vec_pvt_cmplx", &
    -
    2875 "Insufficient memory available.", &
    -
    2876 la_out_of_memory_error)
    -
    2877 return
    -
    2878 end if
    -
    2879 rwptr => rwrk
    +
    2766 ! Local Memory Allocation
    +
    2767 if (present(ipvt)) then
    +
    2768 if (size(ipvt) < n) then
    +
    2769 ! ERROR: IPVT is not big enough
    +
    2770 call errmgr%report_error("solve_least_squares_mtx_pvt", &
    +
    2771 "Incorrectly sized pivot array, argument 3.", &
    +
    2772 la_array_size_error)
    +
    2773 return
    +
    2774 end if
    +
    2775 iptr => ipvt(1:n)
    +
    2776 else
    +
    2777 allocate(iwrk(n), stat = istat)
    +
    2778 if (istat /= 0) then
    +
    2779 ! ERROR: Out of memory
    +
    2780 call errmgr%report_error("solve_least_squares_mtx_pvt", &
    +
    2781 "Insufficient memory available.", &
    +
    2782 la_out_of_memory_error)
    +
    2783 return
    +
    2784 end if
    +
    2785 iptr => iwrk
    +
    2786 iptr = 0
    +
    2787 end if
    +
    2788
    +
    2789 if (present(work)) then
    +
    2790 if (size(work) < lwork) then
    +
    2791 ! ERROR: WORK not sized correctly
    +
    2792 call errmgr%report_error("solve_least_squares_vec_pvt", &
    +
    2793 "Incorrectly sized input array WORK, argument 5.", &
    +
    2794 la_array_size_error)
    +
    2795 return
    +
    2796 end if
    +
    2797 wptr => work(1:lwork)
    +
    2798 else
    +
    2799 allocate(wrk(lwork), stat = istat)
    +
    2800 if (istat /= 0) then
    +
    2801 ! ERROR: Out of memory
    +
    2802 call errmgr%report_error("solve_least_squares_vec_pvt", &
    +
    2803 "Insufficient memory available.", &
    +
    2804 la_out_of_memory_error)
    +
    2805 return
    +
    2806 end if
    +
    2807 wptr => wrk
    +
    2808 end if
    +
    2809
    +
    2810 ! Process
    +
    2811 call dgelsy(m, n, 1, a, m, b, maxmn, iptr, rc, rnk, wptr, lwork, flag)
    +
    2812 if (present(arnk)) arnk = rnk
    +
    2813
    +
    2814 ! Formatting
    +
    2815100 format(a, i0, a)
    +
    2816 end subroutine
    +
    2817
    +
    2818! ------------------------------------------------------------------------------
    +
    2819 module subroutine solve_least_squares_vec_pvt_cmplx(a, b, ipvt, arnk, &
    +
    2820 work, olwork, rwork, err)
    +
    2821 ! Arguments
    +
    2822 complex(real64), intent(inout), dimension(:,:) :: a
    +
    2823 complex(real64), intent(inout), dimension(:) :: b
    +
    2824 integer(int32), intent(inout), target, optional, dimension(:) :: ipvt
    +
    2825 integer(int32), intent(out), optional :: arnk
    +
    2826 complex(real64), intent(out), target, optional, dimension(:) :: work
    +
    2827 integer(int32), intent(out), optional :: olwork
    +
    2828 real(real64), intent(out), target, optional, dimension(:) :: rwork
    +
    2829 class(errors), intent(inout), optional, target :: err
    +
    2830
    +
    2831 ! Local Variables
    +
    2832 integer(int32) :: m, n, maxmn, lwork, istat, flag, rnk
    +
    2833 complex(real64), pointer, dimension(:) :: wptr
    +
    2834 complex(real64), allocatable, target, dimension(:) :: wrk
    +
    2835 real(real64), pointer, dimension(:) :: rwptr
    +
    2836 real(real64), allocatable, target, dimension(:) :: rwrk
    +
    2837 integer(int32), allocatable, target, dimension(:) :: iwrk
    +
    2838 integer(int32), pointer, dimension(:) :: iptr
    +
    2839 complex(real64), dimension(1) :: temp
    +
    2840 real(real64), dimension(1) :: rtemp
    +
    2841 integer(int32), dimension(1) :: itemp
    +
    2842 real(real64) :: rc
    +
    2843 class(errors), pointer :: errmgr
    +
    2844 type(errors), target :: deferr
    +
    2845 character(len = 128) :: errmsg
    +
    2846
    +
    2847 ! Initialization
    +
    2848 m = size(a, 1)
    +
    2849 n = size(a, 2)
    +
    2850 maxmn = max(m, n)
    +
    2851 lrwork = 2 * n
    +
    2852 rc = epsilon(rc)
    +
    2853 if (present(arnk)) arnk = 0
    +
    2854 if (present(err)) then
    +
    2855 errmgr => err
    +
    2856 else
    +
    2857 errmgr => deferr
    +
    2858 end if
    +
    2859
    +
    2860 ! Input Check
    +
    2861 flag = 0
    +
    2862 if (size(b, 1) /= maxmn) then
    +
    2863 flag = 2
    +
    2864 end if
    +
    2865 if (flag /= 0) then
    +
    2866 write(errmsg, 100) "Input number ", flag, &
    +
    2867 " is not sized correctly."
    +
    2868 call errmgr%report_error("solve_least_squares_vec_pvt_cmplx", &
    +
    2869 trim(errmsg), la_array_size_error)
    +
    2870 return
    +
    2871 end if
    +
    2872
    +
    2873 ! Workspace Query
    +
    2874 call zgelsy(m, n, 1, a, m, b, maxmn, itemp, rc, rnk, temp, -1, rtemp, &
    +
    2875 flag)
    +
    2876 lwork = int(temp(1), int32)
    +
    2877 if (present(olwork)) then
    +
    2878 olwork = lwork
    +
    2879 return
    2880 end if
    2881
    -
    2882 ! Process
    -
    2883 call zgelsy(m, n, 1, a, m, b, maxmn, iptr, rc, rnk, wptr, lwork, &
    -
    2884 rwptr, flag)
    -
    2885 if (present(arnk)) arnk = rnk
    -
    2886 end subroutine
    -
    2887
    -
    2888! ------------------------------------------------------------------------------
    -
    2889 module subroutine solve_least_squares_mtx_svd(a, b, s, arnk, work, olwork, err)
    -
    2890 ! Arguments
    -
    2891 real(real64), intent(inout), dimension(:,:) :: a, b
    -
    2892 integer(int32), intent(out), optional :: arnk
    -
    2893 real(real64), intent(out), target, optional, dimension(:) :: work, s
    -
    2894 integer(int32), intent(out), optional :: olwork
    -
    2895 class(errors), intent(inout), optional, target :: err
    -
    2896
    -
    2897 ! Local Variables
    -
    2898 integer(int32) :: m, n, nrhs, mn, maxmn, istat, flag, lwork, rnk
    -
    2899 real(real64), pointer, dimension(:) :: wptr, sptr
    -
    2900 real(real64), allocatable, target, dimension(:) :: wrk, sing
    -
    2901 real(real64), dimension(1) :: temp
    -
    2902 real(real64) :: rcond
    -
    2903 class(errors), pointer :: errmgr
    -
    2904 type(errors), target :: deferr
    -
    2905 character(len = 128) :: errmsg
    -
    2906
    -
    2907 ! Initialization
    -
    2908 m = size(a, 1)
    -
    2909 n = size(a, 2)
    -
    2910 nrhs = size(b, 2)
    -
    2911 mn = min(m, n)
    -
    2912 maxmn = max(m, n)
    -
    2913 rcond = epsilon(rcond)
    -
    2914 if (present(arnk)) arnk = 0
    -
    2915 if (present(err)) then
    -
    2916 errmgr => err
    -
    2917 else
    -
    2918 errmgr => deferr
    -
    2919 end if
    -
    2920
    -
    2921 ! Input Check
    -
    2922 flag = 0
    -
    2923 if (size(b, 1) /= maxmn) then
    -
    2924 flag = 2
    -
    2925 end if
    -
    2926 if (flag /= 0) then
    -
    2927 ! ERROR: One of the input arrays is not sized correctly
    -
    2928 write(errmsg, '(AI0A)') "Input number ", flag, &
    -
    2929 " is not sized correctly."
    -
    2930 call errmgr%report_error("solve_least_squares_mtx_svd", &
    -
    2931 trim(errmsg), la_array_size_error)
    -
    2932 return
    -
    2933 end if
    -
    2934
    -
    2935 ! Workspace Query
    -
    2936 call dgelss(m, n, nrhs, a, m, b, maxmn, temp, rcond, rnk, temp, -1, &
    -
    2937 flag)
    -
    2938 lwork = int(temp(1), int32)
    -
    2939 if (present(olwork)) then
    -
    2940 olwork = lwork
    -
    2941 return
    -
    2942 end if
    -
    2943
    -
    2944 ! Local Memory Allocation
    -
    2945 if (present(s)) then
    -
    2946 if (size(s) < mn) then
    -
    2947 ! ERROR: S not sized correctly
    -
    2948 call errmgr%report_error("solve_least_squares_mtx_svd", &
    -
    2949 "Incorrectly sized input array S, argument 3.", &
    -
    2950 la_array_size_error)
    -
    2951 return
    -
    2952 end if
    -
    2953 sptr => s(1:mn)
    -
    2954 else
    -
    2955 allocate(sing(mn), stat = istat)
    -
    2956 if (istat /= 0) then
    -
    2957 ! ERROR: Out of memory
    -
    2958 call errmgr%report_error("solve_least_squares_mtx_svd", &
    -
    2959 "Insufficient memory available.", &
    -
    2960 la_out_of_memory_error)
    -
    2961 return
    -
    2962 end if
    -
    2963 sptr => sing
    -
    2964 end if
    -
    2965
    -
    2966 if (present(work)) then
    -
    2967 if (size(work) < lwork) then
    -
    2968 ! ERROR: WORK not sized correctly
    -
    2969 call errmgr%report_error("solve_least_squares_mtx_svd", &
    -
    2970 "Incorrectly sized input array WORK, argument 5.", &
    -
    2971 la_array_size_error)
    -
    2972 return
    -
    2973 end if
    -
    2974 wptr => work(1:lwork)
    -
    2975 else
    -
    2976 allocate(wrk(lwork), stat = istat)
    -
    2977 if (istat /= 0) then
    -
    2978 ! ERROR: Out of memory
    -
    2979 call errmgr%report_error("solve_least_squares_mtx_svd", &
    -
    2980 "Insufficient memory available.", &
    -
    2981 la_out_of_memory_error)
    -
    2982 return
    -
    2983 end if
    -
    2984 wptr => wrk
    -
    2985 end if
    -
    2986
    -
    2987 ! Process
    -
    2988 call dgelss(m, n, nrhs, a, m, b, maxmn, sptr, rcond, rnk, wptr, lwork, &
    -
    2989 flag)
    -
    2990 if (present(arnk)) arnk = rnk
    -
    2991 if (flag > 0) then
    -
    2992 write(errmsg, '(I0A)') flag, " superdiagonals could not " // &
    -
    2993 "converge to zero as part of the QR iteration process."
    -
    2994 call errmgr%report_warning("solve_least_squares_mtx_svd", errmsg, &
    -
    2995 la_convergence_error)
    -
    2996 end if
    -
    2997 end subroutine
    -
    2998
    -
    2999! ------------------------------------------------------------------------------
    -
    3000 module subroutine solve_least_squares_mtx_svd_cmplx(a, b, s, arnk, work, &
    -
    3001 olwork, rwork, err)
    -
    3002 ! Arguments
    -
    3003 complex(real64), intent(inout), dimension(:,:) :: a, b
    -
    3004 integer(int32), intent(out), optional :: arnk
    -
    3005 complex(real64), intent(out), target, optional, dimension(:) :: work
    -
    3006 real(real64), intent(out), target, optional, dimension(:) :: s, rwork
    -
    3007 integer(int32), intent(out), optional :: olwork
    -
    3008 class(errors), intent(inout), optional, target :: err
    -
    3009
    -
    3010 ! Local Variables
    -
    3011 integer(int32) :: m, n, nrhs, mn, maxmn, istat, flag, lwork, rnk, lrwork
    -
    3012 complex(real64), pointer, dimension(:) :: wptr
    -
    3013 complex(real64), allocatable, target, dimension(:) :: wrk
    -
    3014 real(real64), pointer, dimension(:) :: rwptr, sptr
    -
    3015 real(real64), allocatable, target, dimension(:) :: rwrk, sing
    -
    3016 complex(real64), dimension(1) :: temp
    -
    3017 real(real64), dimension(1) :: rtemp
    -
    3018 real(real64) :: rcond
    -
    3019 class(errors), pointer :: errmgr
    -
    3020 type(errors), target :: deferr
    -
    3021 character(len = 128) :: errmsg
    -
    3022
    -
    3023 ! Initialization
    -
    3024 m = size(a, 1)
    -
    3025 n = size(a, 2)
    -
    3026 nrhs = size(b, 2)
    -
    3027 mn = min(m, n)
    -
    3028 lrwork = 5 * mn
    -
    3029 maxmn = max(m, n)
    -
    3030 rcond = epsilon(rcond)
    -
    3031 if (present(arnk)) arnk = 0
    -
    3032 if (present(err)) then
    -
    3033 errmgr => err
    -
    3034 else
    -
    3035 errmgr => deferr
    -
    3036 end if
    -
    3037
    -
    3038 ! Input Check
    -
    3039 flag = 0
    -
    3040 if (size(b, 1) /= maxmn) then
    -
    3041 flag = 2
    -
    3042 end if
    -
    3043 if (flag /= 0) then
    -
    3044 ! ERROR: One of the input arrays is not sized correctly
    -
    3045 write(errmsg, '(AI0A)') "Input number ", flag, &
    -
    3046 " is not sized correctly."
    -
    3047 call errmgr%report_error("solve_least_squares_mtx_svd_cmplx", &
    -
    3048 trim(errmsg), la_array_size_error)
    -
    3049 return
    -
    3050 end if
    -
    3051
    -
    3052 ! Workspace Query
    -
    3053 call zgelss(m, n, nrhs, a, m, b, maxmn, rtemp, rcond, rnk, temp, -1, &
    -
    3054 rtemp, flag)
    -
    3055 lwork = int(temp(1), int32)
    -
    3056 if (present(olwork)) then
    -
    3057 olwork = lwork
    -
    3058 return
    -
    3059 end if
    -
    3060
    -
    3061 ! Local Memory Allocation
    -
    3062 if (present(s)) then
    -
    3063 if (size(s) < mn) then
    -
    3064 ! ERROR: S not sized correctly
    -
    3065 call errmgr%report_error("solve_least_squares_mtx_svd_cmplx", &
    -
    3066 "Incorrectly sized input array S, argument 3.", &
    -
    3067 la_array_size_error)
    -
    3068 return
    -
    3069 end if
    -
    3070 sptr => s(1:mn)
    -
    3071 else
    -
    3072 allocate(sing(mn), stat = istat)
    -
    3073 if (istat /= 0) then
    -
    3074 ! ERROR: Out of memory
    -
    3075 call errmgr%report_error("solve_least_squares_mtx_svd_cmplx", &
    -
    3076 "Insufficient memory available.", &
    -
    3077 la_out_of_memory_error)
    -
    3078 return
    -
    3079 end if
    -
    3080 sptr => sing
    -
    3081 end if
    -
    3082
    -
    3083 if (present(work)) then
    -
    3084 if (size(work) < lwork) then
    -
    3085 ! ERROR: WORK not sized correctly
    -
    3086 call errmgr%report_error("solve_least_squares_mtx_svd_cmplx", &
    -
    3087 "Incorrectly sized input array WORK, argument 5.", &
    -
    3088 la_array_size_error)
    -
    3089 return
    -
    3090 end if
    -
    3091 wptr => work(1:lwork)
    -
    3092 else
    -
    3093 allocate(wrk(lwork), stat = istat)
    -
    3094 if (istat /= 0) then
    -
    3095 ! ERROR: Out of memory
    -
    3096 call errmgr%report_error("solve_least_squares_mtx_svd_cmplx", &
    -
    3097 "Insufficient memory available.", &
    -
    3098 la_out_of_memory_error)
    -
    3099 return
    -
    3100 end if
    -
    3101 wptr => wrk
    -
    3102 end if
    -
    3103
    -
    3104 if (present(rwork)) then
    -
    3105 if (size(rwork) < lrwork) then
    -
    3106 ! ERROR: WORK not sized correctly
    -
    3107 call errmgr%report_error("solve_least_squares_mtx_svd_cmplx", &
    -
    3108 "Incorrectly sized input array RWORK, argument 7.", &
    -
    3109 la_array_size_error)
    -
    3110 return
    -
    3111 end if
    -
    3112 rwptr => rwork(1:lrwork)
    -
    3113 else
    -
    3114 allocate(rwrk(lrwork), stat = istat)
    -
    3115 if (istat /= 0) then
    -
    3116 ! ERROR: Out of memory
    -
    3117 call errmgr%report_error("solve_least_squares_mtx_svd_cmplx", &
    -
    3118 "Insufficient memory available.", &
    -
    3119 la_out_of_memory_error)
    -
    3120 return
    -
    3121 end if
    -
    3122 rwptr => rwrk
    -
    3123 end if
    -
    3124
    -
    3125 ! Process
    -
    3126 call zgelss(m, n, nrhs, a, m, b, maxmn, sptr, rcond, rnk, wptr, lwork, &
    -
    3127 rwptr, flag)
    -
    3128 if (present(arnk)) arnk = rnk
    -
    3129 if (flag > 0) then
    -
    3130 write(errmsg, '(I0A)') flag, " superdiagonals could not " // &
    -
    3131 "converge to zero as part of the QR iteration process."
    -
    3132 call errmgr%report_warning("solve_least_squares_mtx_svd_cmplx", &
    -
    3133 errmsg, la_convergence_error)
    -
    3134 end if
    -
    3135 end subroutine
    -
    3136
    -
    3137! ------------------------------------------------------------------------------
    -
    3138 module subroutine solve_least_squares_vec_svd(a, b, s, arnk, work, olwork, err)
    -
    3139 ! Arguments
    -
    3140 real(real64), intent(inout), dimension(:,:) :: a
    -
    3141 real(real64), intent(inout), dimension(:) :: b
    -
    3142 integer(int32), intent(out), optional :: arnk
    -
    3143 real(real64), intent(out), target, optional, dimension(:) :: work, s
    -
    3144 integer(int32), intent(out), optional :: olwork
    -
    3145 class(errors), intent(inout), optional, target :: err
    -
    3146
    -
    3147 ! Local Variables
    -
    3148 integer(int32) :: m, n, mn, maxmn, istat, flag, lwork, rnk
    -
    3149 real(real64), pointer, dimension(:) :: wptr, sptr
    -
    3150 real(real64), allocatable, target, dimension(:) :: wrk, sing
    -
    3151 real(real64), dimension(1) :: temp
    -
    3152 real(real64) :: rcond
    -
    3153 class(errors), pointer :: errmgr
    -
    3154 type(errors), target :: deferr
    -
    3155 character(len = 128) :: errmsg
    -
    3156
    -
    3157 ! Initialization
    -
    3158 m = size(a, 1)
    -
    3159 n = size(a, 2)
    -
    3160 mn = min(m, n)
    -
    3161 maxmn = max(m, n)
    -
    3162 rcond = epsilon(rcond)
    -
    3163 if (present(arnk)) arnk = 0
    -
    3164 if (present(err)) then
    -
    3165 errmgr => err
    -
    3166 else
    -
    3167 errmgr => deferr
    -
    3168 end if
    -
    3169
    -
    3170 ! Input Check
    -
    3171 flag = 0
    -
    3172 if (size(b) /= maxmn) then
    -
    3173 flag = 2
    +
    2882 ! Local Memory Allocation
    +
    2883 if (present(ipvt)) then
    +
    2884 if (size(ipvt) < n) then
    +
    2885 ! ERROR: IPVT is not big enough
    +
    2886 call errmgr%report_error("solve_least_squares_mtx_pvt", &
    +
    2887 "Incorrectly sized pivot array, argument 3.", &
    +
    2888 la_array_size_error)
    +
    2889 return
    +
    2890 end if
    +
    2891 iptr => ipvt(1:n)
    +
    2892 else
    +
    2893 allocate(iwrk(n), stat = istat)
    +
    2894 if (istat /= 0) then
    +
    2895 ! ERROR: Out of memory
    +
    2896 call errmgr%report_error("solve_least_squares_mtx_pvt", &
    +
    2897 "Insufficient memory available.", &
    +
    2898 la_out_of_memory_error)
    +
    2899 return
    +
    2900 end if
    +
    2901 iptr => iwrk
    +
    2902 iptr = 0
    +
    2903 end if
    +
    2904
    +
    2905 if (present(work)) then
    +
    2906 if (size(work) < lwork) then
    +
    2907 ! ERROR: WORK not sized correctly
    +
    2908 call errmgr%report_error("solve_least_squares_vec_pvt_cmplx", &
    +
    2909 "Incorrectly sized input array WORK, argument 5.", &
    +
    2910 la_array_size_error)
    +
    2911 return
    +
    2912 end if
    +
    2913 wptr => work(1:lwork)
    +
    2914 else
    +
    2915 allocate(wrk(lwork), stat = istat)
    +
    2916 if (istat /= 0) then
    +
    2917 ! ERROR: Out of memory
    +
    2918 call errmgr%report_error("solve_least_squares_vec_pvt_cmplx", &
    +
    2919 "Insufficient memory available.", &
    +
    2920 la_out_of_memory_error)
    +
    2921 return
    +
    2922 end if
    +
    2923 wptr => wrk
    +
    2924 end if
    +
    2925
    +
    2926 if (present(rwork)) then
    +
    2927 if (size(rwork) < lrwork) then
    +
    2928 ! ERROR: WORK not sized correctly
    +
    2929 call errmgr%report_error("solve_least_squares_vec_pvt_cmplx", &
    +
    2930 "Incorrectly sized input array RWORK, argument 7.", &
    +
    2931 la_array_size_error)
    +
    2932 return
    +
    2933 end if
    +
    2934 rwptr => rwork(1:lrwork)
    +
    2935 else
    +
    2936 allocate(rwrk(lrwork), stat = istat)
    +
    2937 if (istat /= 0) then
    +
    2938 ! ERROR: Out of memory
    +
    2939 call errmgr%report_error("solve_least_squares_vec_pvt_cmplx", &
    +
    2940 "Insufficient memory available.", &
    +
    2941 la_out_of_memory_error)
    +
    2942 return
    +
    2943 end if
    +
    2944 rwptr => rwrk
    +
    2945 end if
    +
    2946
    +
    2947 ! Process
    +
    2948 call zgelsy(m, n, 1, a, m, b, maxmn, iptr, rc, rnk, wptr, lwork, &
    +
    2949 rwptr, flag)
    +
    2950 if (present(arnk)) arnk = rnk
    +
    2951
    +
    2952 ! Formatting
    +
    2953100 format(a, i0, a)
    +
    2954 end subroutine
    +
    2955
    +
    2956! ------------------------------------------------------------------------------
    +
    2957 module subroutine solve_least_squares_mtx_svd(a, b, s, arnk, work, olwork, err)
    +
    2958 ! Arguments
    +
    2959 real(real64), intent(inout), dimension(:,:) :: a, b
    +
    2960 integer(int32), intent(out), optional :: arnk
    +
    2961 real(real64), intent(out), target, optional, dimension(:) :: work, s
    +
    2962 integer(int32), intent(out), optional :: olwork
    +
    2963 class(errors), intent(inout), optional, target :: err
    +
    2964
    +
    2965 ! Local Variables
    +
    2966 integer(int32) :: m, n, nrhs, mn, maxmn, istat, flag, lwork, rnk
    +
    2967 real(real64), pointer, dimension(:) :: wptr, sptr
    +
    2968 real(real64), allocatable, target, dimension(:) :: wrk, sing
    +
    2969 real(real64), dimension(1) :: temp
    +
    2970 real(real64) :: rcond
    +
    2971 class(errors), pointer :: errmgr
    +
    2972 type(errors), target :: deferr
    +
    2973 character(len = 128) :: errmsg
    +
    2974
    +
    2975 ! Initialization
    +
    2976 m = size(a, 1)
    +
    2977 n = size(a, 2)
    +
    2978 nrhs = size(b, 2)
    +
    2979 mn = min(m, n)
    +
    2980 maxmn = max(m, n)
    +
    2981 rcond = epsilon(rcond)
    +
    2982 if (present(arnk)) arnk = 0
    +
    2983 if (present(err)) then
    +
    2984 errmgr => err
    +
    2985 else
    +
    2986 errmgr => deferr
    +
    2987 end if
    +
    2988
    +
    2989 ! Input Check
    +
    2990 flag = 0
    +
    2991 if (size(b, 1) /= maxmn) then
    +
    2992 flag = 2
    +
    2993 end if
    +
    2994 if (flag /= 0) then
    +
    2995 ! ERROR: One of the input arrays is not sized correctly
    +
    2996 write(errmsg, 100) "Input number ", flag, &
    +
    2997 " is not sized correctly."
    +
    2998 call errmgr%report_error("solve_least_squares_mtx_svd", &
    +
    2999 trim(errmsg), la_array_size_error)
    +
    3000 return
    +
    3001 end if
    +
    3002
    +
    3003 ! Workspace Query
    +
    3004 call dgelss(m, n, nrhs, a, m, b, maxmn, temp, rcond, rnk, temp, -1, &
    +
    3005 flag)
    +
    3006 lwork = int(temp(1), int32)
    +
    3007 if (present(olwork)) then
    +
    3008 olwork = lwork
    +
    3009 return
    +
    3010 end if
    +
    3011
    +
    3012 ! Local Memory Allocation
    +
    3013 if (present(s)) then
    +
    3014 if (size(s) < mn) then
    +
    3015 ! ERROR: S not sized correctly
    +
    3016 call errmgr%report_error("solve_least_squares_mtx_svd", &
    +
    3017 "Incorrectly sized input array S, argument 3.", &
    +
    3018 la_array_size_error)
    +
    3019 return
    +
    3020 end if
    +
    3021 sptr => s(1:mn)
    +
    3022 else
    +
    3023 allocate(sing(mn), stat = istat)
    +
    3024 if (istat /= 0) then
    +
    3025 ! ERROR: Out of memory
    +
    3026 call errmgr%report_error("solve_least_squares_mtx_svd", &
    +
    3027 "Insufficient memory available.", &
    +
    3028 la_out_of_memory_error)
    +
    3029 return
    +
    3030 end if
    +
    3031 sptr => sing
    +
    3032 end if
    +
    3033
    +
    3034 if (present(work)) then
    +
    3035 if (size(work) < lwork) then
    +
    3036 ! ERROR: WORK not sized correctly
    +
    3037 call errmgr%report_error("solve_least_squares_mtx_svd", &
    +
    3038 "Incorrectly sized input array WORK, argument 5.", &
    +
    3039 la_array_size_error)
    +
    3040 return
    +
    3041 end if
    +
    3042 wptr => work(1:lwork)
    +
    3043 else
    +
    3044 allocate(wrk(lwork), stat = istat)
    +
    3045 if (istat /= 0) then
    +
    3046 ! ERROR: Out of memory
    +
    3047 call errmgr%report_error("solve_least_squares_mtx_svd", &
    +
    3048 "Insufficient memory available.", &
    +
    3049 la_out_of_memory_error)
    +
    3050 return
    +
    3051 end if
    +
    3052 wptr => wrk
    +
    3053 end if
    +
    3054
    +
    3055 ! Process
    +
    3056 call dgelss(m, n, nrhs, a, m, b, maxmn, sptr, rcond, rnk, wptr, lwork, &
    +
    3057 flag)
    +
    3058 if (present(arnk)) arnk = rnk
    +
    3059 if (flag > 0) then
    +
    3060 write(errmsg, 101) flag, " superdiagonals could not " // &
    +
    3061 "converge to zero as part of the QR iteration process."
    +
    3062 call errmgr%report_warning("solve_least_squares_mtx_svd", errmsg, &
    +
    3063 la_convergence_error)
    +
    3064 end if
    +
    3065
    +
    3066 ! Formatting
    +
    3067100 format(a, i0, a)
    +
    3068101 format(i0, a)
    +
    3069 end subroutine
    +
    3070
    +
    3071! ------------------------------------------------------------------------------
    +
    3072 module subroutine solve_least_squares_mtx_svd_cmplx(a, b, s, arnk, work, &
    +
    3073 olwork, rwork, err)
    +
    3074 ! Arguments
    +
    3075 complex(real64), intent(inout), dimension(:,:) :: a, b
    +
    3076 integer(int32), intent(out), optional :: arnk
    +
    3077 complex(real64), intent(out), target, optional, dimension(:) :: work
    +
    3078 real(real64), intent(out), target, optional, dimension(:) :: s, rwork
    +
    3079 integer(int32), intent(out), optional :: olwork
    +
    3080 class(errors), intent(inout), optional, target :: err
    +
    3081
    +
    3082 ! Local Variables
    +
    3083 integer(int32) :: m, n, nrhs, mn, maxmn, istat, flag, lwork, rnk, lrwork
    +
    3084 complex(real64), pointer, dimension(:) :: wptr
    +
    3085 complex(real64), allocatable, target, dimension(:) :: wrk
    +
    3086 real(real64), pointer, dimension(:) :: rwptr, sptr
    +
    3087 real(real64), allocatable, target, dimension(:) :: rwrk, sing
    +
    3088 complex(real64), dimension(1) :: temp
    +
    3089 real(real64), dimension(1) :: rtemp
    +
    3090 real(real64) :: rcond
    +
    3091 class(errors), pointer :: errmgr
    +
    3092 type(errors), target :: deferr
    +
    3093 character(len = 128) :: errmsg
    +
    3094
    +
    3095 ! Initialization
    +
    3096 m = size(a, 1)
    +
    3097 n = size(a, 2)
    +
    3098 nrhs = size(b, 2)
    +
    3099 mn = min(m, n)
    +
    3100 lrwork = 5 * mn
    +
    3101 maxmn = max(m, n)
    +
    3102 rcond = epsilon(rcond)
    +
    3103 if (present(arnk)) arnk = 0
    +
    3104 if (present(err)) then
    +
    3105 errmgr => err
    +
    3106 else
    +
    3107 errmgr => deferr
    +
    3108 end if
    +
    3109
    +
    3110 ! Input Check
    +
    3111 flag = 0
    +
    3112 if (size(b, 1) /= maxmn) then
    +
    3113 flag = 2
    +
    3114 end if
    +
    3115 if (flag /= 0) then
    +
    3116 ! ERROR: One of the input arrays is not sized correctly
    +
    3117 write(errmsg, 100) "Input number ", flag, &
    +
    3118 " is not sized correctly."
    +
    3119 call errmgr%report_error("solve_least_squares_mtx_svd_cmplx", &
    +
    3120 trim(errmsg), la_array_size_error)
    +
    3121 return
    +
    3122 end if
    +
    3123
    +
    3124 ! Workspace Query
    +
    3125 call zgelss(m, n, nrhs, a, m, b, maxmn, rtemp, rcond, rnk, temp, -1, &
    +
    3126 rtemp, flag)
    +
    3127 lwork = int(temp(1), int32)
    +
    3128 if (present(olwork)) then
    +
    3129 olwork = lwork
    +
    3130 return
    +
    3131 end if
    +
    3132
    +
    3133 ! Local Memory Allocation
    +
    3134 if (present(s)) then
    +
    3135 if (size(s) < mn) then
    +
    3136 ! ERROR: S not sized correctly
    +
    3137 call errmgr%report_error("solve_least_squares_mtx_svd_cmplx", &
    +
    3138 "Incorrectly sized input array S, argument 3.", &
    +
    3139 la_array_size_error)
    +
    3140 return
    +
    3141 end if
    +
    3142 sptr => s(1:mn)
    +
    3143 else
    +
    3144 allocate(sing(mn), stat = istat)
    +
    3145 if (istat /= 0) then
    +
    3146 ! ERROR: Out of memory
    +
    3147 call errmgr%report_error("solve_least_squares_mtx_svd_cmplx", &
    +
    3148 "Insufficient memory available.", &
    +
    3149 la_out_of_memory_error)
    +
    3150 return
    +
    3151 end if
    +
    3152 sptr => sing
    +
    3153 end if
    +
    3154
    +
    3155 if (present(work)) then
    +
    3156 if (size(work) < lwork) then
    +
    3157 ! ERROR: WORK not sized correctly
    +
    3158 call errmgr%report_error("solve_least_squares_mtx_svd_cmplx", &
    +
    3159 "Incorrectly sized input array WORK, argument 5.", &
    +
    3160 la_array_size_error)
    +
    3161 return
    +
    3162 end if
    +
    3163 wptr => work(1:lwork)
    +
    3164 else
    +
    3165 allocate(wrk(lwork), stat = istat)
    +
    3166 if (istat /= 0) then
    +
    3167 ! ERROR: Out of memory
    +
    3168 call errmgr%report_error("solve_least_squares_mtx_svd_cmplx", &
    +
    3169 "Insufficient memory available.", &
    +
    3170 la_out_of_memory_error)
    +
    3171 return
    +
    3172 end if
    +
    3173 wptr => wrk
    3174 end if
    -
    3175 if (flag /= 0) then
    -
    3176 ! ERROR: One of the input arrays is not sized correctly
    -
    3177 write(errmsg, '(AI0A)') "Input number ", flag, &
    -
    3178 " is not sized correctly."
    -
    3179 call errmgr%report_error("solve_least_squares_vec_svd", &
    -
    3180 trim(errmsg), la_array_size_error)
    -
    3181 return
    -
    3182 end if
    -
    3183
    -
    3184 ! Workspace Query
    -
    3185 call dgelss(m, n, 1, a, m, b, maxmn, temp, rcond, rnk, temp, -1, flag)
    -
    3186 lwork = int(temp(1), int32)
    -
    3187 if (present(olwork)) then
    -
    3188 olwork = lwork
    -
    3189 return
    -
    3190 end if
    -
    3191
    -
    3192 ! Local Memory Allocation
    -
    3193 if (present(s)) then
    -
    3194 if (size(s) < mn) then
    -
    3195 ! ERROR: S not sized correctly
    -
    3196 call errmgr%report_error("solve_least_squares_vec_svd", &
    -
    3197 "Incorrectly sized input array S, argument 3.", &
    -
    3198 la_array_size_error)
    -
    3199 return
    -
    3200 end if
    -
    3201 sptr => s(1:mn)
    -
    3202 else
    -
    3203 allocate(sing(mn), stat = istat)
    -
    3204 if (istat /= 0) then
    -
    3205 ! ERROR: Out of memory
    -
    3206 call errmgr%report_error("solve_least_squares_vec_svd", &
    -
    3207 "Insufficient memory available.", &
    -
    3208 la_out_of_memory_error)
    -
    3209 return
    -
    3210 end if
    -
    3211 sptr => sing
    -
    3212 end if
    -
    3213
    -
    3214 if (present(work)) then
    -
    3215 if (size(work) < lwork) then
    -
    3216 ! ERROR: WORK not sized correctly
    -
    3217 call errmgr%report_error("solve_least_squares_vec_svd", &
    -
    3218 "Incorrectly sized input array WORK, argument 5.", &
    -
    3219 la_array_size_error)
    -
    3220 return
    -
    3221 end if
    -
    3222 wptr => work(1:lwork)
    -
    3223 else
    -
    3224 allocate(wrk(lwork), stat = istat)
    -
    3225 if (istat /= 0) then
    -
    3226 ! ERROR: Out of memory
    -
    3227 call errmgr%report_error("solve_least_squares_vec_svd", &
    -
    3228 "Insufficient memory available.", &
    -
    3229 la_out_of_memory_error)
    -
    3230 return
    -
    3231 end if
    -
    3232 wptr => wrk
    -
    3233 end if
    -
    3234
    -
    3235 ! Process
    -
    3236 call dgelss(m, n, 1, a, m, b, maxmn, sptr, rcond, rnk, wptr, lwork, &
    -
    3237 flag)
    -
    3238 if (present(arnk)) arnk = rnk
    -
    3239 if (flag > 0) then
    -
    3240 write(errmsg, '(I0A)') flag, " superdiagonals could not " // &
    -
    3241 "converge to zero as part of the QR iteration process."
    -
    3242 call errmgr%report_warning("solve_least_squares_vec_svd", errmsg, &
    -
    3243 la_convergence_error)
    +
    3175
    +
    3176 if (present(rwork)) then
    +
    3177 if (size(rwork) < lrwork) then
    +
    3178 ! ERROR: WORK not sized correctly
    +
    3179 call errmgr%report_error("solve_least_squares_mtx_svd_cmplx", &
    +
    3180 "Incorrectly sized input array RWORK, argument 7.", &
    +
    3181 la_array_size_error)
    +
    3182 return
    +
    3183 end if
    +
    3184 rwptr => rwork(1:lrwork)
    +
    3185 else
    +
    3186 allocate(rwrk(lrwork), stat = istat)
    +
    3187 if (istat /= 0) then
    +
    3188 ! ERROR: Out of memory
    +
    3189 call errmgr%report_error("solve_least_squares_mtx_svd_cmplx", &
    +
    3190 "Insufficient memory available.", &
    +
    3191 la_out_of_memory_error)
    +
    3192 return
    +
    3193 end if
    +
    3194 rwptr => rwrk
    +
    3195 end if
    +
    3196
    +
    3197 ! Process
    +
    3198 call zgelss(m, n, nrhs, a, m, b, maxmn, sptr, rcond, rnk, wptr, lwork, &
    +
    3199 rwptr, flag)
    +
    3200 if (present(arnk)) arnk = rnk
    +
    3201 if (flag > 0) then
    +
    3202 write(errmsg, 101) flag, " superdiagonals could not " // &
    +
    3203 "converge to zero as part of the QR iteration process."
    +
    3204 call errmgr%report_warning("solve_least_squares_mtx_svd_cmplx", &
    +
    3205 errmsg, la_convergence_error)
    +
    3206 end if
    +
    3207
    +
    3208 ! Formatting
    +
    3209100 format(a, i0, a)
    +
    3210101 format(i0, a)
    +
    3211 end subroutine
    +
    3212
    +
    3213! ------------------------------------------------------------------------------
    +
    3214 module subroutine solve_least_squares_vec_svd(a, b, s, arnk, work, olwork, err)
    +
    3215 ! Arguments
    +
    3216 real(real64), intent(inout), dimension(:,:) :: a
    +
    3217 real(real64), intent(inout), dimension(:) :: b
    +
    3218 integer(int32), intent(out), optional :: arnk
    +
    3219 real(real64), intent(out), target, optional, dimension(:) :: work, s
    +
    3220 integer(int32), intent(out), optional :: olwork
    +
    3221 class(errors), intent(inout), optional, target :: err
    +
    3222
    +
    3223 ! Local Variables
    +
    3224 integer(int32) :: m, n, mn, maxmn, istat, flag, lwork, rnk
    +
    3225 real(real64), pointer, dimension(:) :: wptr, sptr
    +
    3226 real(real64), allocatable, target, dimension(:) :: wrk, sing
    +
    3227 real(real64), dimension(1) :: temp
    +
    3228 real(real64) :: rcond
    +
    3229 class(errors), pointer :: errmgr
    +
    3230 type(errors), target :: deferr
    +
    3231 character(len = 128) :: errmsg
    +
    3232
    +
    3233 ! Initialization
    +
    3234 m = size(a, 1)
    +
    3235 n = size(a, 2)
    +
    3236 mn = min(m, n)
    +
    3237 maxmn = max(m, n)
    +
    3238 rcond = epsilon(rcond)
    +
    3239 if (present(arnk)) arnk = 0
    +
    3240 if (present(err)) then
    +
    3241 errmgr => err
    +
    3242 else
    +
    3243 errmgr => deferr
    3244 end if
    -
    3245 end subroutine
    -
    3246
    -
    3247! ------------------------------------------------------------------------------
    -
    3248 module subroutine solve_least_squares_vec_svd_cmplx(a, b, s, arnk, work, &
    -
    3249 olwork, rwork, err)
    -
    3250 ! Arguments
    -
    3251 complex(real64), intent(inout), dimension(:,:) :: a
    -
    3252 complex(real64), intent(inout), dimension(:) :: b
    -
    3253 integer(int32), intent(out), optional :: arnk
    -
    3254 complex(real64), intent(out), target, optional, dimension(:) :: work
    -
    3255 real(real64), intent(out), target, optional, dimension(:) :: rwork, s
    -
    3256 integer(int32), intent(out), optional :: olwork
    -
    3257 class(errors), intent(inout), optional, target :: err
    -
    3258
    -
    3259 ! Local Variables
    -
    3260 integer(int32) :: m, n, mn, maxmn, istat, flag, lwork, rnk, lrwork
    -
    3261 real(real64), pointer, dimension(:) :: rwptr, sptr
    -
    3262 real(real64), allocatable, target, dimension(:) :: rwrk, sing
    -
    3263 complex(real64), pointer, dimension(:) :: wptr
    -
    3264 complex(real64), allocatable, target, dimension(:) :: wrk
    -
    3265 complex(real64), dimension(1) :: temp
    -
    3266 real(real64), dimension(1) :: rtemp
    -
    3267 real(real64) :: rcond
    -
    3268 class(errors), pointer :: errmgr
    -
    3269 type(errors), target :: deferr
    -
    3270 character(len = 128) :: errmsg
    -
    3271
    -
    3272 ! Initialization
    -
    3273 m = size(a, 1)
    -
    3274 n = size(a, 2)
    -
    3275 mn = min(m, n)
    -
    3276 lrwork = 5 * mn
    -
    3277 maxmn = max(m, n)
    -
    3278 rcond = epsilon(rcond)
    -
    3279 if (present(arnk)) arnk = 0
    -
    3280 if (present(err)) then
    -
    3281 errmgr => err
    -
    3282 else
    -
    3283 errmgr => deferr
    -
    3284 end if
    -
    3285
    -
    3286 ! Input Check
    -
    3287 flag = 0
    -
    3288 if (size(b) /= maxmn) then
    -
    3289 flag = 2
    -
    3290 end if
    -
    3291 if (flag /= 0) then
    -
    3292 ! ERROR: One of the input arrays is not sized correctly
    -
    3293 write(errmsg, '(AI0A)') "Input number ", flag, &
    -
    3294 " is not sized correctly."
    -
    3295 call errmgr%report_error("solve_least_squares_vec_svd_cmplx", &
    -
    3296 trim(errmsg), la_array_size_error)
    -
    3297 return
    -
    3298 end if
    -
    3299
    -
    3300 ! Workspace Query
    -
    3301 call zgelss(m, n, 1, a, m, b, maxmn, rtemp, rcond, rnk, temp, -1, &
    -
    3302 rtemp, flag)
    -
    3303 lwork = int(temp(1), int32)
    -
    3304 if (present(olwork)) then
    -
    3305 olwork = lwork
    -
    3306 return
    -
    3307 end if
    -
    3308
    -
    3309 ! Local Memory Allocation
    -
    3310 if (present(s)) then
    -
    3311 if (size(s) < mn) then
    -
    3312 ! ERROR: S not sized correctly
    -
    3313 call errmgr%report_error("solve_least_squares_vec_svd_cmplx", &
    -
    3314 "Incorrectly sized input array S, argument 3.", &
    -
    3315 la_array_size_error)
    -
    3316 return
    -
    3317 end if
    -
    3318 sptr => s(1:mn)
    -
    3319 else
    -
    3320 allocate(sing(mn), stat = istat)
    -
    3321 if (istat /= 0) then
    -
    3322 ! ERROR: Out of memory
    -
    3323 call errmgr%report_error("solve_least_squares_vec_svd_cmplx", &
    -
    3324 "Insufficient memory available.", &
    -
    3325 la_out_of_memory_error)
    -
    3326 return
    -
    3327 end if
    -
    3328 sptr => sing
    -
    3329 end if
    -
    3330
    -
    3331 if (present(work)) then
    -
    3332 if (size(work) < lwork) then
    -
    3333 ! ERROR: WORK not sized correctly
    -
    3334 call errmgr%report_error("solve_least_squares_vec_svd_cmplx", &
    -
    3335 "Incorrectly sized input array WORK, argument 5.", &
    -
    3336 la_array_size_error)
    -
    3337 return
    -
    3338 end if
    -
    3339 wptr => work(1:lwork)
    -
    3340 else
    -
    3341 allocate(wrk(lwork), stat = istat)
    -
    3342 if (istat /= 0) then
    -
    3343 ! ERROR: Out of memory
    -
    3344 call errmgr%report_error("solve_least_squares_vec_svd_cmplx", &
    -
    3345 "Insufficient memory available.", &
    -
    3346 la_out_of_memory_error)
    -
    3347 return
    -
    3348 end if
    -
    3349 wptr => wrk
    -
    3350 end if
    +
    3245
    +
    3246 ! Input Check
    +
    3247 flag = 0
    +
    3248 if (size(b) /= maxmn) then
    +
    3249 flag = 2
    +
    3250 end if
    +
    3251 if (flag /= 0) then
    +
    3252 ! ERROR: One of the input arrays is not sized correctly
    +
    3253 write(errmsg, 100) "Input number ", flag, &
    +
    3254 " is not sized correctly."
    +
    3255 call errmgr%report_error("solve_least_squares_vec_svd", &
    +
    3256 trim(errmsg), la_array_size_error)
    +
    3257 return
    +
    3258 end if
    +
    3259
    +
    3260 ! Workspace Query
    +
    3261 call dgelss(m, n, 1, a, m, b, maxmn, temp, rcond, rnk, temp, -1, flag)
    +
    3262 lwork = int(temp(1), int32)
    +
    3263 if (present(olwork)) then
    +
    3264 olwork = lwork
    +
    3265 return
    +
    3266 end if
    +
    3267
    +
    3268 ! Local Memory Allocation
    +
    3269 if (present(s)) then
    +
    3270 if (size(s) < mn) then
    +
    3271 ! ERROR: S not sized correctly
    +
    3272 call errmgr%report_error("solve_least_squares_vec_svd", &
    +
    3273 "Incorrectly sized input array S, argument 3.", &
    +
    3274 la_array_size_error)
    +
    3275 return
    +
    3276 end if
    +
    3277 sptr => s(1:mn)
    +
    3278 else
    +
    3279 allocate(sing(mn), stat = istat)
    +
    3280 if (istat /= 0) then
    +
    3281 ! ERROR: Out of memory
    +
    3282 call errmgr%report_error("solve_least_squares_vec_svd", &
    +
    3283 "Insufficient memory available.", &
    +
    3284 la_out_of_memory_error)
    +
    3285 return
    +
    3286 end if
    +
    3287 sptr => sing
    +
    3288 end if
    +
    3289
    +
    3290 if (present(work)) then
    +
    3291 if (size(work) < lwork) then
    +
    3292 ! ERROR: WORK not sized correctly
    +
    3293 call errmgr%report_error("solve_least_squares_vec_svd", &
    +
    3294 "Incorrectly sized input array WORK, argument 5.", &
    +
    3295 la_array_size_error)
    +
    3296 return
    +
    3297 end if
    +
    3298 wptr => work(1:lwork)
    +
    3299 else
    +
    3300 allocate(wrk(lwork), stat = istat)
    +
    3301 if (istat /= 0) then
    +
    3302 ! ERROR: Out of memory
    +
    3303 call errmgr%report_error("solve_least_squares_vec_svd", &
    +
    3304 "Insufficient memory available.", &
    +
    3305 la_out_of_memory_error)
    +
    3306 return
    +
    3307 end if
    +
    3308 wptr => wrk
    +
    3309 end if
    +
    3310
    +
    3311 ! Process
    +
    3312 call dgelss(m, n, 1, a, m, b, maxmn, sptr, rcond, rnk, wptr, lwork, &
    +
    3313 flag)
    +
    3314 if (present(arnk)) arnk = rnk
    +
    3315 if (flag > 0) then
    +
    3316 write(errmsg, 101) flag, " superdiagonals could not " // &
    +
    3317 "converge to zero as part of the QR iteration process."
    +
    3318 call errmgr%report_warning("solve_least_squares_vec_svd", errmsg, &
    +
    3319 la_convergence_error)
    +
    3320 end if
    +
    3321
    +
    3322 ! Formatting
    +
    3323100 format(a, i0, a)
    +
    3324101 format(i0, a)
    +
    3325 end subroutine
    +
    3326
    +
    3327! ------------------------------------------------------------------------------
    +
    3328 module subroutine solve_least_squares_vec_svd_cmplx(a, b, s, arnk, work, &
    +
    3329 olwork, rwork, err)
    +
    3330 ! Arguments
    +
    3331 complex(real64), intent(inout), dimension(:,:) :: a
    +
    3332 complex(real64), intent(inout), dimension(:) :: b
    +
    3333 integer(int32), intent(out), optional :: arnk
    +
    3334 complex(real64), intent(out), target, optional, dimension(:) :: work
    +
    3335 real(real64), intent(out), target, optional, dimension(:) :: rwork, s
    +
    3336 integer(int32), intent(out), optional :: olwork
    +
    3337 class(errors), intent(inout), optional, target :: err
    +
    3338
    +
    3339 ! Local Variables
    +
    3340 integer(int32) :: m, n, mn, maxmn, istat, flag, lwork, rnk, lrwork
    +
    3341 real(real64), pointer, dimension(:) :: rwptr, sptr
    +
    3342 real(real64), allocatable, target, dimension(:) :: rwrk, sing
    +
    3343 complex(real64), pointer, dimension(:) :: wptr
    +
    3344 complex(real64), allocatable, target, dimension(:) :: wrk
    +
    3345 complex(real64), dimension(1) :: temp
    +
    3346 real(real64), dimension(1) :: rtemp
    +
    3347 real(real64) :: rcond
    +
    3348 class(errors), pointer :: errmgr
    +
    3349 type(errors), target :: deferr
    +
    3350 character(len = 128) :: errmsg
    3351
    -
    3352 if (present(rwork)) then
    -
    3353 if (size(rwork) < lrwork) then
    -
    3354 ! ERROR: WORK not sized correctly
    -
    3355 call errmgr%report_error("solve_least_squares_vec_svd_cmplx", &
    -
    3356 "Incorrectly sized input array RWORK, argument 7.", &
    -
    3357 la_array_size_error)
    -
    3358 return
    -
    3359 end if
    -
    3360 rwptr => rwork(1:lrwork)
    -
    3361 else
    -
    3362 allocate(rwrk(lrwork), stat = istat)
    -
    3363 if (istat /= 0) then
    -
    3364 ! ERROR: Out of memory
    -
    3365 call errmgr%report_error("solve_least_squares_vec_svd_cmplx", &
    -
    3366 "Insufficient memory available.", &
    -
    3367 la_out_of_memory_error)
    -
    3368 return
    -
    3369 end if
    -
    3370 rwptr => rwrk
    -
    3371 end if
    -
    3372
    -
    3373 ! Process
    -
    3374 call zgelss(m, n, 1, a, m, b, maxmn, sptr, rcond, rnk, wptr, lwork, &
    -
    3375 rwptr, flag)
    -
    3376 if (present(arnk)) arnk = rnk
    -
    3377 if (flag > 0) then
    -
    3378 write(errmsg, '(I0A)') flag, " superdiagonals could not " // &
    -
    3379 "converge to zero as part of the QR iteration process."
    -
    3380 call errmgr%report_warning("solve_least_squares_vec_svd_cmplx", &
    -
    3381 errmsg, la_convergence_error)
    -
    3382 end if
    -
    3383 end subroutine
    -
    3384
    -
    3385end submodule
    +
    3352 ! Initialization
    +
    3353 m = size(a, 1)
    +
    3354 n = size(a, 2)
    +
    3355 mn = min(m, n)
    +
    3356 lrwork = 5 * mn
    +
    3357 maxmn = max(m, n)
    +
    3358 rcond = epsilon(rcond)
    +
    3359 if (present(arnk)) arnk = 0
    +
    3360 if (present(err)) then
    +
    3361 errmgr => err
    +
    3362 else
    +
    3363 errmgr => deferr
    +
    3364 end if
    +
    3365
    +
    3366 ! Input Check
    +
    3367 flag = 0
    +
    3368 if (size(b) /= maxmn) then
    +
    3369 flag = 2
    +
    3370 end if
    +
    3371 if (flag /= 0) then
    +
    3372 ! ERROR: One of the input arrays is not sized correctly
    +
    3373 write(errmsg, 100) "Input number ", flag, &
    +
    3374 " is not sized correctly."
    +
    3375 call errmgr%report_error("solve_least_squares_vec_svd_cmplx", &
    +
    3376 trim(errmsg), la_array_size_error)
    +
    3377 return
    +
    3378 end if
    +
    3379
    +
    3380 ! Workspace Query
    +
    3381 call zgelss(m, n, 1, a, m, b, maxmn, rtemp, rcond, rnk, temp, -1, &
    +
    3382 rtemp, flag)
    +
    3383 lwork = int(temp(1), int32)
    +
    3384 if (present(olwork)) then
    +
    3385 olwork = lwork
    +
    3386 return
    +
    3387 end if
    +
    3388
    +
    3389 ! Local Memory Allocation
    +
    3390 if (present(s)) then
    +
    3391 if (size(s) < mn) then
    +
    3392 ! ERROR: S not sized correctly
    +
    3393 call errmgr%report_error("solve_least_squares_vec_svd_cmplx", &
    +
    3394 "Incorrectly sized input array S, argument 3.", &
    +
    3395 la_array_size_error)
    +
    3396 return
    +
    3397 end if
    +
    3398 sptr => s(1:mn)
    +
    3399 else
    +
    3400 allocate(sing(mn), stat = istat)
    +
    3401 if (istat /= 0) then
    +
    3402 ! ERROR: Out of memory
    +
    3403 call errmgr%report_error("solve_least_squares_vec_svd_cmplx", &
    +
    3404 "Insufficient memory available.", &
    +
    3405 la_out_of_memory_error)
    +
    3406 return
    +
    3407 end if
    +
    3408 sptr => sing
    +
    3409 end if
    +
    3410
    +
    3411 if (present(work)) then
    +
    3412 if (size(work) < lwork) then
    +
    3413 ! ERROR: WORK not sized correctly
    +
    3414 call errmgr%report_error("solve_least_squares_vec_svd_cmplx", &
    +
    3415 "Incorrectly sized input array WORK, argument 5.", &
    +
    3416 la_array_size_error)
    +
    3417 return
    +
    3418 end if
    +
    3419 wptr => work(1:lwork)
    +
    3420 else
    +
    3421 allocate(wrk(lwork), stat = istat)
    +
    3422 if (istat /= 0) then
    +
    3423 ! ERROR: Out of memory
    +
    3424 call errmgr%report_error("solve_least_squares_vec_svd_cmplx", &
    +
    3425 "Insufficient memory available.", &
    +
    3426 la_out_of_memory_error)
    +
    3427 return
    +
    3428 end if
    +
    3429 wptr => wrk
    +
    3430 end if
    +
    3431
    +
    3432 if (present(rwork)) then
    +
    3433 if (size(rwork) < lrwork) then
    +
    3434 ! ERROR: WORK not sized correctly
    +
    3435 call errmgr%report_error("solve_least_squares_vec_svd_cmplx", &
    +
    3436 "Incorrectly sized input array RWORK, argument 7.", &
    +
    3437 la_array_size_error)
    +
    3438 return
    +
    3439 end if
    +
    3440 rwptr => rwork(1:lrwork)
    +
    3441 else
    +
    3442 allocate(rwrk(lrwork), stat = istat)
    +
    3443 if (istat /= 0) then
    +
    3444 ! ERROR: Out of memory
    +
    3445 call errmgr%report_error("solve_least_squares_vec_svd_cmplx", &
    +
    3446 "Insufficient memory available.", &
    +
    3447 la_out_of_memory_error)
    +
    3448 return
    +
    3449 end if
    +
    3450 rwptr => rwrk
    +
    3451 end if
    +
    3452
    +
    3453 ! Process
    +
    3454 call zgelss(m, n, 1, a, m, b, maxmn, sptr, rcond, rnk, wptr, lwork, &
    +
    3455 rwptr, flag)
    +
    3456 if (present(arnk)) arnk = rnk
    +
    3457 if (flag > 0) then
    +
    3458 write(errmsg, 101) flag, " superdiagonals could not " // &
    +
    3459 "converge to zero as part of the QR iteration process."
    +
    3460 call errmgr%report_warning("solve_least_squares_vec_svd_cmplx", &
    +
    3461 errmsg, la_convergence_error)
    +
    3462 end if
    +
    3463
    +
    3464 ! Formatting
    +
    3465100 format(a, i0, a)
    +
    3466101 format(i0, a)
    +
    3467 end subroutine
    +
    3468
    +
    3469end submodule
    Provides a set of common linear algebra routines.
    Definition: linalg.f90:15
    diff --git a/doc/html/linalg__sorting_8f90_source.html b/doc/html/linalg__sorting_8f90_source.html index 1ea7a815..e138ecff 100644 --- a/doc/html/linalg__sorting_8f90_source.html +++ b/doc/html/linalg__sorting_8f90_source.html @@ -162,7 +162,7 @@
    64
    65 ! Input Check
    66 if (size(ind) /= n) then
    -
    67 write(errmsg, "(AI0AI0A)") &
    +
    67 write(errmsg, 100) &
    68 "Expected the tracking array to be of size ", n, &
    69 ", but found an array of size ", size(ind), "."
    70 call errmgr%report_error("sort_dbl_array_ind", trim(errmsg), &
    @@ -173,476 +173,488 @@
    75
    76 ! Process
    77 call qsort_dbl_ind(dir, x, ind)
    -
    78 end subroutine
    -
    79
    -
    80! ------------------------------------------------------------------------------
    -
    81 module subroutine sort_cmplx_array(x, ascend)
    -
    82 ! Arguments
    -
    83 complex(real64), intent(inout), dimension(:) :: x
    -
    84 logical, intent(in), optional :: ascend
    -
    85
    -
    86 ! Local Variables
    -
    87 logical :: dir
    +
    78
    +
    79 ! Formatting
    +
    80100 format(a, i0, a, i0, a)
    +
    81 end subroutine
    +
    82
    +
    83! ------------------------------------------------------------------------------
    +
    84 module subroutine sort_cmplx_array(x, ascend)
    +
    85 ! Arguments
    +
    86 complex(real64), intent(inout), dimension(:) :: x
    +
    87 logical, intent(in), optional :: ascend
    88
    -
    89 ! Initialization
    -
    90 if (present(ascend)) then
    -
    91 dir = ascend
    -
    92 else
    -
    93 dir = .true.
    -
    94 end if
    -
    95
    -
    96 ! Process
    -
    97 call qsort_cmplx(dir, x)
    -
    98 end subroutine
    -
    99
    -
    100! ------------------------------------------------------------------------------
    -
    101 module subroutine sort_cmplx_array_ind(x, ind, ascend, err)
    -
    102 ! Arguments
    -
    103 complex(real64), intent(inout), dimension(:) :: x
    -
    104 integer(int32), intent(inout), dimension(:) :: ind
    -
    105 logical, intent(in), optional :: ascend
    -
    106 class(errors), intent(inout), optional, target :: err
    -
    107
    -
    108 ! Local Variables
    -
    109 class(errors), pointer :: errmgr
    -
    110 type(errors), target :: deferr
    -
    111 character(len = 128) :: errmsg
    -
    112 integer(int32) :: n
    -
    113 logical :: dir
    -
    114
    -
    115 ! Initialization
    -
    116 n = size(x)
    -
    117 if (present(err)) then
    -
    118 errmgr => err
    -
    119 else
    -
    120 errmgr => deferr
    -
    121 end if
    -
    122 if (present(ascend)) then
    -
    123 dir = ascend
    -
    124 else
    -
    125 dir = .true. ! Ascend == true
    -
    126 end if
    -
    127
    -
    128 ! Input Check
    -
    129 if (size(ind) /= n) then
    -
    130 write(errmsg, "(AI0AI0A)") &
    -
    131 "Expected the tracking array to be of size ", n, &
    -
    132 ", but found an array of size ", size(ind), "."
    -
    133 call errmgr%report_error("sort_cmplx_array_ind", trim(errmsg), &
    -
    134 la_array_size_error)
    -
    135 return
    -
    136 end if
    -
    137 if (n <= 1) return
    -
    138
    -
    139 ! Process
    -
    140 call qsort_cmplx_ind(dir, x, ind)
    -
    141 end subroutine
    -
    142
    -
    143! ------------------------------------------------------------------------------
    -
    144 module subroutine sort_eigen_cmplx(vals, vecs, ascend, err)
    -
    145 ! Arguments
    -
    146 complex(real64), intent(inout), dimension(:) :: vals
    -
    147 complex(real64), intent(inout), dimension(:,:) :: vecs
    -
    148 logical, intent(in), optional :: ascend
    -
    149 class(errors), intent(inout), optional, target :: err
    -
    150
    -
    151 ! Local Variables
    -
    152 class(errors), pointer :: errmgr
    -
    153 type(errors), target :: deferr
    -
    154 character(len = 128) :: errmsg
    -
    155 integer(int32) :: i, n, flag
    -
    156 logical :: dir
    -
    157 integer(int32), allocatable, dimension(:) :: ind
    -
    158
    -
    159 ! Initialization
    -
    160 if (present(err)) then
    -
    161 errmgr => err
    -
    162 else
    -
    163 errmgr => deferr
    -
    164 end if
    -
    165 if (present(ascend)) then
    -
    166 dir = ascend
    -
    167 else
    -
    168 dir = .true. ! Ascend == true
    -
    169 end if
    -
    170
    -
    171 ! Ensure the eigenvector matrix is sized appropriately
    -
    172 n = size(vals)
    -
    173 if (size(vecs, 1) /= n .or. size(vecs, 2) /= n) then
    -
    174 ! ARRAY SIZE ERROR
    -
    175 write(errmsg, '(AI0AI0AI0AI0A)') &
    -
    176 "Expected the eigenvector matrix to be of size ", n, &
    -
    177 "-by-", n, ", but found a matrix of size ", size(vecs, 1), &
    -
    178 "-by-", size(vecs, 2), "."
    -
    179 call errmgr%report_error("sort_eigen_cmplx", trim(errmsg), &
    -
    180 la_array_size_error)
    -
    181 end if
    -
    182
    -
    183 ! Allocate memory for the tracking array
    -
    184 allocate(ind(n), stat = flag)
    -
    185 if (flag /= 0) then
    -
    186 call errmgr%report_error("sort_eigen_cmplx", &
    -
    187 "Insufficient memory available.", la_out_of_memory_error)
    -
    188 return
    -
    189 end if
    -
    190 do i = 1, n
    -
    191 ind(i) = i
    -
    192 end do
    -
    193
    -
    194 ! Sort
    -
    195 call qsort_cmplx_ind(dir, vals, ind)
    -
    196
    -
    197 ! Shift the eigenvectors around to keep them associated with the
    -
    198 ! appropriate eigenvalue
    -
    199 vecs = vecs(:,ind)
    -
    200 end subroutine
    -
    201
    -
    202! ------------------------------------------------------------------------------
    -
    203 module subroutine sort_eigen_dbl(vals, vecs, ascend, err)
    -
    204 ! Arguments
    -
    205 real(real64), intent(inout), dimension(:) :: vals
    -
    206 real(real64), intent(inout), dimension(:,:) :: vecs
    -
    207 logical, intent(in), optional :: ascend
    -
    208 class(errors), intent(inout), optional, target :: err
    -
    209
    -
    210 ! Local Variables
    -
    211 class(errors), pointer :: errmgr
    -
    212 type(errors), target :: deferr
    -
    213 character(len = 128) :: errmsg
    -
    214 integer(int32) :: i, n, flag
    -
    215 logical :: dir
    -
    216 integer(int32), allocatable, dimension(:) :: ind
    -
    217
    -
    218 ! Initialization
    -
    219 if (present(err)) then
    -
    220 errmgr => err
    -
    221 else
    -
    222 errmgr => deferr
    -
    223 end if
    -
    224 if (present(ascend)) then
    -
    225 dir = ascend
    -
    226 else
    -
    227 dir = .true. ! Ascend == true
    -
    228 end if
    -
    229
    -
    230 ! Ensure the eigenvector matrix is sized appropriately
    -
    231 n = size(vals)
    -
    232 if (size(vecs, 1) /= n .or. size(vecs, 2) /= n) then
    -
    233 ! ARRAY SIZE ERROR
    -
    234 write(errmsg, '(AI0AI0AI0AI0A)') &
    -
    235 "Expected the eigenvector matrix to be of size ", n, &
    -
    236 "-by-", n, ", but found a matrix of size ", size(vecs, 1), &
    -
    237 "-by-", size(vecs, 2), "."
    -
    238 call errmgr%report_error("sort_eigen_dbl", trim(errmsg), &
    -
    239 la_array_size_error)
    -
    240 end if
    -
    241
    -
    242 ! Allocate memory for the tracking array
    -
    243 allocate(ind(n), stat = flag)
    -
    244 if (flag /= 0) then
    -
    245 call errmgr%report_error("sort_eigen_dbl", &
    -
    246 "Insufficient memory available.", la_out_of_memory_error)
    -
    247 return
    -
    248 end if
    -
    249 do i = 1, n
    -
    250 ind(i) = i
    -
    251 end do
    -
    252
    -
    253 ! Sort
    -
    254 call qsort_dbl_ind(dir, vals, ind)
    -
    255
    -
    256 ! Shift the eigenvectors around to keep them associated with the
    -
    257 ! appropriate eigenvalue
    -
    258 vecs = vecs(:,ind)
    -
    259 end subroutine
    -
    260
    -
    261! ******************************************************************************
    -
    262! PRIVATE HELPER ROUTINES
    -
    263! ------------------------------------------------------------------------------
    -
    277 recursive subroutine qsort_dbl_ind(ascend, x, ind)
    -
    278 ! Arguments
    -
    279 logical, intent(in) :: ascend
    -
    280 real(real64), intent(inout), dimension(:) :: x
    -
    281 integer(int32), intent(inout), dimension(:) :: ind
    -
    282
    -
    283 ! Local Variables
    -
    284 integer(int32) :: iq
    -
    285
    -
    286 ! Process
    -
    287 if (size(x) > 1) then
    -
    288 call dbl_partition_ind(ascend, x, ind, iq)
    -
    289 call qsort_dbl_ind(ascend, x(:iq-1), ind(:iq-1))
    -
    290 call qsort_dbl_ind(ascend, x(iq:), ind(iq:))
    -
    291 end if
    -
    292 end subroutine
    -
    293
    -
    294! ------------------------------------------------------------------------------
    -
    310 subroutine dbl_partition_ind(ascend, x, ind, marker)
    -
    311 ! Arguments
    -
    312 logical, intent(in) :: ascend
    -
    313 real(real64), intent(inout), dimension(:) :: x
    -
    314 integer(int32), intent(inout), dimension(:) :: ind
    -
    315 integer(int32), intent(out) :: marker
    -
    316
    -
    317 ! Local Variables
    -
    318 integer(int32) :: i, j, itemp
    -
    319 real(real64) :: temp, pivot
    -
    320
    -
    321 ! Process
    -
    322 pivot = x(1)
    -
    323 i = 0
    -
    324 j = size(x) + 1
    -
    325 if (ascend) then
    -
    326 ! Ascending Sort
    -
    327 do
    -
    328 j = j - 1
    -
    329 do
    -
    330 if (x(j) <= pivot) exit
    -
    331 j = j - 1
    -
    332 end do
    -
    333 i = i + 1
    -
    334 do
    -
    335 if (x(i) >= pivot) exit
    -
    336 i = i + 1
    -
    337 end do
    -
    338 if (i < j) then
    -
    339 ! Exchage X(I) and X(J)
    -
    340 temp = x(i)
    -
    341 x(i) = x(j)
    -
    342 x(j) = temp
    -
    343
    -
    344 itemp = ind(i)
    -
    345 ind(i) = ind(j)
    -
    346 ind(j) = itemp
    -
    347 else if (i == j) then
    -
    348 marker = i + 1
    -
    349 return
    -
    350 else
    -
    351 marker = i
    -
    352 return
    -
    353 end if
    -
    354 end do
    -
    355 else
    -
    356 ! Descending Sort
    -
    357 do
    -
    358 j = j - 1
    -
    359 do
    -
    360 if (x(j) >= pivot) exit
    -
    361 j = j - 1
    -
    362 end do
    -
    363 i = i + 1
    -
    364 do
    -
    365 if (x(i) <= pivot) exit
    -
    366 i = i + 1
    -
    367 end do
    -
    368 if (i < j) then
    -
    369 ! Exchage X(I) and X(J)
    -
    370 temp = x(i)
    -
    371 x(i) = x(j)
    -
    372 x(j) = temp
    -
    373
    -
    374 itemp = ind(i)
    -
    375 ind(i) = ind(j)
    -
    376 ind(j) = itemp
    -
    377 else if (i == j) then
    -
    378 marker = i + 1
    -
    379 return
    -
    380 else
    -
    381 marker = i
    -
    382 return
    -
    383 end if
    -
    384 end do
    -
    385 end if
    -
    386 end subroutine
    -
    387
    -
    388! ------------------------------------------------------------------------------
    -
    403 recursive subroutine qsort_cmplx(ascend, x)
    -
    404 ! Arguments
    -
    405 logical, intent(in) :: ascend
    -
    406 complex(real64), intent(inout), dimension(:) :: x
    -
    407
    -
    408 ! Local Variables
    -
    409 integer(int32) :: iq
    -
    410
    -
    411 ! Process
    -
    412 if (size(x) > 1) then
    -
    413 call cmplx_partition(ascend, x, iq)
    -
    414 call qsort_cmplx(ascend, x(:iq-1))
    -
    415 call qsort_cmplx(ascend, x(iq:))
    -
    416 end if
    -
    417 end subroutine
    -
    418
    -
    419! ------------------------------------------------------------------------------
    -
    436 subroutine cmplx_partition(ascend, x, marker)
    -
    437 ! Arguments
    -
    438 logical, intent(in) :: ascend
    -
    439 complex(real64), intent(inout), dimension(:) :: x
    -
    440 integer(int32), intent(out) :: marker
    -
    441
    -
    442 ! Local Variables
    -
    443 integer(int32) :: i, j
    -
    444 complex(real64) :: temp
    -
    445 real(real64) :: pivot
    -
    446
    -
    447 ! Process
    -
    448 pivot = real(x(1), real64)
    -
    449 i = 0
    -
    450 j = size(x) + 1
    -
    451 if (ascend) then
    -
    452 ! Ascending Sort
    -
    453 do
    -
    454 j = j - 1
    -
    455 do
    -
    456 if (real(x(j), real64) <= pivot) exit
    -
    457 j = j - 1
    -
    458 end do
    -
    459 i = i + 1
    -
    460 do
    -
    461 if (real(x(i), real64) >= pivot) exit
    -
    462 i = i + 1
    -
    463 end do
    -
    464 if (i < j) then
    -
    465 ! Exchage X(I) and X(J)
    -
    466 temp = x(i)
    -
    467 x(i) = x(j)
    -
    468 x(j) = temp
    -
    469 else if (i == j) then
    -
    470 marker = i + 1
    -
    471 return
    -
    472 else
    -
    473 marker = i
    -
    474 return
    -
    475 end if
    -
    476 end do
    -
    477 else
    -
    478 ! Descending Sort
    -
    479 do
    -
    480 j = j - 1
    -
    481 do
    -
    482 if (real(x(j), real64) >= pivot) exit
    -
    483 j = j - 1
    -
    484 end do
    -
    485 i = i + 1
    -
    486 do
    -
    487 if (real(x(i), real64) <= pivot) exit
    -
    488 i = i + 1
    -
    489 end do
    -
    490 if (i < j) then
    -
    491 ! Exchage X(I) and X(J)
    -
    492 temp = x(i)
    -
    493 x(i) = x(j)
    -
    494 x(j) = temp
    -
    495 else if (i == j) then
    -
    496 marker = i + 1
    -
    497 return
    -
    498 else
    -
    499 marker = i
    -
    500 return
    -
    501 end if
    -
    502 end do
    -
    503 end if
    -
    504 end subroutine
    -
    505
    -
    506! ------------------------------------------------------------------------------
    -
    524 recursive subroutine qsort_cmplx_ind(ascend, x, ind)
    -
    525 ! Arguments
    -
    526 logical, intent(in) :: ascend
    -
    527 complex(real64), intent(inout), dimension(:) :: x
    -
    528 integer(int32), intent(inout), dimension(:) :: ind
    -
    529
    -
    530 ! Local Variables
    -
    531 integer(int32) :: iq
    -
    532
    -
    533 ! Process
    -
    534 if (size(x) > 1) then
    -
    535 call cmplx_partition_ind(ascend, x, ind, iq)
    -
    536 call qsort_cmplx_ind(ascend, x(:iq-1), ind(:iq-1))
    -
    537 call qsort_cmplx_ind(ascend, x(iq:), ind(iq:))
    -
    538 end if
    -
    539 end subroutine
    -
    540
    -
    541! ------------------------------------------------------------------------------
    -
    561 subroutine cmplx_partition_ind(ascend, x, ind, marker)
    -
    562 ! Arguments
    -
    563 logical, intent(in) :: ascend
    -
    564 complex(real64), intent(inout), dimension(:) :: x
    -
    565 integer(int32), intent(inout), dimension(:) :: ind
    -
    566 integer(int32), intent(out) :: marker
    -
    567
    -
    568 ! Local Variables
    -
    569 integer(int32) :: i, j, itemp
    -
    570 complex(real64) :: temp
    -
    571 real(real64) :: pivot
    -
    572
    -
    573 ! Process
    -
    574 pivot = real(x(1), real64)
    -
    575 i = 0
    -
    576 j = size(x) + 1
    -
    577 if (ascend) then
    -
    578 ! Ascending Sort
    -
    579 do
    -
    580 j = j - 1
    -
    581 do
    -
    582 if (real(x(j), real64) <= pivot) exit
    -
    583 j = j - 1
    -
    584 end do
    -
    585 i = i + 1
    -
    586 do
    -
    587 if (real(x(i), real64) >= pivot) exit
    -
    588 i = i + 1
    -
    589 end do
    -
    590 if (i < j) then
    -
    591 ! Exchage X(I) and X(J)
    -
    592 temp = x(i)
    -
    593 x(i) = x(j)
    -
    594 x(j) = temp
    -
    595
    -
    596 itemp = ind(i)
    -
    597 ind(i) = ind(j)
    -
    598 ind(j) = itemp
    -
    599 else if (i == j) then
    -
    600 marker = i + 1
    -
    601 return
    -
    602 else
    -
    603 marker = i
    -
    604 return
    -
    605 end if
    -
    606 end do
    -
    607 else
    -
    608 ! Descending Sort
    -
    609 do
    -
    610 j = j - 1
    -
    611 do
    -
    612 if (real(x(j), real64) >= pivot) exit
    -
    613 j = j - 1
    -
    614 end do
    -
    615 i = i + 1
    -
    616 do
    -
    617 if (real(x(i), real64) <= pivot) exit
    -
    618 i = i + 1
    -
    619 end do
    -
    620 if (i < j) then
    -
    621 ! Exchage X(I) and X(J)
    -
    622 temp = x(i)
    -
    623 x(i) = x(j)
    -
    624 x(j) = temp
    -
    625
    -
    626 itemp = ind(i)
    -
    627 ind(i) = ind(j)
    -
    628 ind(j) = itemp
    -
    629 else if (i == j) then
    -
    630 marker = i + 1
    -
    631 return
    -
    632 else
    -
    633 marker = i
    -
    634 return
    -
    635 end if
    -
    636 end do
    -
    637 end if
    -
    638 end subroutine
    -
    639
    -
    640! ------------------------------------------------------------------------------
    -
    641end submodule
    +
    89 ! Local Variables
    +
    90 logical :: dir
    +
    91
    +
    92 ! Initialization
    +
    93 if (present(ascend)) then
    +
    94 dir = ascend
    +
    95 else
    +
    96 dir = .true.
    +
    97 end if
    +
    98
    +
    99 ! Process
    +
    100 call qsort_cmplx(dir, x)
    +
    101 end subroutine
    +
    102
    +
    103! ------------------------------------------------------------------------------
    +
    104 module subroutine sort_cmplx_array_ind(x, ind, ascend, err)
    +
    105 ! Arguments
    +
    106 complex(real64), intent(inout), dimension(:) :: x
    +
    107 integer(int32), intent(inout), dimension(:) :: ind
    +
    108 logical, intent(in), optional :: ascend
    +
    109 class(errors), intent(inout), optional, target :: err
    +
    110
    +
    111 ! Local Variables
    +
    112 class(errors), pointer :: errmgr
    +
    113 type(errors), target :: deferr
    +
    114 character(len = 128) :: errmsg
    +
    115 integer(int32) :: n
    +
    116 logical :: dir
    +
    117
    +
    118 ! Initialization
    +
    119 n = size(x)
    +
    120 if (present(err)) then
    +
    121 errmgr => err
    +
    122 else
    +
    123 errmgr => deferr
    +
    124 end if
    +
    125 if (present(ascend)) then
    +
    126 dir = ascend
    +
    127 else
    +
    128 dir = .true. ! Ascend == true
    +
    129 end if
    +
    130
    +
    131 ! Input Check
    +
    132 if (size(ind) /= n) then
    +
    133 write(errmsg, 100) &
    +
    134 "Expected the tracking array to be of size ", n, &
    +
    135 ", but found an array of size ", size(ind), "."
    +
    136 call errmgr%report_error("sort_cmplx_array_ind", trim(errmsg), &
    +
    137 la_array_size_error)
    +
    138 return
    +
    139 end if
    +
    140 if (n <= 1) return
    +
    141
    +
    142 ! Process
    +
    143 call qsort_cmplx_ind(dir, x, ind)
    +
    144
    +
    145 ! Formatting
    +
    146100 format(a, i0, a, i0, a)
    +
    147 end subroutine
    +
    148
    +
    149! ------------------------------------------------------------------------------
    +
    150 module subroutine sort_eigen_cmplx(vals, vecs, ascend, err)
    +
    151 ! Arguments
    +
    152 complex(real64), intent(inout), dimension(:) :: vals
    +
    153 complex(real64), intent(inout), dimension(:,:) :: vecs
    +
    154 logical, intent(in), optional :: ascend
    +
    155 class(errors), intent(inout), optional, target :: err
    +
    156
    +
    157 ! Local Variables
    +
    158 class(errors), pointer :: errmgr
    +
    159 type(errors), target :: deferr
    +
    160 character(len = 128) :: errmsg
    +
    161 integer(int32) :: i, n, flag
    +
    162 logical :: dir
    +
    163 integer(int32), allocatable, dimension(:) :: ind
    +
    164
    +
    165 ! Initialization
    +
    166 if (present(err)) then
    +
    167 errmgr => err
    +
    168 else
    +
    169 errmgr => deferr
    +
    170 end if
    +
    171 if (present(ascend)) then
    +
    172 dir = ascend
    +
    173 else
    +
    174 dir = .true. ! Ascend == true
    +
    175 end if
    +
    176
    +
    177 ! Ensure the eigenvector matrix is sized appropriately
    +
    178 n = size(vals)
    +
    179 if (size(vecs, 1) /= n .or. size(vecs, 2) /= n) then
    +
    180 ! ARRAY SIZE ERROR
    +
    181 write(errmsg, 100) &
    +
    182 "Expected the eigenvector matrix to be of size ", n, &
    +
    183 "-by-", n, ", but found a matrix of size ", size(vecs, 1), &
    +
    184 "-by-", size(vecs, 2), "."
    +
    185 call errmgr%report_error("sort_eigen_cmplx", trim(errmsg), &
    +
    186 la_array_size_error)
    +
    187 end if
    +
    188
    +
    189 ! Allocate memory for the tracking array
    +
    190 allocate(ind(n), stat = flag)
    +
    191 if (flag /= 0) then
    +
    192 call errmgr%report_error("sort_eigen_cmplx", &
    +
    193 "Insufficient memory available.", la_out_of_memory_error)
    +
    194 return
    +
    195 end if
    +
    196 do i = 1, n
    +
    197 ind(i) = i
    +
    198 end do
    +
    199
    +
    200 ! Sort
    +
    201 call qsort_cmplx_ind(dir, vals, ind)
    +
    202
    +
    203 ! Shift the eigenvectors around to keep them associated with the
    +
    204 ! appropriate eigenvalue
    +
    205 vecs = vecs(:,ind)
    +
    206
    +
    207 ! Formatting
    +
    208100 format(a, i0, a, i0, a, i0, a, i0, a)
    +
    209 end subroutine
    +
    210
    +
    211! ------------------------------------------------------------------------------
    +
    212 module subroutine sort_eigen_dbl(vals, vecs, ascend, err)
    +
    213 ! Arguments
    +
    214 real(real64), intent(inout), dimension(:) :: vals
    +
    215 real(real64), intent(inout), dimension(:,:) :: vecs
    +
    216 logical, intent(in), optional :: ascend
    +
    217 class(errors), intent(inout), optional, target :: err
    +
    218
    +
    219 ! Local Variables
    +
    220 class(errors), pointer :: errmgr
    +
    221 type(errors), target :: deferr
    +
    222 character(len = 128) :: errmsg
    +
    223 integer(int32) :: i, n, flag
    +
    224 logical :: dir
    +
    225 integer(int32), allocatable, dimension(:) :: ind
    +
    226
    +
    227 ! Initialization
    +
    228 if (present(err)) then
    +
    229 errmgr => err
    +
    230 else
    +
    231 errmgr => deferr
    +
    232 end if
    +
    233 if (present(ascend)) then
    +
    234 dir = ascend
    +
    235 else
    +
    236 dir = .true. ! Ascend == true
    +
    237 end if
    +
    238
    +
    239 ! Ensure the eigenvector matrix is sized appropriately
    +
    240 n = size(vals)
    +
    241 if (size(vecs, 1) /= n .or. size(vecs, 2) /= n) then
    +
    242 ! ARRAY SIZE ERROR
    +
    243 write(errmsg, 100) &
    +
    244 "Expected the eigenvector matrix to be of size ", n, &
    +
    245 "-by-", n, ", but found a matrix of size ", size(vecs, 1), &
    +
    246 "-by-", size(vecs, 2), "."
    +
    247 call errmgr%report_error("sort_eigen_dbl", trim(errmsg), &
    +
    248 la_array_size_error)
    +
    249 end if
    +
    250
    +
    251 ! Allocate memory for the tracking array
    +
    252 allocate(ind(n), stat = flag)
    +
    253 if (flag /= 0) then
    +
    254 call errmgr%report_error("sort_eigen_dbl", &
    +
    255 "Insufficient memory available.", la_out_of_memory_error)
    +
    256 return
    +
    257 end if
    +
    258 do i = 1, n
    +
    259 ind(i) = i
    +
    260 end do
    +
    261
    +
    262 ! Sort
    +
    263 call qsort_dbl_ind(dir, vals, ind)
    +
    264
    +
    265 ! Shift the eigenvectors around to keep them associated with the
    +
    266 ! appropriate eigenvalue
    +
    267 vecs = vecs(:,ind)
    +
    268
    +
    269 ! Formatting
    +
    270100 format(a, i0, a, i0, a, i0, a, i0, a)
    +
    271 end subroutine
    +
    272
    +
    273! ******************************************************************************
    +
    274! PRIVATE HELPER ROUTINES
    +
    275! ------------------------------------------------------------------------------
    +
    289 recursive subroutine qsort_dbl_ind(ascend, x, ind)
    +
    290 ! Arguments
    +
    291 logical, intent(in) :: ascend
    +
    292 real(real64), intent(inout), dimension(:) :: x
    +
    293 integer(int32), intent(inout), dimension(:) :: ind
    +
    294
    +
    295 ! Local Variables
    +
    296 integer(int32) :: iq
    +
    297
    +
    298 ! Process
    +
    299 if (size(x) > 1) then
    +
    300 call dbl_partition_ind(ascend, x, ind, iq)
    +
    301 call qsort_dbl_ind(ascend, x(:iq-1), ind(:iq-1))
    +
    302 call qsort_dbl_ind(ascend, x(iq:), ind(iq:))
    +
    303 end if
    +
    304 end subroutine
    +
    305
    +
    306! ------------------------------------------------------------------------------
    +
    322 subroutine dbl_partition_ind(ascend, x, ind, marker)
    +
    323 ! Arguments
    +
    324 logical, intent(in) :: ascend
    +
    325 real(real64), intent(inout), dimension(:) :: x
    +
    326 integer(int32), intent(inout), dimension(:) :: ind
    +
    327 integer(int32), intent(out) :: marker
    +
    328
    +
    329 ! Local Variables
    +
    330 integer(int32) :: i, j, itemp
    +
    331 real(real64) :: temp, pivot
    +
    332
    +
    333 ! Process
    +
    334 pivot = x(1)
    +
    335 i = 0
    +
    336 j = size(x) + 1
    +
    337 if (ascend) then
    +
    338 ! Ascending Sort
    +
    339 do
    +
    340 j = j - 1
    +
    341 do
    +
    342 if (x(j) <= pivot) exit
    +
    343 j = j - 1
    +
    344 end do
    +
    345 i = i + 1
    +
    346 do
    +
    347 if (x(i) >= pivot) exit
    +
    348 i = i + 1
    +
    349 end do
    +
    350 if (i < j) then
    +
    351 ! Exchage X(I) and X(J)
    +
    352 temp = x(i)
    +
    353 x(i) = x(j)
    +
    354 x(j) = temp
    +
    355
    +
    356 itemp = ind(i)
    +
    357 ind(i) = ind(j)
    +
    358 ind(j) = itemp
    +
    359 else if (i == j) then
    +
    360 marker = i + 1
    +
    361 return
    +
    362 else
    +
    363 marker = i
    +
    364 return
    +
    365 end if
    +
    366 end do
    +
    367 else
    +
    368 ! Descending Sort
    +
    369 do
    +
    370 j = j - 1
    +
    371 do
    +
    372 if (x(j) >= pivot) exit
    +
    373 j = j - 1
    +
    374 end do
    +
    375 i = i + 1
    +
    376 do
    +
    377 if (x(i) <= pivot) exit
    +
    378 i = i + 1
    +
    379 end do
    +
    380 if (i < j) then
    +
    381 ! Exchage X(I) and X(J)
    +
    382 temp = x(i)
    +
    383 x(i) = x(j)
    +
    384 x(j) = temp
    +
    385
    +
    386 itemp = ind(i)
    +
    387 ind(i) = ind(j)
    +
    388 ind(j) = itemp
    +
    389 else if (i == j) then
    +
    390 marker = i + 1
    +
    391 return
    +
    392 else
    +
    393 marker = i
    +
    394 return
    +
    395 end if
    +
    396 end do
    +
    397 end if
    +
    398 end subroutine
    +
    399
    +
    400! ------------------------------------------------------------------------------
    +
    415 recursive subroutine qsort_cmplx(ascend, x)
    +
    416 ! Arguments
    +
    417 logical, intent(in) :: ascend
    +
    418 complex(real64), intent(inout), dimension(:) :: x
    +
    419
    +
    420 ! Local Variables
    +
    421 integer(int32) :: iq
    +
    422
    +
    423 ! Process
    +
    424 if (size(x) > 1) then
    +
    425 call cmplx_partition(ascend, x, iq)
    +
    426 call qsort_cmplx(ascend, x(:iq-1))
    +
    427 call qsort_cmplx(ascend, x(iq:))
    +
    428 end if
    +
    429 end subroutine
    +
    430
    +
    431! ------------------------------------------------------------------------------
    +
    448 subroutine cmplx_partition(ascend, x, marker)
    +
    449 ! Arguments
    +
    450 logical, intent(in) :: ascend
    +
    451 complex(real64), intent(inout), dimension(:) :: x
    +
    452 integer(int32), intent(out) :: marker
    +
    453
    +
    454 ! Local Variables
    +
    455 integer(int32) :: i, j
    +
    456 complex(real64) :: temp
    +
    457 real(real64) :: pivot
    +
    458
    +
    459 ! Process
    +
    460 pivot = real(x(1), real64)
    +
    461 i = 0
    +
    462 j = size(x) + 1
    +
    463 if (ascend) then
    +
    464 ! Ascending Sort
    +
    465 do
    +
    466 j = j - 1
    +
    467 do
    +
    468 if (real(x(j), real64) <= pivot) exit
    +
    469 j = j - 1
    +
    470 end do
    +
    471 i = i + 1
    +
    472 do
    +
    473 if (real(x(i), real64) >= pivot) exit
    +
    474 i = i + 1
    +
    475 end do
    +
    476 if (i < j) then
    +
    477 ! Exchage X(I) and X(J)
    +
    478 temp = x(i)
    +
    479 x(i) = x(j)
    +
    480 x(j) = temp
    +
    481 else if (i == j) then
    +
    482 marker = i + 1
    +
    483 return
    +
    484 else
    +
    485 marker = i
    +
    486 return
    +
    487 end if
    +
    488 end do
    +
    489 else
    +
    490 ! Descending Sort
    +
    491 do
    +
    492 j = j - 1
    +
    493 do
    +
    494 if (real(x(j), real64) >= pivot) exit
    +
    495 j = j - 1
    +
    496 end do
    +
    497 i = i + 1
    +
    498 do
    +
    499 if (real(x(i), real64) <= pivot) exit
    +
    500 i = i + 1
    +
    501 end do
    +
    502 if (i < j) then
    +
    503 ! Exchage X(I) and X(J)
    +
    504 temp = x(i)
    +
    505 x(i) = x(j)
    +
    506 x(j) = temp
    +
    507 else if (i == j) then
    +
    508 marker = i + 1
    +
    509 return
    +
    510 else
    +
    511 marker = i
    +
    512 return
    +
    513 end if
    +
    514 end do
    +
    515 end if
    +
    516 end subroutine
    +
    517
    +
    518! ------------------------------------------------------------------------------
    +
    536 recursive subroutine qsort_cmplx_ind(ascend, x, ind)
    +
    537 ! Arguments
    +
    538 logical, intent(in) :: ascend
    +
    539 complex(real64), intent(inout), dimension(:) :: x
    +
    540 integer(int32), intent(inout), dimension(:) :: ind
    +
    541
    +
    542 ! Local Variables
    +
    543 integer(int32) :: iq
    +
    544
    +
    545 ! Process
    +
    546 if (size(x) > 1) then
    +
    547 call cmplx_partition_ind(ascend, x, ind, iq)
    +
    548 call qsort_cmplx_ind(ascend, x(:iq-1), ind(:iq-1))
    +
    549 call qsort_cmplx_ind(ascend, x(iq:), ind(iq:))
    +
    550 end if
    +
    551 end subroutine
    +
    552
    +
    553! ------------------------------------------------------------------------------
    +
    573 subroutine cmplx_partition_ind(ascend, x, ind, marker)
    +
    574 ! Arguments
    +
    575 logical, intent(in) :: ascend
    +
    576 complex(real64), intent(inout), dimension(:) :: x
    +
    577 integer(int32), intent(inout), dimension(:) :: ind
    +
    578 integer(int32), intent(out) :: marker
    +
    579
    +
    580 ! Local Variables
    +
    581 integer(int32) :: i, j, itemp
    +
    582 complex(real64) :: temp
    +
    583 real(real64) :: pivot
    +
    584
    +
    585 ! Process
    +
    586 pivot = real(x(1), real64)
    +
    587 i = 0
    +
    588 j = size(x) + 1
    +
    589 if (ascend) then
    +
    590 ! Ascending Sort
    +
    591 do
    +
    592 j = j - 1
    +
    593 do
    +
    594 if (real(x(j), real64) <= pivot) exit
    +
    595 j = j - 1
    +
    596 end do
    +
    597 i = i + 1
    +
    598 do
    +
    599 if (real(x(i), real64) >= pivot) exit
    +
    600 i = i + 1
    +
    601 end do
    +
    602 if (i < j) then
    +
    603 ! Exchage X(I) and X(J)
    +
    604 temp = x(i)
    +
    605 x(i) = x(j)
    +
    606 x(j) = temp
    +
    607
    +
    608 itemp = ind(i)
    +
    609 ind(i) = ind(j)
    +
    610 ind(j) = itemp
    +
    611 else if (i == j) then
    +
    612 marker = i + 1
    +
    613 return
    +
    614 else
    +
    615 marker = i
    +
    616 return
    +
    617 end if
    +
    618 end do
    +
    619 else
    +
    620 ! Descending Sort
    +
    621 do
    +
    622 j = j - 1
    +
    623 do
    +
    624 if (real(x(j), real64) >= pivot) exit
    +
    625 j = j - 1
    +
    626 end do
    +
    627 i = i + 1
    +
    628 do
    +
    629 if (real(x(i), real64) <= pivot) exit
    +
    630 i = i + 1
    +
    631 end do
    +
    632 if (i < j) then
    +
    633 ! Exchage X(I) and X(J)
    +
    634 temp = x(i)
    +
    635 x(i) = x(j)
    +
    636 x(j) = temp
    +
    637
    +
    638 itemp = ind(i)
    +
    639 ind(i) = ind(j)
    +
    640 ind(j) = itemp
    +
    641 else if (i == j) then
    +
    642 marker = i + 1
    +
    643 return
    +
    644 else
    +
    645 marker = i
    +
    646 return
    +
    647 end if
    +
    648 end do
    +
    649 end if
    +
    650 end subroutine
    +
    651
    +
    652! ------------------------------------------------------------------------------
    +
    653end submodule
    Provides a set of common linear algebra routines.
    Definition: linalg.f90:15
    From 24799206cf99b88e2f72e3eddcb4730b5be26d11 Mon Sep 17 00:00:00 2001 From: jchristopherson Date: Fri, 16 Dec 2022 08:56:52 -0600 Subject: [PATCH 30/65] Code clean up --- src/linalg_basic.f90 | 65 +++++++++++++++++++++++++++++++++++--------- src/linalg_eigen.f90 | 20 +++++++++++--- 2 files changed, 68 insertions(+), 17 deletions(-) diff --git a/src/linalg_basic.f90 b/src/linalg_basic.f90 index 0029c267..adc9e8f9 100644 --- a/src/linalg_basic.f90 +++ b/src/linalg_basic.f90 @@ -63,7 +63,7 @@ module subroutine mtx_mult_mtx(transa, transb, alpha, a, b, beta, c, err) end if if (flag /= 0) then ! ERROR: Matrix dimensions mismatch - write(errmsg, '(AI0A)') & + write(errmsg, 100) & "Matrix dimension mismatch. Input number ", flag, & " was not sized correctly." call errmgr%report_error("mtx_mult_mtx", errmsg, & @@ -73,6 +73,9 @@ module subroutine mtx_mult_mtx(transa, transb, alpha, a, b, beta, c, err) ! Call DGEMM call DGEMM(ta, tb, m, n, k, alpha, a, lda, b, ldb, beta, c, m) + + ! Formatting +100 format(A, I0, A) end subroutine ! ------------------------------------------------------------------------------ @@ -120,7 +123,7 @@ module subroutine mtx_mult_vec(trans, alpha, a, b, beta, c, err) end if if (flag /= 0) then ! ERROR: Matrix dimensions mismatch - write(errmsg, '(AI0A)') & + write(errmsg, 100) & "Matrix dimension mismatch. Input number ", flag, & " was not sized correctly." call errmgr%report_error("mtx_mult_vec", errmsg, & @@ -130,6 +133,9 @@ module subroutine mtx_mult_vec(trans, alpha, a, b, beta, c, err) ! Call DGEMV call DGEMV(t, m, n, alpha, a, m, b, 1, beta, c, 1) + + ! Formatting +100 format(A, I0, A) end subroutine ! xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx ! @@ -200,7 +206,7 @@ module subroutine cmtx_mult_mtx(opa, opb, alpha, a, b, beta, c, err) end if if (flag /= 0) then ! ERROR: Matrix dimensions mismatch - write(errmsg, '(AI0A)') & + write(errmsg, 100) & "Matrix dimension mismatch. Input number ", flag, & " was not sized correctly." call errmgr%report_error("cmtx_mult_mtx", errmsg, & @@ -210,6 +216,9 @@ module subroutine cmtx_mult_mtx(opa, opb, alpha, a, b, beta, c, err) ! Call ZGEMM call ZGEMM(ta, tb, m, n, k, alpha, a, lda, b, ldb, beta, c, m) + + ! Formatting +100 format(A, I0, A) end subroutine ! ------------------------------------------------------------------------------ @@ -262,7 +271,7 @@ module subroutine cmtx_mult_vec(opa, alpha, a, b, beta, c, err) end if if (flag /= 0) then ! ERROR: Matrix dimensions mismatch - write(errmsg, '(AI0A)') & + write(errmsg, 100) & "Matrix dimension mismatch. Input number ", flag, & " was not sized correctly." call errmgr%report_error("cmtx_mult_vec", errmsg, & @@ -272,6 +281,9 @@ module subroutine cmtx_mult_vec(opa, alpha, a, b, beta, c, err) ! Call ZGEMV call ZGEMV(t, m, n, alpha, a, m, b, 1, beta, c, 1) + + ! Formatting +100 format(A, I0, A) end subroutine ! ****************************************************************************** @@ -428,7 +440,7 @@ module subroutine diag_mtx_mult_mtx(lside, trans, alpha, a, b, beta, c, err) end if if (flag /= 0) then ! ERROR: One of the input arrays is not sized correctly - write(errmsg, '(AI0A)') "Input number ", flag, & + write(errmsg, 100) "Input number ", flag, & " is not sized correctly." call errmgr%report_error("diag_mtx_mult_mtx", trim(errmsg), & LA_ARRAY_SIZE_ERROR) @@ -513,6 +525,9 @@ module subroutine diag_mtx_mult_mtx(lside, trans, alpha, a, b, beta, c, err) end if end if end if + + ! Formatting +100 format(A, I0, A) end subroutine ! ------------------------------------------------------------------------------ @@ -633,7 +648,7 @@ module subroutine diag_mtx_mult_mtx3(lside, trans, alpha, a, b, beta, c, err) end if if (flag /= 0) then ! ERROR: One of the input arrays is not sized correctly - write(errmsg, '(AI0A)') "Input number ", flag, & + write(errmsg, 100) "Input number ", flag, & " is not sized correctly." call errmgr%report_error("diag_mtx_mult_mtx3", trim(errmsg), & LA_ARRAY_SIZE_ERROR) @@ -718,6 +733,9 @@ module subroutine diag_mtx_mult_mtx3(lside, trans, alpha, a, b, beta, c, err) end if end if end if + + ! Formatting +100 format(A, I0, A) end subroutine ! ------------------------------------------------------------------------------ @@ -783,7 +801,7 @@ module subroutine diag_mtx_mult_mtx4(lside, opb, alpha, a, b, beta, c, err) end if if (flag /= 0) then ! ERROR: One of the input arrays is not sized correctly - write(errmsg, '(AI0A)') "Input number ", flag, & + write(errmsg, 100) "Input number ", flag, & " is not sized correctly." call errmgr%report_error("diag_mtx_mult_mtx4", trim(errmsg), & LA_ARRAY_SIZE_ERROR) @@ -890,6 +908,9 @@ module subroutine diag_mtx_mult_mtx4(lside, opb, alpha, a, b, beta, c, err) end if end if end if + + ! Formatting +100 format(A, I0, A) end subroutine ! ------------------------------------------------------------------------------ @@ -955,7 +976,7 @@ module subroutine diag_mtx_mult_mtx_cmplx(lside, opb, alpha, a, b, beta, c, err) end if if (flag /= 0) then ! ERROR: One of the input arrays is not sized correctly - write(errmsg, '(AI0A)') "Input number ", flag, & + write(errmsg, 100) "Input number ", flag, & " is not sized correctly." call errmgr%report_error("diag_mtx_mult_mtx_cmplx", trim(errmsg), & LA_ARRAY_SIZE_ERROR) @@ -1062,6 +1083,9 @@ module subroutine diag_mtx_mult_mtx_cmplx(lside, opb, alpha, a, b, beta, c, err) end if end if end if + + ! Formatting +100 format(A, I0, A) end subroutine ! ------------------------------------------------------------------------------ @@ -1183,7 +1207,7 @@ module subroutine diag_mtx_mult_mtx_mix(lside, opb, alpha, a, b, beta, c, err) end if if (flag /= 0) then ! ERROR: One of the input arrays is not sized correctly - write(errmsg, '(AI0A)') "Input number ", flag, & + write(errmsg, 100) "Input number ", flag, & " is not sized correctly." call errmgr%report_error("diag_mtx_mult_mtx_mix", trim(errmsg), & LA_ARRAY_SIZE_ERROR) @@ -1290,6 +1314,9 @@ module subroutine diag_mtx_mult_mtx_mix(lside, opb, alpha, a, b, beta, c, err) end if end if end if + + ! Formatting +100 format(A, I0, A) end subroutine ! ------------------------------------------------------------------------------ @@ -1477,7 +1504,7 @@ function DLAMCH(cmach) result(x) call DGESVD('N', 'N', m, n, a, m, s, dummy, m, dummy, n, w, & lwork - mn, flag) if (flag > 0) then - write(errmsg, '(I0A)') flag, " superdiagonals could not " // & + write(errmsg, 100) flag, " superdiagonals could not " // & "converge to zero as part of the QR iteration process." call errmgr%report_warning("mtx_rank", errmsg, LA_CONVERGENCE_ERROR) end if @@ -1505,6 +1532,9 @@ function DLAMCH(cmach) result(x) if (s(i) < t) exit rnk = rnk + 1 end do + + ! Formatting +100 format(I0, A) end function ! ------------------------------------------------------------------------------ @@ -1606,7 +1636,7 @@ function DLAMCH(cmach) result(x) call ZGESVD('N', 'N', m, n, a, m, s, cdummy, m, cdummy, n, wptr, & lwork - mn, rw, flag) if (flag > 0) then - write(errmsg, '(I0A)') flag, " superdiagonals could not " // & + write(errmsg, 100) flag, " superdiagonals could not " // & "converge to zero as part of the QR iteration process." call errmgr%report_warning("mtx_rank_cmplx", errmsg, LA_CONVERGENCE_ERROR) end if @@ -1634,6 +1664,9 @@ function DLAMCH(cmach) result(x) if (s(i) < t) exit rnk = rnk + 1 end do + + ! Formatting +100 format(I0, A) end function ! ------------------------------------------------------------------------------ @@ -2004,7 +2037,7 @@ module subroutine tri_mtx_mult_dbl(upper, alpha, a, beta, b, err) end if if (flag /= 0) then ! ERROR: Incorrectly sized matrix - write(errmsg, '(AI0AI0AI0AI0AI0A)') "The matrix at input ", flag, & + write(errmsg, 100) "The matrix at input ", flag, & " was not sized appropriately. A matrix of ", n, "-by-", n, & "was expected, but a matrix of ", d1, "-by-", d2, " was found." call errmgr%report_error("tri_mtx_mult_dbl", trim(errmsg), & @@ -2068,6 +2101,9 @@ module subroutine tri_mtx_mult_dbl(upper, alpha, a, beta, b, err) end do end if end if + + ! Formatting +100 format(A, I0, A, I0, A, I0, A, I0, A, I0, A) end subroutine ! ------------------------------------------------------------------------------ @@ -2111,7 +2147,7 @@ module subroutine tri_mtx_mult_cmplx(upper, alpha, a, beta, b, err) end if if (flag /= 0) then ! ERROR: Incorrectly sized matrix - write(errmsg, '(AI0AI0AI0AI0AI0A)') "The matrix at input ", flag, & + write(errmsg, 100) "The matrix at input ", flag, & " was not sized appropriately. A matrix of ", n, "-by-", n, & "was expected, but a matrix of ", d1, "-by-", d2, " was found." call errmgr%report_error("tri_mtx_mult_cmplx", trim(errmsg), & @@ -2175,6 +2211,9 @@ module subroutine tri_mtx_mult_cmplx(upper, alpha, a, beta, b, err) end do end if end if + + ! Formatting +100 format(A, I0, A, I0, A, I0, A, I0, A, I0, A) end subroutine ! ------------------------------------------------------------------------------ diff --git a/src/linalg_eigen.f90 b/src/linalg_eigen.f90 index d914644e..ea199fa7 100644 --- a/src/linalg_eigen.f90 +++ b/src/linalg_eigen.f90 @@ -48,7 +48,7 @@ module subroutine eigen_symm(vecs, a, vals, work, olwork, err) end if if (flag /= 0) then ! ERROR: One of the input arrays is not sized correctly - write(errmsg, '(AI0A)') "Input number ", flag, & + write(errmsg, 100) "Input number ", flag, & " is not sized correctly." call errmgr%report_error("eigen_symm", trim(errmsg), & LA_ARRAY_SIZE_ERROR) @@ -91,6 +91,9 @@ module subroutine eigen_symm(vecs, a, vals, work, olwork, err) call errmgr%report_error("eigen_symm", & "The algorithm failed to converge.", LA_CONVERGENCE_ERROR) end if + + ! Formatting +100 format(A, I0, A) end subroutine ! ------------------------------------------------------------------------------ @@ -149,7 +152,7 @@ module subroutine eigen_asymm(a, vals, vecs, work, olwork, err) end if if (flag /= 0) then ! ERROR: One of the input arrays is not sized correctly - write(errmsg, '(AI0A)') "Input number ", flag, & + write(errmsg, 100) "Input number ", flag, & " is not sized correctly." call errmgr%report_error("eigen_asymm", trim(errmsg), & LA_ARRAY_SIZE_ERROR) @@ -264,6 +267,9 @@ module subroutine eigen_asymm(a, vals, vecs, work, olwork, err) vals(i) = cmplx(wr(i), wi(i), real64) end do end if + + ! Formatting +100 format(A, I0, A) end subroutine ! ------------------------------------------------------------------------------ @@ -326,7 +332,7 @@ module subroutine eigen_gen(a, b, alpha, beta, vecs, work, olwork, err) end if if (flag /= 0) then ! ERROR: One of the input arrays is not sized correctly - write(errmsg, '(AI0A)') "Input number ", flag, & + write(errmsg, 100) "Input number ", flag, & " is not sized correctly." call errmgr%report_error("eigen_gen", trim(errmsg), & LA_ARRAY_SIZE_ERROR) @@ -459,6 +465,9 @@ module subroutine eigen_gen(a, b, alpha, beta, vecs, work, olwork, err) end do if (.not.present(beta)) alpha = alpha / bptr end if + + ! Formatting +100 format(A, I0, A) end subroutine ! ------------------------------------------------------------------------------ @@ -513,7 +522,7 @@ module subroutine eigen_cmplx(a, vals, vecs, work, olwork, rwork, err) end if if (flag /= 0) then ! ERROR: One of the input arrays is not sized correctly - write(errmsg, '(AI0A)') "Input number ", flag, & + write(errmsg, 100) "Input number ", flag, & " is not sized correctly." call errmgr%report_error("eigen_cmplx", trim(errmsg), & LA_ARRAY_SIZE_ERROR) @@ -587,6 +596,9 @@ module subroutine eigen_cmplx(a, vals, vecs, work, olwork, rwork, err) LA_CONVERGENCE_ERROR) return end if + + ! Formatting +100 format(A, I0, A) end subroutine ! ------------------------------------------------------------------------------ From 22bff4bb1bb526cb4dedf4e253f6ccd7eaa3082f Mon Sep 17 00:00:00 2001 From: jchristopherson Date: Fri, 16 Dec 2022 09:06:22 -0600 Subject: [PATCH 31/65] Update readme --- README.md | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/README.md b/README.md index 113cd0fc..776a489e 100644 --- a/README.md +++ b/README.md @@ -10,7 +10,7 @@ This example solves a normally defined system of 3 equations of 3 unknowns. ```fortran program example use iso_fortran_env - use linalg_core + use linalg implicit none ! Local Variables @@ -61,7 +61,7 @@ This example solves an overdefined system of 3 equations of 2 uknowns. ```fortran program example use iso_fortran_env - use linalg_core + use linalg implicit none ! Local Variables @@ -120,7 +120,7 @@ This example computes the eigenvalues and eigenvectors of a mechanical system co ! Notice: x1" = the second time derivative of x1. program example use iso_fortran_env - use linalg_core + use linalg implicit none ! Define the model parameters From 9017bc621475081e01b6f5f4e4f0ffb37d3ee167 Mon Sep 17 00:00:00 2001 From: jchristopherson Date: Fri, 16 Dec 2022 14:00:31 -0600 Subject: [PATCH 32/65] Bug fix --- CMakeLists.txt | 2 -- src/linalg_factor.f90 | 6 +++--- src/linalg_solve.f90 | 10 +++++----- 3 files changed, 8 insertions(+), 10 deletions(-) diff --git a/CMakeLists.txt b/CMakeLists.txt index f9e52e08..1c3b6ed9 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -21,8 +21,6 @@ find_package(LAPACK) find_package(ferror 1.4.0 QUIET) add_subdirectory(dependencies) -# print_all_variables() - # Source add_subdirectory(src) add_fortran_library( diff --git a/src/linalg_factor.f90 b/src/linalg_factor.f90 index 7ffa1845..465a67b4 100644 --- a/src/linalg_factor.f90 +++ b/src/linalg_factor.f90 @@ -2838,13 +2838,13 @@ module subroutine svd_cmplx(a, s, u, vt, work, olwork, rwork, err) rwptr, flag) else if (present(u) .and. .not.present(vt)) then call ZGESVD(jobu, jobvt, m, n, a, m, s, u, m, temp, n, wptr, & - rwptr, lwork, flag) + lwork, rwptr, flag) else if (.not.present(u) .and. present(vt)) then call ZGESVD(jobu, jobvt, m, n, a, m, s, temp, m, vt, n, wptr, & - rwptr, lwork, flag) + lwork, rwptr, flag) else call ZGESVD(jobu, jobvt, m, n, a, m, s, temp, m, temp, n, wptr, & - rwptr, lwork, flag) + lwork, rwptr, flag) end if ! Check for convergence diff --git a/src/linalg_solve.f90 b/src/linalg_solve.f90 index d7b105a8..f362a8bd 100644 --- a/src/linalg_solve.f90 +++ b/src/linalg_solve.f90 @@ -1630,7 +1630,7 @@ module subroutine mtx_inverse_dbl(a, iwork, work, olwork, err) class(errors), intent(inout), optional, target :: err ! Local Variables - integer(int32) :: n, liwork, lwork, istat, flag + integer(int32) :: n, liwork, lwork, istat, flag, itemp(1) integer(int32), pointer, dimension(:) :: iptr integer(int32), allocatable, target, dimension(:) :: iwrk real(real64), pointer, dimension(:) :: wptr @@ -1656,7 +1656,7 @@ module subroutine mtx_inverse_dbl(a, iwork, work, olwork, err) end if ! Workspace Query - call DGETRI(n, a, n, istat, temp, -1, flag) + call DGETRI(n, a, n, itemp, temp, -1, flag) lwork = int(temp(1), int32) if (present(olwork)) then olwork = lwork @@ -1731,7 +1731,7 @@ module subroutine mtx_inverse_cmplx(a, iwork, work, olwork, err) class(errors), intent(inout), optional, target :: err ! Local Variables - integer(int32) :: n, liwork, lwork, istat, flag + integer(int32) :: n, liwork, lwork, istat, flag, itemp(1) integer(int32), pointer, dimension(:) :: iptr integer(int32), allocatable, target, dimension(:) :: iwrk complex(real64), pointer, dimension(:) :: wptr @@ -1757,7 +1757,7 @@ module subroutine mtx_inverse_cmplx(a, iwork, work, olwork, err) end if ! Workspace Query - call ZGETRI(n, a, n, istat, temp, -1, flag) + call ZGETRI(n, a, n, itemp, temp, -1, flag) lwork = int(temp(1), int32) if (present(olwork)) then olwork = lwork @@ -2035,7 +2035,7 @@ function DLAMCH(cmach) result(x) end if ! Workspace Query - call ZGESVD('S', 'A', m, n, a, m, a(1:mn,:), a, m, a, n, temp, -1, & + call ZGESVD('S', 'A', m, n, a, m, rtemp, a, m, a, n, temp, -1, & rtemp, flag) lwork = int(temp(1), int32) lwork = lwork + m * mn + n * n From 3be45ed86fe25adc4f170d862f776ece5eaae47b Mon Sep 17 00:00:00 2001 From: jchristopherson Date: Fri, 16 Dec 2022 14:07:18 -0600 Subject: [PATCH 33/65] Update examples --- CMakeLists.txt | 7 ++- examples/CMakeLists.txt | 6 --- examples/linalg_cholesky_downdate_example.f90 | 2 +- examples/linalg_cholesky_example.f90 | 2 +- examples/linalg_cholesky_update_example.f90 | 2 +- examples/linalg_eigen_example.f90 | 2 +- examples/linalg_inverse_example.f90 | 2 +- examples/linalg_lu_example.f90 | 2 +- examples/linalg_lu_example_immutable.f90 | 43 ------------------- examples/linalg_lu_full_example.f90 | 2 +- examples/linalg_od_example.f90 | 2 +- examples/linalg_pinverse_example.f90 | 2 +- examples/linalg_qr_example.f90 | 2 +- examples/linalg_qr_full_example.f90 | 2 +- examples/linalg_qr_mult_example.f90 | 2 +- examples/linalg_qr_update_example.f90 | 2 +- examples/linalg_svd_example.f90 | 2 +- 17 files changed, 20 insertions(+), 64 deletions(-) delete mode 100644 examples/linalg_lu_example_immutable.f90 diff --git a/CMakeLists.txt b/CMakeLists.txt index 1c3b6ed9..2aad2d42 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -45,4 +45,9 @@ if (BUILD_TESTING) add_subdirectory(tests) endif() -# Examples \ No newline at end of file +# Examples +option(BUILD_LINALG_EXAMPLES "Build examples") +message(STATUS "Build LINALG examples: ${BUILD_LINALG_EXAMPLES}") +if (BUILD_LINALG_EXAMPLES) + add_subdirectory(examples) +endif() \ No newline at end of file diff --git a/examples/CMakeLists.txt b/examples/CMakeLists.txt index aa44b23c..879a0363 100644 --- a/examples/CMakeLists.txt +++ b/examples/CMakeLists.txt @@ -54,12 +54,6 @@ target_link_libraries(pinverse_example linalg) add_executable(svd_example linalg_svd_example.f90) target_link_libraries(svd_example linalg) -# -------------------- -# Immutable LU Example -add_executable(lu_example_immutable linalg_lu_example_immutable.f90) -target_link_libraries(lu_example_immutable linalg) - - # -------------------- # C API Eigenvalue Example include_directories(${PROJECT_SOURCE_DIR}/include) diff --git a/examples/linalg_cholesky_downdate_example.f90 b/examples/linalg_cholesky_downdate_example.f90 index f97509fd..452b1669 100644 --- a/examples/linalg_cholesky_downdate_example.f90 +++ b/examples/linalg_cholesky_downdate_example.f90 @@ -2,7 +2,7 @@ program example use iso_fortran_env, only : real64, int32 - use linalg_core + use linalg implicit none ! Variables diff --git a/examples/linalg_cholesky_example.f90 b/examples/linalg_cholesky_example.f90 index 184a6afd..bf080bbb 100644 --- a/examples/linalg_cholesky_example.f90 +++ b/examples/linalg_cholesky_example.f90 @@ -2,7 +2,7 @@ program example use iso_fortran_env, only : real64, int32 - use linalg_core + use linalg implicit none ! Variables diff --git a/examples/linalg_cholesky_update_example.f90 b/examples/linalg_cholesky_update_example.f90 index 2d095b2e..60946d6c 100644 --- a/examples/linalg_cholesky_update_example.f90 +++ b/examples/linalg_cholesky_update_example.f90 @@ -2,7 +2,7 @@ program example use iso_fortran_env, only : real64, int32 - use linalg_core + use linalg implicit none ! Variables diff --git a/examples/linalg_eigen_example.f90 b/examples/linalg_eigen_example.f90 index 71456952..1a8ca4b1 100644 --- a/examples/linalg_eigen_example.f90 +++ b/examples/linalg_eigen_example.f90 @@ -17,7 +17,7 @@ ! Notice: x1" = the second time derivative of x1. program example use iso_fortran_env, only : real64, int32 - use linalg_core + use linalg implicit none ! Define the model parameters diff --git a/examples/linalg_inverse_example.f90 b/examples/linalg_inverse_example.f90 index 17f7b021..61595b8d 100644 --- a/examples/linalg_inverse_example.f90 +++ b/examples/linalg_inverse_example.f90 @@ -2,7 +2,7 @@ program example use iso_fortran_env, only : real64, int32 - use linalg_core + use linalg implicit none ! Variables diff --git a/examples/linalg_lu_example.f90 b/examples/linalg_lu_example.f90 index e55c4a41..299502f8 100644 --- a/examples/linalg_lu_example.f90 +++ b/examples/linalg_lu_example.f90 @@ -4,7 +4,7 @@ ! https://www.mathworks.com/help/matlab/ref/lu.html?s_tid=srchtitle program example use iso_fortran_env, only : real64, int32 - use linalg_core + use linalg implicit none ! Local Variables diff --git a/examples/linalg_lu_example_immutable.f90 b/examples/linalg_lu_example_immutable.f90 deleted file mode 100644 index a666ca91..00000000 --- a/examples/linalg_lu_example_immutable.f90 +++ /dev/null @@ -1,43 +0,0 @@ -! linalg_lu_example_immutable.f90 - -program example - use iso_fortran_env - use linalg_immutable - - ! Local Variables - type(lu_results) :: lu - real(real64) :: a(3,3), b(3), pb(3), y(3), x(3) - - ! Build the 3-by-3 matrix A - ! | 1 2 3 | - ! A = | 4 5 6 | - ! | 7 8 0 | - a = reshape( & - [1.0d0, 4.0d0, 7.0d0, 2.0d0, 5.0d0, 8.0d0, 3.0d0, 6.0d0, 0.0d0], & - [3, 3]) - - ! Compute the LU factorization - lu = mat_lu(a) - - ! Build the right-hand-side vector B. - ! | -1 | - ! b = | -2 | - ! | -3 | - b = [-1.0d0, -2.0d0, -3.0d0] - - ! Apply the row pivots (P * B) - pb = matmul(lu%p, b) - - ! Compute the solution to the lower triangular problem L Y = P B, for Y - y = mat_solve_lower_tri(lu%l, pb) - - ! Compute the solution to the upper triangular problem U X = Y - x = mat_solve_upper_tri(lu%u, y) - - ! The solution is: - ! | 1/3 | - ! x = | -2/3 | - ! | 0 | - print '(A)', "LU Solution: X = " - print '(F8.4)', (x(i), i = 1, size(x)) -end program diff --git a/examples/linalg_lu_full_example.f90 b/examples/linalg_lu_full_example.f90 index 3dde96de..0a944a64 100644 --- a/examples/linalg_lu_full_example.f90 +++ b/examples/linalg_lu_full_example.f90 @@ -2,7 +2,7 @@ program example use iso_fortran_env, only : real64, int32 - use linalg_core + use linalg implicit none ! Variables diff --git a/examples/linalg_od_example.f90 b/examples/linalg_od_example.f90 index 07bc2650..f56eea08 100644 --- a/examples/linalg_od_example.f90 +++ b/examples/linalg_od_example.f90 @@ -3,7 +3,7 @@ ! Example Source: https://en.wikipedia.org/wiki/Overdetermined_system program example use iso_fortran_env, only : real64, int32 - use linalg_core + use linalg implicit none ! Local Variables diff --git a/examples/linalg_pinverse_example.f90 b/examples/linalg_pinverse_example.f90 index 1576bc68..b48a1517 100644 --- a/examples/linalg_pinverse_example.f90 +++ b/examples/linalg_pinverse_example.f90 @@ -2,7 +2,7 @@ program example use iso_fortran_env, only : int32, real64 - use linalg_core + use linalg implicit none ! Variables diff --git a/examples/linalg_qr_example.f90 b/examples/linalg_qr_example.f90 index e65f6a8d..edd551b2 100644 --- a/examples/linalg_qr_example.f90 +++ b/examples/linalg_qr_example.f90 @@ -7,7 +7,7 @@ ! instead. program example use iso_fortran_env, only : real64, int32 - use linalg_core + use linalg implicit none ! Local Variables diff --git a/examples/linalg_qr_full_example.f90 b/examples/linalg_qr_full_example.f90 index e714649b..dff26abf 100644 --- a/examples/linalg_qr_full_example.f90 +++ b/examples/linalg_qr_full_example.f90 @@ -2,7 +2,7 @@ program example use iso_fortran_env, only : real64, int32 - use linalg_core + use linalg implicit none ! Variables diff --git a/examples/linalg_qr_mult_example.f90 b/examples/linalg_qr_mult_example.f90 index 52650059..178967ac 100644 --- a/examples/linalg_qr_mult_example.f90 +++ b/examples/linalg_qr_mult_example.f90 @@ -2,7 +2,7 @@ program example use iso_fortran_env, only : real64, int32 - use linalg_core + use linalg implicit none ! Variables diff --git a/examples/linalg_qr_update_example.f90 b/examples/linalg_qr_update_example.f90 index 40829ebd..27d5b65c 100644 --- a/examples/linalg_qr_update_example.f90 +++ b/examples/linalg_qr_update_example.f90 @@ -2,7 +2,7 @@ program example use iso_fortran_env - use linalg_core + use linalg implicit none ! Variables diff --git a/examples/linalg_svd_example.f90 b/examples/linalg_svd_example.f90 index 151efeb5..aedb11d6 100644 --- a/examples/linalg_svd_example.f90 +++ b/examples/linalg_svd_example.f90 @@ -2,7 +2,7 @@ program example use iso_fortran_env, only : int32, real64 - use linalg_core + use linalg implicit none ! Variables From 268c42bce2d579b6adcfc3862932ca30f4c915cd Mon Sep 17 00:00:00 2001 From: jchristopherson Date: Fri, 16 Dec 2022 14:10:13 -0600 Subject: [PATCH 34/65] Update documentation --- doc/C Doxyfile | 2769 ++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 2769 insertions(+) create mode 100644 doc/C Doxyfile diff --git a/doc/C Doxyfile b/doc/C Doxyfile new file mode 100644 index 00000000..2c09a9ca --- /dev/null +++ b/doc/C Doxyfile @@ -0,0 +1,2769 @@ +# Doxyfile 1.9.5 + +# This file describes the settings to be used by the documentation system +# doxygen (www.doxygen.org) for a project. +# +# All text after a double hash (##) is considered a comment and is placed in +# front of the TAG it is preceding. +# +# All text after a single hash (#) is considered a comment and will be ignored. +# The format is: +# TAG = value [value, ...] +# For lists, items can also be appended using: +# TAG += value [value, ...] +# Values that contain spaces should be placed between quotes (\" \"). +# +# Note: +# +# Use doxygen to compare the used configuration file with the template +# configuration file: +# doxygen -x [configFile] +# Use doxygen to compare the used configuration file with the template +# configuration file without replacing the environment variables or CMake type +# replacement variables: +# doxygen -x_noenv [configFile] + +#--------------------------------------------------------------------------- +# Project related configuration options +#--------------------------------------------------------------------------- + +# This tag specifies the encoding used for all characters in the configuration +# file that follow. The default is UTF-8 which is also the encoding used for all +# text before the first occurrence of this tag. Doxygen uses libiconv (or the +# iconv built into libc) for the transcoding. See +# https://www.gnu.org/software/libiconv/ for the list of possible encodings. +# The default value is: UTF-8. + +DOXYFILE_ENCODING = UTF-8 + +# The PROJECT_NAME tag is a single word (or a sequence of words surrounded by +# double-quotes, unless you are using Doxywizard) that should identify the +# project for which the documentation is generated. This name is used in the +# title of most generated pages and in a few other places. +# The default value is: My Project. + +PROJECT_NAME = linalg + +# The PROJECT_NUMBER tag can be used to enter a project or revision number. This +# could be handy for archiving the generated documentation or if some version +# control system is used. + +PROJECT_NUMBER = 1.6.1 + +# Using the PROJECT_BRIEF tag one can provide an optional one line description +# for a project that appears at the top of each page and should give viewer a +# quick idea about the purpose of the project. Keep the description short. + +PROJECT_BRIEF = "A linear algebra library that provides a user-friendly interface to several BLAS and LAPACK routines." + +# With the PROJECT_LOGO tag one can specify a logo or an icon that is included +# in the documentation. The maximum height of the logo should not exceed 55 +# pixels and the maximum width should not exceed 200 pixels. Doxygen will copy +# the logo to the output directory. + +PROJECT_LOGO = + +# The OUTPUT_DIRECTORY tag is used to specify the (relative or absolute) path +# into which the generated documentation will be written. If a relative path is +# entered, it will be relative to the location where doxygen was started. If +# left blank the current directory will be used. + +OUTPUT_DIRECTORY = "C" + +# If the CREATE_SUBDIRS tag is set to YES then doxygen will create up to 4096 +# sub-directories (in 2 levels) under the output directory of each output format +# and will distribute the generated files over these directories. Enabling this +# option can be useful when feeding doxygen a huge amount of source files, where +# putting all generated files in the same directory would otherwise causes +# performance problems for the file system. Adapt CREATE_SUBDIRS_LEVEL to +# control the number of sub-directories. +# The default value is: NO. + +CREATE_SUBDIRS = NO + +# Controls the number of sub-directories that will be created when +# CREATE_SUBDIRS tag is set to YES. Level 0 represents 16 directories, and every +# level increment doubles the number of directories, resulting in 4096 +# directories at level 8 which is the default and also the maximum value. The +# sub-directories are organized in 2 levels, the first level always has a fixed +# numer of 16 directories. +# Minimum value: 0, maximum value: 8, default value: 8. +# This tag requires that the tag CREATE_SUBDIRS is set to YES. + +CREATE_SUBDIRS_LEVEL = 8 + +# If the ALLOW_UNICODE_NAMES tag is set to YES, doxygen will allow non-ASCII +# characters to appear in the names of generated files. If set to NO, non-ASCII +# characters will be escaped, for example _xE3_x81_x84 will be used for Unicode +# U+3044. +# The default value is: NO. + +ALLOW_UNICODE_NAMES = NO + +# The OUTPUT_LANGUAGE tag is used to specify the language in which all +# documentation generated by doxygen is written. Doxygen will use this +# information to generate all constant output in the proper language. +# Possible values are: Afrikaans, Arabic, Armenian, Brazilian, Bulgarian, +# Catalan, Chinese, Chinese-Traditional, Croatian, Czech, Danish, Dutch, English +# (United States), Esperanto, Farsi (Persian), Finnish, French, German, Greek, +# Hindi, Hungarian, Indonesian, Italian, Japanese, Japanese-en (Japanese with +# English messages), Korean, Korean-en (Korean with English messages), Latvian, +# Lithuanian, Macedonian, Norwegian, Persian (Farsi), Polish, Portuguese, +# Romanian, Russian, Serbian, Serbian-Cyrillic, Slovak, Slovene, Spanish, +# Swedish, Turkish, Ukrainian and Vietnamese. +# The default value is: English. + +OUTPUT_LANGUAGE = English + +# If the BRIEF_MEMBER_DESC tag is set to YES, doxygen will include brief member +# descriptions after the members that are listed in the file and class +# documentation (similar to Javadoc). Set to NO to disable this. +# The default value is: YES. + +BRIEF_MEMBER_DESC = YES + +# If the REPEAT_BRIEF tag is set to YES, doxygen will prepend the brief +# description of a member or function before the detailed description +# +# Note: If both HIDE_UNDOC_MEMBERS and BRIEF_MEMBER_DESC are set to NO, the +# brief descriptions will be completely suppressed. +# The default value is: YES. + +REPEAT_BRIEF = YES + +# This tag implements a quasi-intelligent brief description abbreviator that is +# used to form the text in various listings. Each string in this list, if found +# as the leading text of the brief description, will be stripped from the text +# and the result, after processing the whole list, is used as the annotated +# text. Otherwise, the brief description is used as-is. If left blank, the +# following values are used ($name is automatically replaced with the name of +# the entity):The $name class, The $name widget, The $name file, is, provides, +# specifies, contains, represents, a, an and the. + +ABBREVIATE_BRIEF = "The $name class" \ + "The $name widget" \ + "The $name file" \ + is \ + provides \ + specifies \ + contains \ + represents \ + a \ + an \ + the + +# If the ALWAYS_DETAILED_SEC and REPEAT_BRIEF tags are both set to YES then +# doxygen will generate a detailed section even if there is only a brief +# description. +# The default value is: NO. + +ALWAYS_DETAILED_SEC = NO + +# If the INLINE_INHERITED_MEMB tag is set to YES, doxygen will show all +# inherited members of a class in the documentation of that class as if those +# members were ordinary class members. Constructors, destructors and assignment +# operators of the base classes will not be shown. +# The default value is: NO. + +INLINE_INHERITED_MEMB = NO + +# If the FULL_PATH_NAMES tag is set to YES, doxygen will prepend the full path +# before files name in the file list and in the header files. If set to NO the +# shortest path that makes the file name unique will be used +# The default value is: YES. + +FULL_PATH_NAMES = YES + +# The STRIP_FROM_PATH tag can be used to strip a user-defined part of the path. +# Stripping is only done if one of the specified strings matches the left-hand +# part of the path. The tag can be used to show relative paths in the file list. +# If left blank the directory from which doxygen is run is used as the path to +# strip. +# +# Note that you can specify absolute paths here, but also relative paths, which +# will be relative from the directory where doxygen is started. +# This tag requires that the tag FULL_PATH_NAMES is set to YES. + +STRIP_FROM_PATH = + +# The STRIP_FROM_INC_PATH tag can be used to strip a user-defined part of the +# path mentioned in the documentation of a class, which tells the reader which +# header file to include in order to use a class. If left blank only the name of +# the header file containing the class definition is used. Otherwise one should +# specify the list of include paths that are normally passed to the compiler +# using the -I flag. + +STRIP_FROM_INC_PATH = + +# If the SHORT_NAMES tag is set to YES, doxygen will generate much shorter (but +# less readable) file names. This can be useful is your file systems doesn't +# support long names like on DOS, Mac, or CD-ROM. +# The default value is: NO. + +SHORT_NAMES = NO + +# If the JAVADOC_AUTOBRIEF tag is set to YES then doxygen will interpret the +# first line (until the first dot) of a Javadoc-style comment as the brief +# description. If set to NO, the Javadoc-style will behave just like regular Qt- +# style comments (thus requiring an explicit @brief command for a brief +# description.) +# The default value is: NO. + +JAVADOC_AUTOBRIEF = NO + +# If the JAVADOC_BANNER tag is set to YES then doxygen will interpret a line +# such as +# /*************** +# as being the beginning of a Javadoc-style comment "banner". If set to NO, the +# Javadoc-style will behave just like regular comments and it will not be +# interpreted by doxygen. +# The default value is: NO. + +JAVADOC_BANNER = NO + +# If the QT_AUTOBRIEF tag is set to YES then doxygen will interpret the first +# line (until the first dot) of a Qt-style comment as the brief description. If +# set to NO, the Qt-style will behave just like regular Qt-style comments (thus +# requiring an explicit \brief command for a brief description.) +# The default value is: NO. + +QT_AUTOBRIEF = NO + +# The MULTILINE_CPP_IS_BRIEF tag can be set to YES to make doxygen treat a +# multi-line C++ special comment block (i.e. a block of //! or /// comments) as +# a brief description. This used to be the default behavior. The new default is +# to treat a multi-line C++ comment block as a detailed description. Set this +# tag to YES if you prefer the old behavior instead. +# +# Note that setting this tag to YES also means that rational rose comments are +# not recognized any more. +# The default value is: NO. + +MULTILINE_CPP_IS_BRIEF = NO + +# By default Python docstrings are displayed as preformatted text and doxygen's +# special commands cannot be used. By setting PYTHON_DOCSTRING to NO the +# doxygen's special commands can be used and the contents of the docstring +# documentation blocks is shown as doxygen documentation. +# The default value is: YES. + +PYTHON_DOCSTRING = YES + +# If the INHERIT_DOCS tag is set to YES then an undocumented member inherits the +# documentation from any documented member that it re-implements. +# The default value is: YES. + +INHERIT_DOCS = YES + +# If the SEPARATE_MEMBER_PAGES tag is set to YES then doxygen will produce a new +# page for each member. If set to NO, the documentation of a member will be part +# of the file/class/namespace that contains it. +# The default value is: NO. + +SEPARATE_MEMBER_PAGES = NO + +# The TAB_SIZE tag can be used to set the number of spaces in a tab. Doxygen +# uses this value to replace tabs by spaces in code fragments. +# Minimum value: 1, maximum value: 16, default value: 4. + +TAB_SIZE = 4 + +# This tag can be used to specify a number of aliases that act as commands in +# the documentation. An alias has the form: +# name=value +# For example adding +# "sideeffect=@par Side Effects:^^" +# will allow you to put the command \sideeffect (or @sideeffect) in the +# documentation, which will result in a user-defined paragraph with heading +# "Side Effects:". Note that you cannot put \n's in the value part of an alias +# to insert newlines (in the resulting output). You can put ^^ in the value part +# of an alias to insert a newline as if a physical newline was in the original +# file. When you need a literal { or } or , in the value part of an alias you +# have to escape them by means of a backslash (\), this can lead to conflicts +# with the commands \{ and \} for these it is advised to use the version @{ and +# @} or use a double escape (\\{ and \\}) + +ALIASES = + +# Set the OPTIMIZE_OUTPUT_FOR_C tag to YES if your project consists of C sources +# only. Doxygen will then generate output that is more tailored for C. For +# instance, some of the names that are used will be different. The list of all +# members will be omitted, etc. +# The default value is: NO. + +OPTIMIZE_OUTPUT_FOR_C = YES + +# Set the OPTIMIZE_OUTPUT_JAVA tag to YES if your project consists of Java or +# Python sources only. Doxygen will then generate output that is more tailored +# for that language. For instance, namespaces will be presented as packages, +# qualified scopes will look different, etc. +# The default value is: NO. + +OPTIMIZE_OUTPUT_JAVA = NO + +# Set the OPTIMIZE_FOR_FORTRAN tag to YES if your project consists of Fortran +# sources. Doxygen will then generate output that is tailored for Fortran. +# The default value is: NO. + +OPTIMIZE_FOR_FORTRAN = NO + +# Set the OPTIMIZE_OUTPUT_VHDL tag to YES if your project consists of VHDL +# sources. Doxygen will then generate output that is tailored for VHDL. +# The default value is: NO. + +OPTIMIZE_OUTPUT_VHDL = NO + +# Set the OPTIMIZE_OUTPUT_SLICE tag to YES if your project consists of Slice +# sources only. Doxygen will then generate output that is more tailored for that +# language. For instance, namespaces will be presented as modules, types will be +# separated into more groups, etc. +# The default value is: NO. + +OPTIMIZE_OUTPUT_SLICE = NO + +# Doxygen selects the parser to use depending on the extension of the files it +# parses. With this tag you can assign which parser to use for a given +# extension. Doxygen has a built-in mapping, but you can override or extend it +# using this tag. The format is ext=language, where ext is a file extension, and +# language is one of the parsers supported by doxygen: IDL, Java, JavaScript, +# Csharp (C#), C, C++, Lex, D, PHP, md (Markdown), Objective-C, Python, Slice, +# VHDL, Fortran (fixed format Fortran: FortranFixed, free formatted Fortran: +# FortranFree, unknown formatted Fortran: Fortran. In the later case the parser +# tries to guess whether the code is fixed or free formatted code, this is the +# default for Fortran type files). For instance to make doxygen treat .inc files +# as Fortran files (default is PHP), and .f files as C (default is Fortran), +# use: inc=Fortran f=C. +# +# Note: For files without extension you can use no_extension as a placeholder. +# +# Note that for custom extensions you also need to set FILE_PATTERNS otherwise +# the files are not read by doxygen. When specifying no_extension you should add +# * to the FILE_PATTERNS. +# +# Note see also the list of default file extension mappings. + +EXTENSION_MAPPING = + +# If the MARKDOWN_SUPPORT tag is enabled then doxygen pre-processes all comments +# according to the Markdown format, which allows for more readable +# documentation. See https://daringfireball.net/projects/markdown/ for details. +# The output of markdown processing is further processed by doxygen, so you can +# mix doxygen, HTML, and XML commands with Markdown formatting. Disable only in +# case of backward compatibilities issues. +# The default value is: YES. + +MARKDOWN_SUPPORT = YES + +# When the TOC_INCLUDE_HEADINGS tag is set to a non-zero value, all headings up +# to that level are automatically included in the table of contents, even if +# they do not have an id attribute. +# Note: This feature currently applies only to Markdown headings. +# Minimum value: 0, maximum value: 99, default value: 5. +# This tag requires that the tag MARKDOWN_SUPPORT is set to YES. + +TOC_INCLUDE_HEADINGS = 5 + +# When enabled doxygen tries to link words that correspond to documented +# classes, or namespaces to their corresponding documentation. Such a link can +# be prevented in individual cases by putting a % sign in front of the word or +# globally by setting AUTOLINK_SUPPORT to NO. +# The default value is: YES. + +AUTOLINK_SUPPORT = YES + +# If you use STL classes (i.e. std::string, std::vector, etc.) but do not want +# to include (a tag file for) the STL sources as input, then you should set this +# tag to YES in order to let doxygen match functions declarations and +# definitions whose arguments contain STL classes (e.g. func(std::string); +# versus func(std::string) {}). This also make the inheritance and collaboration +# diagrams that involve STL classes more complete and accurate. +# The default value is: NO. + +BUILTIN_STL_SUPPORT = NO + +# If you use Microsoft's C++/CLI language, you should set this option to YES to +# enable parsing support. +# The default value is: NO. + +CPP_CLI_SUPPORT = NO + +# Set the SIP_SUPPORT tag to YES if your project consists of sip (see: +# https://www.riverbankcomputing.com/software/sip/intro) sources only. Doxygen +# will parse them like normal C++ but will assume all classes use public instead +# of private inheritance when no explicit protection keyword is present. +# The default value is: NO. + +SIP_SUPPORT = NO + +# For Microsoft's IDL there are propget and propput attributes to indicate +# getter and setter methods for a property. Setting this option to YES will make +# doxygen to replace the get and set methods by a property in the documentation. +# This will only work if the methods are indeed getting or setting a simple +# type. If this is not the case, or you want to show the methods anyway, you +# should set this option to NO. +# The default value is: YES. + +IDL_PROPERTY_SUPPORT = YES + +# If member grouping is used in the documentation and the DISTRIBUTE_GROUP_DOC +# tag is set to YES then doxygen will reuse the documentation of the first +# member in the group (if any) for the other members of the group. By default +# all members of a group must be documented explicitly. +# The default value is: NO. + +DISTRIBUTE_GROUP_DOC = NO + +# If one adds a struct or class to a group and this option is enabled, then also +# any nested class or struct is added to the same group. By default this option +# is disabled and one has to add nested compounds explicitly via \ingroup. +# The default value is: NO. + +GROUP_NESTED_COMPOUNDS = NO + +# Set the SUBGROUPING tag to YES to allow class member groups of the same type +# (for instance a group of public functions) to be put as a subgroup of that +# type (e.g. under the Public Functions section). Set it to NO to prevent +# subgrouping. Alternatively, this can be done per class using the +# \nosubgrouping command. +# The default value is: YES. + +SUBGROUPING = YES + +# When the INLINE_GROUPED_CLASSES tag is set to YES, classes, structs and unions +# are shown inside the group in which they are included (e.g. using \ingroup) +# instead of on a separate page (for HTML and Man pages) or section (for LaTeX +# and RTF). +# +# Note that this feature does not work in combination with +# SEPARATE_MEMBER_PAGES. +# The default value is: NO. + +INLINE_GROUPED_CLASSES = NO + +# When the INLINE_SIMPLE_STRUCTS tag is set to YES, structs, classes, and unions +# with only public data fields or simple typedef fields will be shown inline in +# the documentation of the scope in which they are defined (i.e. file, +# namespace, or group documentation), provided this scope is documented. If set +# to NO, structs, classes, and unions are shown on a separate page (for HTML and +# Man pages) or section (for LaTeX and RTF). +# The default value is: NO. + +INLINE_SIMPLE_STRUCTS = NO + +# When TYPEDEF_HIDES_STRUCT tag is enabled, a typedef of a struct, union, or +# enum is documented as struct, union, or enum with the name of the typedef. So +# typedef struct TypeS {} TypeT, will appear in the documentation as a struct +# with name TypeT. When disabled the typedef will appear as a member of a file, +# namespace, or class. And the struct will be named TypeS. This can typically be +# useful for C code in case the coding convention dictates that all compound +# types are typedef'ed and only the typedef is referenced, never the tag name. +# The default value is: NO. + +TYPEDEF_HIDES_STRUCT = NO + +# The size of the symbol lookup cache can be set using LOOKUP_CACHE_SIZE. This +# cache is used to resolve symbols given their name and scope. Since this can be +# an expensive process and often the same symbol appears multiple times in the +# code, doxygen keeps a cache of pre-resolved symbols. If the cache is too small +# doxygen will become slower. If the cache is too large, memory is wasted. The +# cache size is given by this formula: 2^(16+LOOKUP_CACHE_SIZE). The valid range +# is 0..9, the default is 0, corresponding to a cache size of 2^16=65536 +# symbols. At the end of a run doxygen will report the cache usage and suggest +# the optimal cache size from a speed point of view. +# Minimum value: 0, maximum value: 9, default value: 0. + +LOOKUP_CACHE_SIZE = 0 + +# The NUM_PROC_THREADS specifies the number of threads doxygen is allowed to use +# during processing. When set to 0 doxygen will based this on the number of +# cores available in the system. You can set it explicitly to a value larger +# than 0 to get more control over the balance between CPU load and processing +# speed. At this moment only the input processing can be done using multiple +# threads. Since this is still an experimental feature the default is set to 1, +# which effectively disables parallel processing. Please report any issues you +# encounter. Generating dot graphs in parallel is controlled by the +# DOT_NUM_THREADS setting. +# Minimum value: 0, maximum value: 32, default value: 1. + +NUM_PROC_THREADS = 1 + +#--------------------------------------------------------------------------- +# Build related configuration options +#--------------------------------------------------------------------------- + +# If the EXTRACT_ALL tag is set to YES, doxygen will assume all entities in +# documentation are documented, even if no documentation was available. Private +# class members and static file members will be hidden unless the +# EXTRACT_PRIVATE respectively EXTRACT_STATIC tags are set to YES. +# Note: This will also disable the warnings about undocumented members that are +# normally produced when WARNINGS is set to YES. +# The default value is: NO. + +EXTRACT_ALL = NO + +# If the EXTRACT_PRIVATE tag is set to YES, all private members of a class will +# be included in the documentation. +# The default value is: NO. + +EXTRACT_PRIVATE = NO + +# If the EXTRACT_PRIV_VIRTUAL tag is set to YES, documented private virtual +# methods of a class will be included in the documentation. +# The default value is: NO. + +EXTRACT_PRIV_VIRTUAL = NO + +# If the EXTRACT_PACKAGE tag is set to YES, all members with package or internal +# scope will be included in the documentation. +# The default value is: NO. + +EXTRACT_PACKAGE = NO + +# If the EXTRACT_STATIC tag is set to YES, all static members of a file will be +# included in the documentation. +# The default value is: NO. + +EXTRACT_STATIC = NO + +# If the EXTRACT_LOCAL_CLASSES tag is set to YES, classes (and structs) defined +# locally in source files will be included in the documentation. If set to NO, +# only classes defined in header files are included. Does not have any effect +# for Java sources. +# The default value is: YES. + +EXTRACT_LOCAL_CLASSES = YES + +# This flag is only useful for Objective-C code. If set to YES, local methods, +# which are defined in the implementation section but not in the interface are +# included in the documentation. If set to NO, only methods in the interface are +# included. +# The default value is: NO. + +EXTRACT_LOCAL_METHODS = NO + +# If this flag is set to YES, the members of anonymous namespaces will be +# extracted and appear in the documentation as a namespace called +# 'anonymous_namespace{file}', where file will be replaced with the base name of +# the file that contains the anonymous namespace. By default anonymous namespace +# are hidden. +# The default value is: NO. + +EXTRACT_ANON_NSPACES = NO + +# If this flag is set to YES, the name of an unnamed parameter in a declaration +# will be determined by the corresponding definition. By default unnamed +# parameters remain unnamed in the output. +# The default value is: YES. + +RESOLVE_UNNAMED_PARAMS = YES + +# If the HIDE_UNDOC_MEMBERS tag is set to YES, doxygen will hide all +# undocumented members inside documented classes or files. If set to NO these +# members will be included in the various overviews, but no documentation +# section is generated. This option has no effect if EXTRACT_ALL is enabled. +# The default value is: NO. + +HIDE_UNDOC_MEMBERS = NO + +# If the HIDE_UNDOC_CLASSES tag is set to YES, doxygen will hide all +# undocumented classes that are normally visible in the class hierarchy. If set +# to NO, these classes will be included in the various overviews. This option +# has no effect if EXTRACT_ALL is enabled. +# The default value is: NO. + +HIDE_UNDOC_CLASSES = NO + +# If the HIDE_FRIEND_COMPOUNDS tag is set to YES, doxygen will hide all friend +# declarations. If set to NO, these declarations will be included in the +# documentation. +# The default value is: NO. + +HIDE_FRIEND_COMPOUNDS = NO + +# If the HIDE_IN_BODY_DOCS tag is set to YES, doxygen will hide any +# documentation blocks found inside the body of a function. If set to NO, these +# blocks will be appended to the function's detailed documentation block. +# The default value is: NO. + +HIDE_IN_BODY_DOCS = NO + +# The INTERNAL_DOCS tag determines if documentation that is typed after a +# \internal command is included. If the tag is set to NO then the documentation +# will be excluded. Set it to YES to include the internal documentation. +# The default value is: NO. + +INTERNAL_DOCS = NO + +# With the correct setting of option CASE_SENSE_NAMES doxygen will better be +# able to match the capabilities of the underlying filesystem. In case the +# filesystem is case sensitive (i.e. it supports files in the same directory +# whose names only differ in casing), the option must be set to YES to properly +# deal with such files in case they appear in the input. For filesystems that +# are not case sensitive the option should be set to NO to properly deal with +# output files written for symbols that only differ in casing, such as for two +# classes, one named CLASS and the other named Class, and to also support +# references to files without having to specify the exact matching casing. On +# Windows (including Cygwin) and MacOS, users should typically set this option +# to NO, whereas on Linux or other Unix flavors it should typically be set to +# YES. +# Possible values are: SYSTEM, NO and YES. +# The default value is: SYSTEM. + +CASE_SENSE_NAMES = SYSTEM + +# If the HIDE_SCOPE_NAMES tag is set to NO then doxygen will show members with +# their full class and namespace scopes in the documentation. If set to YES, the +# scope will be hidden. +# The default value is: NO. + +HIDE_SCOPE_NAMES = NO + +# If the HIDE_COMPOUND_REFERENCE tag is set to NO (default) then doxygen will +# append additional text to a page's title, such as Class Reference. If set to +# YES the compound reference will be hidden. +# The default value is: NO. + +HIDE_COMPOUND_REFERENCE= NO + +# If the SHOW_HEADERFILE tag is set to YES then the documentation for a class +# will show which file needs to be included to use the class. +# The default value is: YES. + +SHOW_HEADERFILE = YES + +# If the SHOW_INCLUDE_FILES tag is set to YES then doxygen will put a list of +# the files that are included by a file in the documentation of that file. +# The default value is: YES. + +SHOW_INCLUDE_FILES = YES + +# If the SHOW_GROUPED_MEMB_INC tag is set to YES then Doxygen will add for each +# grouped member an include statement to the documentation, telling the reader +# which file to include in order to use the member. +# The default value is: NO. + +SHOW_GROUPED_MEMB_INC = NO + +# If the FORCE_LOCAL_INCLUDES tag is set to YES then doxygen will list include +# files with double quotes in the documentation rather than with sharp brackets. +# The default value is: NO. + +FORCE_LOCAL_INCLUDES = NO + +# If the INLINE_INFO tag is set to YES then a tag [inline] is inserted in the +# documentation for inline members. +# The default value is: YES. + +INLINE_INFO = YES + +# If the SORT_MEMBER_DOCS tag is set to YES then doxygen will sort the +# (detailed) documentation of file and class members alphabetically by member +# name. If set to NO, the members will appear in declaration order. +# The default value is: YES. + +SORT_MEMBER_DOCS = YES + +# If the SORT_BRIEF_DOCS tag is set to YES then doxygen will sort the brief +# descriptions of file, namespace and class members alphabetically by member +# name. If set to NO, the members will appear in declaration order. Note that +# this will also influence the order of the classes in the class list. +# The default value is: NO. + +SORT_BRIEF_DOCS = NO + +# If the SORT_MEMBERS_CTORS_1ST tag is set to YES then doxygen will sort the +# (brief and detailed) documentation of class members so that constructors and +# destructors are listed first. If set to NO the constructors will appear in the +# respective orders defined by SORT_BRIEF_DOCS and SORT_MEMBER_DOCS. +# Note: If SORT_BRIEF_DOCS is set to NO this option is ignored for sorting brief +# member documentation. +# Note: If SORT_MEMBER_DOCS is set to NO this option is ignored for sorting +# detailed member documentation. +# The default value is: NO. + +SORT_MEMBERS_CTORS_1ST = NO + +# If the SORT_GROUP_NAMES tag is set to YES then doxygen will sort the hierarchy +# of group names into alphabetical order. If set to NO the group names will +# appear in their defined order. +# The default value is: NO. + +SORT_GROUP_NAMES = NO + +# If the SORT_BY_SCOPE_NAME tag is set to YES, the class list will be sorted by +# fully-qualified names, including namespaces. If set to NO, the class list will +# be sorted only by class name, not including the namespace part. +# Note: This option is not very useful if HIDE_SCOPE_NAMES is set to YES. +# Note: This option applies only to the class list, not to the alphabetical +# list. +# The default value is: NO. + +SORT_BY_SCOPE_NAME = NO + +# If the STRICT_PROTO_MATCHING option is enabled and doxygen fails to do proper +# type resolution of all parameters of a function it will reject a match between +# the prototype and the implementation of a member function even if there is +# only one candidate or it is obvious which candidate to choose by doing a +# simple string match. By disabling STRICT_PROTO_MATCHING doxygen will still +# accept a match between prototype and implementation in such cases. +# The default value is: NO. + +STRICT_PROTO_MATCHING = NO + +# The GENERATE_TODOLIST tag can be used to enable (YES) or disable (NO) the todo +# list. This list is created by putting \todo commands in the documentation. +# The default value is: YES. + +GENERATE_TODOLIST = YES + +# The GENERATE_TESTLIST tag can be used to enable (YES) or disable (NO) the test +# list. This list is created by putting \test commands in the documentation. +# The default value is: YES. + +GENERATE_TESTLIST = YES + +# The GENERATE_BUGLIST tag can be used to enable (YES) or disable (NO) the bug +# list. This list is created by putting \bug commands in the documentation. +# The default value is: YES. + +GENERATE_BUGLIST = YES + +# The GENERATE_DEPRECATEDLIST tag can be used to enable (YES) or disable (NO) +# the deprecated list. This list is created by putting \deprecated commands in +# the documentation. +# The default value is: YES. + +GENERATE_DEPRECATEDLIST= YES + +# The ENABLED_SECTIONS tag can be used to enable conditional documentation +# sections, marked by \if ... \endif and \cond +# ... \endcond blocks. + +ENABLED_SECTIONS = + +# The MAX_INITIALIZER_LINES tag determines the maximum number of lines that the +# initial value of a variable or macro / define can have for it to appear in the +# documentation. If the initializer consists of more lines than specified here +# it will be hidden. Use a value of 0 to hide initializers completely. The +# appearance of the value of individual variables and macros / defines can be +# controlled using \showinitializer or \hideinitializer command in the +# documentation regardless of this setting. +# Minimum value: 0, maximum value: 10000, default value: 30. + +MAX_INITIALIZER_LINES = 30 + +# Set the SHOW_USED_FILES tag to NO to disable the list of files generated at +# the bottom of the documentation of classes and structs. If set to YES, the +# list will mention the files that were used to generate the documentation. +# The default value is: YES. + +SHOW_USED_FILES = YES + +# Set the SHOW_FILES tag to NO to disable the generation of the Files page. This +# will remove the Files entry from the Quick Index and from the Folder Tree View +# (if specified). +# The default value is: YES. + +SHOW_FILES = YES + +# Set the SHOW_NAMESPACES tag to NO to disable the generation of the Namespaces +# page. This will remove the Namespaces entry from the Quick Index and from the +# Folder Tree View (if specified). +# The default value is: YES. + +SHOW_NAMESPACES = YES + +# The FILE_VERSION_FILTER tag can be used to specify a program or script that +# doxygen should invoke to get the current version for each file (typically from +# the version control system). Doxygen will invoke the program by executing (via +# popen()) the command command input-file, where command is the value of the +# FILE_VERSION_FILTER tag, and input-file is the name of an input file provided +# by doxygen. Whatever the program writes to standard output is used as the file +# version. For an example see the documentation. + +FILE_VERSION_FILTER = + +# The LAYOUT_FILE tag can be used to specify a layout file which will be parsed +# by doxygen. The layout file controls the global structure of the generated +# output files in an output format independent way. To create the layout file +# that represents doxygen's defaults, run doxygen with the -l option. You can +# optionally specify a file name after the option, if omitted DoxygenLayout.xml +# will be used as the name of the layout file. See also section "Changing the +# layout of pages" for information. +# +# Note that if you run doxygen from a directory containing a file called +# DoxygenLayout.xml, doxygen will parse it automatically even if the LAYOUT_FILE +# tag is left empty. + +LAYOUT_FILE = + +# The CITE_BIB_FILES tag can be used to specify one or more bib files containing +# the reference definitions. This must be a list of .bib files. The .bib +# extension is automatically appended if omitted. This requires the bibtex tool +# to be installed. See also https://en.wikipedia.org/wiki/BibTeX for more info. +# For LaTeX the style of the bibliography can be controlled using +# LATEX_BIB_STYLE. To use this feature you need bibtex and perl available in the +# search path. See also \cite for info how to create references. + +CITE_BIB_FILES = + +#--------------------------------------------------------------------------- +# Configuration options related to warning and progress messages +#--------------------------------------------------------------------------- + +# The QUIET tag can be used to turn on/off the messages that are generated to +# standard output by doxygen. If QUIET is set to YES this implies that the +# messages are off. +# The default value is: NO. + +QUIET = NO + +# The WARNINGS tag can be used to turn on/off the warning messages that are +# generated to standard error (stderr) by doxygen. If WARNINGS is set to YES +# this implies that the warnings are on. +# +# Tip: Turn warnings on while writing the documentation. +# The default value is: YES. + +WARNINGS = YES + +# If the WARN_IF_UNDOCUMENTED tag is set to YES then doxygen will generate +# warnings for undocumented members. If EXTRACT_ALL is set to YES then this flag +# will automatically be disabled. +# The default value is: YES. + +WARN_IF_UNDOCUMENTED = YES + +# If the WARN_IF_DOC_ERROR tag is set to YES, doxygen will generate warnings for +# potential errors in the documentation, such as documenting some parameters in +# a documented function twice, or documenting parameters that don't exist or +# using markup commands wrongly. +# The default value is: YES. + +WARN_IF_DOC_ERROR = YES + +# If WARN_IF_INCOMPLETE_DOC is set to YES, doxygen will warn about incomplete +# function parameter documentation. If set to NO, doxygen will accept that some +# parameters have no documentation without warning. +# The default value is: YES. + +WARN_IF_INCOMPLETE_DOC = YES + +# This WARN_NO_PARAMDOC option can be enabled to get warnings for functions that +# are documented, but have no documentation for their parameters or return +# value. If set to NO, doxygen will only warn about wrong parameter +# documentation, but not about the absence of documentation. If EXTRACT_ALL is +# set to YES then this flag will automatically be disabled. See also +# WARN_IF_INCOMPLETE_DOC +# The default value is: NO. + +WARN_NO_PARAMDOC = NO + +# If the WARN_AS_ERROR tag is set to YES then doxygen will immediately stop when +# a warning is encountered. If the WARN_AS_ERROR tag is set to FAIL_ON_WARNINGS +# then doxygen will continue running as if WARN_AS_ERROR tag is set to NO, but +# at the end of the doxygen process doxygen will return with a non-zero status. +# Possible values are: NO, YES and FAIL_ON_WARNINGS. +# The default value is: NO. + +WARN_AS_ERROR = NO + +# The WARN_FORMAT tag determines the format of the warning messages that doxygen +# can produce. The string should contain the $file, $line, and $text tags, which +# will be replaced by the file and line number from which the warning originated +# and the warning text. Optionally the format may contain $version, which will +# be replaced by the version of the file (if it could be obtained via +# FILE_VERSION_FILTER) +# See also: WARN_LINE_FORMAT +# The default value is: $file:$line: $text. + +WARN_FORMAT = "$file:$line: $text" + +# In the $text part of the WARN_FORMAT command it is possible that a reference +# to a more specific place is given. To make it easier to jump to this place +# (outside of doxygen) the user can define a custom "cut" / "paste" string. +# Example: +# WARN_LINE_FORMAT = "'vi $file +$line'" +# See also: WARN_FORMAT +# The default value is: at line $line of file $file. + +WARN_LINE_FORMAT = "at line $line of file $file" + +# The WARN_LOGFILE tag can be used to specify a file to which warning and error +# messages should be written. If left blank the output is written to standard +# error (stderr). In case the file specified cannot be opened for writing the +# warning and error messages are written to standard error. When as file - is +# specified the warning and error messages are written to standard output +# (stdout). + +WARN_LOGFILE = + +#--------------------------------------------------------------------------- +# Configuration options related to the input files +#--------------------------------------------------------------------------- + +# The INPUT tag is used to specify the files and/or directories that contain +# documented source files. You may enter file names like myfile.cpp or +# directories like /usr/src/myproject. Separate the files or directories with +# spaces. See also FILE_PATTERNS and EXTENSION_MAPPING +# Note: If this tag is empty the current directory is searched. + +INPUT = ../include + +# This tag can be used to specify the character encoding of the source files +# that doxygen parses. Internally doxygen uses the UTF-8 encoding. Doxygen uses +# libiconv (or the iconv built into libc) for the transcoding. See the libiconv +# documentation (see: +# https://www.gnu.org/software/libiconv/) for the list of possible encodings. +# See also: INPUT_FILE_ENCODING +# The default value is: UTF-8. + +INPUT_ENCODING = UTF-8 + +# This tag can be used to specify the character encoding of the source files +# that doxygen parses The INPUT_FILE_ENCODING tag can be used to specify +# character encoding on a per file pattern basis. Doxygen will compare the file +# name with each pattern and apply the encoding instead of the default +# INPUT_ENCODING) if there is a match. The character encodings are a list of the +# form: pattern=encoding (like *.php=ISO-8859-1). See cfg_input_encoding +# "INPUT_ENCODING" for further information on supported encodings. + +INPUT_FILE_ENCODING = + +# If the value of the INPUT tag contains directories, you can use the +# FILE_PATTERNS tag to specify one or more wildcard patterns (like *.cpp and +# *.h) to filter out the source-files in the directories. +# +# Note that for custom extensions or not directly supported extensions you also +# need to set EXTENSION_MAPPING for the extension otherwise the files are not +# read by doxygen. +# +# Note the list of default checked file patterns might differ from the list of +# default file extension mappings. +# +# If left blank the following patterns are tested:*.c, *.cc, *.cxx, *.cpp, +# *.c++, *.java, *.ii, *.ixx, *.ipp, *.i++, *.inl, *.idl, *.ddl, *.odl, *.h, +# *.hh, *.hxx, *.hpp, *.h++, *.l, *.cs, *.d, *.php, *.php4, *.php5, *.phtml, +# *.inc, *.m, *.markdown, *.md, *.mm, *.dox (to be provided as doxygen C +# comment), *.py, *.pyw, *.f90, *.f95, *.f03, *.f08, *.f18, *.f, *.for, *.vhd, +# *.vhdl, *.ucf, *.qsf and *.ice. + +FILE_PATTERNS = *.c \ + *.cc \ + *.cxx \ + *.cpp \ + *.c++ \ + *.java \ + *.ii \ + *.ixx \ + *.ipp \ + *.i++ \ + *.inl \ + *.idl \ + *.ddl \ + *.odl \ + *.h \ + *.hh \ + *.hxx \ + *.hpp \ + *.h++ \ + *.l \ + *.cs \ + *.d \ + *.php \ + *.php4 \ + *.php5 \ + *.phtml \ + *.inc \ + *.m \ + *.markdown \ + *.md \ + *.mm \ + *.dox \ + *.py \ + *.pyw \ + *.f90 \ + *.f95 \ + *.f03 \ + *.f08 \ + *.f18 \ + *.f \ + *.for \ + *.vhd \ + *.vhdl \ + *.ucf \ + *.qsf \ + *.ice + +# The RECURSIVE tag can be used to specify whether or not subdirectories should +# be searched for input files as well. +# The default value is: NO. + +RECURSIVE = YES + +# The EXCLUDE tag can be used to specify files and/or directories that should be +# excluded from the INPUT source files. This way you can easily exclude a +# subdirectory from a directory tree whose root is specified with the INPUT tag. +# +# Note that relative paths are relative to the directory from which doxygen is +# run. + +EXCLUDE = + +# The EXCLUDE_SYMLINKS tag can be used to select whether or not files or +# directories that are symbolic links (a Unix file system feature) are excluded +# from the input. +# The default value is: NO. + +EXCLUDE_SYMLINKS = NO + +# If the value of the INPUT tag contains directories, you can use the +# EXCLUDE_PATTERNS tag to specify one or more wildcard patterns to exclude +# certain files from those directories. +# +# Note that the wildcards are matched against the file with absolute path, so to +# exclude all test directories for example use the pattern */test/* + +EXCLUDE_PATTERNS = + +# The EXCLUDE_SYMBOLS tag can be used to specify one or more symbol names +# (namespaces, classes, functions, etc.) that should be excluded from the +# output. The symbol name can be a fully qualified name, a word, or if the +# wildcard * is used, a substring. Examples: ANamespace, AClass, +# ANamespace::AClass, ANamespace::*Test +# +# Note that the wildcards are matched against the file with absolute path, so to +# exclude all test directories use the pattern */test/* + +EXCLUDE_SYMBOLS = + +# The EXAMPLE_PATH tag can be used to specify one or more files or directories +# that contain example code fragments that are included (see the \include +# command). + +EXAMPLE_PATH = + +# If the value of the EXAMPLE_PATH tag contains directories, you can use the +# EXAMPLE_PATTERNS tag to specify one or more wildcard pattern (like *.cpp and +# *.h) to filter out the source-files in the directories. If left blank all +# files are included. + +EXAMPLE_PATTERNS = * + +# If the EXAMPLE_RECURSIVE tag is set to YES then subdirectories will be +# searched for input files to be used with the \include or \dontinclude commands +# irrespective of the value of the RECURSIVE tag. +# The default value is: NO. + +EXAMPLE_RECURSIVE = NO + +# The IMAGE_PATH tag can be used to specify one or more files or directories +# that contain images that are to be included in the documentation (see the +# \image command). + +IMAGE_PATH = + +# The INPUT_FILTER tag can be used to specify a program that doxygen should +# invoke to filter for each input file. Doxygen will invoke the filter program +# by executing (via popen()) the command: +# +# +# +# where is the value of the INPUT_FILTER tag, and is the +# name of an input file. Doxygen will then use the output that the filter +# program writes to standard output. If FILTER_PATTERNS is specified, this tag +# will be ignored. +# +# Note that the filter must not add or remove lines; it is applied before the +# code is scanned, but not when the output code is generated. If lines are added +# or removed, the anchors will not be placed correctly. +# +# Note that doxygen will use the data processed and written to standard output +# for further processing, therefore nothing else, like debug statements or used +# commands (so in case of a Windows batch file always use @echo OFF), should be +# written to standard output. +# +# Note that for custom extensions or not directly supported extensions you also +# need to set EXTENSION_MAPPING for the extension otherwise the files are not +# properly processed by doxygen. + +INPUT_FILTER = + +# The FILTER_PATTERNS tag can be used to specify filters on a per file pattern +# basis. Doxygen will compare the file name with each pattern and apply the +# filter if there is a match. The filters are a list of the form: pattern=filter +# (like *.cpp=my_cpp_filter). See INPUT_FILTER for further information on how +# filters are used. If the FILTER_PATTERNS tag is empty or if none of the +# patterns match the file name, INPUT_FILTER is applied. +# +# Note that for custom extensions or not directly supported extensions you also +# need to set EXTENSION_MAPPING for the extension otherwise the files are not +# properly processed by doxygen. + +FILTER_PATTERNS = + +# If the FILTER_SOURCE_FILES tag is set to YES, the input filter (if set using +# INPUT_FILTER) will also be used to filter the input files that are used for +# producing the source files to browse (i.e. when SOURCE_BROWSER is set to YES). +# The default value is: NO. + +FILTER_SOURCE_FILES = NO + +# The FILTER_SOURCE_PATTERNS tag can be used to specify source filters per file +# pattern. A pattern will override the setting for FILTER_PATTERN (if any) and +# it is also possible to disable source filtering for a specific pattern using +# *.ext= (so without naming a filter). +# This tag requires that the tag FILTER_SOURCE_FILES is set to YES. + +FILTER_SOURCE_PATTERNS = + +# If the USE_MDFILE_AS_MAINPAGE tag refers to the name of a markdown file that +# is part of the input, its contents will be placed on the main page +# (index.html). This can be useful if you have a project on for instance GitHub +# and want to reuse the introduction page also for the doxygen output. + +USE_MDFILE_AS_MAINPAGE = + +# The Fortran standard specifies that for fixed formatted Fortran code all +# characters from position 72 are to be considered as comment. A common +# extension is to allow longer lines before the automatic comment starts. The +# setting FORTRAN_COMMENT_AFTER will also make it possible that longer lines can +# be processed before the automatic comment starts. +# Minimum value: 7, maximum value: 10000, default value: 72. + +FORTRAN_COMMENT_AFTER = 72 + +#--------------------------------------------------------------------------- +# Configuration options related to source browsing +#--------------------------------------------------------------------------- + +# If the SOURCE_BROWSER tag is set to YES then a list of source files will be +# generated. Documented entities will be cross-referenced with these sources. +# +# Note: To get rid of all source code in the generated output, make sure that +# also VERBATIM_HEADERS is set to NO. +# The default value is: NO. + +SOURCE_BROWSER = NO + +# Setting the INLINE_SOURCES tag to YES will include the body of functions, +# classes and enums directly into the documentation. +# The default value is: NO. + +INLINE_SOURCES = NO + +# Setting the STRIP_CODE_COMMENTS tag to YES will instruct doxygen to hide any +# special comment blocks from generated source code fragments. Normal C, C++ and +# Fortran comments will always remain visible. +# The default value is: YES. + +STRIP_CODE_COMMENTS = YES + +# If the REFERENCED_BY_RELATION tag is set to YES then for each documented +# entity all documented functions referencing it will be listed. +# The default value is: NO. + +REFERENCED_BY_RELATION = NO + +# If the REFERENCES_RELATION tag is set to YES then for each documented function +# all documented entities called/used by that function will be listed. +# The default value is: NO. + +REFERENCES_RELATION = NO + +# If the REFERENCES_LINK_SOURCE tag is set to YES and SOURCE_BROWSER tag is set +# to YES then the hyperlinks from functions in REFERENCES_RELATION and +# REFERENCED_BY_RELATION lists will link to the source code. Otherwise they will +# link to the documentation. +# The default value is: YES. + +REFERENCES_LINK_SOURCE = YES + +# If SOURCE_TOOLTIPS is enabled (the default) then hovering a hyperlink in the +# source code will show a tooltip with additional information such as prototype, +# brief description and links to the definition and documentation. Since this +# will make the HTML file larger and loading of large files a bit slower, you +# can opt to disable this feature. +# The default value is: YES. +# This tag requires that the tag SOURCE_BROWSER is set to YES. + +SOURCE_TOOLTIPS = YES + +# If the USE_HTAGS tag is set to YES then the references to source code will +# point to the HTML generated by the htags(1) tool instead of doxygen built-in +# source browser. The htags tool is part of GNU's global source tagging system +# (see https://www.gnu.org/software/global/global.html). You will need version +# 4.8.6 or higher. +# +# To use it do the following: +# - Install the latest version of global +# - Enable SOURCE_BROWSER and USE_HTAGS in the configuration file +# - Make sure the INPUT points to the root of the source tree +# - Run doxygen as normal +# +# Doxygen will invoke htags (and that will in turn invoke gtags), so these +# tools must be available from the command line (i.e. in the search path). +# +# The result: instead of the source browser generated by doxygen, the links to +# source code will now point to the output of htags. +# The default value is: NO. +# This tag requires that the tag SOURCE_BROWSER is set to YES. + +USE_HTAGS = NO + +# If the VERBATIM_HEADERS tag is set the YES then doxygen will generate a +# verbatim copy of the header file for each class for which an include is +# specified. Set to NO to disable this. +# See also: Section \class. +# The default value is: YES. + +VERBATIM_HEADERS = YES + +# If the CLANG_ASSISTED_PARSING tag is set to YES then doxygen will use the +# clang parser (see: +# http://clang.llvm.org/) for more accurate parsing at the cost of reduced +# performance. This can be particularly helpful with template rich C++ code for +# which doxygen's built-in parser lacks the necessary type information. +# Note: The availability of this option depends on whether or not doxygen was +# generated with the -Duse_libclang=ON option for CMake. +# The default value is: NO. + +CLANG_ASSISTED_PARSING = NO + +# If the CLANG_ASSISTED_PARSING tag is set to YES and the CLANG_ADD_INC_PATHS +# tag is set to YES then doxygen will add the directory of each input to the +# include path. +# The default value is: YES. +# This tag requires that the tag CLANG_ASSISTED_PARSING is set to YES. + +CLANG_ADD_INC_PATHS = YES + +# If clang assisted parsing is enabled you can provide the compiler with command +# line options that you would normally use when invoking the compiler. Note that +# the include paths will already be set by doxygen for the files and directories +# specified with INPUT and INCLUDE_PATH. +# This tag requires that the tag CLANG_ASSISTED_PARSING is set to YES. + +CLANG_OPTIONS = + +# If clang assisted parsing is enabled you can provide the clang parser with the +# path to the directory containing a file called compile_commands.json. This +# file is the compilation database (see: +# http://clang.llvm.org/docs/HowToSetupToolingForLLVM.html) containing the +# options used when the source files were built. This is equivalent to +# specifying the -p option to a clang tool, such as clang-check. These options +# will then be passed to the parser. Any options specified with CLANG_OPTIONS +# will be added as well. +# Note: The availability of this option depends on whether or not doxygen was +# generated with the -Duse_libclang=ON option for CMake. + +CLANG_DATABASE_PATH = + +#--------------------------------------------------------------------------- +# Configuration options related to the alphabetical class index +#--------------------------------------------------------------------------- + +# If the ALPHABETICAL_INDEX tag is set to YES, an alphabetical index of all +# compounds will be generated. Enable this if the project contains a lot of +# classes, structs, unions or interfaces. +# The default value is: YES. + +ALPHABETICAL_INDEX = YES + +# In case all classes in a project start with a common prefix, all classes will +# be put under the same header in the alphabetical index. The IGNORE_PREFIX tag +# can be used to specify a prefix (or a list of prefixes) that should be ignored +# while generating the index headers. +# This tag requires that the tag ALPHABETICAL_INDEX is set to YES. + +IGNORE_PREFIX = + +#--------------------------------------------------------------------------- +# Configuration options related to the HTML output +#--------------------------------------------------------------------------- + +# If the GENERATE_HTML tag is set to YES, doxygen will generate HTML output +# The default value is: YES. + +GENERATE_HTML = YES + +# The HTML_OUTPUT tag is used to specify where the HTML docs will be put. If a +# relative path is entered the value of OUTPUT_DIRECTORY will be put in front of +# it. +# The default directory is: html. +# This tag requires that the tag GENERATE_HTML is set to YES. + +HTML_OUTPUT = html + +# The HTML_FILE_EXTENSION tag can be used to specify the file extension for each +# generated HTML page (for example: .htm, .php, .asp). +# The default value is: .html. +# This tag requires that the tag GENERATE_HTML is set to YES. + +HTML_FILE_EXTENSION = .html + +# The HTML_HEADER tag can be used to specify a user-defined HTML header file for +# each generated HTML page. If the tag is left blank doxygen will generate a +# standard header. +# +# To get valid HTML the header file that includes any scripts and style sheets +# that doxygen needs, which is dependent on the configuration options used (e.g. +# the setting GENERATE_TREEVIEW). It is highly recommended to start with a +# default header using +# doxygen -w html new_header.html new_footer.html new_stylesheet.css +# YourConfigFile +# and then modify the file new_header.html. See also section "Doxygen usage" +# for information on how to generate the default header that doxygen normally +# uses. +# Note: The header is subject to change so you typically have to regenerate the +# default header when upgrading to a newer version of doxygen. For a description +# of the possible markers and block names see the documentation. +# This tag requires that the tag GENERATE_HTML is set to YES. + +HTML_HEADER = + +# The HTML_FOOTER tag can be used to specify a user-defined HTML footer for each +# generated HTML page. If the tag is left blank doxygen will generate a standard +# footer. See HTML_HEADER for more information on how to generate a default +# footer and what special commands can be used inside the footer. See also +# section "Doxygen usage" for information on how to generate the default footer +# that doxygen normally uses. +# This tag requires that the tag GENERATE_HTML is set to YES. + +HTML_FOOTER = + +# The HTML_STYLESHEET tag can be used to specify a user-defined cascading style +# sheet that is used by each HTML page. It can be used to fine-tune the look of +# the HTML output. If left blank doxygen will generate a default style sheet. +# See also section "Doxygen usage" for information on how to generate the style +# sheet that doxygen normally uses. +# Note: It is recommended to use HTML_EXTRA_STYLESHEET instead of this tag, as +# it is more robust and this tag (HTML_STYLESHEET) will in the future become +# obsolete. +# This tag requires that the tag GENERATE_HTML is set to YES. + +HTML_STYLESHEET = + +# The HTML_EXTRA_STYLESHEET tag can be used to specify additional user-defined +# cascading style sheets that are included after the standard style sheets +# created by doxygen. Using this option one can overrule certain style aspects. +# This is preferred over using HTML_STYLESHEET since it does not replace the +# standard style sheet and is therefore more robust against future updates. +# Doxygen will copy the style sheet files to the output directory. +# Note: The order of the extra style sheet files is of importance (e.g. the last +# style sheet in the list overrules the setting of the previous ones in the +# list). For an example see the documentation. +# This tag requires that the tag GENERATE_HTML is set to YES. + +HTML_EXTRA_STYLESHEET = + +# The HTML_EXTRA_FILES tag can be used to specify one or more extra images or +# other source files which should be copied to the HTML output directory. Note +# that these files will be copied to the base HTML output directory. Use the +# $relpath^ marker in the HTML_HEADER and/or HTML_FOOTER files to load these +# files. In the HTML_STYLESHEET file, use the file name only. Also note that the +# files will be copied as-is; there are no commands or markers available. +# This tag requires that the tag GENERATE_HTML is set to YES. + +HTML_EXTRA_FILES = + +# The HTML_COLORSTYLE tag can be used to specify if the generated HTML output +# should be rendered with a dark or light theme. Default setting AUTO_LIGHT +# enables light output unless the user preference is dark output. Other options +# are DARK to always use dark mode, LIGHT to always use light mode, AUTO_DARK to +# default to dark mode unless the user prefers light mode, and TOGGLE to let the +# user toggle between dark and light mode via a button. +# Possible values are: LIGHT Always generate light output., DARK Always generate +# dark output., AUTO_LIGHT Automatically set the mode according to the user +# preference, use light mode if no preference is set (the default)., AUTO_DARK +# Automatically set the mode according to the user preference, use dark mode if +# no preference is set. and TOGGLE Allow to user to switch between light and +# dark mode via a button.. +# The default value is: AUTO_LIGHT. +# This tag requires that the tag GENERATE_HTML is set to YES. + +HTML_COLORSTYLE = AUTO_LIGHT + +# The HTML_COLORSTYLE_HUE tag controls the color of the HTML output. Doxygen +# will adjust the colors in the style sheet and background images according to +# this color. Hue is specified as an angle on a color-wheel, see +# https://en.wikipedia.org/wiki/Hue for more information. For instance the value +# 0 represents red, 60 is yellow, 120 is green, 180 is cyan, 240 is blue, 300 +# purple, and 360 is red again. +# Minimum value: 0, maximum value: 359, default value: 220. +# This tag requires that the tag GENERATE_HTML is set to YES. + +HTML_COLORSTYLE_HUE = 220 + +# The HTML_COLORSTYLE_SAT tag controls the purity (or saturation) of the colors +# in the HTML output. For a value of 0 the output will use gray-scales only. A +# value of 255 will produce the most vivid colors. +# Minimum value: 0, maximum value: 255, default value: 100. +# This tag requires that the tag GENERATE_HTML is set to YES. + +HTML_COLORSTYLE_SAT = 100 + +# The HTML_COLORSTYLE_GAMMA tag controls the gamma correction applied to the +# luminance component of the colors in the HTML output. Values below 100 +# gradually make the output lighter, whereas values above 100 make the output +# darker. The value divided by 100 is the actual gamma applied, so 80 represents +# a gamma of 0.8, The value 220 represents a gamma of 2.2, and 100 does not +# change the gamma. +# Minimum value: 40, maximum value: 240, default value: 80. +# This tag requires that the tag GENERATE_HTML is set to YES. + +HTML_COLORSTYLE_GAMMA = 80 + +# If the HTML_TIMESTAMP tag is set to YES then the footer of each generated HTML +# page will contain the date and time when the page was generated. Setting this +# to YES can help to show when doxygen was last run and thus if the +# documentation is up to date. +# The default value is: NO. +# This tag requires that the tag GENERATE_HTML is set to YES. + +HTML_TIMESTAMP = NO + +# If the HTML_DYNAMIC_MENUS tag is set to YES then the generated HTML +# documentation will contain a main index with vertical navigation menus that +# are dynamically created via JavaScript. If disabled, the navigation index will +# consists of multiple levels of tabs that are statically embedded in every HTML +# page. Disable this option to support browsers that do not have JavaScript, +# like the Qt help browser. +# The default value is: YES. +# This tag requires that the tag GENERATE_HTML is set to YES. + +HTML_DYNAMIC_MENUS = YES + +# If the HTML_DYNAMIC_SECTIONS tag is set to YES then the generated HTML +# documentation will contain sections that can be hidden and shown after the +# page has loaded. +# The default value is: NO. +# This tag requires that the tag GENERATE_HTML is set to YES. + +HTML_DYNAMIC_SECTIONS = NO + +# With HTML_INDEX_NUM_ENTRIES one can control the preferred number of entries +# shown in the various tree structured indices initially; the user can expand +# and collapse entries dynamically later on. Doxygen will expand the tree to +# such a level that at most the specified number of entries are visible (unless +# a fully collapsed tree already exceeds this amount). So setting the number of +# entries 1 will produce a full collapsed tree by default. 0 is a special value +# representing an infinite number of entries and will result in a full expanded +# tree by default. +# Minimum value: 0, maximum value: 9999, default value: 100. +# This tag requires that the tag GENERATE_HTML is set to YES. + +HTML_INDEX_NUM_ENTRIES = 100 + +# If the GENERATE_DOCSET tag is set to YES, additional index files will be +# generated that can be used as input for Apple's Xcode 3 integrated development +# environment (see: +# https://developer.apple.com/xcode/), introduced with OSX 10.5 (Leopard). To +# create a documentation set, doxygen will generate a Makefile in the HTML +# output directory. Running make will produce the docset in that directory and +# running make install will install the docset in +# ~/Library/Developer/Shared/Documentation/DocSets so that Xcode will find it at +# startup. See https://developer.apple.com/library/archive/featuredarticles/Doxy +# genXcode/_index.html for more information. +# The default value is: NO. +# This tag requires that the tag GENERATE_HTML is set to YES. + +GENERATE_DOCSET = NO + +# This tag determines the name of the docset feed. A documentation feed provides +# an umbrella under which multiple documentation sets from a single provider +# (such as a company or product suite) can be grouped. +# The default value is: Doxygen generated docs. +# This tag requires that the tag GENERATE_DOCSET is set to YES. + +DOCSET_FEEDNAME = "Doxygen generated docs" + +# This tag determines the URL of the docset feed. A documentation feed provides +# an umbrella under which multiple documentation sets from a single provider +# (such as a company or product suite) can be grouped. +# This tag requires that the tag GENERATE_DOCSET is set to YES. + +DOCSET_FEEDURL = + +# This tag specifies a string that should uniquely identify the documentation +# set bundle. This should be a reverse domain-name style string, e.g. +# com.mycompany.MyDocSet. Doxygen will append .docset to the name. +# The default value is: org.doxygen.Project. +# This tag requires that the tag GENERATE_DOCSET is set to YES. + +DOCSET_BUNDLE_ID = org.doxygen.Project + +# The DOCSET_PUBLISHER_ID tag specifies a string that should uniquely identify +# the documentation publisher. This should be a reverse domain-name style +# string, e.g. com.mycompany.MyDocSet.documentation. +# The default value is: org.doxygen.Publisher. +# This tag requires that the tag GENERATE_DOCSET is set to YES. + +DOCSET_PUBLISHER_ID = org.doxygen.Publisher + +# The DOCSET_PUBLISHER_NAME tag identifies the documentation publisher. +# The default value is: Publisher. +# This tag requires that the tag GENERATE_DOCSET is set to YES. + +DOCSET_PUBLISHER_NAME = Publisher + +# If the GENERATE_HTMLHELP tag is set to YES then doxygen generates three +# additional HTML index files: index.hhp, index.hhc, and index.hhk. The +# index.hhp is a project file that can be read by Microsoft's HTML Help Workshop +# on Windows. In the beginning of 2021 Microsoft took the original page, with +# a.o. the download links, offline the HTML help workshop was already many years +# in maintenance mode). You can download the HTML help workshop from the web +# archives at Installation executable (see: +# http://web.archive.org/web/20160201063255/http://download.microsoft.com/downlo +# ad/0/A/9/0A939EF6-E31C-430F-A3DF-DFAE7960D564/htmlhelp.exe). +# +# The HTML Help Workshop contains a compiler that can convert all HTML output +# generated by doxygen into a single compiled HTML file (.chm). Compiled HTML +# files are now used as the Windows 98 help format, and will replace the old +# Windows help format (.hlp) on all Windows platforms in the future. Compressed +# HTML files also contain an index, a table of contents, and you can search for +# words in the documentation. The HTML workshop also contains a viewer for +# compressed HTML files. +# The default value is: NO. +# This tag requires that the tag GENERATE_HTML is set to YES. + +GENERATE_HTMLHELP = NO + +# The CHM_FILE tag can be used to specify the file name of the resulting .chm +# file. You can add a path in front of the file if the result should not be +# written to the html output directory. +# This tag requires that the tag GENERATE_HTMLHELP is set to YES. + +CHM_FILE = + +# The HHC_LOCATION tag can be used to specify the location (absolute path +# including file name) of the HTML help compiler (hhc.exe). If non-empty, +# doxygen will try to run the HTML help compiler on the generated index.hhp. +# The file has to be specified with full path. +# This tag requires that the tag GENERATE_HTMLHELP is set to YES. + +HHC_LOCATION = + +# The GENERATE_CHI flag controls if a separate .chi index file is generated +# (YES) or that it should be included in the main .chm file (NO). +# The default value is: NO. +# This tag requires that the tag GENERATE_HTMLHELP is set to YES. + +GENERATE_CHI = NO + +# The CHM_INDEX_ENCODING is used to encode HtmlHelp index (hhk), content (hhc) +# and project file content. +# This tag requires that the tag GENERATE_HTMLHELP is set to YES. + +CHM_INDEX_ENCODING = + +# The BINARY_TOC flag controls whether a binary table of contents is generated +# (YES) or a normal table of contents (NO) in the .chm file. Furthermore it +# enables the Previous and Next buttons. +# The default value is: NO. +# This tag requires that the tag GENERATE_HTMLHELP is set to YES. + +BINARY_TOC = NO + +# The TOC_EXPAND flag can be set to YES to add extra items for group members to +# the table of contents of the HTML help documentation and to the tree view. +# The default value is: NO. +# This tag requires that the tag GENERATE_HTMLHELP is set to YES. + +TOC_EXPAND = NO + +# If the GENERATE_QHP tag is set to YES and both QHP_NAMESPACE and +# QHP_VIRTUAL_FOLDER are set, an additional index file will be generated that +# can be used as input for Qt's qhelpgenerator to generate a Qt Compressed Help +# (.qch) of the generated HTML documentation. +# The default value is: NO. +# This tag requires that the tag GENERATE_HTML is set to YES. + +GENERATE_QHP = NO + +# If the QHG_LOCATION tag is specified, the QCH_FILE tag can be used to specify +# the file name of the resulting .qch file. The path specified is relative to +# the HTML output folder. +# This tag requires that the tag GENERATE_QHP is set to YES. + +QCH_FILE = + +# The QHP_NAMESPACE tag specifies the namespace to use when generating Qt Help +# Project output. For more information please see Qt Help Project / Namespace +# (see: +# https://doc.qt.io/archives/qt-4.8/qthelpproject.html#namespace). +# The default value is: org.doxygen.Project. +# This tag requires that the tag GENERATE_QHP is set to YES. + +QHP_NAMESPACE = org.doxygen.Project + +# The QHP_VIRTUAL_FOLDER tag specifies the namespace to use when generating Qt +# Help Project output. For more information please see Qt Help Project / Virtual +# Folders (see: +# https://doc.qt.io/archives/qt-4.8/qthelpproject.html#virtual-folders). +# The default value is: doc. +# This tag requires that the tag GENERATE_QHP is set to YES. + +QHP_VIRTUAL_FOLDER = doc + +# If the QHP_CUST_FILTER_NAME tag is set, it specifies the name of a custom +# filter to add. For more information please see Qt Help Project / Custom +# Filters (see: +# https://doc.qt.io/archives/qt-4.8/qthelpproject.html#custom-filters). +# This tag requires that the tag GENERATE_QHP is set to YES. + +QHP_CUST_FILTER_NAME = + +# The QHP_CUST_FILTER_ATTRS tag specifies the list of the attributes of the +# custom filter to add. For more information please see Qt Help Project / Custom +# Filters (see: +# https://doc.qt.io/archives/qt-4.8/qthelpproject.html#custom-filters). +# This tag requires that the tag GENERATE_QHP is set to YES. + +QHP_CUST_FILTER_ATTRS = + +# The QHP_SECT_FILTER_ATTRS tag specifies the list of the attributes this +# project's filter section matches. Qt Help Project / Filter Attributes (see: +# https://doc.qt.io/archives/qt-4.8/qthelpproject.html#filter-attributes). +# This tag requires that the tag GENERATE_QHP is set to YES. + +QHP_SECT_FILTER_ATTRS = + +# The QHG_LOCATION tag can be used to specify the location (absolute path +# including file name) of Qt's qhelpgenerator. If non-empty doxygen will try to +# run qhelpgenerator on the generated .qhp file. +# This tag requires that the tag GENERATE_QHP is set to YES. + +QHG_LOCATION = + +# If the GENERATE_ECLIPSEHELP tag is set to YES, additional index files will be +# generated, together with the HTML files, they form an Eclipse help plugin. To +# install this plugin and make it available under the help contents menu in +# Eclipse, the contents of the directory containing the HTML and XML files needs +# to be copied into the plugins directory of eclipse. The name of the directory +# within the plugins directory should be the same as the ECLIPSE_DOC_ID value. +# After copying Eclipse needs to be restarted before the help appears. +# The default value is: NO. +# This tag requires that the tag GENERATE_HTML is set to YES. + +GENERATE_ECLIPSEHELP = NO + +# A unique identifier for the Eclipse help plugin. When installing the plugin +# the directory name containing the HTML and XML files should also have this +# name. Each documentation set should have its own identifier. +# The default value is: org.doxygen.Project. +# This tag requires that the tag GENERATE_ECLIPSEHELP is set to YES. + +ECLIPSE_DOC_ID = org.doxygen.Project + +# If you want full control over the layout of the generated HTML pages it might +# be necessary to disable the index and replace it with your own. The +# DISABLE_INDEX tag can be used to turn on/off the condensed index (tabs) at top +# of each HTML page. A value of NO enables the index and the value YES disables +# it. Since the tabs in the index contain the same information as the navigation +# tree, you can set this option to YES if you also set GENERATE_TREEVIEW to YES. +# The default value is: NO. +# This tag requires that the tag GENERATE_HTML is set to YES. + +DISABLE_INDEX = NO + +# The GENERATE_TREEVIEW tag is used to specify whether a tree-like index +# structure should be generated to display hierarchical information. If the tag +# value is set to YES, a side panel will be generated containing a tree-like +# index structure (just like the one that is generated for HTML Help). For this +# to work a browser that supports JavaScript, DHTML, CSS and frames is required +# (i.e. any modern browser). Windows users are probably better off using the +# HTML help feature. Via custom style sheets (see HTML_EXTRA_STYLESHEET) one can +# further fine tune the look of the index (see "Fine-tuning the output"). As an +# example, the default style sheet generated by doxygen has an example that +# shows how to put an image at the root of the tree instead of the PROJECT_NAME. +# Since the tree basically has the same information as the tab index, you could +# consider setting DISABLE_INDEX to YES when enabling this option. +# The default value is: NO. +# This tag requires that the tag GENERATE_HTML is set to YES. + +GENERATE_TREEVIEW = YES + +# When both GENERATE_TREEVIEW and DISABLE_INDEX are set to YES, then the +# FULL_SIDEBAR option determines if the side bar is limited to only the treeview +# area (value NO) or if it should extend to the full height of the window (value +# YES). Setting this to YES gives a layout similar to +# https://docs.readthedocs.io with more room for contents, but less room for the +# project logo, title, and description. If either GENERATE_TREEVIEW or +# DISABLE_INDEX is set to NO, this option has no effect. +# The default value is: NO. +# This tag requires that the tag GENERATE_HTML is set to YES. + +FULL_SIDEBAR = NO + +# The ENUM_VALUES_PER_LINE tag can be used to set the number of enum values that +# doxygen will group on one line in the generated HTML documentation. +# +# Note that a value of 0 will completely suppress the enum values from appearing +# in the overview section. +# Minimum value: 0, maximum value: 20, default value: 4. +# This tag requires that the tag GENERATE_HTML is set to YES. + +ENUM_VALUES_PER_LINE = 4 + +# If the treeview is enabled (see GENERATE_TREEVIEW) then this tag can be used +# to set the initial width (in pixels) of the frame in which the tree is shown. +# Minimum value: 0, maximum value: 1500, default value: 250. +# This tag requires that the tag GENERATE_HTML is set to YES. + +TREEVIEW_WIDTH = 250 + +# If the EXT_LINKS_IN_WINDOW option is set to YES, doxygen will open links to +# external symbols imported via tag files in a separate window. +# The default value is: NO. +# This tag requires that the tag GENERATE_HTML is set to YES. + +EXT_LINKS_IN_WINDOW = NO + +# If the OBFUSCATE_EMAILS tag is set to YES, doxygen will obfuscate email +# addresses. +# The default value is: YES. +# This tag requires that the tag GENERATE_HTML is set to YES. + +OBFUSCATE_EMAILS = YES + +# If the HTML_FORMULA_FORMAT option is set to svg, doxygen will use the pdf2svg +# tool (see https://github.com/dawbarton/pdf2svg) or inkscape (see +# https://inkscape.org) to generate formulas as SVG images instead of PNGs for +# the HTML output. These images will generally look nicer at scaled resolutions. +# Possible values are: png (the default) and svg (looks nicer but requires the +# pdf2svg or inkscape tool). +# The default value is: png. +# This tag requires that the tag GENERATE_HTML is set to YES. + +HTML_FORMULA_FORMAT = png + +# Use this tag to change the font size of LaTeX formulas included as images in +# the HTML documentation. When you change the font size after a successful +# doxygen run you need to manually remove any form_*.png images from the HTML +# output directory to force them to be regenerated. +# Minimum value: 8, maximum value: 50, default value: 10. +# This tag requires that the tag GENERATE_HTML is set to YES. + +FORMULA_FONTSIZE = 10 + +# The FORMULA_MACROFILE can contain LaTeX \newcommand and \renewcommand commands +# to create new LaTeX commands to be used in formulas as building blocks. See +# the section "Including formulas" for details. + +FORMULA_MACROFILE = + +# Enable the USE_MATHJAX option to render LaTeX formulas using MathJax (see +# https://www.mathjax.org) which uses client side JavaScript for the rendering +# instead of using pre-rendered bitmaps. Use this if you do not have LaTeX +# installed or if you want to formulas look prettier in the HTML output. When +# enabled you may also need to install MathJax separately and configure the path +# to it using the MATHJAX_RELPATH option. +# The default value is: NO. +# This tag requires that the tag GENERATE_HTML is set to YES. + +USE_MATHJAX = YES + +# With MATHJAX_VERSION it is possible to specify the MathJax version to be used. +# Note that the different versions of MathJax have different requirements with +# regards to the different settings, so it is possible that also other MathJax +# settings have to be changed when switching between the different MathJax +# versions. +# Possible values are: MathJax_2 and MathJax_3. +# The default value is: MathJax_2. +# This tag requires that the tag USE_MATHJAX is set to YES. + +MATHJAX_VERSION = MathJax_2 + +# When MathJax is enabled you can set the default output format to be used for +# the MathJax output. For more details about the output format see MathJax +# version 2 (see: +# http://docs.mathjax.org/en/v2.7-latest/output.html) and MathJax version 3 +# (see: +# http://docs.mathjax.org/en/latest/web/components/output.html). +# Possible values are: HTML-CSS (which is slower, but has the best +# compatibility. This is the name for Mathjax version 2, for MathJax version 3 +# this will be translated into chtml), NativeMML (i.e. MathML. Only supported +# for NathJax 2. For MathJax version 3 chtml will be used instead.), chtml (This +# is the name for Mathjax version 3, for MathJax version 2 this will be +# translated into HTML-CSS) and SVG. +# The default value is: HTML-CSS. +# This tag requires that the tag USE_MATHJAX is set to YES. + +MATHJAX_FORMAT = HTML-CSS + +# When MathJax is enabled you need to specify the location relative to the HTML +# output directory using the MATHJAX_RELPATH option. The destination directory +# should contain the MathJax.js script. For instance, if the mathjax directory +# is located at the same level as the HTML output directory, then +# MATHJAX_RELPATH should be ../mathjax. The default value points to the MathJax +# Content Delivery Network so you can quickly see the result without installing +# MathJax. However, it is strongly recommended to install a local copy of +# MathJax from https://www.mathjax.org before deployment. The default value is: +# - in case of MathJax version 2: https://cdn.jsdelivr.net/npm/mathjax@2 +# - in case of MathJax version 3: https://cdn.jsdelivr.net/npm/mathjax@3 +# This tag requires that the tag USE_MATHJAX is set to YES. + +MATHJAX_RELPATH = + +# The MATHJAX_EXTENSIONS tag can be used to specify one or more MathJax +# extension names that should be enabled during MathJax rendering. For example +# for MathJax version 2 (see +# https://docs.mathjax.org/en/v2.7-latest/tex.html#tex-and-latex-extensions): +# MATHJAX_EXTENSIONS = TeX/AMSmath TeX/AMSsymbols +# For example for MathJax version 3 (see +# http://docs.mathjax.org/en/latest/input/tex/extensions/index.html): +# MATHJAX_EXTENSIONS = ams +# This tag requires that the tag USE_MATHJAX is set to YES. + +MATHJAX_EXTENSIONS = + +# The MATHJAX_CODEFILE tag can be used to specify a file with javascript pieces +# of code that will be used on startup of the MathJax code. See the MathJax site +# (see: +# http://docs.mathjax.org/en/v2.7-latest/output.html) for more details. For an +# example see the documentation. +# This tag requires that the tag USE_MATHJAX is set to YES. + +MATHJAX_CODEFILE = + +# When the SEARCHENGINE tag is enabled doxygen will generate a search box for +# the HTML output. The underlying search engine uses javascript and DHTML and +# should work on any modern browser. Note that when using HTML help +# (GENERATE_HTMLHELP), Qt help (GENERATE_QHP), or docsets (GENERATE_DOCSET) +# there is already a search function so this one should typically be disabled. +# For large projects the javascript based search engine can be slow, then +# enabling SERVER_BASED_SEARCH may provide a better solution. It is possible to +# search using the keyboard; to jump to the search box use + S +# (what the is depends on the OS and browser, but it is typically +# , /
    "),i=e.children()[0];return y("body").append(e),t=i.offsetWidth,e.css("overflow","scroll"),t===(i=i.offsetWidth)&&(i=e[0].clientWidth),e.remove(),s=t-i},getScrollInfo:function(t){var e=t.isWindow||t.isDocument?"":t.element.css("overflow-x"),i=t.isWindow||t.isDocument?"":t.element.css("overflow-y"),e="scroll"===e||"auto"===e&&t.widthx(D(s),D(n))?o.important="horizontal":o.important="vertical",p.using.call(this,t,o)}),h.offset(y.extend(l,{using:t}))})},y.ui.position={fit:{left:function(t,e){var i=e.within,s=i.isWindow?i.scrollLeft:i.offset.left,n=i.width,o=t.left-e.collisionPosition.marginLeft,h=s-o,a=o+e.collisionWidth-n-s;e.collisionWidth>n?0n?0=this.options.distance},_mouseDelayMet:function(){return this.mouseDelayMet},_mouseStart:function(){},_mouseDrag:function(){},_mouseStop:function(){},_mouseCapture:function(){return!0}}),y.ui.plugin={add:function(t,e,i){var s,n=y.ui[t].prototype;for(s in i)n.plugins[s]=n.plugins[s]||[],n.plugins[s].push([e,i[s]])},call:function(t,e,i,s){var n,o=t.plugins[e];if(o&&(s||t.element[0].parentNode&&11!==t.element[0].parentNode.nodeType))for(n=0;n
    ").css({overflow:"hidden",position:this.element.css("position"),width:this.element.outerWidth(),height:this.element.outerHeight(),top:this.element.css("top"),left:this.element.css("left")})),this.element=this.element.parent().data("ui-resizable",this.element.resizable("instance")),this.elementIsWrapper=!0,t={marginTop:this.originalElement.css("marginTop"),marginRight:this.originalElement.css("marginRight"),marginBottom:this.originalElement.css("marginBottom"),marginLeft:this.originalElement.css("marginLeft")},this.element.css(t),this.originalElement.css("margin",0),this.originalResizeStyle=this.originalElement.css("resize"),this.originalElement.css("resize","none"),this._proportionallyResizeElements.push(this.originalElement.css({position:"static",zoom:1,display:"block"})),this.originalElement.css(t),this._proportionallyResize()),this._setupHandles(),e.autoHide&&y(this.element).on("mouseenter",function(){e.disabled||(i._removeClass("ui-resizable-autohide"),i._handles.show())}).on("mouseleave",function(){e.disabled||i.resizing||(i._addClass("ui-resizable-autohide"),i._handles.hide())}),this._mouseInit()},_destroy:function(){this._mouseDestroy(),this._addedHandles.remove();function t(t){y(t).removeData("resizable").removeData("ui-resizable").off(".resizable")}var e;return this.elementIsWrapper&&(t(this.element),e=this.element,this.originalElement.css({position:e.css("position"),width:e.outerWidth(),height:e.outerHeight(),top:e.css("top"),left:e.css("left")}).insertAfter(e),e.remove()),this.originalElement.css("resize",this.originalResizeStyle),t(this.originalElement),this},_setOption:function(t,e){switch(this._super(t,e),t){case"handles":this._removeHandles(),this._setupHandles();break;case"aspectRatio":this._aspectRatio=!!e}},_setupHandles:function(){var t,e,i,s,n,o=this.options,h=this;if(this.handles=o.handles||(y(".ui-resizable-handle",this.element).length?{n:".ui-resizable-n",e:".ui-resizable-e",s:".ui-resizable-s",w:".ui-resizable-w",se:".ui-resizable-se",sw:".ui-resizable-sw",ne:".ui-resizable-ne",nw:".ui-resizable-nw"}:"e,s,se"),this._handles=y(),this._addedHandles=y(),this.handles.constructor===String)for("all"===this.handles&&(this.handles="n,e,s,w,se,sw,ne,nw"),i=this.handles.split(","),this.handles={},e=0;e"),this._addClass(n,"ui-resizable-handle "+s),n.css({zIndex:o.zIndex}),this.handles[t]=".ui-resizable-"+t,this.element.children(this.handles[t]).length||(this.element.append(n),this._addedHandles=this._addedHandles.add(n));this._renderAxis=function(t){var e,i,s;for(e in t=t||this.element,this.handles)this.handles[e].constructor===String?this.handles[e]=this.element.children(this.handles[e]).first().show():(this.handles[e].jquery||this.handles[e].nodeType)&&(this.handles[e]=y(this.handles[e]),this._on(this.handles[e],{mousedown:h._mouseDown})),this.elementIsWrapper&&this.originalElement[0].nodeName.match(/^(textarea|input|select|button)$/i)&&(i=y(this.handles[e],this.element),s=/sw|ne|nw|se|n|s/.test(e)?i.outerHeight():i.outerWidth(),i=["padding",/ne|nw|n/.test(e)?"Top":/se|sw|s/.test(e)?"Bottom":/^e$/.test(e)?"Right":"Left"].join(""),t.css(i,s),this._proportionallyResize()),this._handles=this._handles.add(this.handles[e])},this._renderAxis(this.element),this._handles=this._handles.add(this.element.find(".ui-resizable-handle")),this._handles.disableSelection(),this._handles.on("mouseover",function(){h.resizing||(this.className&&(n=this.className.match(/ui-resizable-(se|sw|ne|nw|n|e|s|w)/i)),h.axis=n&&n[1]?n[1]:"se")}),o.autoHide&&(this._handles.hide(),this._addClass("ui-resizable-autohide"))},_removeHandles:function(){this._addedHandles.remove()},_mouseCapture:function(t){var e,i,s=!1;for(e in this.handles)(i=y(this.handles[e])[0])!==t.target&&!y.contains(i,t.target)||(s=!0);return!this.options.disabled&&s},_mouseStart:function(t){var e,i,s=this.options,n=this.element;return this.resizing=!0,this._renderProxy(),e=this._num(this.helper.css("left")),i=this._num(this.helper.css("top")),s.containment&&(e+=y(s.containment).scrollLeft()||0,i+=y(s.containment).scrollTop()||0),this.offset=this.helper.offset(),this.position={left:e,top:i},this.size=this._helper?{width:this.helper.width(),height:this.helper.height()}:{width:n.width(),height:n.height()},this.originalSize=this._helper?{width:n.outerWidth(),height:n.outerHeight()}:{width:n.width(),height:n.height()},this.sizeDiff={width:n.outerWidth()-n.width(),height:n.outerHeight()-n.height()},this.originalPosition={left:e,top:i},this.originalMousePosition={left:t.pageX,top:t.pageY},this.aspectRatio="number"==typeof s.aspectRatio?s.aspectRatio:this.originalSize.width/this.originalSize.height||1,s=y(".ui-resizable-"+this.axis).css("cursor"),y("body").css("cursor","auto"===s?this.axis+"-resize":s),this._addClass("ui-resizable-resizing"),this._propagate("start",t),!0},_mouseDrag:function(t){var e=this.originalMousePosition,i=this.axis,s=t.pageX-e.left||0,e=t.pageY-e.top||0,i=this._change[i];return this._updatePrevProperties(),i&&(e=i.apply(this,[t,s,e]),this._updateVirtualBoundaries(t.shiftKey),(this._aspectRatio||t.shiftKey)&&(e=this._updateRatio(e,t)),e=this._respectSize(e,t),this._updateCache(e),this._propagate("resize",t),e=this._applyChanges(),!this._helper&&this._proportionallyResizeElements.length&&this._proportionallyResize(),y.isEmptyObject(e)||(this._updatePrevProperties(),this._trigger("resize",t,this.ui()),this._applyChanges())),!1},_mouseStop:function(t){this.resizing=!1;var e,i,s,n=this.options,o=this;return this._helper&&(s=(e=(i=this._proportionallyResizeElements).length&&/textarea/i.test(i[0].nodeName))&&this._hasScroll(i[0],"left")?0:o.sizeDiff.height,i=e?0:o.sizeDiff.width,e={width:o.helper.width()-i,height:o.helper.height()-s},i=parseFloat(o.element.css("left"))+(o.position.left-o.originalPosition.left)||null,s=parseFloat(o.element.css("top"))+(o.position.top-o.originalPosition.top)||null,n.animate||this.element.css(y.extend(e,{top:s,left:i})),o.helper.height(o.size.height),o.helper.width(o.size.width),this._helper&&!n.animate&&this._proportionallyResize()),y("body").css("cursor","auto"),this._removeClass("ui-resizable-resizing"),this._propagate("stop",t),this._helper&&this.helper.remove(),!1},_updatePrevProperties:function(){this.prevPosition={top:this.position.top,left:this.position.left},this.prevSize={width:this.size.width,height:this.size.height}},_applyChanges:function(){var t={};return this.position.top!==this.prevPosition.top&&(t.top=this.position.top+"px"),this.position.left!==this.prevPosition.left&&(t.left=this.position.left+"px"),this.size.width!==this.prevSize.width&&(t.width=this.size.width+"px"),this.size.height!==this.prevSize.height&&(t.height=this.size.height+"px"),this.helper.css(t),t},_updateVirtualBoundaries:function(t){var e,i,s=this.options,n={minWidth:this._isNumber(s.minWidth)?s.minWidth:0,maxWidth:this._isNumber(s.maxWidth)?s.maxWidth:1/0,minHeight:this._isNumber(s.minHeight)?s.minHeight:0,maxHeight:this._isNumber(s.maxHeight)?s.maxHeight:1/0};(this._aspectRatio||t)&&(e=n.minHeight*this.aspectRatio,i=n.minWidth/this.aspectRatio,s=n.maxHeight*this.aspectRatio,t=n.maxWidth/this.aspectRatio,e>n.minWidth&&(n.minWidth=e),i>n.minHeight&&(n.minHeight=i),st.width,h=this._isNumber(t.height)&&e.minHeight&&e.minHeight>t.height,a=this.originalPosition.left+this.originalSize.width,r=this.originalPosition.top+this.originalSize.height,l=/sw|nw|w/.test(i),i=/nw|ne|n/.test(i);return o&&(t.width=e.minWidth),h&&(t.height=e.minHeight),s&&(t.width=e.maxWidth),n&&(t.height=e.maxHeight),o&&l&&(t.left=a-e.minWidth),s&&l&&(t.left=a-e.maxWidth),h&&i&&(t.top=r-e.minHeight),n&&i&&(t.top=r-e.maxHeight),t.width||t.height||t.left||!t.top?t.width||t.height||t.top||!t.left||(t.left=null):t.top=null,t},_getPaddingPlusBorderDimensions:function(t){for(var e=0,i=[],s=[t.css("borderTopWidth"),t.css("borderRightWidth"),t.css("borderBottomWidth"),t.css("borderLeftWidth")],n=[t.css("paddingTop"),t.css("paddingRight"),t.css("paddingBottom"),t.css("paddingLeft")];e<4;e++)i[e]=parseFloat(s[e])||0,i[e]+=parseFloat(n[e])||0;return{height:i[0]+i[2],width:i[1]+i[3]}},_proportionallyResize:function(){if(this._proportionallyResizeElements.length)for(var t,e=0,i=this.helper||this.element;e
    ").css({overflow:"hidden"}),this._addClass(this.helper,this._helper),this.helper.css({width:this.element.outerWidth(),height:this.element.outerHeight(),position:"absolute",left:this.elementOffset.left+"px",top:this.elementOffset.top+"px",zIndex:++e.zIndex}),this.helper.appendTo("body").disableSelection()):this.helper=this.element},_change:{e:function(t,e){return{width:this.originalSize.width+e}},w:function(t,e){var i=this.originalSize;return{left:this.originalPosition.left+e,width:i.width-e}},n:function(t,e,i){var s=this.originalSize;return{top:this.originalPosition.top+i,height:s.height-i}},s:function(t,e,i){return{height:this.originalSize.height+i}},se:function(t,e,i){return y.extend(this._change.s.apply(this,arguments),this._change.e.apply(this,[t,e,i]))},sw:function(t,e,i){return y.extend(this._change.s.apply(this,arguments),this._change.w.apply(this,[t,e,i]))},ne:function(t,e,i){return y.extend(this._change.n.apply(this,arguments),this._change.e.apply(this,[t,e,i]))},nw:function(t,e,i){return y.extend(this._change.n.apply(this,arguments),this._change.w.apply(this,[t,e,i]))}},_propagate:function(t,e){y.ui.plugin.call(this,t,[e,this.ui()]),"resize"!==t&&this._trigger(t,e,this.ui())},plugins:{},ui:function(){return{originalElement:this.originalElement,element:this.element,helper:this.helper,position:this.position,size:this.size,originalSize:this.originalSize,originalPosition:this.originalPosition}}}),y.ui.plugin.add("resizable","animate",{stop:function(e){var i=y(this).resizable("instance"),t=i.options,s=i._proportionallyResizeElements,n=s.length&&/textarea/i.test(s[0].nodeName),o=n&&i._hasScroll(s[0],"left")?0:i.sizeDiff.height,h=n?0:i.sizeDiff.width,n={width:i.size.width-h,height:i.size.height-o},h=parseFloat(i.element.css("left"))+(i.position.left-i.originalPosition.left)||null,o=parseFloat(i.element.css("top"))+(i.position.top-i.originalPosition.top)||null;i.element.animate(y.extend(n,o&&h?{top:o,left:h}:{}),{duration:t.animateDuration,easing:t.animateEasing,step:function(){var t={width:parseFloat(i.element.css("width")),height:parseFloat(i.element.css("height")),top:parseFloat(i.element.css("top")),left:parseFloat(i.element.css("left"))};s&&s.length&&y(s[0]).css({width:t.width,height:t.height}),i._updateCache(t),i._propagate("resize",e)}})}}),y.ui.plugin.add("resizable","containment",{start:function(){var i,s,n=y(this).resizable("instance"),t=n.options,e=n.element,o=t.containment,h=o instanceof y?o.get(0):/parent/.test(o)?e.parent().get(0):o;h&&(n.containerElement=y(h),/document/.test(o)||o===document?(n.containerOffset={left:0,top:0},n.containerPosition={left:0,top:0},n.parentData={element:y(document),left:0,top:0,width:y(document).width(),height:y(document).height()||document.body.parentNode.scrollHeight}):(i=y(h),s=[],y(["Top","Right","Left","Bottom"]).each(function(t,e){s[t]=n._num(i.css("padding"+e))}),n.containerOffset=i.offset(),n.containerPosition=i.position(),n.containerSize={height:i.innerHeight()-s[3],width:i.innerWidth()-s[1]},t=n.containerOffset,e=n.containerSize.height,o=n.containerSize.width,o=n._hasScroll(h,"left")?h.scrollWidth:o,e=n._hasScroll(h)?h.scrollHeight:e,n.parentData={element:h,left:t.left,top:t.top,width:o,height:e}))},resize:function(t){var e=y(this).resizable("instance"),i=e.options,s=e.containerOffset,n=e.position,o=e._aspectRatio||t.shiftKey,h={top:0,left:0},a=e.containerElement,t=!0;a[0]!==document&&/static/.test(a.css("position"))&&(h=s),n.left<(e._helper?s.left:0)&&(e.size.width=e.size.width+(e._helper?e.position.left-s.left:e.position.left-h.left),o&&(e.size.height=e.size.width/e.aspectRatio,t=!1),e.position.left=i.helper?s.left:0),n.top<(e._helper?s.top:0)&&(e.size.height=e.size.height+(e._helper?e.position.top-s.top:e.position.top),o&&(e.size.width=e.size.height*e.aspectRatio,t=!1),e.position.top=e._helper?s.top:0),i=e.containerElement.get(0)===e.element.parent().get(0),n=/relative|absolute/.test(e.containerElement.css("position")),i&&n?(e.offset.left=e.parentData.left+e.position.left,e.offset.top=e.parentData.top+e.position.top):(e.offset.left=e.element.offset().left,e.offset.top=e.element.offset().top),n=Math.abs(e.sizeDiff.width+(e._helper?e.offset.left-h.left:e.offset.left-s.left)),s=Math.abs(e.sizeDiff.height+(e._helper?e.offset.top-h.top:e.offset.top-s.top)),n+e.size.width>=e.parentData.width&&(e.size.width=e.parentData.width-n,o&&(e.size.height=e.size.width/e.aspectRatio,t=!1)),s+e.size.height>=e.parentData.height&&(e.size.height=e.parentData.height-s,o&&(e.size.width=e.size.height*e.aspectRatio,t=!1)),t||(e.position.left=e.prevPosition.left,e.position.top=e.prevPosition.top,e.size.width=e.prevSize.width,e.size.height=e.prevSize.height)},stop:function(){var t=y(this).resizable("instance"),e=t.options,i=t.containerOffset,s=t.containerPosition,n=t.containerElement,o=y(t.helper),h=o.offset(),a=o.outerWidth()-t.sizeDiff.width,o=o.outerHeight()-t.sizeDiff.height;t._helper&&!e.animate&&/relative/.test(n.css("position"))&&y(this).css({left:h.left-s.left-i.left,width:a,height:o}),t._helper&&!e.animate&&/static/.test(n.css("position"))&&y(this).css({left:h.left-s.left-i.left,width:a,height:o})}}),y.ui.plugin.add("resizable","alsoResize",{start:function(){var t=y(this).resizable("instance").options;y(t.alsoResize).each(function(){var t=y(this);t.data("ui-resizable-alsoresize",{width:parseFloat(t.width()),height:parseFloat(t.height()),left:parseFloat(t.css("left")),top:parseFloat(t.css("top"))})})},resize:function(t,i){var e=y(this).resizable("instance"),s=e.options,n=e.originalSize,o=e.originalPosition,h={height:e.size.height-n.height||0,width:e.size.width-n.width||0,top:e.position.top-o.top||0,left:e.position.left-o.left||0};y(s.alsoResize).each(function(){var t=y(this),s=y(this).data("ui-resizable-alsoresize"),n={},e=t.parents(i.originalElement[0]).length?["width","height"]:["width","height","top","left"];y.each(e,function(t,e){var i=(s[e]||0)+(h[e]||0);i&&0<=i&&(n[e]=i||null)}),t.css(n)})},stop:function(){y(this).removeData("ui-resizable-alsoresize")}}),y.ui.plugin.add("resizable","ghost",{start:function(){var t=y(this).resizable("instance"),e=t.size;t.ghost=t.originalElement.clone(),t.ghost.css({opacity:.25,display:"block",position:"relative",height:e.height,width:e.width,margin:0,left:0,top:0}),t._addClass(t.ghost,"ui-resizable-ghost"),!1!==y.uiBackCompat&&"string"==typeof t.options.ghost&&t.ghost.addClass(this.options.ghost),t.ghost.appendTo(t.helper)},resize:function(){var t=y(this).resizable("instance");t.ghost&&t.ghost.css({position:"relative",height:t.size.height,width:t.size.width})},stop:function(){var t=y(this).resizable("instance");t.ghost&&t.helper&&t.helper.get(0).removeChild(t.ghost.get(0))}}),y.ui.plugin.add("resizable","grid",{resize:function(){var t,e=y(this).resizable("instance"),i=e.options,s=e.size,n=e.originalSize,o=e.originalPosition,h=e.axis,a="number"==typeof i.grid?[i.grid,i.grid]:i.grid,r=a[0]||1,l=a[1]||1,u=Math.round((s.width-n.width)/r)*r,p=Math.round((s.height-n.height)/l)*l,d=n.width+u,c=n.height+p,f=i.maxWidth&&i.maxWidthd,s=i.minHeight&&i.minHeight>c;i.grid=a,m&&(d+=r),s&&(c+=l),f&&(d-=r),g&&(c-=l),/^(se|s|e)$/.test(h)?(e.size.width=d,e.size.height=c):/^(ne)$/.test(h)?(e.size.width=d,e.size.height=c,e.position.top=o.top-p):/^(sw)$/.test(h)?(e.size.width=d,e.size.height=c,e.position.left=o.left-u):((c-l<=0||d-r<=0)&&(t=e._getPaddingPlusBorderDimensions(this)),0=f[g]?0:Math.min(f[g],n));!a&&1-1){targetElements.on(evt+EVENT_NAMESPACE,function elementToggle(event){$.powerTip.toggle(this,event)})}else{targetElements.on(evt+EVENT_NAMESPACE,function elementOpen(event){$.powerTip.show(this,event)})}});$.each(options.closeEvents,function(idx,evt){if($.inArray(evt,options.openEvents)<0){targetElements.on(evt+EVENT_NAMESPACE,function elementClose(event){$.powerTip.hide(this,!isMouseEvent(event))})}});targetElements.on("keydown"+EVENT_NAMESPACE,function elementKeyDown(event){if(event.keyCode===27){$.powerTip.hide(this,true)}})}return targetElements};$.fn.powerTip.defaults={fadeInTime:200,fadeOutTime:100,followMouse:false,popupId:"powerTip",popupClass:null,intentSensitivity:7,intentPollInterval:100,closeDelay:100,placement:"n",smartPlacement:false,offset:10,mouseOnToPopup:false,manual:false,openEvents:["mouseenter","focus"],closeEvents:["mouseleave","blur"]};$.fn.powerTip.smartPlacementLists={n:["n","ne","nw","s"],e:["e","ne","se","w","nw","sw","n","s","e"],s:["s","se","sw","n"],w:["w","nw","sw","e","ne","se","n","s","w"],nw:["nw","w","sw","n","s","se","nw"],ne:["ne","e","se","n","s","sw","ne"],sw:["sw","w","nw","s","n","ne","sw"],se:["se","e","ne","s","n","nw","se"],"nw-alt":["nw-alt","n","ne-alt","sw-alt","s","se-alt","w","e"],"ne-alt":["ne-alt","n","nw-alt","se-alt","s","sw-alt","e","w"],"sw-alt":["sw-alt","s","se-alt","nw-alt","n","ne-alt","w","e"],"se-alt":["se-alt","s","sw-alt","ne-alt","n","nw-alt","e","w"]};$.powerTip={show:function apiShowTip(element,event){if(isMouseEvent(event)){trackMouse(event);session.previousX=event.pageX;session.previousY=event.pageY;$(element).data(DATA_DISPLAYCONTROLLER).show()}else{$(element).first().data(DATA_DISPLAYCONTROLLER).show(true,true)}return element},reposition:function apiResetPosition(element){$(element).first().data(DATA_DISPLAYCONTROLLER).resetPosition();return element},hide:function apiCloseTip(element,immediate){var displayController;immediate=element?immediate:true;if(element){displayController=$(element).first().data(DATA_DISPLAYCONTROLLER)}else if(session.activeHover){displayController=session.activeHover.data(DATA_DISPLAYCONTROLLER)}if(displayController){displayController.hide(immediate)}return element},toggle:function apiToggle(element,event){if(session.activeHover&&session.activeHover.is(element)){$.powerTip.hide(element,!isMouseEvent(event))}else{$.powerTip.show(element,event)}return element}};$.powerTip.showTip=$.powerTip.show;$.powerTip.closeTip=$.powerTip.hide;function CSSCoordinates(){var me=this;me.top="auto";me.left="auto";me.right="auto";me.bottom="auto";me.set=function(property,value){if($.isNumeric(value)){me[property]=Math.round(value)}}}function DisplayController(element,options,tipController){var hoverTimer=null,myCloseDelay=null;function openTooltip(immediate,forceOpen){cancelTimer();if(!element.data(DATA_HASACTIVEHOVER)){if(!immediate){session.tipOpenImminent=true;hoverTimer=setTimeout(function intentDelay(){hoverTimer=null;checkForIntent()},options.intentPollInterval)}else{if(forceOpen){element.data(DATA_FORCEDOPEN,true)}closeAnyDelayed();tipController.showTip(element)}}else{cancelClose()}}function closeTooltip(disableDelay){if(myCloseDelay){myCloseDelay=session.closeDelayTimeout=clearTimeout(myCloseDelay);session.delayInProgress=false}cancelTimer();session.tipOpenImminent=false;if(element.data(DATA_HASACTIVEHOVER)){element.data(DATA_FORCEDOPEN,false);if(!disableDelay){session.delayInProgress=true;session.closeDelayTimeout=setTimeout(function closeDelay(){session.closeDelayTimeout=null;tipController.hideTip(element);session.delayInProgress=false;myCloseDelay=null},options.closeDelay);myCloseDelay=session.closeDelayTimeout}else{tipController.hideTip(element)}}}function checkForIntent(){var xDifference=Math.abs(session.previousX-session.currentX),yDifference=Math.abs(session.previousY-session.currentY),totalDifference=xDifference+yDifference;if(totalDifference",{id:options.popupId});if($body.length===0){$body=$("body")}$body.append(tipElement);session.tooltips=session.tooltips?session.tooltips.add(tipElement):tipElement}if(options.followMouse){if(!tipElement.data(DATA_HASMOUSEMOVE)){$document.on("mousemove"+EVENT_NAMESPACE,positionTipOnCursor);$window.on("scroll"+EVENT_NAMESPACE,positionTipOnCursor);tipElement.data(DATA_HASMOUSEMOVE,true)}}function beginShowTip(element){element.data(DATA_HASACTIVEHOVER,true);tipElement.queue(function queueTipInit(next){showTip(element);next()})}function showTip(element){var tipContent;if(!element.data(DATA_HASACTIVEHOVER)){return}if(session.isTipOpen){if(!session.isClosing){hideTip(session.activeHover)}tipElement.delay(100).queue(function queueTipAgain(next){showTip(element);next()});return}element.trigger("powerTipPreRender");tipContent=getTooltipContent(element);if(tipContent){tipElement.empty().append(tipContent)}else{return}element.trigger("powerTipRender");session.activeHover=element;session.isTipOpen=true;tipElement.data(DATA_MOUSEONTOTIP,options.mouseOnToPopup);tipElement.addClass(options.popupClass);if(!options.followMouse||element.data(DATA_FORCEDOPEN)){positionTipOnElement(element);session.isFixedTipOpen=true}else{positionTipOnCursor()}if(!element.data(DATA_FORCEDOPEN)&&!options.followMouse){$document.on("click"+EVENT_NAMESPACE,function documentClick(event){var target=event.target;if(target!==element[0]){if(options.mouseOnToPopup){if(target!==tipElement[0]&&!$.contains(tipElement[0],target)){$.powerTip.hide()}}else{$.powerTip.hide()}}})}if(options.mouseOnToPopup&&!options.manual){tipElement.on("mouseenter"+EVENT_NAMESPACE,function tipMouseEnter(){if(session.activeHover){session.activeHover.data(DATA_DISPLAYCONTROLLER).cancel()}});tipElement.on("mouseleave"+EVENT_NAMESPACE,function tipMouseLeave(){if(session.activeHover){session.activeHover.data(DATA_DISPLAYCONTROLLER).hide()}})}tipElement.fadeIn(options.fadeInTime,function fadeInCallback(){if(!session.desyncTimeout){session.desyncTimeout=setInterval(closeDesyncedTip,500)}element.trigger("powerTipOpen")})}function hideTip(element){session.isClosing=true;session.isTipOpen=false;session.desyncTimeout=clearInterval(session.desyncTimeout);element.data(DATA_HASACTIVEHOVER,false);element.data(DATA_FORCEDOPEN,false);$document.off("click"+EVENT_NAMESPACE);tipElement.off(EVENT_NAMESPACE);tipElement.fadeOut(options.fadeOutTime,function fadeOutCallback(){var coords=new CSSCoordinates;session.activeHover=null;session.isClosing=false;session.isFixedTipOpen=false;tipElement.removeClass();coords.set("top",session.currentY+options.offset);coords.set("left",session.currentX+options.offset);tipElement.css(coords);element.trigger("powerTipClose")})}function positionTipOnCursor(){var tipWidth,tipHeight,coords,collisions,collisionCount;if(!session.isFixedTipOpen&&(session.isTipOpen||session.tipOpenImminent&&tipElement.data(DATA_HASMOUSEMOVE))){tipWidth=tipElement.outerWidth();tipHeight=tipElement.outerHeight();coords=new CSSCoordinates;coords.set("top",session.currentY+options.offset);coords.set("left",session.currentX+options.offset);collisions=getViewportCollisions(coords,tipWidth,tipHeight);if(collisions!==Collision.none){collisionCount=countFlags(collisions);if(collisionCount===1){if(collisions===Collision.right){coords.set("left",session.scrollLeft+session.windowWidth-tipWidth)}else if(collisions===Collision.bottom){coords.set("top",session.scrollTop+session.windowHeight-tipHeight)}}else{coords.set("left",session.currentX-tipWidth-options.offset);coords.set("top",session.currentY-tipHeight-options.offset)}}tipElement.css(coords)}}function positionTipOnElement(element){var priorityList,finalPlacement;if(options.smartPlacement||options.followMouse&&element.data(DATA_FORCEDOPEN)){priorityList=$.fn.powerTip.smartPlacementLists[options.placement];$.each(priorityList,function(idx,pos){var collisions=getViewportCollisions(placeTooltip(element,pos),tipElement.outerWidth(),tipElement.outerHeight());finalPlacement=pos;return collisions!==Collision.none})}else{placeTooltip(element,options.placement);finalPlacement=options.placement}tipElement.removeClass("w nw sw e ne se n s w se-alt sw-alt ne-alt nw-alt");tipElement.addClass(finalPlacement)}function placeTooltip(element,placement){var iterationCount=0,tipWidth,tipHeight,coords=new CSSCoordinates;coords.set("top",0);coords.set("left",0);tipElement.css(coords);do{tipWidth=tipElement.outerWidth();tipHeight=tipElement.outerHeight();coords=placementCalculator.compute(element,placement,tipWidth,tipHeight,options.offset);tipElement.css(coords)}while(++iterationCount<=5&&(tipWidth!==tipElement.outerWidth()||tipHeight!==tipElement.outerHeight()));return coords}function closeDesyncedTip(){var isDesynced=false,hasDesyncableCloseEvent=$.grep(["mouseleave","mouseout","blur","focusout"],function(eventType){return $.inArray(eventType,options.closeEvents)!==-1}).length>0;if(session.isTipOpen&&!session.isClosing&&!session.delayInProgress&&hasDesyncableCloseEvent){if(session.activeHover.data(DATA_HASACTIVEHOVER)===false||session.activeHover.is(":disabled")){isDesynced=true}else if(!isMouseOver(session.activeHover)&&!session.activeHover.is(":focus")&&!session.activeHover.data(DATA_FORCEDOPEN)){if(tipElement.data(DATA_MOUSEONTOTIP)){if(!isMouseOver(tipElement)){isDesynced=true}}else{isDesynced=true}}if(isDesynced){hideTip(session.activeHover)}}}this.showTip=beginShowTip;this.hideTip=hideTip;this.resetPosition=positionTipOnElement}function isSvgElement(element){return Boolean(window.SVGElement&&element[0]instanceof SVGElement)}function isMouseEvent(event){return Boolean(event&&$.inArray(event.type,MOUSE_EVENTS)>-1&&typeof event.pageX==="number")}function initTracking(){if(!session.mouseTrackingActive){session.mouseTrackingActive=true;getViewportDimensions();$(getViewportDimensions);$document.on("mousemove"+EVENT_NAMESPACE,trackMouse);$window.on("resize"+EVENT_NAMESPACE,trackResize);$window.on("scroll"+EVENT_NAMESPACE,trackScroll)}}function getViewportDimensions(){session.scrollLeft=$window.scrollLeft();session.scrollTop=$window.scrollTop();session.windowWidth=$window.width();session.windowHeight=$window.height()}function trackResize(){session.windowWidth=$window.width();session.windowHeight=$window.height()}function trackScroll(){var x=$window.scrollLeft(),y=$window.scrollTop();if(x!==session.scrollLeft){session.currentX+=x-session.scrollLeft;session.scrollLeft=x}if(y!==session.scrollTop){session.currentY+=y-session.scrollTop;session.scrollTop=y}}function trackMouse(event){session.currentX=event.pageX;session.currentY=event.pageY}function isMouseOver(element){var elementPosition=element.offset(),elementBox=element[0].getBoundingClientRect(),elementWidth=elementBox.right-elementBox.left,elementHeight=elementBox.bottom-elementBox.top;return session.currentX>=elementPosition.left&&session.currentX<=elementPosition.left+elementWidth&&session.currentY>=elementPosition.top&&session.currentY<=elementPosition.top+elementHeight}function getTooltipContent(element){var tipText=element.data(DATA_POWERTIP),tipObject=element.data(DATA_POWERTIPJQ),tipTarget=element.data(DATA_POWERTIPTARGET),targetElement,content;if(tipText){if($.isFunction(tipText)){tipText=tipText.call(element[0])}content=tipText}else if(tipObject){if($.isFunction(tipObject)){tipObject=tipObject.call(element[0])}if(tipObject.length>0){content=tipObject.clone(true,true)}}else if(tipTarget){targetElement=$("#"+tipTarget);if(targetElement.length>0){content=targetElement.html()}}return content}function getViewportCollisions(coords,elementWidth,elementHeight){var viewportTop=session.scrollTop,viewportLeft=session.scrollLeft,viewportBottom=viewportTop+session.windowHeight,viewportRight=viewportLeft+session.windowWidth,collisions=Collision.none;if(coords.topviewportBottom||Math.abs(coords.bottom-session.windowHeight)>viewportBottom){collisions|=Collision.bottom}if(coords.leftviewportRight){collisions|=Collision.left}if(coords.left+elementWidth>viewportRight||coords.right1)){a.preventDefault();var c=a.originalEvent.changedTouches[0],d=document.createEvent("MouseEvents");d.initMouseEvent(b,!0,!0,window,1,c.screenX,c.screenY,c.clientX,c.clientY,!1,!1,!1,!1,0,null),a.target.dispatchEvent(d)}}if(a.support.touch="ontouchend"in document,a.support.touch){var e,b=a.ui.mouse.prototype,c=b._mouseInit,d=b._mouseDestroy;b._touchStart=function(a){var b=this;!e&&b._mouseCapture(a.originalEvent.changedTouches[0])&&(e=!0,b._touchMoved=!1,f(a,"mouseover"),f(a,"mousemove"),f(a,"mousedown"))},b._touchMove=function(a){e&&(this._touchMoved=!0,f(a,"mousemove"))},b._touchEnd=function(a){e&&(f(a,"mouseup"),f(a,"mouseout"),this._touchMoved||f(a,"click"),e=!1)},b._mouseInit=function(){var b=this;b.element.bind({touchstart:a.proxy(b,"_touchStart"),touchmove:a.proxy(b,"_touchMove"),touchend:a.proxy(b,"_touchEnd")}),c.call(b)},b._mouseDestroy=function(){var b=this;b.element.unbind({touchstart:a.proxy(b,"_touchStart"),touchmove:a.proxy(b,"_touchMove"),touchend:a.proxy(b,"_touchEnd")}),d.call(b)}}}(jQuery);/*! SmartMenus jQuery Plugin - v1.1.0 - September 17, 2017 + * http://www.smartmenus.org/ + * Copyright Vasil Dinkov, Vadikom Web Ltd. http://vadikom.com; Licensed MIT */(function(t){"function"==typeof define&&define.amd?define(["jquery"],t):"object"==typeof module&&"object"==typeof module.exports?module.exports=t(require("jquery")):t(jQuery)})(function($){function initMouseDetection(t){var e=".smartmenus_mouse";if(mouseDetectionEnabled||t)mouseDetectionEnabled&&t&&($(document).off(e),mouseDetectionEnabled=!1);else{var i=!0,s=null,o={mousemove:function(t){var e={x:t.pageX,y:t.pageY,timeStamp:(new Date).getTime()};if(s){var o=Math.abs(s.x-e.x),a=Math.abs(s.y-e.y);if((o>0||a>0)&&2>=o&&2>=a&&300>=e.timeStamp-s.timeStamp&&(mouse=!0,i)){var n=$(t.target).closest("a");n.is("a")&&$.each(menuTrees,function(){return $.contains(this.$root[0],n[0])?(this.itemEnter({currentTarget:n[0]}),!1):void 0}),i=!1}}s=e}};o[touchEvents?"touchstart":"pointerover pointermove pointerout MSPointerOver MSPointerMove MSPointerOut"]=function(t){isTouchEvent(t.originalEvent)&&(mouse=!1)},$(document).on(getEventsNS(o,e)),mouseDetectionEnabled=!0}}function isTouchEvent(t){return!/^(4|mouse)$/.test(t.pointerType)}function getEventsNS(t,e){e||(e="");var i={};for(var s in t)i[s.split(" ").join(e+" ")+e]=t[s];return i}var menuTrees=[],mouse=!1,touchEvents="ontouchstart"in window,mouseDetectionEnabled=!1,requestAnimationFrame=window.requestAnimationFrame||function(t){return setTimeout(t,1e3/60)},cancelAnimationFrame=window.cancelAnimationFrame||function(t){clearTimeout(t)},canAnimate=!!$.fn.animate;return $.SmartMenus=function(t,e){this.$root=$(t),this.opts=e,this.rootId="",this.accessIdPrefix="",this.$subArrow=null,this.activatedItems=[],this.visibleSubMenus=[],this.showTimeout=0,this.hideTimeout=0,this.scrollTimeout=0,this.clickActivated=!1,this.focusActivated=!1,this.zIndexInc=0,this.idInc=0,this.$firstLink=null,this.$firstSub=null,this.disabled=!1,this.$disableOverlay=null,this.$touchScrollingSub=null,this.cssTransforms3d="perspective"in t.style||"webkitPerspective"in t.style,this.wasCollapsible=!1,this.init()},$.extend($.SmartMenus,{hideAll:function(){$.each(menuTrees,function(){this.menuHideAll()})},destroy:function(){for(;menuTrees.length;)menuTrees[0].destroy();initMouseDetection(!0)},prototype:{init:function(t){var e=this;if(!t){menuTrees.push(this),this.rootId=((new Date).getTime()+Math.random()+"").replace(/\D/g,""),this.accessIdPrefix="sm-"+this.rootId+"-",this.$root.hasClass("sm-rtl")&&(this.opts.rightToLeftSubMenus=!0);var i=".smartmenus";this.$root.data("smartmenus",this).attr("data-smartmenus-id",this.rootId).dataSM("level",1).on(getEventsNS({"mouseover focusin":$.proxy(this.rootOver,this),"mouseout focusout":$.proxy(this.rootOut,this),keydown:$.proxy(this.rootKeyDown,this)},i)).on(getEventsNS({mouseenter:$.proxy(this.itemEnter,this),mouseleave:$.proxy(this.itemLeave,this),mousedown:$.proxy(this.itemDown,this),focus:$.proxy(this.itemFocus,this),blur:$.proxy(this.itemBlur,this),click:$.proxy(this.itemClick,this)},i),"a"),i+=this.rootId,this.opts.hideOnClick&&$(document).on(getEventsNS({touchstart:$.proxy(this.docTouchStart,this),touchmove:$.proxy(this.docTouchMove,this),touchend:$.proxy(this.docTouchEnd,this),click:$.proxy(this.docClick,this)},i)),$(window).on(getEventsNS({"resize orientationchange":$.proxy(this.winResize,this)},i)),this.opts.subIndicators&&(this.$subArrow=$("").addClass("sub-arrow"),this.opts.subIndicatorsText&&this.$subArrow.html(this.opts.subIndicatorsText)),initMouseDetection()}if(this.$firstSub=this.$root.find("ul").each(function(){e.menuInit($(this))}).eq(0),this.$firstLink=this.$root.find("a").eq(0),this.opts.markCurrentItem){var s=/(index|default)\.[^#\?\/]*/i,o=/#.*/,a=window.location.href.replace(s,""),n=a.replace(o,"");this.$root.find("a").each(function(){var t=this.href.replace(s,""),i=$(this);(t==a||t==n)&&(i.addClass("current"),e.opts.markCurrentTree&&i.parentsUntil("[data-smartmenus-id]","ul").each(function(){$(this).dataSM("parent-a").addClass("current")}))})}this.wasCollapsible=this.isCollapsible()},destroy:function(t){if(!t){var e=".smartmenus";this.$root.removeData("smartmenus").removeAttr("data-smartmenus-id").removeDataSM("level").off(e),e+=this.rootId,$(document).off(e),$(window).off(e),this.opts.subIndicators&&(this.$subArrow=null)}this.menuHideAll();var i=this;this.$root.find("ul").each(function(){var t=$(this);t.dataSM("scroll-arrows")&&t.dataSM("scroll-arrows").remove(),t.dataSM("shown-before")&&((i.opts.subMenusMinWidth||i.opts.subMenusMaxWidth)&&t.css({width:"",minWidth:"",maxWidth:""}).removeClass("sm-nowrap"),t.dataSM("scroll-arrows")&&t.dataSM("scroll-arrows").remove(),t.css({zIndex:"",top:"",left:"",marginLeft:"",marginTop:"",display:""})),0==(t.attr("id")||"").indexOf(i.accessIdPrefix)&&t.removeAttr("id")}).removeDataSM("in-mega").removeDataSM("shown-before").removeDataSM("scroll-arrows").removeDataSM("parent-a").removeDataSM("level").removeDataSM("beforefirstshowfired").removeAttr("role").removeAttr("aria-hidden").removeAttr("aria-labelledby").removeAttr("aria-expanded"),this.$root.find("a.has-submenu").each(function(){var t=$(this);0==t.attr("id").indexOf(i.accessIdPrefix)&&t.removeAttr("id")}).removeClass("has-submenu").removeDataSM("sub").removeAttr("aria-haspopup").removeAttr("aria-controls").removeAttr("aria-expanded").closest("li").removeDataSM("sub"),this.opts.subIndicators&&this.$root.find("span.sub-arrow").remove(),this.opts.markCurrentItem&&this.$root.find("a.current").removeClass("current"),t||(this.$root=null,this.$firstLink=null,this.$firstSub=null,this.$disableOverlay&&(this.$disableOverlay.remove(),this.$disableOverlay=null),menuTrees.splice($.inArray(this,menuTrees),1))},disable:function(t){if(!this.disabled){if(this.menuHideAll(),!t&&!this.opts.isPopup&&this.$root.is(":visible")){var e=this.$root.offset();this.$disableOverlay=$('
    ').css({position:"absolute",top:e.top,left:e.left,width:this.$root.outerWidth(),height:this.$root.outerHeight(),zIndex:this.getStartZIndex(!0),opacity:0}).appendTo(document.body)}this.disabled=!0}},docClick:function(t){return this.$touchScrollingSub?(this.$touchScrollingSub=null,void 0):((this.visibleSubMenus.length&&!$.contains(this.$root[0],t.target)||$(t.target).closest("a").length)&&this.menuHideAll(),void 0)},docTouchEnd:function(){if(this.lastTouch){if(!(!this.visibleSubMenus.length||void 0!==this.lastTouch.x2&&this.lastTouch.x1!=this.lastTouch.x2||void 0!==this.lastTouch.y2&&this.lastTouch.y1!=this.lastTouch.y2||this.lastTouch.target&&$.contains(this.$root[0],this.lastTouch.target))){this.hideTimeout&&(clearTimeout(this.hideTimeout),this.hideTimeout=0);var t=this;this.hideTimeout=setTimeout(function(){t.menuHideAll()},350)}this.lastTouch=null}},docTouchMove:function(t){if(this.lastTouch){var e=t.originalEvent.touches[0];this.lastTouch.x2=e.pageX,this.lastTouch.y2=e.pageY}},docTouchStart:function(t){var e=t.originalEvent.touches[0];this.lastTouch={x1:e.pageX,y1:e.pageY,target:e.target}},enable:function(){this.disabled&&(this.$disableOverlay&&(this.$disableOverlay.remove(),this.$disableOverlay=null),this.disabled=!1)},getClosestMenu:function(t){for(var e=$(t).closest("ul");e.dataSM("in-mega");)e=e.parent().closest("ul");return e[0]||null},getHeight:function(t){return this.getOffset(t,!0)},getOffset:function(t,e){var i;"none"==t.css("display")&&(i={position:t[0].style.position,visibility:t[0].style.visibility},t.css({position:"absolute",visibility:"hidden"}).show());var s=t[0].getBoundingClientRect&&t[0].getBoundingClientRect(),o=s&&(e?s.height||s.bottom-s.top:s.width||s.right-s.left);return o||0===o||(o=e?t[0].offsetHeight:t[0].offsetWidth),i&&t.hide().css(i),o},getStartZIndex:function(t){var e=parseInt(this[t?"$root":"$firstSub"].css("z-index"));return!t&&isNaN(e)&&(e=parseInt(this.$root.css("z-index"))),isNaN(e)?1:e},getTouchPoint:function(t){return t.touches&&t.touches[0]||t.changedTouches&&t.changedTouches[0]||t},getViewport:function(t){var e=t?"Height":"Width",i=document.documentElement["client"+e],s=window["inner"+e];return s&&(i=Math.min(i,s)),i},getViewportHeight:function(){return this.getViewport(!0)},getViewportWidth:function(){return this.getViewport()},getWidth:function(t){return this.getOffset(t)},handleEvents:function(){return!this.disabled&&this.isCSSOn()},handleItemEvents:function(t){return this.handleEvents()&&!this.isLinkInMegaMenu(t)},isCollapsible:function(){return"static"==this.$firstSub.css("position")},isCSSOn:function(){return"inline"!=this.$firstLink.css("display")},isFixed:function(){var t="fixed"==this.$root.css("position");return t||this.$root.parentsUntil("body").each(function(){return"fixed"==$(this).css("position")?(t=!0,!1):void 0}),t},isLinkInMegaMenu:function(t){return $(this.getClosestMenu(t[0])).hasClass("mega-menu")},isTouchMode:function(){return!mouse||this.opts.noMouseOver||this.isCollapsible()},itemActivate:function(t,e){var i=t.closest("ul"),s=i.dataSM("level");if(s>1&&(!this.activatedItems[s-2]||this.activatedItems[s-2][0]!=i.dataSM("parent-a")[0])){var o=this;$(i.parentsUntil("[data-smartmenus-id]","ul").get().reverse()).add(i).each(function(){o.itemActivate($(this).dataSM("parent-a"))})}if((!this.isCollapsible()||e)&&this.menuHideSubMenus(this.activatedItems[s-1]&&this.activatedItems[s-1][0]==t[0]?s:s-1),this.activatedItems[s-1]=t,this.$root.triggerHandler("activate.smapi",t[0])!==!1){var a=t.dataSM("sub");a&&(this.isTouchMode()||!this.opts.showOnClick||this.clickActivated)&&this.menuShow(a)}},itemBlur:function(t){var e=$(t.currentTarget);this.handleItemEvents(e)&&this.$root.triggerHandler("blur.smapi",e[0])},itemClick:function(t){var e=$(t.currentTarget);if(this.handleItemEvents(e)){if(this.$touchScrollingSub&&this.$touchScrollingSub[0]==e.closest("ul")[0])return this.$touchScrollingSub=null,t.stopPropagation(),!1;if(this.$root.triggerHandler("click.smapi",e[0])===!1)return!1;var i=$(t.target).is(".sub-arrow"),s=e.dataSM("sub"),o=s?2==s.dataSM("level"):!1,a=this.isCollapsible(),n=/toggle$/.test(this.opts.collapsibleBehavior),r=/link$/.test(this.opts.collapsibleBehavior),h=/^accordion/.test(this.opts.collapsibleBehavior);if(s&&!s.is(":visible")){if((!r||!a||i)&&(this.opts.showOnClick&&o&&(this.clickActivated=!0),this.itemActivate(e,h),s.is(":visible")))return this.focusActivated=!0,!1}else if(a&&(n||i))return this.itemActivate(e,h),this.menuHide(s),n&&(this.focusActivated=!1),!1;return this.opts.showOnClick&&o||e.hasClass("disabled")||this.$root.triggerHandler("select.smapi",e[0])===!1?!1:void 0}},itemDown:function(t){var e=$(t.currentTarget);this.handleItemEvents(e)&&e.dataSM("mousedown",!0)},itemEnter:function(t){var e=$(t.currentTarget);if(this.handleItemEvents(e)){if(!this.isTouchMode()){this.showTimeout&&(clearTimeout(this.showTimeout),this.showTimeout=0);var i=this;this.showTimeout=setTimeout(function(){i.itemActivate(e)},this.opts.showOnClick&&1==e.closest("ul").dataSM("level")?1:this.opts.showTimeout)}this.$root.triggerHandler("mouseenter.smapi",e[0])}},itemFocus:function(t){var e=$(t.currentTarget);this.handleItemEvents(e)&&(!this.focusActivated||this.isTouchMode()&&e.dataSM("mousedown")||this.activatedItems.length&&this.activatedItems[this.activatedItems.length-1][0]==e[0]||this.itemActivate(e,!0),this.$root.triggerHandler("focus.smapi",e[0]))},itemLeave:function(t){var e=$(t.currentTarget);this.handleItemEvents(e)&&(this.isTouchMode()||(e[0].blur(),this.showTimeout&&(clearTimeout(this.showTimeout),this.showTimeout=0)),e.removeDataSM("mousedown"),this.$root.triggerHandler("mouseleave.smapi",e[0]))},menuHide:function(t){if(this.$root.triggerHandler("beforehide.smapi",t[0])!==!1&&(canAnimate&&t.stop(!0,!0),"none"!=t.css("display"))){var e=function(){t.css("z-index","")};this.isCollapsible()?canAnimate&&this.opts.collapsibleHideFunction?this.opts.collapsibleHideFunction.call(this,t,e):t.hide(this.opts.collapsibleHideDuration,e):canAnimate&&this.opts.hideFunction?this.opts.hideFunction.call(this,t,e):t.hide(this.opts.hideDuration,e),t.dataSM("scroll")&&(this.menuScrollStop(t),t.css({"touch-action":"","-ms-touch-action":"","-webkit-transform":"",transform:""}).off(".smartmenus_scroll").removeDataSM("scroll").dataSM("scroll-arrows").hide()),t.dataSM("parent-a").removeClass("highlighted").attr("aria-expanded","false"),t.attr({"aria-expanded":"false","aria-hidden":"true"});var i=t.dataSM("level");this.activatedItems.splice(i-1,1),this.visibleSubMenus.splice($.inArray(t,this.visibleSubMenus),1),this.$root.triggerHandler("hide.smapi",t[0])}},menuHideAll:function(){this.showTimeout&&(clearTimeout(this.showTimeout),this.showTimeout=0);for(var t=this.opts.isPopup?1:0,e=this.visibleSubMenus.length-1;e>=t;e--)this.menuHide(this.visibleSubMenus[e]);this.opts.isPopup&&(canAnimate&&this.$root.stop(!0,!0),this.$root.is(":visible")&&(canAnimate&&this.opts.hideFunction?this.opts.hideFunction.call(this,this.$root):this.$root.hide(this.opts.hideDuration))),this.activatedItems=[],this.visibleSubMenus=[],this.clickActivated=!1,this.focusActivated=!1,this.zIndexInc=0,this.$root.triggerHandler("hideAll.smapi")},menuHideSubMenus:function(t){for(var e=this.activatedItems.length-1;e>=t;e--){var i=this.activatedItems[e].dataSM("sub");i&&this.menuHide(i)}},menuInit:function(t){if(!t.dataSM("in-mega")){t.hasClass("mega-menu")&&t.find("ul").dataSM("in-mega",!0);for(var e=2,i=t[0];(i=i.parentNode.parentNode)!=this.$root[0];)e++;var s=t.prevAll("a").eq(-1);s.length||(s=t.prevAll().find("a").eq(-1)),s.addClass("has-submenu").dataSM("sub",t),t.dataSM("parent-a",s).dataSM("level",e).parent().dataSM("sub",t);var o=s.attr("id")||this.accessIdPrefix+ ++this.idInc,a=t.attr("id")||this.accessIdPrefix+ ++this.idInc;s.attr({id:o,"aria-haspopup":"true","aria-controls":a,"aria-expanded":"false"}),t.attr({id:a,role:"group","aria-hidden":"true","aria-labelledby":o,"aria-expanded":"false"}),this.opts.subIndicators&&s[this.opts.subIndicatorsPos](this.$subArrow.clone())}},menuPosition:function(t){var e,i,s=t.dataSM("parent-a"),o=s.closest("li"),a=o.parent(),n=t.dataSM("level"),r=this.getWidth(t),h=this.getHeight(t),u=s.offset(),l=u.left,c=u.top,d=this.getWidth(s),m=this.getHeight(s),p=$(window),f=p.scrollLeft(),v=p.scrollTop(),b=this.getViewportWidth(),S=this.getViewportHeight(),g=a.parent().is("[data-sm-horizontal-sub]")||2==n&&!a.hasClass("sm-vertical"),M=this.opts.rightToLeftSubMenus&&!o.is("[data-sm-reverse]")||!this.opts.rightToLeftSubMenus&&o.is("[data-sm-reverse]"),w=2==n?this.opts.mainMenuSubOffsetX:this.opts.subMenusSubOffsetX,T=2==n?this.opts.mainMenuSubOffsetY:this.opts.subMenusSubOffsetY;if(g?(e=M?d-r-w:w,i=this.opts.bottomToTopSubMenus?-h-T:m+T):(e=M?w-r:d-w,i=this.opts.bottomToTopSubMenus?m-T-h:T),this.opts.keepInViewport){var y=l+e,I=c+i;if(M&&f>y?e=g?f-y+e:d-w:!M&&y+r>f+b&&(e=g?f+b-r-y+e:w-r),g||(S>h&&I+h>v+S?i+=v+S-h-I:(h>=S||v>I)&&(i+=v-I)),g&&(I+h>v+S+.49||v>I)||!g&&h>S+.49){var x=this;t.dataSM("scroll-arrows")||t.dataSM("scroll-arrows",$([$('')[0],$('')[0]]).on({mouseenter:function(){t.dataSM("scroll").up=$(this).hasClass("scroll-up"),x.menuScroll(t)},mouseleave:function(e){x.menuScrollStop(t),x.menuScrollOut(t,e)},"mousewheel DOMMouseScroll":function(t){t.preventDefault()}}).insertAfter(t));var A=".smartmenus_scroll";if(t.dataSM("scroll",{y:this.cssTransforms3d?0:i-m,step:1,itemH:m,subH:h,arrowDownH:this.getHeight(t.dataSM("scroll-arrows").eq(1))}).on(getEventsNS({mouseover:function(e){x.menuScrollOver(t,e)},mouseout:function(e){x.menuScrollOut(t,e)},"mousewheel DOMMouseScroll":function(e){x.menuScrollMousewheel(t,e)}},A)).dataSM("scroll-arrows").css({top:"auto",left:"0",marginLeft:e+(parseInt(t.css("border-left-width"))||0),width:r-(parseInt(t.css("border-left-width"))||0)-(parseInt(t.css("border-right-width"))||0),zIndex:t.css("z-index")}).eq(g&&this.opts.bottomToTopSubMenus?0:1).show(),this.isFixed()){var C={};C[touchEvents?"touchstart touchmove touchend":"pointerdown pointermove pointerup MSPointerDown MSPointerMove MSPointerUp"]=function(e){x.menuScrollTouch(t,e)},t.css({"touch-action":"none","-ms-touch-action":"none"}).on(getEventsNS(C,A))}}}t.css({top:"auto",left:"0",marginLeft:e,marginTop:i-m})},menuScroll:function(t,e,i){var s,o=t.dataSM("scroll"),a=t.dataSM("scroll-arrows"),n=o.up?o.upEnd:o.downEnd;if(!e&&o.momentum){if(o.momentum*=.92,s=o.momentum,.5>s)return this.menuScrollStop(t),void 0}else s=i||(e||!this.opts.scrollAccelerate?this.opts.scrollStep:Math.floor(o.step));var r=t.dataSM("level");if(this.activatedItems[r-1]&&this.activatedItems[r-1].dataSM("sub")&&this.activatedItems[r-1].dataSM("sub").is(":visible")&&this.menuHideSubMenus(r-1),o.y=o.up&&o.y>=n||!o.up&&n>=o.y?o.y:Math.abs(n-o.y)>s?o.y+(o.up?s:-s):n,t.css(this.cssTransforms3d?{"-webkit-transform":"translate3d(0, "+o.y+"px, 0)",transform:"translate3d(0, "+o.y+"px, 0)"}:{marginTop:o.y}),mouse&&(o.up&&o.y>o.downEnd||!o.up&&o.y0;t.dataSM("scroll-arrows").eq(i?0:1).is(":visible")&&(t.dataSM("scroll").up=i,this.menuScroll(t,!0))}e.preventDefault()},menuScrollOut:function(t,e){mouse&&(/^scroll-(up|down)/.test((e.relatedTarget||"").className)||(t[0]==e.relatedTarget||$.contains(t[0],e.relatedTarget))&&this.getClosestMenu(e.relatedTarget)==t[0]||t.dataSM("scroll-arrows").css("visibility","hidden"))},menuScrollOver:function(t,e){if(mouse&&!/^scroll-(up|down)/.test(e.target.className)&&this.getClosestMenu(e.target)==t[0]){this.menuScrollRefreshData(t);var i=t.dataSM("scroll"),s=$(window).scrollTop()-t.dataSM("parent-a").offset().top-i.itemH;t.dataSM("scroll-arrows").eq(0).css("margin-top",s).end().eq(1).css("margin-top",s+this.getViewportHeight()-i.arrowDownH).end().css("visibility","visible")}},menuScrollRefreshData:function(t){var e=t.dataSM("scroll"),i=$(window).scrollTop()-t.dataSM("parent-a").offset().top-e.itemH;this.cssTransforms3d&&(i=-(parseFloat(t.css("margin-top"))-i)),$.extend(e,{upEnd:i,downEnd:i+this.getViewportHeight()-e.subH})},menuScrollStop:function(t){return this.scrollTimeout?(cancelAnimationFrame(this.scrollTimeout),this.scrollTimeout=0,t.dataSM("scroll").step=1,!0):void 0},menuScrollTouch:function(t,e){if(e=e.originalEvent,isTouchEvent(e)){var i=this.getTouchPoint(e);if(this.getClosestMenu(i.target)==t[0]){var s=t.dataSM("scroll");if(/(start|down)$/i.test(e.type))this.menuScrollStop(t)?(e.preventDefault(),this.$touchScrollingSub=t):this.$touchScrollingSub=null,this.menuScrollRefreshData(t),$.extend(s,{touchStartY:i.pageY,touchStartTime:e.timeStamp});else if(/move$/i.test(e.type)){var o=void 0!==s.touchY?s.touchY:s.touchStartY;if(void 0!==o&&o!=i.pageY){this.$touchScrollingSub=t;var a=i.pageY>o;void 0!==s.up&&s.up!=a&&$.extend(s,{touchStartY:i.pageY,touchStartTime:e.timeStamp}),$.extend(s,{up:a,touchY:i.pageY}),this.menuScroll(t,!0,Math.abs(i.pageY-o))}e.preventDefault()}else void 0!==s.touchY&&((s.momentum=15*Math.pow(Math.abs(i.pageY-s.touchStartY)/(e.timeStamp-s.touchStartTime),2))&&(this.menuScrollStop(t),this.menuScroll(t),e.preventDefault()),delete s.touchY)}}},menuShow:function(t){if((t.dataSM("beforefirstshowfired")||(t.dataSM("beforefirstshowfired",!0),this.$root.triggerHandler("beforefirstshow.smapi",t[0])!==!1))&&this.$root.triggerHandler("beforeshow.smapi",t[0])!==!1&&(t.dataSM("shown-before",!0),canAnimate&&t.stop(!0,!0),!t.is(":visible"))){var e=t.dataSM("parent-a"),i=this.isCollapsible();if((this.opts.keepHighlighted||i)&&e.addClass("highlighted"),i)t.removeClass("sm-nowrap").css({zIndex:"",width:"auto",minWidth:"",maxWidth:"",top:"",left:"",marginLeft:"",marginTop:""});else{if(t.css("z-index",this.zIndexInc=(this.zIndexInc||this.getStartZIndex())+1),(this.opts.subMenusMinWidth||this.opts.subMenusMaxWidth)&&(t.css({width:"auto",minWidth:"",maxWidth:""}).addClass("sm-nowrap"),this.opts.subMenusMinWidth&&t.css("min-width",this.opts.subMenusMinWidth),this.opts.subMenusMaxWidth)){var s=this.getWidth(t);t.css("max-width",this.opts.subMenusMaxWidth),s>this.getWidth(t)&&t.removeClass("sm-nowrap").css("width",this.opts.subMenusMaxWidth)}this.menuPosition(t)}var o=function(){t.css("overflow","")};i?canAnimate&&this.opts.collapsibleShowFunction?this.opts.collapsibleShowFunction.call(this,t,o):t.show(this.opts.collapsibleShowDuration,o):canAnimate&&this.opts.showFunction?this.opts.showFunction.call(this,t,o):t.show(this.opts.showDuration,o),e.attr("aria-expanded","true"),t.attr({"aria-expanded":"true","aria-hidden":"false"}),this.visibleSubMenus.push(t),this.$root.triggerHandler("show.smapi",t[0])}},popupHide:function(t){this.hideTimeout&&(clearTimeout(this.hideTimeout),this.hideTimeout=0);var e=this;this.hideTimeout=setTimeout(function(){e.menuHideAll()},t?1:this.opts.hideTimeout)},popupShow:function(t,e){if(!this.opts.isPopup)return alert('SmartMenus jQuery Error:\n\nIf you want to show this menu via the "popupShow" method, set the isPopup:true option.'),void 0;if(this.hideTimeout&&(clearTimeout(this.hideTimeout),this.hideTimeout=0),this.$root.dataSM("shown-before",!0),canAnimate&&this.$root.stop(!0,!0),!this.$root.is(":visible")){this.$root.css({left:t,top:e});var i=this,s=function(){i.$root.css("overflow","")};canAnimate&&this.opts.showFunction?this.opts.showFunction.call(this,this.$root,s):this.$root.show(this.opts.showDuration,s),this.visibleSubMenus[0]=this.$root}},refresh:function(){this.destroy(!0),this.init(!0)},rootKeyDown:function(t){if(this.handleEvents())switch(t.keyCode){case 27:var e=this.activatedItems[0];if(e){this.menuHideAll(),e[0].focus();var i=e.dataSM("sub");i&&this.menuHide(i)}break;case 32:var s=$(t.target);if(s.is("a")&&this.handleItemEvents(s)){var i=s.dataSM("sub");i&&!i.is(":visible")&&(this.itemClick({currentTarget:t.target}),t.preventDefault())}}},rootOut:function(t){if(this.handleEvents()&&!this.isTouchMode()&&t.target!=this.$root[0]&&(this.hideTimeout&&(clearTimeout(this.hideTimeout),this.hideTimeout=0),!this.opts.showOnClick||!this.opts.hideOnClick)){var e=this;this.hideTimeout=setTimeout(function(){e.menuHideAll()},this.opts.hideTimeout)}},rootOver:function(t){this.handleEvents()&&!this.isTouchMode()&&t.target!=this.$root[0]&&this.hideTimeout&&(clearTimeout(this.hideTimeout),this.hideTimeout=0)},winResize:function(t){if(this.handleEvents()){if(!("onorientationchange"in window)||"orientationchange"==t.type){var e=this.isCollapsible();this.wasCollapsible&&e||(this.activatedItems.length&&this.activatedItems[this.activatedItems.length-1][0].blur(),this.menuHideAll()),this.wasCollapsible=e}}else if(this.$disableOverlay){var i=this.$root.offset();this.$disableOverlay.css({top:i.top,left:i.left,width:this.$root.outerWidth(),height:this.$root.outerHeight()})}}}}),$.fn.dataSM=function(t,e){return e?this.data(t+"_smartmenus",e):this.data(t+"_smartmenus")},$.fn.removeDataSM=function(t){return this.removeData(t+"_smartmenus")},$.fn.smartmenus=function(options){if("string"==typeof options){var args=arguments,method=options;return Array.prototype.shift.call(args),this.each(function(){var t=$(this).data("smartmenus");t&&t[method]&&t[method].apply(t,args)})}return this.each(function(){var dataOpts=$(this).data("sm-options")||null;if(dataOpts)try{dataOpts=eval("("+dataOpts+")")}catch(e){dataOpts=null,alert('ERROR\n\nSmartMenus jQuery init:\nInvalid "data-sm-options" attribute value syntax.')}new $.SmartMenus(this,$.extend({},$.fn.smartmenus.defaults,options,dataOpts))})},$.fn.smartmenus.defaults={isPopup:!1,mainMenuSubOffsetX:0,mainMenuSubOffsetY:0,subMenusSubOffsetX:0,subMenusSubOffsetY:0,subMenusMinWidth:"10em",subMenusMaxWidth:"20em",subIndicators:!0,subIndicatorsPos:"append",subIndicatorsText:"",scrollStep:30,scrollAccelerate:!0,showTimeout:250,hideTimeout:500,showDuration:0,showFunction:null,hideDuration:0,hideFunction:function(t,e){t.fadeOut(200,e)},collapsibleShowDuration:0,collapsibleShowFunction:function(t,e){t.slideDown(200,e)},collapsibleHideDuration:0,collapsibleHideFunction:function(t,e){t.slideUp(200,e)},showOnClick:!1,hideOnClick:!0,noMouseOver:!1,keepInViewport:!0,keepHighlighted:!0,markCurrentItem:!1,markCurrentTree:!0,rightToLeftSubMenus:!1,bottomToTopSubMenus:!1,collapsibleBehavior:"default"},$}); \ No newline at end of file diff --git a/doc/C/html/linalg_8h.html b/doc/C/html/linalg_8h.html new file mode 100644 index 00000000..a5f07bd1 --- /dev/null +++ b/doc/C/html/linalg_8h.html @@ -0,0 +1,5071 @@ + + + + + + + +linalg: D:/Code/linalg/include/linalg.h File Reference + + + + + + + + + + + + + + + +
    +
    + + + + + + +
    +
    linalg 1.6.1 +
    +
    A linear algebra library that provides a user-friendly interface to several BLAS and LAPACK routines.
    +
    +
    + + + + + + + +
    +
    + +
    +
    +
    + +
    + +
    +
    + + +
    +
    +
    +
    +
    +
    Loading...
    +
    Searching...
    +
    No Matches
    +
    +
    +
    +
    + +
    + +
    linalg.h File Reference
    +
    +
    +
    #include <stdbool.h>
    +#include <complex.h>
    +
    +

    Go to the source code of this file.

    + + + + + + + + + + + + + + + + + + + + + + + + +

    +Macros

    +#define LA_NO_OPERATION   0
     
    +#define LA_TRANSPOSE   1
     
    +#define LA_HERMITIAN_TRANSPOSE   2
     
    +#define LA_NO_ERROR   0
     
    +#define LA_INVALID_INPUT_ERROR   101
     
    +#define LA_ARRAY_SIZE_ERROR   102
     
    +#define LA_SINGULAR_MATRIX_ERROR   103
     
    +#define LA_MATRIX_FORMAT_ERROR   104
     
    +#define LA_OUT_OF_MEMORY_ERROR   105
     
    +#define LA_CONVERGENCE_ERROR   106
     
    +#define LA_INVALID_OPERATION_ERROR   107
     
    + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +

    +Functions

    int la_rank1_update (int m, int n, double alpha, const double *x, const double *y, double *a, int lda)
     
    int la_rank1_update_cmplx (int m, int n, double complex alpha, const double complex *x, const double complex *y, double complex *a, int lda)
     
    int la_trace (int m, int n, const double *a, int lda, double *rst)
     
    int la_trace_cmplx (int m, int n, const double complex *a, int lda, double complex *rst)
     
    int la_mtx_mult (bool transa, bool transb, int m, int n, int k, double alpha, const double *a, int lda, const double *b, int ldb, double beta, double *c, int ldc)
     
    int la_mtx_mult_cmplx (int opa, int opb, int m, int n, int k, double complex alpha, const double complex *a, int lda, const double complex *b, int ldb, double complex beta, double complex *c, int ldc)
     
    int la_diag_mtx_mult (bool lside, bool transb, int m, int n, int k, double alpha, const double *a, const double *b, int ldb, double beta, double *c, int ldc)
     
    int la_diag_mtx_mult_cmplx (bool lside, int opb, int m, int n, int k, double complex alpha, const double complex *a, const double complex *b, int ldb, double complex beta, double complex *c, int ldc)
     
    int la_diag_mtx_mult_mixed (bool lside, int opb, int m, int n, int k, double complex alpha, const double *a, const double complex *b, int ldb, double complex beta, double complex *c, int ldc)
     
    int la_rank (int m, int n, double *a, int lda, int *rnk)
     
    int la_rank_cmplx (int m, int n, double complex *a, int lda, int *rnk)
     
    int la_det (int n, double *a, int lda, double *d)
     
    int la_det_cmplx (int n, double complex *a, int lda, double complex *d)
     
    int la_tri_mtx_mult (bool upper, double alpha, int n, const double *a, int lda, double beta, double *b, int ldb)
     
    int la_tri_mtx_mult_cmplx (bool upper, double complex alpha, int n, const double complex *a, int lda, double complex beta, double complex *b, int ldb)
     
    int la_lu_factor (int m, int n, double *a, int lda, int *ipvt)
     
    int la_lu_factor_cmplx (int m, int n, double complex *a, int lda, int *ipvt)
     
    int la_form_lu (int n, double *a, int lda, int *ipvt, double *u, int ldu, double *p, int ldp)
     
    int la_form_lu_cmplx (int n, double complex *a, int lda, int *ipvt, double complex *u, int ldu, double *p, int ldp)
     
    int la_qr_factor (int m, int n, double *a, int lda, double *tau)
     
    int la_qr_factor_cmplx (int m, int n, double complex *a, int lda, double complex *tau)
     
    int la_qr_factor_pvt (int m, int n, double *a, int lda, double *tau, int *jpvt)
     
    int la_qr_factor_cmplx_pvt (int m, int n, double complex *a, int lda, double complex *tau, int *jpvt)
     
    int la_form_qr (bool fullq, int m, int n, double *r, int ldr, const double *tau, double *q, int ldq)
     
    int la_form_qr_cmplx (bool fullq, int m, int n, double complex *r, int ldr, const double complex *tau, double complex *q, int ldq)
     
    int la_form_qr_pvt (bool fullq, int m, int n, double *r, int ldr, const double *tau, const int *pvt, double *q, int ldq, double *p, int ldp)
     
    int la_form_qr_cmplx_pvt (bool fullq, int m, int n, double complex *r, int ldr, const double complex *tau, const int *pvt, double complex *q, int ldq, double complex *p, int ldp)
     
    int la_mult_qr (bool lside, bool trans, int m, int n, int k, double *a, int lda, const double *tau, double *c, int ldc)
     
    int la_mult_qr_cmplx (bool lside, bool trans, int m, int n, int k, double complex *a, int lda, const double complex *tau, double complex *c, int ldc)
     
    int la_qr_rank1_update (int m, int n, double *q, int ldq, double *r, int ldr, double *u, double *v)
     
    int la_qr_rank1_update_cmplx (int m, int n, double complex *q, int ldq, double complex *r, int ldr, double complex *u, double complex *v)
     
    int la_cholesky_factor (bool upper, int n, double *a, int lda)
     
    int la_cholesky_factor_cmplx (bool upper, int n, double complex *a, int lda)
     
    int la_cholesky_rank1_update (int n, double *r, int ldr, double *u)
     
    int la_cholesky_rank1_update_cmplx (int n, double complex *r, int ldr, double complex *u)
     
    int la_cholesky_rank1_downdate (int n, double *r, int ldr, double *u)
     
    int la_cholesky_rank1_downdate_cmplx (int n, double complex *r, int ldr, double complex *u)
     
    int la_svd (int m, int n, double *a, int lda, double *s, double *u, int ldu, double *vt, int ldv)
     
    int la_svd_cmplx (int m, int n, double complex *a, int lda, double *s, double complex *u, int ldu, double complex *vt, int ldv)
     
    int la_solve_tri_mtx (bool lside, bool upper, bool trans, bool nounit, int m, int n, double alpha, const double *a, int lda, double *b, int ldb)
     
    int la_solve_tri_mtx_cmplx (bool lside, bool upper, bool trans, bool nounit, int m, int n, double complex alpha, const double complex *a, int lda, double complex *b, int ldb)
     
    int la_solve_lu (int m, int n, const double *a, int lda, const int *ipvt, double *b, int ldb)
     
    int la_solve_lu_cmplx (int m, int n, const double complex *a, int lda, const int *ipvt, double complex *b, int ldb)
     
    int la_solve_qr (int m, int n, int k, double *a, int lda, const double *tau, double *b, int ldb)
     
    int la_solve_qr_cmplx (int m, int n, int k, double complex *a, int lda, const double complex *tau, double complex *b, int ldb)
     
    int la_solve_qr_pvt (int m, int n, int k, double *a, int lda, const double *tau, const int *jpvt, double *b, int ldb)
     
    int la_solve_qr_cmplx_pvt (int m, int n, int k, double complex *a, int lda, const double complex *tau, const int *jpvt, double complex *b, int ldb)
     
    int la_solve_cholesky (bool upper, int m, int n, const double *a, int lda, double *b, int ldb)
     
    int la_solve_cholesky_cmplx (bool upper, int m, int n, const double complex *a, int lda, double complex *b, int ldb)
     
    int la_solve_least_squares (int m, int n, int k, double *a, int lda, double *b, int ldb)
     
    int la_solve_least_squares_cmplx (int m, int n, int k, double complex *a, int lda, double complex *b, int ldb)
     
    int la_inverse (int n, double *a, int lda)
     
    int la_inverse_cmplx (int n, double complex *a, int lda)
     
    int la_pinverse (int m, int n, double *a, int lda, double *ainv, int ldai)
     
    int la_pinverse_cmplx (int m, int n, double complex *a, int lda, double complex *ainv, int ldai)
     
    int la_eigen_symm (bool vecs, int n, double *a, int lda, double *vals)
     
    int la_eigen_asymm (bool vecs, int n, double *a, int lda, double complex *vals, double complex *v, int ldv)
     
    int la_eigen_gen (bool vecs, int n, double *a, int lda, double *b, int ldb, double complex *alpha, double *beta, double complex *v, int ldv)
     
    int la_eigen_cmplx (bool vecs, int n, double complex *a, int lda, double complex *vals, double complex *v, int ldv)
     
    int la_sort_eigen (bool ascend, int n, double *vals, double *vecs, int ldv)
     
    int la_sort_eigen_cmplx (bool ascend, int n, double complex *vals, double complex *vecs, int ldv)
     
    +

    Function Documentation

    + +

    ◆ la_cholesky_factor()

    + +
    +
    + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
    int la_cholesky_factor (bool upper,
    int n,
    double * a,
    int lda 
    )
    +
    +

    Computes the Cholesky factorization of a symmetric, positive definite matrix.

    +
    Parameters
    + + + + + +
    upperSet to true to compute the upper triangular factoriztion A = U**T * U; else, set to false to compute the lower triangular factorzation A = L * L**T.
    nThe dimension of matrix A.
    aOn input, the N-by-N matrix to factor. On output, the factored matrix is returned in either the upper or lower triangular portion of the matrix, dependent upon the value of upper.
    ldaThe leading dimension of matrix A.
    +
    +
    +
    Returns
    An error code. The following codes are possible.
      +
    • LA_NO_ERROR: No error occurred. Successful operation.
    • +
    • LA_INVALID_INPUT_ERROR: Occurs if lda is not correct.
    • +
    • LA_MATRIX_FORMAT_ERROR: Occurs if a is not positive definite.
    • +
    +
    + +
    +
    + +

    ◆ la_cholesky_factor_cmplx()

    + +
    +
    + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
    int la_cholesky_factor_cmplx (bool upper,
    int n,
    double complex * a,
    int lda 
    )
    +
    +

    Computes the Cholesky factorization of a symmetric, positive definite matrix.

    +
    Parameters
    + + + + + +
    upperSet to true to compute the upper triangular factoriztion A = U**T * U; else, set to false to compute the lower triangular factorzation A = L * L**T.
    nThe dimension of matrix A.
    aOn input, the N-by-N matrix to factor. On output, the factored matrix is returned in either the upper or lower triangular portion of the matrix, dependent upon the value of upper.
    ldaThe leading dimension of matrix A.
    +
    +
    +
    Returns
    An error code. The following codes are possible.
      +
    • LA_NO_ERROR: No error occurred. Successful operation.
    • +
    • LA_INVALID_INPUT_ERROR: Occurs if lda is not correct.
    • +
    • LA_MATRIX_FORMAT_ERROR: Occurs if a is not positive definite.
    • +
    +
    + +
    +
    + +

    ◆ la_cholesky_rank1_downdate()

    + +
    +
    + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
    int la_cholesky_rank1_downdate (int n,
    double * r,
    int ldr,
    double * u 
    )
    +
    +

    Computes the rank 1 downdate to a Cholesky factored matrix (upper triangular).

    +
    Parameters
    + + + + + +
    nThe dimension of the matrix.
    rOn input, the N-by-N upper triangular matrix R. On output, the updated matrix R1.
    ldrThe leading dimension of matrix R.
    uOn input, the N-element update vector U. On output, the rotation sines used to transform R to R1.
    +
    +
    +
    Returns
    An error code. The following codes are possible.
      +
    • LA_NO_ERROR: No error occurred. Successful operation.
    • +
    • LA_INVALID_INPUT_ERROR: Occurs if ldr is not correct.
    • +
    • LA_OUT_OF_MEMORY_ERROR: Occurs if local memory must be allocated, and there is insufficient memory available.
    • +
    • LA_MATRIX_FORMAT_ERROR: Occurs if the downdated matrix is not positive definite.
    • +
    +
    + +
    +
    + +

    ◆ la_cholesky_rank1_downdate_cmplx()

    + +
    +
    + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
    int la_cholesky_rank1_downdate_cmplx (int n,
    double complex * r,
    int ldr,
    double complex * u 
    )
    +
    +

    Computes the rank 1 downdate to a Cholesky factored matrix (upper triangular).

    +
    Parameters
    + + + + + +
    nThe dimension of the matrix.
    rOn input, the N-by-N upper triangular matrix R. On output, the updated matrix R1.
    ldrThe leading dimension of matrix R.
    uOn input, the N-element update vector U. On output, the rotation sines used to transform R to R1.
    +
    +
    +
    Returns
    An error code. The following codes are possible.
      +
    • LA_NO_ERROR: No error occurred. Successful operation.
    • +
    • LA_INVALID_INPUT_ERROR: Occurs if ldr is not correct.
    • +
    • LA_OUT_OF_MEMORY_ERROR: Occurs if local memory must be allocated, and there is insufficient memory available.
    • +
    • LA_MATRIX_FORMAT_ERROR: Occurs if the downdated matrix is not positive definite.
    • +
    +
    + +
    +
    + +

    ◆ la_cholesky_rank1_update()

    + +
    +
    + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
    int la_cholesky_rank1_update (int n,
    double * r,
    int ldr,
    double * u 
    )
    +
    +

    Computes the rank 1 update to a Cholesky factored matrix (upper triangular).

    +
    Parameters
    + + + + + +
    nThe dimension of the matrix.
    rOn input, the N-by-N upper triangular matrix R. On output, the updated matrix R1.
    ldrThe leading dimension of matrix R.
    uOn input, the N-element update vector U. On output, the rotation sines used to transform R to R1.
    +
    +
    +
    Returns
    An error code. The following codes are possible.
      +
    • LA_NO_ERROR: No error occurred. Successful operation.
    • +
    • LA_INVALID_INPUT_ERROR: Occurs if ldr is not correct.
    • +
    • LA_OUT_OF_MEMORY_ERROR: Occurs if local memory must be allocated, and there is insufficient memory available.
    • +
    +
    + +
    +
    + +

    ◆ la_cholesky_rank1_update_cmplx()

    + +
    +
    + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
    int la_cholesky_rank1_update_cmplx (int n,
    double complex * r,
    int ldr,
    double complex * u 
    )
    +
    +

    Computes the rank 1 update to a Cholesky factored matrix (upper triangular).

    +
    Parameters
    + + + + + +
    nThe dimension of the matrix.
    rOn input, the N-by-N upper triangular matrix R. On output, the updated matrix R1.
    ldrThe leading dimension of matrix R.
    uOn input, the N-element update vector U. On output, the rotation sines used to transform R to R1.
    +
    +
    +
    Returns
    An error code. The following codes are possible.
      +
    • LA_NO_ERROR: No error occurred. Successful operation.
    • +
    • LA_INVALID_INPUT_ERROR: Occurs if ldr is not correct.
    • +
    • LA_OUT_OF_MEMORY_ERROR: Occurs if local memory must be allocated, and there is insufficient memory available.
    • +
    +
    + +
    +
    + +

    ◆ la_det()

    + +
    +
    + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
    int la_det (int n,
    double * a,
    int lda,
    double * d 
    )
    +
    +

    Computes the determinant of a square matrix.

    +
    Parameters
    + + + + + +
    nThe dimension of the matrix.
    aThe N-by-N matrix. The matrix is overwritten on output.
    ldaThe leading dimension of the matrix.
    dThe determinant of a.
    +
    +
    +
    Returns
    An error code. The following codes are possible.
      +
    • LA_NO_ERROR: No error occurred. Successful operation.
    • +
    • LA_ARRAY_SIZE_ERROR: Occurs if any of the input arrays are not sized appropriately.
    • +
    • LA_OUT_OF_MEMORY_ERROR: Occurs if local memory must be allocated, and there is insufficient memory available.
    • +
    +
    + +
    +
    + +

    ◆ la_det_cmplx()

    + +
    +
    + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
    int la_det_cmplx (int n,
    double complex * a,
    int lda,
    double complex * d 
    )
    +
    +

    Computes the determinant of a square matrix.

    +
    Parameters
    + + + + + +
    nThe dimension of the matrix.
    aThe N-by-N matrix. The matrix is overwritten on output.
    ldaThe leading dimension of the matrix.
    dThe determinant of a.
    +
    +
    +
    Returns
    An error code. The following codes are possible.
      +
    • LA_NO_ERROR: No error occurred. Successful operation.
    • +
    • LA_ARRAY_SIZE_ERROR: Occurs if any of the input arrays are not sized appropriately.
    • +
    • LA_OUT_OF_MEMORY_ERROR: Occurs if local memory must be allocated, and there is insufficient memory available.
    • +
    +
    + +
    +
    + +

    ◆ la_diag_mtx_mult()

    + +
    +
    + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
    int la_diag_mtx_mult (bool lside,
    bool transb,
    int m,
    int n,
    int k,
    double alpha,
    const double * a,
    const double * b,
    int ldb,
    double beta,
    double * c,
    int ldc 
    )
    +
    +

    Computes the matrix operation: \( C = \alpha A op(B) + \beta C \), or \( C = \alpha op(B) A + \beta C \).

    +
    Parameters
    + + + + + + + + + + + + + +
    lsideSet to true to apply matrix A from the left; else, set to false to apply matrix A from the left.
    transSet to true if op(B) == B**T; else, set to false if op(B) == B.
    mThe number of rows in the matrix C.
    nThe number of columns in the matrix C.
    kThe inner dimension of the matrix product A * op(B).
    alphaA scalar multiplier.
    aA P-element array containing the diagonal elements of matrix A where P = MIN(m, k) if lside is true; else, P = MIN(n, k) if lside is false.
    bThe LDB-by-TDB matrix B where (LDB = leading dimension of B, and TDB = trailing dimension of B):
      +
    • lside == true & trans == true: LDB = n, TDB = k
    • +
    • lside == true & trans == false: LDB = k, TDB = n
    • +
    • lside == false & trans == true: LDB = k, TDB = m
    • +
    • lside == false & trans == false: LDB = m, TDB = k
    • +
    +
    ldbThe leading dimension of matrix B.
    betaA scalar multiplier.
    cThe m by n matrix C.
    ldcThe leading dimension of matrix C.
    +
    +
    +
    Returns
    An error code. The following codes are possible.
      +
    • LA_NO_ERROR: No error occurred. Successful operation.
    • +
    • LA_INVALID_INPUT_ERROR: Occurs if ldb, or ldc are not correct.
    • +
    • LA_ARRAY_SIZE_ERROR: Occurs if any of the input array sizes are incorrect.
    • +
    +
    + +
    +
    + +

    ◆ la_diag_mtx_mult_cmplx()

    + +
    +
    + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
    int la_diag_mtx_mult_cmplx (bool lside,
    int opb,
    int m,
    int n,
    int k,
    double complex alpha,
    const double complex * a,
    const double complex * b,
    int ldb,
    double complex beta,
    double complex * c,
    int ldc 
    )
    +
    +

    Computes the matrix operation: \( C = \alpha A op(B) + \beta C \), or \( C = \alpha op(B) A + \beta * C \).

    +
    Parameters
    + + + + + + + + + + + + + +
    lsideSet to true to apply matrix A from the left; else, set to false to apply matrix A from the left.
    opbSet to LA_TRANSPOSE to compute op(B) as a direct transpose of B, set to LA_HERMITIAN_TRANSPOSE to compute op(B) as the Hermitian transpose of B, otherwise, set to LA_NO_OPERATION to compute op(B) as B.
    mThe number of rows in the matrix C.
    nThe number of columns in the matrix C.
    kThe inner dimension of the matrix product A * op(B).
    alphaA scalar multiplier.
    aA P-element array containing the diagonal elements of matrix A where P = MIN(m, k) if lside is true; else, P = MIN(n, k) if lside is false.
    bThe LDB-by-TDB matrix B where (LDB = leading dimension of B, and TDB = trailing dimension of B):
      +
    • lside == true & trans == true: LDB = n, TDB = k
    • +
    • lside == true & trans == false: LDB = k, TDB = n
    • +
    • lside == false & trans == true: LDB = k, TDB = m
    • +
    • lside == false & trans == false: LDB = m, TDB = k
    • +
    +
    ldbThe leading dimension of matrix B.
    betaA scalar multiplier.
    cThe m by n matrix C.
    ldcThe leading dimension of matrix C.
    +
    +
    +
    Returns
    An error code. The following codes are possible.
      +
    • LA_NO_ERROR: No error occurred. Successful operation.
    • +
    • LA_INVALID_INPUT_ERROR: Occurs if ldb, or ldc are not correct.
    • +
    • LA_ARRAY_SIZE_ERROR: Occurs if any of the input array sizes are incorrect.
    • +
    +
    + +
    +
    + +

    ◆ la_diag_mtx_mult_mixed()

    + +
    +
    + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
    int la_diag_mtx_mult_mixed (bool lside,
    int opb,
    int m,
    int n,
    int k,
    double complex alpha,
    const double * a,
    const double complex * b,
    int ldb,
    double complex beta,
    double complex * c,
    int ldc 
    )
    +
    +

    Computes the matrix operation: \( C = \alpha A op(B) + \beta C \), or \( C = \alpha op(B) A + \beta C \).

    +
    Parameters
    + + + + + + + + + + + + + +
    lsideSet to true to apply matrix A from the left; else, set to false to apply matrix A from the left.
    opbSet to LA_TRANSPOSE to compute op(B) as a direct transpose of B, set to LA_HERMITIAN_TRANSPOSE to compute op(B) as the Hermitian transpose of B, otherwise, set to LA_NO_OPERATION to compute op(B) as B.
    mThe number of rows in the matrix C.
    nThe number of columns in the matrix C.
    kThe inner dimension of the matrix product A * op(B).
    alphaA scalar multiplier.
    aA P-element array containing the diagonal elements of matrix A where P = MIN(m, k) if lside is true; else, P = MIN(n, k) if lside is false.
    bThe LDB-by-TDB matrix B where (LDB = leading dimension of B, and TDB = trailing dimension of B):
      +
    • lside == true & trans == true: LDB = n, TDB = k
    • +
    • lside == true & trans == false: LDB = k, TDB = n
    • +
    • lside == false & trans == true: LDB = k, TDB = m
    • +
    • lside == false & trans == false: LDB = m, TDB = k
    • +
    +
    ldbThe leading dimension of matrix B.
    betaA scalar multiplier.
    cThe m by n matrix C.
    ldcThe leading dimension of matrix C.
    +
    +
    +
    Returns
    An error code. The following codes are possible.
      +
    • LA_NO_ERROR: No error occurred. Successful operation.
    • +
    • LA_INVALID_INPUT_ERROR: Occurs if ldb, or ldc are not correct.
    • +
    • LA_ARRAY_SIZE_ERROR: Occurs if any of the input array sizes are incorrect.
    • +
    +
    + +
    +
    + +

    ◆ la_eigen_asymm()

    + +
    +
    + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
    int la_eigen_asymm (bool vecs,
    int n,
    double * a,
    int lda,
    double complex * vals,
    double complex * v,
    int ldv 
    )
    +
    +

    Computes the eigenvalues, and optionally the right eigenvectors of a square matrix.

    +
    Parameters
    + + + + + + + +
    vecsSet to true to compute the eigenvectors as well as the eigenvalues; else, set to false to just compute the eigenvalues.
    nThe dimension of the matrix.
    aOn input, the N-by-N matrix on which to operate. On output, the contents of this matrix are overwritten.
    ldaThe leading dimension of matrix A.
    valsAn N-element array containing the eigenvalues of the matrix. The eigenvalues are not sorted.
    vAn N-by-N matrix where the right eigenvectors will be written (one per column).
    +
    +
    +
    Returns
    An error code. The following codes are possible.
      +
    • LA_NO_ERROR: No error occurred. Successful operation.
    • +
    • LA_INVALID_INPUT_ERROR: Occurs if lda or ldv is not correct.
    • +
    • LA_OUT_OF_MEMORY_ERROR: Occurs if local memory must be allocated, and there is insufficient memory available.
    • +
    • LA_CONVERGENCE_ERROR: Occurs if the algorithm failed to converge.
    • +
    +
    + +
    +
    + +

    ◆ la_eigen_cmplx()

    + +
    +
    + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
    int la_eigen_cmplx (bool vecs,
    int n,
    double complex * a,
    int lda,
    double complex * vals,
    double complex * v,
    int ldv 
    )
    +
    +

    Computes the eigenvalues, and optionally the right eigenvectors of a square matrix.

    +
    Parameters
    + + + + + + + +
    vecsSet to true to compute the eigenvectors as well as the eigenvalues; else, set to false to just compute the eigenvalues.
    nThe dimension of the matrix.
    aOn input, the N-by-N matrix on which to operate. On output, the contents of this matrix are overwritten.
    ldaThe leading dimension of matrix A.
    valsAn N-element array containing the eigenvalues of the matrix. The eigenvalues are not sorted.
    vAn N-by-N matrix where the right eigenvectors will be written (one per column).
    +
    +
    +
    Returns
    An error code. The following codes are possible.
      +
    • LA_NO_ERROR: No error occurred. Successful operation.
    • +
    • LA_INVALID_INPUT_ERROR: Occurs if lda or ldv is not correct.
    • +
    • LA_OUT_OF_MEMORY_ERROR: Occurs if local memory must be allocated, and there is insufficient memory available.
    • +
    • LA_CONVERGENCE_ERROR: Occurs if the algorithm failed to converge.
    • +
    +
    + +
    +
    + +

    ◆ la_eigen_gen()

    + +
    +
    + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
    int la_eigen_gen (bool vecs,
    int n,
    double * a,
    int lda,
    double * b,
    int ldb,
    double complex * alpha,
    double * beta,
    double complex * v,
    int ldv 
    )
    +
    +

    Computes the eigenvalues, and optionally the right eigenvectors of a square matrix assuming the structure of the eigenvalue problem is A*X = lambda*B*X.

    +
    Parameters
    + + + + + + + + + + +
    vecsSet to true to compute the eigenvectors as well as the eigenvalues; else, set to false to just compute the eigenvalues.
    nThe dimension of the matrix.
    aOn input, the N-by-N matrix A. On output, the contents of this matrix are overwritten.
    ldaThe leading dimension of matrix A.
    bOn input, the N-by-N matrix B. On output, the contents of this matrix are overwritten.
    ldbThe leading dimension of matrix B.
    alphaAn N-element array a factor of the eigenvalues. The eigenvalues must be computed as ALPHA / BETA. This however, is not as trivial as it seems as it is entirely possible, and likely, that ALPHA / BETA can overflow or underflow. With that said, the values in ALPHA will always be less than and usually comparable with the NORM(A).
    betaAn N-element array that contains the denominator used to determine the eigenvalues as ALPHA / BETA. If used, the values in this array will always be less than and usually comparable with the NORM(B).
    vAn N-by-N matrix where the right eigenvectors will be written (one per column).
    +
    +
    +
    Returns
    An error code. The following codes are possible.
      +
    • LA_NO_ERROR: No error occurred. Successful operation.
    • +
    • LA_INVALID_INPUT_ERROR: Occurs if lda or ldv is not correct.
    • +
    • LA_OUT_OF_MEMORY_ERROR: Occurs if local memory must be allocated, and there is insufficient memory available.
    • +
    • LA_CONVERGENCE_ERROR: Occurs if the algorithm failed to converge.
    • +
    +
    + +
    +
    + +

    ◆ la_eigen_symm()

    + +
    +
    + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
    int la_eigen_symm (bool vecs,
    int n,
    double * a,
    int lda,
    double * vals 
    )
    +
    +

    Computes the eigenvalues, and optionally the eigenvectors of a real, symmetric matrix.

    +
    Parameters
    + + + + + + +
    vecsSet to true to compute the eigenvectors as well as the eigenvalues; else, set to false to just compute the eigenvalues.
    nThe dimension of the matrix.
    aOn input, the N-by-N symmetric matrix on which to operate. On output, and if vecs is set to true, the matrix will contain the eigenvectors (one per column) corresponding to each eigenvalue in vals. If vecs is set to false, the lower triangular portion of the matrix is overwritten.
    ldaThe leading dimension of matrix A.
    valsAn N-element array that will contain the eigenvalues sorted into ascending order.
    +
    +
    +
    Returns
    An error code. The following codes are possible.
      +
    • LA_NO_ERROR: No error occurred. Successful operation.
    • +
    • LA_INVALID_INPUT_ERROR: Occurs if lda is not correct.
    • +
    • LA_OUT_OF_MEMORY_ERROR: Occurs if local memory must be allocated, and there is insufficient memory available.
    • +
    • LA_CONVERGENCE_ERROR: Occurs if the algorithm failed to converge.
    • +
    +
    + +
    +
    + +

    ◆ la_form_lu()

    + +
    +
    + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
    int la_form_lu (int n,
    double * a,
    int lda,
    int * ipvt,
    double * u,
    int ldu,
    double * p,
    int ldp 
    )
    +
    +

    Extracts the L, U, and P matrices from the LU factorization output from la_lu_factor.

    +
    Parameters
    + + + + + + + + + +
    nThe dimension of the input matrix.
    aOn input, the N-by-N matrix as output by la_lu_factor. On output, the N-by-N lower triangular matrix L.
    ldaThe leading dimension of a.
    ipvtThe N-element pivot array as output by la_lu_factor.
    uAn N-by-N matrix where the U matrix will be written.
    lduThe leading dimension of u.
    pAn N-by-N matrix where the row permutation matrix will be written.
    ldpThe leading dimension of p.
    +
    +
    +
    Returns
    An error code. The following codes are possible.
      +
    • LA_NO_ERROR: No error occurred. Successful operation.
    • +
    • LA_INVALID_INPUT_ERROR: Occurs if lda, ldu, or ldp is not correct.
    • +
    +
    + +
    +
    + +

    ◆ la_form_lu_cmplx()

    + +
    +
    + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
    int la_form_lu_cmplx (int n,
    double complex * a,
    int lda,
    int * ipvt,
    double complex * u,
    int ldu,
    double * p,
    int ldp 
    )
    +
    +

    Extracts the L, U, and P matrices from the LU factorization output from la_lu_factor_cmplx.

    +
    Parameters
    + + + + + + + + + +
    nThe dimension of the input matrix.
    aOn input, the N-by-N matrix as output by la_lu_factor_cmplx. On output, the N-by-N lower triangular matrix L.
    ldaThe leading dimension of a.
    ipvtThe N-element pivot array as output by la_lu_factor_cmplx.
    uAn N-by-N matrix where the U matrix will be written.
    lduThe leading dimension of u.
    pAn N-by-N matrix where the row permutation matrix will be written.
    ldpThe leading dimension of p.
    +
    +
    +
    Returns
    An error code. The following codes are possible.
      +
    • LA_NO_ERROR: No error occurred. Successful operation.
    • +
    • LA_INVALID_INPUT_ERROR: Occurs if lda, ldu, or ldp is not correct.
    • +
    +
    + +
    +
    + +

    ◆ la_form_qr()

    + +
    +
    + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
    int la_form_qr (bool fullq,
    int m,
    int n,
    double * r,
    int ldr,
    const double * tau,
    double * q,
    int ldq 
    )
    +
    +

    Forms the full M-by-M orthogonal matrix Q from the elementary reflectors returned by the base QR factorization algorithm.

    +
    Parameters
    + + + + + + + + + +
    fullqSet to true to always return the full Q matrix; else, set to false, and in the event that M > N, Q may be supplied as M-by-N, and therefore only return the useful submatrix Q1 (Q = [Q1, Q2]) as the factorization can be written as Q * R = [Q1, Q2] * [R1; 0].
    mThe number of rows in R.
    nThe number of columns in R.
    rOn input, the M-by-N factored matrix as returned by the QR factorization routine. On output, the upper triangular matrix R.
    ldrThe leading dimension of matrix R.
    tauA MIN(M, N)-element array containing the scalar factors of each elementary reflector defined in r.
    qAn M-by-M matrix where the full Q matrix will be written. In the event that fullq is set to false, and M > N, this matrix need only by M-by-N.
    ldqThe leading dimension of matrix Q.
    +
    +
    +
    Returns
    An error code. The following codes are possible.
      +
    • LA_NO_ERROR: No error occurred. Successful operation.
    • +
    • LA_INVALID_INPUT_ERROR: Occurs if lda is not correct.
    • +
    • LA_OUT_OF_MEMORY_ERROR: Occurs if there is insufficient memory available.
    • +
    +
    + +
    +
    + +

    ◆ la_form_qr_cmplx()

    + +
    +
    + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
    int la_form_qr_cmplx (bool fullq,
    int m,
    int n,
    double complex * r,
    int ldr,
    const double complex * tau,
    double complex * q,
    int ldq 
    )
    +
    +

    Forms the full M-by-M orthogonal matrix Q from the elementary reflectors returned by the base QR factorization algorithm.

    +
    Parameters
    + + + + + + + + + +
    fullqSet to true to always return the full Q matrix; else, set to false, and in the event that M > N, Q may be supplied as M-by-N, and therefore only return the useful submatrix Q1 (Q = [Q1, Q2]) as the factorization can be written as Q * R = [Q1, Q2] * [R1; 0].
    mThe number of rows in R.
    nThe number of columns in R.
    rOn input, the M-by-N factored matrix as returned by the QR factorization routine. On output, the upper triangular matrix R.
    ldrThe leading dimension of matrix R.
    tauA MIN(M, N)-element array containing the scalar factors of each elementary reflector defined in r.
    qAn M-by-M matrix where the full Q matrix will be written. In the event that fullq is set to false, and M > N, this matrix need only by M-by-N.
    ldqThe leading dimension of matrix Q.
    +
    +
    +
    Returns
    An error code. The following codes are possible.
      +
    • LA_NO_ERROR: No error occurred. Successful operation.
    • +
    • LA_INVALID_INPUT_ERROR: Occurs if lda is not correct.
    • +
    • LA_OUT_OF_MEMORY_ERROR: Occurs if there is insufficient memory available.
    • +
    +
    + +
    +
    + +

    ◆ la_form_qr_cmplx_pvt()

    + +
    +
    + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
    int la_form_qr_cmplx_pvt (bool fullq,
    int m,
    int n,
    double complex * r,
    int ldr,
    const double complex * tau,
    const int * pvt,
    double complex * q,
    int ldq,
    double complex * p,
    int ldp 
    )
    +
    +

    Forms the full M-by-M orthogonal matrix Q from the elementary reflectors returned by the base QR factorization algorithm. This routine also inflates the pivot array into an N-by-N matrix P such that \( A P = Q R \).

    +
    Parameters
    + + + + + + + + + + + + +
    fullqSet to true to always return the full Q matrix; else, set to false, and in the event that M > N, Q may be supplied as M-by-N, and therefore only return the useful submatrix Q1 (Q = [Q1, Q2]) as the factorization can be written as Q * R = [Q1, Q2] * [R1; 0].
    mThe number of rows in R.
    nThe number of columns in R.
    rOn input, the M-by-N factored matrix as returned by the QR factorization routine. On output, the upper triangular matrix R.
    ldrThe leading dimension of matrix R.
    tauA MIN(M, N)-element array containing the scalar factors of each elementary reflector defined in r.
    pvtAn N-element array containing the pivot information from the QR factorization.
    qAn M-by-M matrix where the full Q matrix will be written. In the event that fullq is set to false, and M > N, this matrix need only by M-by-N.
    ldqThe leading dimension of matrix Q.
    pAn N-by-N matrix where the pivot matrix P will be written.
    ldpThe leading dimension of matrix P.
    +
    +
    +
    Returns
    An error code. The following codes are possible.
      +
    • LA_NO_ERROR: No error occurred. Successful operation.
    • +
    • LA_INVALID_INPUT_ERROR: Occurs if lda is not correct.
    • +
    • LA_OUT_OF_MEMORY_ERROR: Occurs if there is insufficient memory available.
    • +
    +
    + +
    +
    + +

    ◆ la_form_qr_pvt()

    + +
    +
    + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
    int la_form_qr_pvt (bool fullq,
    int m,
    int n,
    double * r,
    int ldr,
    const double * tau,
    const int * pvt,
    double * q,
    int ldq,
    double * p,
    int ldp 
    )
    +
    +

    Forms the full M-by-M orthogonal matrix Q from the elementary reflectors returned by the base QR factorization algorithm. This routine also inflates the pivot array into an N-by-N matrix P such that \( A P = Q R \).

    +
    Parameters
    + + + + + + + + + + + + +
    fullqSet to true to always return the full Q matrix; else, set to false, and in the event that M > N, Q may be supplied as M-by-N, and therefore only return the useful submatrix Q1 (Q = [Q1, Q2]) as the factorization can be written as Q * R = [Q1, Q2] * [R1; 0].
    mThe number of rows in R.
    nThe number of columns in R.
    rOn input, the M-by-N factored matrix as returned by the QR factorization routine. On output, the upper triangular matrix R.
    ldrThe leading dimension of matrix R.
    tauA MIN(M, N)-element array containing the scalar factors of each elementary reflector defined in r.
    pvtAn N-element array containing the pivot information from the QR factorization.
    qAn M-by-M matrix where the full Q matrix will be written. In the event that fullq is set to false, and M > N, this matrix need only by M-by-N.
    ldqThe leading dimension of matrix Q.
    pAn N-by-N matrix where the pivot matrix P will be written.
    ldpThe leading dimension of matrix P.
    +
    +
    +
    Returns
    An error code. The following codes are possible.
      +
    • LA_NO_ERROR: No error occurred. Successful operation.
    • +
    • LA_INVALID_INPUT_ERROR: Occurs if lda is not correct.
    • +
    • LA_OUT_OF_MEMORY_ERROR: Occurs if there is insufficient memory available.
    • +
    +
    + +
    +
    + +

    ◆ la_inverse()

    + +
    +
    + + + + + + + + + + + + + + + + + + + + + + + + +
    int la_inverse (int n,
    double * a,
    int lda 
    )
    +
    +

    Computes the inverse of a square matrix.

    +
    Parameters
    + + + + +
    nThe dimension of matrix A.
    aOn input, the N-by-N matrix to invert. On output, the inverted matrix.
    ldaThe leading dimension of matrix A.
    +
    +
    +
    Returns
    An error code. The following codes are possible.
      +
    • LA_NO_ERROR: No error occurred. Successful operation.
    • +
    • LA_INVALID_INPUT_ERROR: Occurs if lda is not correct.
    • +
    • LA_SINGULAR_MATRIX_ERROR: Occurs if the input matrix is singular.
    • +
    +
    + +
    +
    + +

    ◆ la_inverse_cmplx()

    + +
    +
    + + + + + + + + + + + + + + + + + + + + + + + + +
    int la_inverse_cmplx (int n,
    double complex * a,
    int lda 
    )
    +
    +

    Computes the inverse of a square matrix.

    +
    Parameters
    + + + + +
    nThe dimension of matrix A.
    aOn input, the N-by-N matrix to invert. On output, the inverted matrix.
    ldaThe leading dimension of matrix A.
    +
    +
    +
    Returns
    An error code. The following codes are possible.
      +
    • LA_NO_ERROR: No error occurred. Successful operation.
    • +
    • LA_INVALID_INPUT_ERROR: Occurs if lda is not correct.
    • +
    • LA_SINGULAR_MATRIX_ERROR: Occurs if the input matrix is singular.
    • +
    +
    + +
    +
    + +

    ◆ la_lu_factor()

    + +
    +
    + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
    int la_lu_factor (int m,
    int n,
    double * a,
    int lda,
    int * ipvt 
    )
    +
    +

    Computes the LU factorization of an M-by-N matrix.

    +
    Parameters
    + + + + + + +
    mThe number of rows in the matrix.
    nThe number of columns in the matrix.
    aOn input, the M-by-N matrix on which to operate. On output, the LU factored matrix in the form [L\U] where the unit diagonal elements of L are not stored.
    ldaThe leading dimension of matrix A.
    ipvtAn MIN(M, N)-element array used to track row-pivot operations. The array stored pivot information such that row I is interchanged with row IPVT(I).
    +
    +
    +
    Returns
    An error code. The following codes are possible.
      +
    • LA_NO_ERROR: No error occurred. Successful operation.
    • +
    • LA_INVALID_INPUT_ERROR: Occurs if lda is not correct.
    • +
    • LA_SINGULAR_MATRIX_ERROR: Occurs as a warning if a is found to be singular.
    • +
    +
    + +
    +
    + +

    ◆ la_lu_factor_cmplx()

    + +
    +
    + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
    int la_lu_factor_cmplx (int m,
    int n,
    double complex * a,
    int lda,
    int * ipvt 
    )
    +
    +

    Computes the LU factorization of an M-by-N matrix.

    +
    Parameters
    + + + + + + +
    mThe number of rows in the matrix.
    nThe number of columns in the matrix.
    aOn input, the M-by-N matrix on which to operate. On output, the LU factored matrix in the form [L\U] where the unit diagonal elements of L are not stored.
    ldaThe leading dimension of matrix A.
    ipvtAn MIN(M, N)-element array used to track row-pivot operations. The array stored pivot information such that row I is interchanged with row IPVT(I).
    +
    +
    +
    Returns
    An error code. The following codes are possible.
      +
    • LA_NO_ERROR: No error occurred. Successful operation.
    • +
    • LA_INVALID_INPUT_ERROR: Occurs if lda is not correct.
    • +
    • LA_SINGULAR_MATRIX_ERROR: Occurs as a warning if a is found to be singular.
    • +
    +
    + +
    +
    + +

    ◆ la_mtx_mult()

    + +
    +
    + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
    int la_mtx_mult (bool transa,
    bool transb,
    int m,
    int n,
    int k,
    double alpha,
    const double * a,
    int lda,
    const double * b,
    int ldb,
    double beta,
    double * c,
    int ldc 
    )
    +
    +

    Computes the matrix operation \( C = \alpha op(A) op(B) + \beta C \).

    +
    Parameters
    + + + + + + + + + + + + + + +
    transaSet to true to compute op(A) as the transpose of A; else, set to false to compute op(A) as A.
    transbSet to true to compute op(B) as the transpose of B; else, set to false to compute op(B) as B.
    mThe number of rows in c.
    nThe number of columns in c.
    kThe interior dimension of the product a and b.
    alphaA scalar multiplier.
    aIf transa is true, this matrix must be k by m; else, if transa is false, this matrix must be m by k.
    ldaThe leading dimension of matrix a.
    bIf transb is true, this matrix must be n by k; else, if transb is false, this matrix must be k by n.
    ldbThe leading dimension of matrix b.
    betaA scalar multiplier.
    cThe m by n matrix C.
    ldcThe leading dimension of matrix c.
    +
    +
    +
    Returns
    An error code. The following codes are possible.
      +
    • LA_NO_ERROR: No error occurred. Successful operation.
    • +
    • LA_INVALID_INPUT_ERROR: Occurs if lda, ldb, or ldc are not correct.
    • +
    +
    + +
    +
    + +

    ◆ la_mtx_mult_cmplx()

    + +
    +
    + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
    int la_mtx_mult_cmplx (int opa,
    int opb,
    int m,
    int n,
    int k,
    double complex alpha,
    const double complex * a,
    int lda,
    const double complex * b,
    int ldb,
    double complex beta,
    double complex * c,
    int ldc 
    )
    +
    +

    Computes the matrix operation \( C = \alpha op(A) op(B) + \beta C \).

    +
    Parameters
    + + + + + + + + + + + + + + +
    opaSet to LA_TRANSPOSE to compute op(A) as a direct transpose of A, set to LA_HERMITIAN_TRANSPOSE to compute op(A) as the Hermitian transpose of A, otherwise, set to LA_NO_OPERATION to compute op(A) as A.
    opbSet to TLA_RANSPOSE to compute op(B) as a direct transpose of B, set to LA_HERMITIAN_TRANSPOSE to compute op(B) as the Hermitian transpose of B, otherwise, set to LA_NO_OPERATION to compute op(B) as B.
    mThenumber of rows in c.
    nThe number of columns in c.
    kThe interior dimension of the product a and b.
    alphaA scalar multiplier.
    aIf opa is LA_TRANSPOSE or LA_HERMITIAN_TRANSPOSE, this matrix must be k by m; else, this matrix must be m by k.
    ldaThe leading dimension of matrix a.
    bIf opb is LA_TRANSPOSE or LA_HERMITIAN_TRANSPOSE, this matrix must be n by k; else, this matrix must be k by n.
    ldbThe leading dimension of matrix b.
    betaA scalar multiplier.
    cThe m by n matrix C.
    ldcThe leading dimension of matrix c.
    +
    +
    +
    Returns
    An error code. The following codes are possible.
      +
    • LA_NO_ERROR: No error occurred. Successful operation.
    • +
    • LA_INVALID_INPUT_ERROR: Occurs if lda, ldb, or ldc are not correct.
    • +
    +
    + +
    +
    + +

    ◆ la_mult_qr()

    + +
    +
    + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
    int la_mult_qr (bool lside,
    bool trans,
    int m,
    int n,
    int k,
    double * a,
    int lda,
    const double * tau,
    double * c,
    int ldc 
    )
    +
    +

    Multiplies a general matrix by the orthogonal matrix Q from a QR factorization such that: \( C = op(Q) C \), or \( C = C op(Q) \).

    +
    Parameters
    + + + + + + + + + + + +
    lsideSet to true to apply \( Q \) or \( Q^T \) from the left; else, set to false to apply \( Q \) or \( Q^T \) from the right.
    transSet to true to apply Q**T; else, set to false.
    mThe number of rows in matrix C.
    nThe number of columns in matrix C.
    kThe number of elementary reflectors whose product defines the matrix Q.
    aOn input, an LDA-by-K matrix containing the elementary reflectors output from the QR factorization. If lside is set to true, LDA = M, and M >= K >= 0; else, if lside is set to false, LDA = N, and N >= K >= 0. Notice, the contents of this matrix are restored on exit.
    ldaThe leading dimension of matrix A.
    tauA K-element array containing the scalar factors of each elementary reflector defined in a.
    cOn input, the M-by-N matrix C. On output, the product of the orthogonal matrix Q and the original matrix C.
    ldcTHe leading dimension of matrix C.
    +
    +
    +
    Returns
    An error code. The following codes are possible.
      +
    • LA_NO_ERROR: No error occurred. Successful operation.
    • +
    • LA_INVALID_INPUT_ERROR: Occurs if lda is not correct.
    • +
    • LA_OUT_OF_MEMORY_ERROR: Occurs if there is insufficient memory available.
    • +
    +
    + +
    +
    + +

    ◆ la_mult_qr_cmplx()

    + +
    +
    + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
    int la_mult_qr_cmplx (bool lside,
    bool trans,
    int m,
    int n,
    int k,
    double complex * a,
    int lda,
    const double complex * tau,
    double complex * c,
    int ldc 
    )
    +
    +

    Multiplies a general matrix by the orthogonal matrix Q from a QR factorization such that: \( C = op(Q) C \), or \( C = C op(Q) \).

    +
    Parameters
    + + + + + + + + + + + +
    lsideSet to true to apply \( Q \) or \( Q^H \) from the left; else, set to false to apply \( Q \) or \( Q^H \) from the right.
    transSet to true to apply Q**H; else, set to false.
    mThe number of rows in matrix C.
    nThe number of columns in matrix C.
    kThe number of elementary reflectors whose product defines the matrix Q.
    aOn input, an LDA-by-K matrix containing the elementary reflectors output from the QR factorization. If lside is set to true, LDA = M, and M >= K >= 0; else, if lside is set to false, LDA = N, and N >= K >= 0. Notice, the contents of this matrix are restored on exit.
    ldaThe leading dimension of matrix A.
    tauA K-element array containing the scalar factors of each elementary reflector defined in a.
    cOn input, the M-by-N matrix C. On output, the product of the orthogonal matrix Q and the original matrix C.
    ldcTHe leading dimension of matrix C.
    +
    +
    +
    Returns
    An error code. The following codes are possible.
      +
    • LA_NO_ERROR: No error occurred. Successful operation.
    • +
    • LA_INVALID_INPUT_ERROR: Occurs if lda is not correct.
    • +
    • LA_OUT_OF_MEMORY_ERROR: Occurs if there is insufficient memory available.
    • +
    +
    + +
    +
    + +

    ◆ la_pinverse()

    + +
    +
    + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
    int la_pinverse (int m,
    int n,
    double * a,
    int lda,
    double * ainv,
    int ldai 
    )
    +
    +

    Computes the Moore-Penrose pseudo-inverse of an M-by-N matrix by means of singular value decomposition.

    +
    Parameters
    + + + + + + +
    mThe number of rows in the matrix. @parma n The number of columns in the matrix.
    aOn input, the M-by-N matrix to invert. The matrix is overwritten on output.
    ldaThe leading dimension of matrix A.
    ainvThe N-by-M matrix where the pseudo-inverse of a will be written.
    ldaiThe leading dimension of matrix AINV.
    +
    +
    +
    Returns
    An error code. The following codes are possible.
      +
    • LA_NO_ERROR: No error occurred. Successful operation.
    • +
    • LA_INVALID_INPUT_ERROR: Occurs if lda, or ldai is not correct.
    • +
    +
    + +
    +
    + +

    ◆ la_pinverse_cmplx()

    + +
    +
    + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
    int la_pinverse_cmplx (int m,
    int n,
    double complex * a,
    int lda,
    double complex * ainv,
    int ldai 
    )
    +
    +

    Computes the Moore-Penrose pseudo-inverse of an M-by-N matrix by means of singular value decomposition.

    +
    Parameters
    + + + + + + +
    mThe number of rows in the matrix. @parma n The number of columns in the matrix.
    aOn input, the M-by-N matrix to invert. The matrix is overwritten on output.
    ldaThe leading dimension of matrix A.
    ainvThe N-by-M matrix where the pseudo-inverse of a will be written.
    ldaiThe leading dimension of matrix AINV.
    +
    +
    +
    Returns
    An error code. The following codes are possible.
      +
    • LA_NO_ERROR: No error occurred. Successful operation.
    • +
    • LA_INVALID_INPUT_ERROR: Occurs if lda, or ldai is not correct.
    • +
    +
    + +
    +
    + +

    ◆ la_qr_factor()

    + +
    +
    + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
    int la_qr_factor (int m,
    int n,
    double * a,
    int lda,
    double * tau 
    )
    +
    +

    Computes the QR factorization of an M-by-N matrix without pivoting.

    +
    Parameters
    + + + + + + +
    mThe number of rows in the matrix.
    nThe number of columns in the matrix.
    aOn input, the M-by-N matrix to factor. On output, the elements on and above the diagonal contain the MIN(M, N)-by-N upper trapezoidal matrix R (R is upper triangular if M >= N). The elements below the diagonal, along with the array tau, represent the orthogonal matrix Q as a product of elementary reflectors.
    ldaThe leading dimension of matrix A.
    tauA MIN(M, N)-element array used to store the scalar factors of the elementary reflectors.
    +
    +
    +
    Returns
    An error code. The following codes are possible.
      +
    • LA_NO_ERROR: No error occurred. Successful operation.
    • +
    • LA_INVALID_INPUT_ERROR: Occurs if lda is not correct.
    • +
    • LA_OUT_OF_MEMORY_ERROR: Occurs if there is insufficient memory available.
    • +
    +
    + +
    +
    + +

    ◆ la_qr_factor_cmplx()

    + +
    +
    + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
    int la_qr_factor_cmplx (int m,
    int n,
    double complex * a,
    int lda,
    double complex * tau 
    )
    +
    +

    Computes the QR factorization of an M-by-N matrix without pivoting.

    +
    Parameters
    + + + + + + +
    mThe number of rows in the matrix.
    nThe number of columns in the matrix.
    aOn input, the M-by-N matrix to factor. On output, the elements on and above the diagonal contain the MIN(M, N)-by-N upper trapezoidal matrix R (R is upper triangular if M >= N). The elements below the diagonal, along with the array tau, represent the orthogonal matrix Q as a product of elementary reflectors.
    ldaThe leading dimension of matrix A.
    tauA MIN(M, N)-element array used to store the scalar factors of the elementary reflectors.
    +
    +
    +
    Returns
    An error code. The following codes are possible.
      +
    • LA_NO_ERROR: No error occurred. Successful operation.
    • +
    • LA_INVALID_INPUT_ERROR: Occurs if lda is not correct.
    • +
    • LA_OUT_OF_MEMORY_ERROR: Occurs if there is insufficient memory available.
    • +
    +
    + +
    +
    + +

    ◆ la_qr_factor_cmplx_pvt()

    + +
    +
    + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
    int la_qr_factor_cmplx_pvt (int m,
    int n,
    double complex * a,
    int lda,
    double complex * tau,
    int * jpvt 
    )
    +
    +

    Computes the QR factorization of an M-by-N matrix with column pivoting.

    +
    Parameters
    + + + + + + + +
    mThe number of rows in the matrix.
    nThe number of columns in the matrix.
    aOn input, the M-by-N matrix to factor. On output, the elements on and above the diagonal contain the MIN(M, N)-by-N upper trapezoidal matrix R (R is upper triangular if M >= N). The elements below the diagonal, along with the array tau, represent the orthogonal matrix Q as a product of elementary reflectors.
    ldaThe leading dimension of matrix A.
    tauA MIN(M, N)-element array used to store the scalar factors of the elementary reflectors.
    jpvtOn input, an N-element array that if JPVT(I) .ne. 0, the I-th column of A is permuted to the front of A * P; if JPVT(I) = 0, the I-th column of A is a free column. On output, if JPVT(I) = K, then the I-th column of A * P was the K-th column of A.
    +
    +
    +
    Returns
    An error code. The following codes are possible.
      +
    • LA_NO_ERROR: No error occurred. Successful operation.
    • +
    • LA_INVALID_INPUT_ERROR: Occurs if lda is not correct.
    • +
    • LA_OUT_OF_MEMORY_ERROR: Occurs if there is insufficient memory available.
    • +
    +
    + +
    +
    + +

    ◆ la_qr_factor_pvt()

    + +
    +
    + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
    int la_qr_factor_pvt (int m,
    int n,
    double * a,
    int lda,
    double * tau,
    int * jpvt 
    )
    +
    +

    Computes the QR factorization of an M-by-N matrix with column pivoting.

    +
    Parameters
    + + + + + + + +
    mThe number of rows in the matrix.
    nThe number of columns in the matrix.
    aOn input, the M-by-N matrix to factor. On output, the elements on and above the diagonal contain the MIN(M, N)-by-N upper trapezoidal matrix R (R is upper triangular if M >= N). The elements below the diagonal, along with the array tau, represent the orthogonal matrix Q as a product of elementary reflectors.
    ldaThe leading dimension of matrix A.
    tauA MIN(M, N)-element array used to store the scalar factors of the elementary reflectors.
    jpvtOn input, an N-element array that if JPVT(I) .ne. 0, the I-th column of A is permuted to the front of A * P; if JPVT(I) = 0, the I-th column of A is a free column. On output, if JPVT(I) = K, then the I-th column of A * P was the K-th column of A.
    +
    +
    +
    Returns
    An error code. The following codes are possible.
      +
    • LA_NO_ERROR: No error occurred. Successful operation.
    • +
    • LA_INVALID_INPUT_ERROR: Occurs if lda is not correct.
    • +
    • LA_OUT_OF_MEMORY_ERROR: Occurs if there is insufficient memory available.
    • +
    +
    + +
    +
    + +

    ◆ la_qr_rank1_update()

    + +
    +
    + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
    int la_qr_rank1_update (int m,
    int n,
    double * q,
    int ldq,
    double * r,
    int ldr,
    double * u,
    double * v 
    )
    +
    +

    Computes the rank 1 update to an M-by-N QR factored matrix A (M >= N) where \( A = Q R \), and \( A1 = A + U V^T \) such that \( A1 = Q1 R1 \).

    +
    Parameters
    + + + + + + + + + +
    mThe number of rows in R.
    nThe number of columns in R.
    qOn input, the original M-by-K orthogonal matrix Q. On output, the updated matrix Q1.
    ldqThe leading dimension of matrix Q.
    rOn input, the M-by-N matrix R. On output, the updated matrix R1.
    ldrThe leading dimension of matrix R.
    uOn input, the M-element U update vector. On output, the original content of the array is overwritten.
    vOn input, the N-element V update vector. On output, the original content of the array is overwritten.
    +
    +
    +
    Returns
    An error code. The following codes are possible.
      +
    • LA_NO_ERROR: No error occurred. Successful operation.
    • +
    • LA_INVALID_INPUT_ERROR: Occurs if ldq or ldr is not correct.
    • +
    • LA_OUT_OF_MEMORY_ERROR: Occurs if there is insufficient memory available.
    • +
    +
    + +
    +
    + +

    ◆ la_qr_rank1_update_cmplx()

    + +
    +
    + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
    int la_qr_rank1_update_cmplx (int m,
    int n,
    double complex * q,
    int ldq,
    double complex * r,
    int ldr,
    double complex * u,
    double complex * v 
    )
    +
    +

    Computes the rank 1 update to an M-by-N QR factored matrix A (M >= N) where \( A = Q R \), and \( A1 = A + U V^T \) such that \( A1 = Q1 R1 \).

    +
    Parameters
    + + + + + + + + + +
    mThe number of rows in R.
    nThe number of columns in R.
    qOn input, the original M-by-K orthogonal matrix Q. On output, the updated matrix Q1.
    ldqThe leading dimension of matrix Q.
    rOn input, the M-by-N matrix R. On output, the updated matrix R1.
    ldrThe leading dimension of matrix R.
    uOn input, the M-element U update vector. On output, the original content of the array is overwritten.
    vOn input, the N-element V update vector. On output, the original content of the array is overwritten.
    +
    +
    +
    Returns
    An error code. The following codes are possible.
      +
    • LA_NO_ERROR: No error occurred. Successful operation.
    • +
    • LA_INVALID_INPUT_ERROR: Occurs if ldq or ldr is not correct.
    • +
    • LA_OUT_OF_MEMORY_ERROR: Occurs if there is insufficient memory available.
    • +
    +
    + +
    +
    + +

    ◆ la_rank()

    + +
    +
    + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
    int la_rank (int m,
    int n,
    double * a,
    int lda,
    int * rnk 
    )
    +
    +

    Computes the rank of a matrix.

    +
    Parameters
    + + + + + + +
    mThe number of rows in the matrix.
    nThe number of columns in the matrix.
    aThe M-by-N matrix. The matrix is overwritten as part of this operation.
    ldaThe leading dimension of matrix A.
    rnkThe rank of a.
    +
    +
    +
    Returns
    An error code. The following codes are possible.
      +
    • LA_NO_ERROR: No error occurred. Successful operation.
    • +
    • LA_INVALID_INPUT_ERROR: Occurs if lda is not correct.
    • +
    • LA_OUT_OF_MEMORY_ERROR: Occurs if local memory must be allocated, and there is insufficient memory available.
    • +
    • LA_CONVERGENCE_ERROR: Occurs as a warning if the QR iteration process could not converge to a zero value.
    • +
    +
    + +
    +
    + +

    ◆ la_rank1_update()

    + +
    +
    + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
    int la_rank1_update (int m,
    int n,
    double alpha,
    const double * x,
    const double * y,
    double * a,
    int lda 
    )
    +
    +

    Performs the rank-1 update to matrix A such that: \( A = \alpha X Y^T + A \), where \( A \) is an M-by-N matrix, \( \alpha \) is a scalar, \( X \) is an M-element array, and \( Y \) is an N-element array.

    +
    Parameters
    + + + + + + + + +
    mThe number of rows in the matrix.
    nThe number of columns in the matrix.
    alphaThe scalar multiplier.
    xAn M-element array.
    yAn N-element array.
    aOn input, the M-by-N matrix to update. On output, the updated M-by-N matrix.
    ldaThe leading dimension of matrix A.
    +
    +
    +
    Returns
    An error code. The following codes are possible.
      +
    • LA_NO_ERROR: No error occurred. Successful operation.
    • +
    • LA_INVALID_INPUT_ERROR: Occurs if lda is not correct.
    • +
    +
    + +
    +
    + +

    ◆ la_rank1_update_cmplx()

    + +
    +
    + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
    int la_rank1_update_cmplx (int m,
    int n,
    double complex alpha,
    const double complex * x,
    const double complex * y,
    double complex * a,
    int lda 
    )
    +
    +

    Performs the rank-1 update to matrix A such that: \( A = \alpha X Y^T + A \), where \( A \) is an M-by-N matrix, \( \alpha \) is a scalar, \( X \) is an M-element array, and \( Y \) is an N-element array.

    +
    Parameters
    + + + + + + + + +
    mThe number of rows in the matrix.
    nThe number of columns in the matrix.
    alphaThe scalar multiplier.
    xAn M-element array.
    yAn N-element array.
    aOn input, the M-by-N matrix to update. On output, the updated M-by-N matrix.
    ldaThe leading dimension of matrix A.
    +
    +
    +
    Returns
    An error code. The following codes are possible.
      +
    • LA_NO_ERROR: No error occurred. Successful operation.
    • +
    • LA_INVALID_INPUT_ERROR: Occurs if lda is not correct.
    • +
    +
    + +
    +
    + +

    ◆ la_rank_cmplx()

    + +
    +
    + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
    int la_rank_cmplx (int m,
    int n,
    double complex * a,
    int lda,
    int * rnk 
    )
    +
    +

    Computes the rank of a matrix.

    +
    Parameters
    + + + + + + +
    mThe number of rows in the matrix.
    nThe number of columns in the matrix.
    aThe M-by-N matrix. The matrix is overwritten as part of this operation.
    ldaThe leading dimension of matrix A.
    rnkThe rank of a.
    +
    +
    +
    Returns
    An error code. The following codes are possible.
      +
    • LA_NO_ERROR: No error occurred. Successful operation.
    • +
    • LA_INVALID_INPUT_ERROR: Occurs if lda is not correct.
    • +
    • LA_OUT_OF_MEMORY_ERROR: Occurs if local memory must be allocated, and there is insufficient memory available.
    • +
    • LA_CONVERGENCE_ERROR: Occurs as a warning if the QR iteration process could not converge to a zero value.
    • +
    +
    + +
    +
    + +

    ◆ la_solve_cholesky()

    + +
    +
    + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
    int la_solve_cholesky (bool upper,
    int m,
    int n,
    const double * a,
    int lda,
    double * b,
    int ldb 
    )
    +
    +

    Solves a system of Cholesky factored equations.

    +
    Parameters
    + + + + + + + + +
    upperSet to true if the original matrix A was factored such that A = U**T * U; else, set to false if the factorization of A was A = L**T * L.
    mThe number of rows in matrix B.
    nThe number of columns in matrix B.
    aThe M-by-M Cholesky factored matrix.
    ldaThe leading dimension of matrix A.
    bOn input, the M-by-N right-hand-side matrix B. On output, the M-by-N solution matrix X.
    ldbThe leading dimension of matrix B.
    +
    +
    +
    Returns
    An error code. The following codes are possible.
      +
    • LA_NO_ERROR: No error occurred. Successful operation.
    • +
    • LA_INVALID_INPUT_ERROR: Occurs if lda, or ldb is not correct.
    • +
    +
    + +
    +
    + +

    ◆ la_solve_cholesky_cmplx()

    + +
    +
    + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
    int la_solve_cholesky_cmplx (bool upper,
    int m,
    int n,
    const double complex * a,
    int lda,
    double complex * b,
    int ldb 
    )
    +
    +

    Solves a system of Cholesky factored equations.

    +
    Parameters
    + + + + + + + + +
    upperSet to true if the original matrix A was factored such that A = U**T * U; else, set to false if the factorization of A was A = L**T * L.
    mThe number of rows in matrix B.
    nThe number of columns in matrix B.
    aThe M-by-M Cholesky factored matrix.
    ldaThe leading dimension of matrix A.
    bOn input, the M-by-N right-hand-side matrix B. On output, the M-by-N solution matrix X.
    ldbThe leading dimension of matrix B.
    +
    +
    +
    Returns
    An error code. The following codes are possible.
      +
    • LA_NO_ERROR: No error occurred. Successful operation.
    • +
    • LA_INVALID_INPUT_ERROR: Occurs if lda, or ldb is not correct.
    • +
    +
    + +
    +
    + +

    ◆ la_solve_least_squares()

    + +
    +
    + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
    int la_solve_least_squares (int m,
    int n,
    int k,
    double * a,
    int lda,
    double * b,
    int ldb 
    )
    +
    +

    Solves the overdetermined or underdetermined system (A*X = B) of M equations of N unknowns using a QR or LQ factorization of the matrix A. Notice, it is assumed that matrix A has full rank.

    +
    Parameters
    + + + + + + + + +
    mThe number of equations (rows in matrix A).
    nThe number of unknowns (columns in matrix A).
    kThe number of columns in the right-hand-side matrix.
    aOn input, the M-by-N matrix A. On output, if M >= N, the QR factorization of A in the form as output by qr_factor; else, if M < N, the LQ factorization of A.
    ldaThe leading dimension of matrix A.
    bIf M >= N, the M-by-NRHS matrix B. On output, the first N rows contain the N-by-NRHS solution matrix X. If M < N, an N-by-NRHS matrix with the first M rows containing the matrix B. On output, the N-by-NRHS solution matrix X.
    ldbThe leading dimension of matrix B.
    +
    +
    +
    Returns
    An error code. The following codes are possible.
      +
    • LA_NO_ERROR: No error occurred. Successful operation.
    • +
    • LA_INVALID_INPUT_ERROR: Occurs if lda, or ldb is not correct.
    • +
    • LA_OUT_OF_MEMORY_ERROR: Occurs if local memory must be allocated, and there is insufficient memory available.
    • +
    • LA_INVALID_OPERATION_ERROR: Occurs if a is not of full rank.
    • +
    +
    + +
    +
    + +

    ◆ la_solve_least_squares_cmplx()

    + +
    +
    + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
    int la_solve_least_squares_cmplx (int m,
    int n,
    int k,
    double complex * a,
    int lda,
    double complex * b,
    int ldb 
    )
    +
    +

    Solves the overdetermined or underdetermined system (A*X = B) of M equations of N unknowns using a QR or LQ factorization of the matrix A. Notice, it is assumed that matrix A has full rank.

    +
    Parameters
    + + + + + + + + +
    mThe number of equations (rows in matrix A).
    nThe number of unknowns (columns in matrix A).
    kThe number of columns in the right-hand-side matrix.
    aOn input, the M-by-N matrix A. On output, if M >= N, the QR factorization of A in the form as output by qr_factor; else, if M < N, the LQ factorization of A.
    ldaThe leading dimension of matrix A.
    bIf M >= N, the M-by-NRHS matrix B. On output, the first N rows contain the N-by-NRHS solution matrix X. If M < N, an N-by-NRHS matrix with the first M rows containing the matrix B. On output, the N-by-NRHS solution matrix X.
    ldbThe leading dimension of matrix B.
    +
    +
    +
    Returns
    An error code. The following codes are possible.
      +
    • LA_NO_ERROR: No error occurred. Successful operation.
    • +
    • LA_INVALID_INPUT_ERROR: Occurs if lda, or ldb is not correct.
    • +
    • LA_OUT_OF_MEMORY_ERROR: Occurs if local memory must be allocated, and there is insufficient memory available.
    • +
    • LA_INVALID_OPERATION_ERROR: Occurs if a is not of full rank.
    • +
    +
    + +
    +
    + +

    ◆ la_solve_lu()

    + +
    +
    + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
    int la_solve_lu (int m,
    int n,
    const double * a,
    int lda,
    const int * ipvt,
    double * b,
    int ldb 
    )
    +
    +

    Solves a system of LU-factored equations.

    +
    Parameters
    + + + + + + + + +
    mThe number of rows in matrix B.
    nThe number of columns in matrix B.
    aThe M-by-M LU factored matrix.
    ldaThe leading dimension of matrix A.
    ipvtThe M-element pivot array from the LU factorization.
    bOn input, the M-by-N right-hand-side. On output, the M-by-N solution.
    ldbThe leading dimension of matrix B.
    +
    +
    +
    Returns
    An error code. The following codes are possible.
      +
    • LA_NO_ERROR: No error occurred. Successful operation.
    • +
    • LA_INVALID_INPUT_ERROR: Occurs if lda, or ldb is not correct.
    • +
    +
    + +
    +
    + +

    ◆ la_solve_lu_cmplx()

    + +
    +
    + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
    int la_solve_lu_cmplx (int m,
    int n,
    const double complex * a,
    int lda,
    const int * ipvt,
    double complex * b,
    int ldb 
    )
    +
    +

    Solves a system of LU-factored equations.

    +
    Parameters
    + + + + + + + + +
    mThe number of rows in matrix B.
    nThe number of columns in matrix B.
    aThe M-by-M LU factored matrix.
    ldaThe leading dimension of matrix A.
    ipvtThe M-element pivot array from the LU factorization.
    bOn input, the M-by-N right-hand-side. On output, the M-by-N solution.
    ldbThe leading dimension of matrix B.
    +
    +
    +
    Returns
    An error code. The following codes are possible.
      +
    • LA_NO_ERROR: No error occurred. Successful operation.
    • +
    • LA_INVALID_INPUT_ERROR: Occurs if lda, or ldb is not correct.
    • +
    +
    + +
    +
    + +

    ◆ la_solve_qr()

    + +
    +
    + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
    int la_solve_qr (int m,
    int n,
    int k,
    double * a,
    int lda,
    const double * tau,
    double * b,
    int ldb 
    )
    +
    +

    Solves a system of M QR-factored equations of N unknowns where M >= N.

    +
    Parameters
    + + + + + + + + + +
    mThe number of equations (rows in matrix A).
    nThe number of unknowns (columns in matrix A).
    kThe number of columns in the right-hand-side matrix.
    aOn input, the M-by-N QR factored matrix as returned by qr_factor. On output, the contents of this matrix are restored.
    ldaThe leading dimension of matrix A.
    tauA MIN(M, N)-element array containing the scalar factors of the elementary reflectors as returned by qr_factor.
    bOn input, the M-by-K right-hand-side matrix. On output, the first N rows are overwritten by the solution matrix X.
    ldbThe leading dimension of matrix B.
    +
    +
    +
    Returns
    An error code. The following codes are possible.
      +
    • LA_NO_ERROR: No error occurred. Successful operation.
    • +
    • LA_INVALID_INPUT_ERROR: Occurs if lda, or ldb is not correct, or if m is less than n.
    • +
    • LA_OUT_OF_MEMORY_ERROR: Occurs if local memory must be allocated, and there is insufficient memory available.
    • +
    +
    + +
    +
    + +

    ◆ la_solve_qr_cmplx()

    + +
    +
    + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
    int la_solve_qr_cmplx (int m,
    int n,
    int k,
    double complex * a,
    int lda,
    const double complex * tau,
    double complex * b,
    int ldb 
    )
    +
    +

    Solves a system of M QR-factored equations of N unknowns where M >= N.

    +
    Parameters
    + + + + + + + + + +
    mThe number of equations (rows in matrix A).
    nThe number of unknowns (columns in matrix A).
    kThe number of columns in the right-hand-side matrix.
    aOn input, the M-by-N QR factored matrix as returned by qr_factor. On output, the contents of this matrix are restored.
    ldaThe leading dimension of matrix A.
    tauA MIN(M, N)-element array containing the scalar factors of the elementary reflectors as returned by qr_factor.
    bOn input, the M-by-K right-hand-side matrix. On output, the first N rows are overwritten by the solution matrix X.
    ldbThe leading dimension of matrix B.
    +
    +
    +
    Returns
    An error code. The following codes are possible.
      +
    • LA_NO_ERROR: No error occurred. Successful operation.
    • +
    • LA_INVALID_INPUT_ERROR: Occurs if lda, or ldb is not correct, or if m is less than n.
    • +
    • LA_OUT_OF_MEMORY_ERROR: Occurs if local memory must be allocated, and there is insufficient memory available.
    • +
    +
    + +
    +
    + +

    ◆ la_solve_qr_cmplx_pvt()

    + +
    +
    + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
    int la_solve_qr_cmplx_pvt (int m,
    int n,
    int k,
    double complex * a,
    int lda,
    const double complex * tau,
    const int * jpvt,
    double complex * b,
    int ldb 
    )
    +
    +

    Solves a system of M QR-factored equations of N unknowns.

    +
    Parameters
    + + + + + + + + + + +
    mThe number of equations (rows in matrix A).
    nThe number of unknowns (columns in matrix A).
    kThe number of columns in the right-hand-side matrix.
    aOn input, the M-by-N QR factored matrix as returned by qr_factor. On output, the contents of this matrix are restored.
    ldaThe leading dimension of matrix A.
    tauA MIN(M, N)-element array containing the scalar factors of the elementary reflectors as returned by qr_factor.
    jpvtThe N-element array that was used to track the column pivoting operations in the QR factorization.
    bOn input, the M-by-K right-hand-side matrix. On output, the first N rows are overwritten by the solution matrix X.
    ldbThe leading dimension of matrix B.
    +
    +
    +
    Returns
    An error code. The following codes are possible.
      +
    • LA_NO_ERROR: No error occurred. Successful operation.
    • +
    • LA_INVALID_INPUT_ERROR: Occurs if lda, or ldb is not correct.
    • +
    • LA_OUT_OF_MEMORY_ERROR: Occurs if local memory must be allocated, and there is insufficient memory available.
    • +
    +
    + +
    +
    + +

    ◆ la_solve_qr_pvt()

    + +
    +
    + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
    int la_solve_qr_pvt (int m,
    int n,
    int k,
    double * a,
    int lda,
    const double * tau,
    const int * jpvt,
    double * b,
    int ldb 
    )
    +
    +

    Solves a system of M QR-factored equations of N unknowns.

    +
    Parameters
    + + + + + + + + + + +
    mThe number of equations (rows in matrix A).
    nThe number of unknowns (columns in matrix A).
    kThe number of columns in the right-hand-side matrix.
    aOn input, the M-by-N QR factored matrix as returned by qr_factor. On output, the contents of this matrix are restored.
    ldaThe leading dimension of matrix A.
    tauA MIN(M, N)-element array containing the scalar factors of the elementary reflectors as returned by qr_factor.
    jpvtThe N-element array that was used to track the column pivoting operations in the QR factorization.
    bOn input, the M-by-K right-hand-side matrix. On output, the first N rows are overwritten by the solution matrix X.
    ldbThe leading dimension of matrix B.
    +
    +
    +
    Returns
    An error code. The following codes are possible.
      +
    • LA_NO_ERROR: No error occurred. Successful operation.
    • +
    • LA_INVALID_INPUT_ERROR: Occurs if lda, or ldb is not correct.
    • +
    • LA_OUT_OF_MEMORY_ERROR: Occurs if local memory must be allocated, and there is insufficient memory available.
    • +
    +
    + +
    +
    + +

    ◆ la_solve_tri_mtx()

    + +
    +
    + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
    int la_solve_tri_mtx (bool lside,
    bool upper,
    bool trans,
    bool nounit,
    int m,
    int n,
    double alpha,
    const double * a,
    int lda,
    double * b,
    int ldb 
    )
    +
    +

    Solves one of the matrix equations: op(A) * X = alpha * B, or X * op(A) = alpha * B, where A is a triangular matrix.

    +
    Parameters
    + + + + + + + + + + + + +
    lsideSet to true to solve op(A) * X = alpha * B; else, set to false to solve X * op(A) = alpha * B.
    upperSet to true if A is an upper triangular matrix; else, set to false if A is a lower triangular matrix.
    transSet to true if op(A) = A**T; else, set to false if op(A) = A.
    nounitSet to true if A is not a unit-diagonal matrix (ones on every diagonal element); else, set to false if A is a unit-diagonal matrix.
    mThe number of rows in matrix B.
    nThe number of columns in matrix B.
    alphaThe scalar multiplier to B.
    aIf lside is true, the M-by-M triangular matrix on which to operate; else, if lside is false, the N-by-N triangular matrix on which to operate.
    ldaThe leading dimension of matrix A.
    bOn input, the M-by-N right-hand-side. On output, the M-by-N solution.
    ldbThe leading dimension of matrix B.
    +
    +
    +
    Returns
    An error code. The following codes are possible.
      +
    • LA_NO_ERROR: No error occurred. Successful operation.
    • +
    • LA_INVALID_INPUT_ERROR: Occurs if lda, or ldb is not correct.
    • +
    +
    + +
    +
    + +

    ◆ la_solve_tri_mtx_cmplx()

    + +
    +
    + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
    int la_solve_tri_mtx_cmplx (bool lside,
    bool upper,
    bool trans,
    bool nounit,
    int m,
    int n,
    double complex alpha,
    const double complex * a,
    int lda,
    double complex * b,
    int ldb 
    )
    +
    +

    Solves one of the matrix equations: op(A) * X = alpha * B, or X * op(A) = alpha * B, where A is a triangular matrix.

    +
    Parameters
    + + + + + + + + + + + + +
    lsideSet to true to solve op(A) * X = alpha * B; else, set to false to solve X * op(A) = alpha * B.
    upperSet to true if A is an upper triangular matrix; else, set to false if A is a lower triangular matrix.
    transSet to true if op(A) = A**H; else, set to false if op(A) = A.
    nounitSet to true if A is not a unit-diagonal matrix (ones on every diagonal element); else, set to false if A is a unit-diagonal matrix.
    mThe number of rows in matrix B.
    nThe number of columns in matrix B.
    alphaThe scalar multiplier to B.
    aIf lside is true, the M-by-M triangular matrix on which to operate; else, if lside is false, the N-by-N triangular matrix on which to operate.
    ldaThe leading dimension of matrix A.
    bOn input, the M-by-N right-hand-side. On output, the M-by-N solution.
    ldbThe leading dimension of matrix B.
    +
    +
    +
    Returns
    An error code. The following codes are possible.
      +
    • LA_NO_ERROR: No error occurred. Successful operation.
    • +
    • LA_INVALID_INPUT_ERROR: Occurs if lda, or ldb is not correct.
    • +
    +
    + +
    +
    + +

    ◆ la_sort_eigen()

    + +
    +
    + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
    int la_sort_eigen (bool ascend,
    int n,
    double * vals,
    double * vecs,
    int ldv 
    )
    +
    +

    A sorting routine specifically tailored for sorting of eigenvalues and their associated eigenvectors using a quick-sort approach.

    +
    Parameters
    + + + + + + +
    ascend
    nThe number of eigenvalues.
    valsOn input, an N-element array containing the eigenvalues. On output, the sorted eigenvalues.
    vecsOn input, an N-by-N matrix containing the eigenvectors associated with vals (one vector per column). On output, the sorted eigenvector matrix.
    ldvThe leading dimension of vecs.
    +
    +
    +
    Returns
    An error code. The following codes are possible.
      +
    • LA_NO_ERROR: No error occurred. Successful operation.
    • +
    • LA_INVALID_INPUT_ERROR: Occurs if ldv is not correct.
    • +
    • LA_OUT_OF_MEMORY_ERROR: Occurs if local memory must be allocated, and there is insufficient memory available.
    • +
    +
    + +
    +
    + +

    ◆ la_sort_eigen_cmplx()

    + +
    +
    + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
    int la_sort_eigen_cmplx (bool ascend,
    int n,
    double complex * vals,
    double complex * vecs,
    int ldv 
    )
    +
    +

    A sorting routine specifically tailored for sorting of eigenvalues and their associated eigenvectors using a quick-sort approach.

    +
    Parameters
    + + + + + + +
    ascend
    nThe number of eigenvalues.
    valsOn input, an N-element array containing the eigenvalues. On output, the sorted eigenvalues.
    vecsOn input, an N-by-N matrix containing the eigenvectors associated with vals (one vector per column). On output, the sorted eigenvector matrix.
    ldvThe leading dimension of vecs.
    +
    +
    +
    Returns
    An error code. The following codes are possible.
      +
    • LA_NO_ERROR: No error occurred. Successful operation.
    • +
    • LA_INVALID_INPUT_ERROR: Occurs if ldv is not correct.
    • +
    • LA_OUT_OF_MEMORY_ERROR: Occurs if local memory must be allocated, and there is insufficient memory available.
    • +
    +
    + +
    +
    + +

    ◆ la_svd()

    + +
    +
    + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
    int la_svd (int m,
    int n,
    double * a,
    int lda,
    double * s,
    double * u,
    int ldu,
    double * vt,
    int ldv 
    )
    +
    +

    Computes the singular value decomposition of a matrix A. The SVD is defined as: A = U * S * V**T, where U is an M-by-M orthogonal matrix, S is an M-by-N diagonal matrix, and V is an N-by-N orthogonal matrix.

    +
    Parameters
    + + + + + + + + + + +
    mThe number of rows in the matrix.
    nThe number of columns in the matrix.
    aOn input, the M-by-N matrix to factor. The matrix is overwritten on output.
    ldaThe leading dimension of matrix A.
    sA MIN(M, N)-element array containing the singular values of a sorted in descending order.
    uAn M-by-M matrix where the orthogonal U matrix will be written.
    lduThe leading dimension of matrix U.
    vtAn N-by-N matrix where the transpose of the right singular vector matrix V.
    ldvThe leading dimension of matrix V.
    +
    +
    +
    Returns
    An error code. The following codes are possible.
      +
    • LA_NO_ERROR: No error occurred. Successful operation.
    • +
    • LA_INVALID_INPUT_ERROR: Occurs if lda, ldu, or ldv is not correct.
    • +
    • LA_OUT_OF_MEMORY_ERROR: Occurs if local memory must be allocated, and there is insufficient memory available.
    • +
    • LA_CONVERGENCE_ERROR: Occurs as a warning if the QR iteration process could not converge to a zero value.
    • +
    +
    + +
    +
    + +

    ◆ la_svd_cmplx()

    + +
    +
    + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
    int la_svd_cmplx (int m,
    int n,
    double complex * a,
    int lda,
    double * s,
    double complex * u,
    int ldu,
    double complex * vt,
    int ldv 
    )
    +
    +

    Computes the singular value decomposition of a matrix A. The SVD is defined as: A = U * S * V**T, where U is an M-by-M orthogonal matrix, S is an M-by-N diagonal matrix, and V is an N-by-N orthogonal matrix.

    +
    Parameters
    + + + + + + + + + + +
    mThe number of rows in the matrix.
    nThe number of columns in the matrix.
    aOn input, the M-by-N matrix to factor. The matrix is overwritten on output.
    ldaThe leading dimension of matrix A.
    sA MIN(M, N)-element array containing the singular values of a sorted in descending order.
    uAn M-by-M matrix where the orthogonal U matrix will be written.
    lduThe leading dimension of matrix U.
    vtAn N-by-N matrix where the transpose of the right singular vector matrix V.
    ldvThe leading dimension of matrix V.
    +
    +
    +
    Returns
    An error code. The following codes are possible.
      +
    • LA_NO_ERROR: No error occurred. Successful operation.
    • +
    • LA_INVALID_INPUT_ERROR: Occurs if lda, ldu, or ldv is not correct.
    • +
    • LA_OUT_OF_MEMORY_ERROR: Occurs if local memory must be allocated, and there is insufficient memory available.
    • +
    • LA_CONVERGENCE_ERROR: Occurs as a warning if the QR iteration process could not converge to a zero value.
    • +
    +
    + +
    +
    + +

    ◆ la_trace()

    + +
    +
    + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
    int la_trace (int m,
    int n,
    const double * a,
    int lda,
    double * rst 
    )
    +
    +

    Computes the trace of a matrix (the sum of the main diagonal elements).

    +
    Parameters
    + + + + + + +
    mThe number of rows in the matrix.
    nThe number of columns in the matrix.
    aThe M-by-N matrix on which to operate.
    ldaThe leading dimension of the matrix.
    rstThe results of the operation.
    +
    +
    +
    Returns
    An error code. The following codes are possible.
      +
    • LA_NO_ERROR: No error occurred. Successful operation.
    • +
    • LA_INVALID_INPUT_ERROR: Occurs if lda is not correct.
    • +
    +
    + +
    +
    + +

    ◆ la_trace_cmplx()

    + +
    +
    + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
    int la_trace_cmplx (int m,
    int n,
    const double complex * a,
    int lda,
    double complex * rst 
    )
    +
    +

    Computes the trace of a matrix (the sum of the main diagonal elements).

    +
    Parameters
    + + + + + + +
    mThe number of rows in the matrix.
    nThe number of columns in the matrix.
    aThe M-by-N matrix on which to operate.
    ldaThe leading dimension of the matrix.
    rstThe results of the operation.
    +
    +
    +
    Returns
    An error code. The following codes are possible.
      +
    • LA_NO_ERROR: No error occurred. Successful operation.
    • +
    • LA_INVALID_INPUT_ERROR: Occurs if lda is not correct.
    • +
    +
    + +
    +
    + +

    ◆ la_tri_mtx_mult()

    + +
    +
    + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
    int la_tri_mtx_mult (bool upper,
    double alpha,
    int n,
    const double * a,
    int lda,
    double beta,
    double * b,
    int ldb 
    )
    +
    +

    Computes the triangular matrix operation: \( B = \alpha A^T A + \beta B \), or \( B = \alpha A A^T + \beta B \), where \( A \) is a triangular matrix.

    +
    Parameters
    + + + + + + + + + +
    upperSet to true if matrix \( A \) is upper triangular, and \( B = \alpha A^T A + \beta B \) is to be calculated; else, set to false if \( A \) is lower triangular, and \( B = \alpha A A^T + \beta B \) is to be computed.
    alphaA scalar multiplier.
    nThe dimension of the matrix.
    aThe n by n triangular matrix A. Notice, if upper is true, only the upper triangular portion of this matrix is referenced; else, if upper is false, only the lower triangular portion of this matrix is referenced.
    ldaThe leading dimension of matrix A.
    betaA scalar multiplier.
    bOn input, the n by n matrix B. On output, the n by n resulting matrix.
    ldbThe leading dimension of matrix B.
    +
    +
    +
    Returns
    An error code. The following codes are possible.
      +
    • LA_NO_ERROR: No error occurred. Successful operation.
    • +
    • LA_INVALID_INPUT_ERROR: Occurs if lda or ldb are not correct.
    • +
    +
    + +
    +
    + +

    ◆ la_tri_mtx_mult_cmplx()

    + +
    +
    + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
    int la_tri_mtx_mult_cmplx (bool upper,
    double complex alpha,
    int n,
    const double complex * a,
    int lda,
    double complex beta,
    double complex * b,
    int ldb 
    )
    +
    +

    Computes the triangular matrix operation: \( B = \alpha A^T A + \beta B \), or \( B = \alpha A A^T + \beta B \), where \( A \) is a triangular matrix.

    +
    Parameters
    + + + + + + + + + +
    upperSet to true if matrix \( A \) is upper triangular, and \( B = \alpha A^T A + \beta B \) is to be calculated; else, set to false if \( A \) is lower triangular, and \( B = \alpha A A^T + \beta B \) is to be computed.
    alphaA scalar multiplier.
    nThe dimension of the matrix.
    aThe n by n triangular matrix A. Notice, if upper is true, only the upper triangular portion of this matrix is referenced; else, if upper is false, only the lower triangular portion of this matrix is referenced.
    ldaThe leading dimension of matrix A.
    betaA scalar multiplier.
    bOn input, the n by n matrix B. On output, the n by n resulting matrix.
    ldbThe leading dimension of matrix B.
    +
    +
    +
    Returns
    An error code. The following codes are possible.
      +
    • LA_NO_ERROR: No error occurred. Successful operation.
    • +
    • LA_INVALID_INPUT_ERROR: Occurs if lda or ldb are not correct.
    • +
    +
    + +
    +
    +
    +
    + + + + diff --git a/doc/C/html/linalg_8h.js b/doc/C/html/linalg_8h.js new file mode 100644 index 00000000..32aee583 --- /dev/null +++ b/doc/C/html/linalg_8h.js @@ -0,0 +1,64 @@ +var linalg_8h = +[ + [ "la_cholesky_factor", "linalg_8h.html#a3967bc139cba341a513d1353bea62ac9", null ], + [ "la_cholesky_factor_cmplx", "linalg_8h.html#a1734acc61ef569dfff9c83bcad566f67", null ], + [ "la_cholesky_rank1_downdate", "linalg_8h.html#a292e54c48a8e7f0203bf11f02844691f", null ], + [ "la_cholesky_rank1_downdate_cmplx", "linalg_8h.html#a00c15ec713541d15eae1fd0b01897689", null ], + [ "la_cholesky_rank1_update", "linalg_8h.html#abeb7ee58d4151498be96aa91432f296f", null ], + [ "la_cholesky_rank1_update_cmplx", "linalg_8h.html#af19ebf41be31ee92f657131a8fbf55a3", null ], + [ "la_det", "linalg_8h.html#ac7b4894cd929a106e02a8e37a4d52913", null ], + [ "la_det_cmplx", "linalg_8h.html#ace9edf6a878ee4dd0b220b75b7db6431", null ], + [ "la_diag_mtx_mult", "linalg_8h.html#a4b74177a8914b109e1bf3aa56c9d9cb7", null ], + [ "la_diag_mtx_mult_cmplx", "linalg_8h.html#a63bec2daa56fdc4bbf3f45b67ea14f65", null ], + [ "la_diag_mtx_mult_mixed", "linalg_8h.html#a4d5bad18dcc8a52d9594cc21954c572d", null ], + [ "la_eigen_asymm", "linalg_8h.html#a9491626ab4b3664771e1282b61eeaa74", null ], + [ "la_eigen_cmplx", "linalg_8h.html#ae5a16375c14c924836c33bafa747a1cf", null ], + [ "la_eigen_gen", "linalg_8h.html#af3c6f1a45aee2f275d4b109c9bb660d2", null ], + [ "la_eigen_symm", "linalg_8h.html#ac208d5e6849972a77ef261f2e368868c", null ], + [ "la_form_lu", "linalg_8h.html#a15774f6323c34d307c99b32ac4f188a7", null ], + [ "la_form_lu_cmplx", "linalg_8h.html#a73bea3ca338925cfa4a58bcaea726a14", null ], + [ "la_form_qr", "linalg_8h.html#afe39765d805c1d9ae93e9aa2f20d8548", null ], + [ "la_form_qr_cmplx", "linalg_8h.html#a0338870fe1142f88c96db63495fec615", null ], + [ "la_form_qr_cmplx_pvt", "linalg_8h.html#ad76e25c5eb98075e83cc9df493be5b38", null ], + [ "la_form_qr_pvt", "linalg_8h.html#aace787c5b11959a457b936ace4995033", null ], + [ "la_inverse", "linalg_8h.html#a95d6ed56844c62d553b940091837014b", null ], + [ "la_inverse_cmplx", "linalg_8h.html#a7a821b41c61670f5710214a4d9178998", null ], + [ "la_lu_factor", "linalg_8h.html#a248142a5f0826cddac5daf1c74f234a6", null ], + [ "la_lu_factor_cmplx", "linalg_8h.html#ace554b62c12a5d9a2434c8171c756c47", null ], + [ "la_mtx_mult", "linalg_8h.html#a968b10545320af7bbe1030867ae88e8c", null ], + [ "la_mtx_mult_cmplx", "linalg_8h.html#aefefe80e13f74470d5afaf44b3a45e76", null ], + [ "la_mult_qr", "linalg_8h.html#a95f921847131eaedd62a439490d2a801", null ], + [ "la_mult_qr_cmplx", "linalg_8h.html#acc25c0daa53c10ace21a61d78b2e79f3", null ], + [ "la_pinverse", "linalg_8h.html#af7f8185c0f25ad3fb0b89cc98d77b3d6", null ], + [ "la_pinverse_cmplx", "linalg_8h.html#a71ba1a09caca9d59a9d24b95c7ea749b", null ], + [ "la_qr_factor", "linalg_8h.html#a791d5221eb8ad4fcd106cb218590dfc9", null ], + [ "la_qr_factor_cmplx", "linalg_8h.html#ae5ffa6e8d9c850bd41f43f7564bf6896", null ], + [ "la_qr_factor_cmplx_pvt", "linalg_8h.html#a4a3f6dafe185c2985fc76aab3d0abb97", null ], + [ "la_qr_factor_pvt", "linalg_8h.html#a4bc671dad87b42ff285a4241322a3764", null ], + [ "la_qr_rank1_update", "linalg_8h.html#a9b0639faf9ac0af9bbdb348b92746d5f", null ], + [ "la_qr_rank1_update_cmplx", "linalg_8h.html#acfbd42393c8b1931ff11bc4c7e858aef", null ], + [ "la_rank", "linalg_8h.html#a089690d293303e30c6eef0bb1e982191", null ], + [ "la_rank1_update", "linalg_8h.html#ab346fed23fd61f02d65e09c795c26d74", null ], + [ "la_rank1_update_cmplx", "linalg_8h.html#a3c958fe274f8d1663dd0188455a5fe15", null ], + [ "la_rank_cmplx", "linalg_8h.html#afdc9b7e6ffab89915a082c00ceac7258", null ], + [ "la_solve_cholesky", "linalg_8h.html#a0dc578507a0cb6ada776142476383590", null ], + [ "la_solve_cholesky_cmplx", "linalg_8h.html#a719ffdff56c8fa0875409c4f4e5e95cf", null ], + [ "la_solve_least_squares", "linalg_8h.html#a02eb049983dd41f2307bb52594fb210e", null ], + [ "la_solve_least_squares_cmplx", "linalg_8h.html#ac3bb7b959d8cc7400e9b13290a895b64", null ], + [ "la_solve_lu", "linalg_8h.html#aae725d3247301d1163c58f89edff3d4b", null ], + [ "la_solve_lu_cmplx", "linalg_8h.html#aa067ac0d3f58e28371d413ab7419da74", null ], + [ "la_solve_qr", "linalg_8h.html#aefdc2e6758482d02a3aa7978f7d5efe0", null ], + [ "la_solve_qr_cmplx", "linalg_8h.html#a0ff5f2519eb1d2af94e3b4a26dfb10fe", null ], + [ "la_solve_qr_cmplx_pvt", "linalg_8h.html#ad0ee4a9c71de62911a71a342790f5070", null ], + [ "la_solve_qr_pvt", "linalg_8h.html#a62f97b4319f5574aef5e52bbacff14bb", null ], + [ "la_solve_tri_mtx", "linalg_8h.html#aed7b29bbff1472ebe805054eb9d8c6d4", null ], + [ "la_solve_tri_mtx_cmplx", "linalg_8h.html#af87823d73fb5a319e4262594d147e38c", null ], + [ "la_sort_eigen", "linalg_8h.html#abf5918abab8f97fc2ac5887e051ff493", null ], + [ "la_sort_eigen_cmplx", "linalg_8h.html#a090178a5f99a4b400da80481aad77757", null ], + [ "la_svd", "linalg_8h.html#a56c0cea99a066e74c8fff9682d5ca92d", null ], + [ "la_svd_cmplx", "linalg_8h.html#afbffa0856d75c607a03d3dc7b5b1076e", null ], + [ "la_trace", "linalg_8h.html#a7f611f8f3de7d56120c78e70671c7112", null ], + [ "la_trace_cmplx", "linalg_8h.html#a021fbb7fdccf557ec407a86bace43d85", null ], + [ "la_tri_mtx_mult", "linalg_8h.html#ae7d70f1ef2a2824772e1bf0f726c257e", null ], + [ "la_tri_mtx_mult_cmplx", "linalg_8h.html#a02c464a9dd95298c91f431ae4d0773e9", null ] +]; \ No newline at end of file diff --git a/doc/C/html/linalg_8h_source.html b/doc/C/html/linalg_8h_source.html new file mode 100644 index 00000000..50ec7802 --- /dev/null +++ b/doc/C/html/linalg_8h_source.html @@ -0,0 +1,377 @@ + + + + + + + +linalg: D:/Code/linalg/include/linalg.h Source File + + + + + + + + + + + + + + + +
    +
    + + + + + + +
    +
    linalg 1.6.1 +
    +
    A linear algebra library that provides a user-friendly interface to several BLAS and LAPACK routines.
    +
    +
    + + + + + + + +
    +
    + +
    +
    +
    + +
    + +
    +
    + + +
    +
    +
    +
    +
    +
    Loading...
    +
    Searching...
    +
    No Matches
    +
    +
    +
    +
    + +
    +
    linalg.h
    +
    +
    +Go to the documentation of this file.
    1
    +
    2#ifndef LINALG_H_DEFINED
    +
    3#define LINALG_H_DEFINED
    +
    4
    +
    5#include <stdbool.h>
    +
    6#include <complex.h>
    +
    7
    +
    8#define LA_NO_OPERATION 0
    +
    9#define LA_TRANSPOSE 1
    +
    10#define LA_HERMITIAN_TRANSPOSE 2
    +
    11#define LA_NO_ERROR 0
    +
    12#define LA_INVALID_INPUT_ERROR 101
    +
    13#define LA_ARRAY_SIZE_ERROR 102
    +
    14#define LA_SINGULAR_MATRIX_ERROR 103
    +
    15#define LA_MATRIX_FORMAT_ERROR 104
    +
    16#define LA_OUT_OF_MEMORY_ERROR 105
    +
    17#define LA_CONVERGENCE_ERROR 106
    +
    18#define LA_INVALID_OPERATION_ERROR 107
    +
    19
    +
    20#ifdef __cplusplus
    +
    21extern "C" {
    +
    22#endif
    +
    23
    +
    43int la_rank1_update(int m, int n, double alpha, const double *x,
    +
    44 const double *y, double *a, int lda);
    +
    45
    +
    65int la_rank1_update_cmplx(int m, int n, double complex alpha,
    +
    66 const double complex *x, const double complex *y, double complex *a,
    +
    67 int lda);
    +
    68
    +
    83int la_trace(int m, int n, const double *a, int lda, double *rst);
    +
    84
    +
    99int la_trace_cmplx(int m, int n, const double complex *a, int lda,
    +
    100 double complex *rst);
    +
    101
    +
    128int la_mtx_mult(bool transa, bool transb, int m, int n, int k, double alpha,
    +
    129 const double *a, int lda, const double *b, int ldb, double beta,
    +
    130 double *c, int ldc);
    +
    131
    +
    160int la_mtx_mult_cmplx(int opa, int opb, int m, int n, int k,
    +
    161 double complex alpha, const double complex *a, int lda,
    +
    162 const double complex *b, int ldb, double complex beta, double complex *c,
    +
    163 int ldc);
    +
    164
    +
    198int la_diag_mtx_mult(bool lside, bool transb, int m, int n, int k,
    +
    199 double alpha, const double *a, const double *b, int ldb, double beta,
    +
    200 double *c, int ldc);
    +
    201
    +
    236int la_diag_mtx_mult_cmplx(bool lside, int opb, int m, int n, int k,
    +
    237 double complex alpha, const double complex *a, const double complex *b,
    +
    238 int ldb, double complex beta, double complex *c, int ldc);
    +
    239
    +
    274int la_diag_mtx_mult_mixed(bool lside, int opb, int m, int n, int k,
    +
    275 double complex alpha, const double *a, const double complex *b,
    +
    276 int ldb, double complex beta, double complex *c, int ldc);
    +
    277
    +
    296int la_rank(int m, int n, double *a, int lda, int *rnk);
    +
    297
    +
    316int la_rank_cmplx(int m, int n, double complex *a, int lda, int *rnk);
    +
    317
    +
    333int la_det(int n, double *a, int lda, double *d);
    +
    334
    +
    350int la_det_cmplx(int n, double complex *a, int lda, double complex *d);
    +
    351
    +
    377int la_tri_mtx_mult(bool upper, double alpha, int n, const double *a, int lda,
    +
    378 double beta, double *b, int ldb);
    +
    379
    +
    405int la_tri_mtx_mult_cmplx(bool upper, double complex alpha, int n,
    +
    406 const double complex *a, int lda, double complex beta,
    +
    407 double complex *b, int ldb);
    +
    408
    +
    428int la_lu_factor(int m, int n, double *a, int lda, int *ipvt);
    +
    429
    +
    449int la_lu_factor_cmplx(int m, int n, double complex *a, int lda, int *ipvt);
    +
    450
    +
    472int la_form_lu(int n, double *a, int lda, int *ipvt, double *u, int ldu,
    +
    473 double *p, int ldp);
    +
    474
    +
    496int la_form_lu_cmplx(int n, double complex *a, int lda, int *ipvt,
    +
    497 double complex *u, int ldu, double *p, int ldp);
    +
    498
    +
    520int la_qr_factor(int m, int n, double *a, int lda, double *tau);
    +
    521
    +
    543int la_qr_factor_cmplx(int m, int n, double complex *a, int lda,
    +
    544 double complex *tau);
    +
    545
    +
    570int la_qr_factor_pvt(int m, int n, double *a, int lda, double *tau, int *jpvt);
    +
    571
    +
    596int la_qr_factor_cmplx_pvt(int m, int n, double complex *a, int lda,
    +
    597 double complex *tau, int *jpvt);
    +
    598
    +
    625int la_form_qr(bool fullq, int m, int n, double *r, int ldr, const double *tau,
    +
    626 double *q, int ldq);
    +
    627
    +
    654int la_form_qr_cmplx(bool fullq, int m, int n, double complex *r, int ldr,
    +
    655 const double complex *tau, double complex *q, int ldq);
    +
    656
    +
    689int la_form_qr_pvt(bool fullq, int m, int n, double *r, int ldr,
    +
    690 const double *tau, const int *pvt, double *q, int ldq, double *p, int ldp);
    +
    691
    +
    724int la_form_qr_cmplx_pvt(bool fullq, int m, int n, double complex *r, int ldr,
    +
    725 const double complex *tau, const int *pvt, double complex *q, int ldq,
    +
    726 double complex *p, int ldp);
    +
    727
    +
    757int la_mult_qr(bool lside, bool trans, int m, int n, int k, double *a, int lda,
    +
    758 const double *tau, double *c, int ldc);
    +
    759
    +
    789int la_mult_qr_cmplx(bool lside, bool trans, int m, int n, int k,
    +
    790 double complex *a, int lda, const double complex *tau, double complex *c,
    +
    791 int ldc);
    +
    792
    +
    817int la_qr_rank1_update(int m, int n, double *q, int ldq, double *r, int ldr,
    +
    818 double *u, double *v);
    +
    819
    +
    844int la_qr_rank1_update_cmplx(int m, int n, double complex *q, int ldq,
    +
    845 double complex *r, int ldr, double complex *u, double complex *v);
    +
    846
    +
    865int la_cholesky_factor(bool upper, int n, double *a, int lda);
    +
    866
    +
    885int la_cholesky_factor_cmplx(bool upper, int n, double complex *a, int lda);
    +
    886
    +
    904int la_cholesky_rank1_update(int n, double *r, int ldr, double *u);
    +
    905
    +
    923int la_cholesky_rank1_update_cmplx(int n, double complex *r, int ldr,
    +
    924 double complex *u);
    +
    925
    +
    945int la_cholesky_rank1_downdate(int n, double *r, int ldr, double *u);
    +
    946
    +
    966int la_cholesky_rank1_downdate_cmplx(int n, double complex *r, int ldr,
    +
    967 double complex *u);
    +
    968
    +
    998int la_svd(int m, int n, double *a, int lda, double *s, double *u, int ldu,
    +
    999 double *vt, int ldv);
    +
    1000
    +
    1030int la_svd_cmplx(int m, int n, double complex *a, int lda, double *s,
    +
    1031 double complex *u, int ldu, double complex *vt, int ldv);
    +
    1032
    +
    1061int la_solve_tri_mtx(bool lside, bool upper, bool trans, bool nounit, int m,
    +
    1062 int n, double alpha, const double *a, int lda, double *b, int ldb);
    +
    1063
    +
    1092int la_solve_tri_mtx_cmplx(bool lside, bool upper, bool trans, bool nounit,
    +
    1093 int m, int n, double complex alpha, const double complex *a, int lda,
    +
    1094 double complex *b, int ldb);
    +
    1095
    +
    1112int la_solve_lu(int m, int n, const double *a, int lda, const int *ipvt,
    +
    1113 double *b, int ldb);
    +
    1114
    +
    1131int la_solve_lu_cmplx(int m, int n, const double complex *a, int lda,
    +
    1132 const int *ipvt, double complex *b, int ldb);
    +
    1133
    +
    1157int la_solve_qr(int m, int n, int k, double *a, int lda, const double *tau,
    +
    1158 double *b, int ldb);
    +
    1159
    +
    1183int la_solve_qr_cmplx(int m, int n, int k, double complex *a, int lda,
    +
    1184 const double complex *tau, double complex *b, int ldb);
    +
    1185
    +
    1209int la_solve_qr_pvt(int m, int n, int k, double *a, int lda, const double *tau,
    +
    1210 const int *jpvt, double *b, int ldb);
    +
    1211
    +
    1235int la_solve_qr_cmplx_pvt(int m, int n, int k, double complex *a, int lda,
    +
    1236 const double complex *tau, const int *jpvt, double complex *b, int ldb);
    +
    1237
    +
    1256int la_solve_cholesky(bool upper, int m, int n, const double *a, int lda,
    +
    1257 double *b, int ldb);
    +
    1258
    +
    1277int la_solve_cholesky_cmplx(bool upper, int m, int n, const double complex *a,
    +
    1278 int lda, double complex *b, int ldb);
    +
    1279
    +
    1305int la_solve_least_squares(int m, int n, int k, double *a, int lda, double *b,
    +
    1306 int ldb);
    +
    1307
    +
    1333int la_solve_least_squares_cmplx(int m, int n, int k, double complex *a,
    +
    1334 int lda, double complex *b, int ldb);
    +
    1335
    +
    1349int la_inverse(int n, double *a, int lda);
    +
    1350
    +
    1364int la_inverse_cmplx(int n, double complex *a, int lda);
    +
    1365
    +
    1383int la_pinverse(int m, int n, double *a, int lda, double *ainv, int ldai);
    +
    1384
    +
    1402int la_pinverse_cmplx(int m, int n, double complex *a, int lda,
    +
    1403 double complex *ainv, int ldai);
    +
    1404
    +
    1428int la_eigen_symm(bool vecs, int n, double *a, int lda, double *vals);
    +
    1429
    +
    1452int la_eigen_asymm(bool vecs, int n, double *a, int lda,
    +
    1453 double complex *vals, double complex *v, int ldv);
    +
    1454
    +
    1487int la_eigen_gen(bool vecs, int n, double *a, int lda, double *b, int ldb,
    +
    1488 double complex *alpha, double *beta, double complex *v, int ldv);
    +
    1489
    +
    1512int la_eigen_cmplx(bool vecs, int n, double complex *a, int lda,
    +
    1513 double complex *vals, double complex *v, int ldv);
    +
    1514
    +
    1534int la_sort_eigen(bool ascend, int n, double *vals, double *vecs, int ldv);
    +
    1535
    +
    1555int la_sort_eigen_cmplx(bool ascend, int n, double complex *vals,
    +
    1556 double complex *vecs, int ldv);
    +
    1557
    +
    1558#ifdef __cplusplus
    +
    1559}
    +
    1560#endif // __cplusplus
    +
    1561#endif // LINALG_H_DEFINED
    +
    int la_cholesky_rank1_downdate_cmplx(int n, double complex *r, int ldr, double complex *u)
    +
    int la_trace_cmplx(int m, int n, const double complex *a, int lda, double complex *rst)
    +
    int la_tri_mtx_mult_cmplx(bool upper, double complex alpha, int n, const double complex *a, int lda, double complex beta, double complex *b, int ldb)
    +
    int la_solve_least_squares(int m, int n, int k, double *a, int lda, double *b, int ldb)
    +
    int la_form_qr_cmplx(bool fullq, int m, int n, double complex *r, int ldr, const double complex *tau, double complex *q, int ldq)
    +
    int la_rank(int m, int n, double *a, int lda, int *rnk)
    +
    int la_sort_eigen_cmplx(bool ascend, int n, double complex *vals, double complex *vecs, int ldv)
    +
    int la_solve_cholesky(bool upper, int m, int n, const double *a, int lda, double *b, int ldb)
    +
    int la_solve_qr_cmplx(int m, int n, int k, double complex *a, int lda, const double complex *tau, double complex *b, int ldb)
    +
    int la_form_lu(int n, double *a, int lda, int *ipvt, double *u, int ldu, double *p, int ldp)
    +
    int la_cholesky_factor_cmplx(bool upper, int n, double complex *a, int lda)
    +
    int la_lu_factor(int m, int n, double *a, int lda, int *ipvt)
    +
    int la_cholesky_rank1_downdate(int n, double *r, int ldr, double *u)
    +
    int la_cholesky_factor(bool upper, int n, double *a, int lda)
    +
    int la_rank1_update_cmplx(int m, int n, double complex alpha, const double complex *x, const double complex *y, double complex *a, int lda)
    +
    int la_qr_factor_cmplx_pvt(int m, int n, double complex *a, int lda, double complex *tau, int *jpvt)
    +
    int la_diag_mtx_mult(bool lside, bool transb, int m, int n, int k, double alpha, const double *a, const double *b, int ldb, double beta, double *c, int ldc)
    +
    int la_qr_factor_pvt(int m, int n, double *a, int lda, double *tau, int *jpvt)
    +
    int la_diag_mtx_mult_mixed(bool lside, int opb, int m, int n, int k, double complex alpha, const double *a, const double complex *b, int ldb, double complex beta, double complex *c, int ldc)
    +
    int la_svd(int m, int n, double *a, int lda, double *s, double *u, int ldu, double *vt, int ldv)
    +
    int la_solve_qr_pvt(int m, int n, int k, double *a, int lda, const double *tau, const int *jpvt, double *b, int ldb)
    +
    int la_diag_mtx_mult_cmplx(bool lside, int opb, int m, int n, int k, double complex alpha, const double complex *a, const double complex *b, int ldb, double complex beta, double complex *c, int ldc)
    +
    int la_solve_cholesky_cmplx(bool upper, int m, int n, const double complex *a, int lda, double complex *b, int ldb)
    +
    int la_pinverse_cmplx(int m, int n, double complex *a, int lda, double complex *ainv, int ldai)
    +
    int la_form_lu_cmplx(int n, double complex *a, int lda, int *ipvt, double complex *u, int ldu, double *p, int ldp)
    +
    int la_qr_factor(int m, int n, double *a, int lda, double *tau)
    +
    int la_inverse_cmplx(int n, double complex *a, int lda)
    +
    int la_trace(int m, int n, const double *a, int lda, double *rst)
    +
    int la_eigen_asymm(bool vecs, int n, double *a, int lda, double complex *vals, double complex *v, int ldv)
    +
    int la_inverse(int n, double *a, int lda)
    +
    int la_mult_qr(bool lside, bool trans, int m, int n, int k, double *a, int lda, const double *tau, double *c, int ldc)
    +
    int la_mtx_mult(bool transa, bool transb, int m, int n, int k, double alpha, const double *a, int lda, const double *b, int ldb, double beta, double *c, int ldc)
    +
    int la_qr_rank1_update(int m, int n, double *q, int ldq, double *r, int ldr, double *u, double *v)
    +
    int la_solve_lu_cmplx(int m, int n, const double complex *a, int lda, const int *ipvt, double complex *b, int ldb)
    +
    int la_form_qr_pvt(bool fullq, int m, int n, double *r, int ldr, const double *tau, const int *pvt, double *q, int ldq, double *p, int ldp)
    +
    int la_solve_lu(int m, int n, const double *a, int lda, const int *ipvt, double *b, int ldb)
    +
    int la_rank1_update(int m, int n, double alpha, const double *x, const double *y, double *a, int lda)
    +
    int la_cholesky_rank1_update(int n, double *r, int ldr, double *u)
    +
    int la_sort_eigen(bool ascend, int n, double *vals, double *vecs, int ldv)
    +
    int la_eigen_symm(bool vecs, int n, double *a, int lda, double *vals)
    +
    int la_solve_least_squares_cmplx(int m, int n, int k, double complex *a, int lda, double complex *b, int ldb)
    +
    int la_det(int n, double *a, int lda, double *d)
    +
    int la_mult_qr_cmplx(bool lside, bool trans, int m, int n, int k, double complex *a, int lda, const double complex *tau, double complex *c, int ldc)
    +
    int la_lu_factor_cmplx(int m, int n, double complex *a, int lda, int *ipvt)
    +
    int la_det_cmplx(int n, double complex *a, int lda, double complex *d)
    +
    int la_qr_rank1_update_cmplx(int m, int n, double complex *q, int ldq, double complex *r, int ldr, double complex *u, double complex *v)
    +
    int la_solve_qr_cmplx_pvt(int m, int n, int k, double complex *a, int lda, const double complex *tau, const int *jpvt, double complex *b, int ldb)
    +
    int la_form_qr_cmplx_pvt(bool fullq, int m, int n, double complex *r, int ldr, const double complex *tau, const int *pvt, double complex *q, int ldq, double complex *p, int ldp)
    +
    int la_eigen_cmplx(bool vecs, int n, double complex *a, int lda, double complex *vals, double complex *v, int ldv)
    +
    int la_qr_factor_cmplx(int m, int n, double complex *a, int lda, double complex *tau)
    +
    int la_tri_mtx_mult(bool upper, double alpha, int n, const double *a, int lda, double beta, double *b, int ldb)
    +
    int la_solve_tri_mtx(bool lside, bool upper, bool trans, bool nounit, int m, int n, double alpha, const double *a, int lda, double *b, int ldb)
    +
    int la_solve_qr(int m, int n, int k, double *a, int lda, const double *tau, double *b, int ldb)
    +
    int la_mtx_mult_cmplx(int opa, int opb, int m, int n, int k, double complex alpha, const double complex *a, int lda, const double complex *b, int ldb, double complex beta, double complex *c, int ldc)
    +
    int la_cholesky_rank1_update_cmplx(int n, double complex *r, int ldr, double complex *u)
    +
    int la_eigen_gen(bool vecs, int n, double *a, int lda, double *b, int ldb, double complex *alpha, double *beta, double complex *v, int ldv)
    +
    int la_pinverse(int m, int n, double *a, int lda, double *ainv, int ldai)
    +
    int la_solve_tri_mtx_cmplx(bool lside, bool upper, bool trans, bool nounit, int m, int n, double complex alpha, const double complex *a, int lda, double complex *b, int ldb)
    +
    int la_svd_cmplx(int m, int n, double complex *a, int lda, double *s, double complex *u, int ldu, double complex *vt, int ldv)
    +
    int la_rank_cmplx(int m, int n, double complex *a, int lda, int *rnk)
    +
    int la_form_qr(bool fullq, int m, int n, double *r, int ldr, const double *tau, double *q, int ldq)
    +
    +
    + + + + diff --git a/doc/C/html/menu.js b/doc/C/html/menu.js new file mode 100644 index 00000000..b0b26936 --- /dev/null +++ b/doc/C/html/menu.js @@ -0,0 +1,136 @@ +/* + @licstart The following is the entire license notice for the JavaScript code in this file. + + The MIT License (MIT) + + Copyright (C) 1997-2020 by Dimitri van Heesch + + Permission is hereby granted, free of charge, to any person obtaining a copy of this software + and associated documentation files (the "Software"), to deal in the Software without restriction, + including without limitation the rights to use, copy, modify, merge, publish, distribute, + sublicense, and/or sell copies of the Software, and to permit persons to whom the Software is + furnished to do so, subject to the following conditions: + + The above copyright notice and this permission notice shall be included in all copies or + substantial portions of the Software. + + THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING + BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND + NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, + DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, + OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. + + @licend The above is the entire license notice for the JavaScript code in this file + */ +function initMenu(relPath,searchEnabled,serverSide,searchPage,search) { + function makeTree(data,relPath) { + var result=''; + if ('children' in data) { + result+='
      '; + for (var i in data.children) { + var url; + var link; + link = data.children[i].url; + if (link.substring(0,1)=='^') { + url = link.substring(1); + } else { + url = relPath+link; + } + result+='
    • '+ + data.children[i].text+''+ + makeTree(data.children[i],relPath)+'
    • '; + } + result+='
    '; + } + return result; + } + var searchBoxHtml; + if (searchEnabled) { + if (serverSide) { + searchBoxHtml='
    '+ + '
    '+ + '
     '+ + ''+ + '
    '+ + '
    '+ + '
    '+ + '
    '; + } else { + searchBoxHtml='
    '+ + ''+ + ' '+ + ''+ + ''+ + ''+ + ''+ + ''+ + '
    '; + } + } + + $('#main-nav').before('
    '+ + ''+ + ''+ + '
    '); + $('#main-nav').append(makeTree(menudata,relPath)); + $('#main-nav').children(':first').addClass('sm sm-dox').attr('id','main-menu'); + if (searchBoxHtml) { + $('#main-menu').append('
  • '); + } + var $mainMenuState = $('#main-menu-state'); + var prevWidth = 0; + if ($mainMenuState.length) { + function initResizableIfExists() { + if (typeof initResizable==='function') initResizable(); + } + // animate mobile menu + $mainMenuState.change(function(e) { + var $menu = $('#main-menu'); + var options = { duration: 250, step: initResizableIfExists }; + if (this.checked) { + options['complete'] = function() { $menu.css('display', 'block') }; + $menu.hide().slideDown(options); + } else { + options['complete'] = function() { $menu.css('display', 'none') }; + $menu.show().slideUp(options); + } + }); + // set default menu visibility + function resetState() { + var $menu = $('#main-menu'); + var $mainMenuState = $('#main-menu-state'); + var newWidth = $(window).outerWidth(); + if (newWidth!=prevWidth) { + if ($(window).outerWidth()<768) { + $mainMenuState.prop('checked',false); $menu.hide(); + $('#searchBoxPos1').html(searchBoxHtml); + $('#searchBoxPos2').hide(); + } else { + $menu.show(); + $('#searchBoxPos1').empty(); + $('#searchBoxPos2').html(searchBoxHtml); + $('#searchBoxPos2').show(); + } + if (typeof searchBox!=='undefined') { + searchBox.CloseResultsWindow(); + } + prevWidth = newWidth; + } + } + $(window).ready(function() { resetState(); initResizableIfExists(); }); + $(window).resize(resetState); + } + $('#main-menu').smartmenus(); +} +/* @license-end */ diff --git a/doc/C/html/menudata.js b/doc/C/html/menudata.js new file mode 100644 index 00000000..682914a5 --- /dev/null +++ b/doc/C/html/menudata.js @@ -0,0 +1,33 @@ +/* + @licstart The following is the entire license notice for the JavaScript code in this file. + + The MIT License (MIT) + + Copyright (C) 1997-2020 by Dimitri van Heesch + + Permission is hereby granted, free of charge, to any person obtaining a copy of this software + and associated documentation files (the "Software"), to deal in the Software without restriction, + including without limitation the rights to use, copy, modify, merge, publish, distribute, + sublicense, and/or sell copies of the Software, and to permit persons to whom the Software is + furnished to do so, subject to the following conditions: + + The above copyright notice and this permission notice shall be included in all copies or + substantial portions of the Software. + + THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING + BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND + NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, + DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, + OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. + + @licend The above is the entire license notice for the JavaScript code in this file +*/ +var menudata={children:[ +{text:"Main Page",url:"index.html"}, +{text:"Files",url:"files.html",children:[ +{text:"File List",url:"files.html"}, +{text:"Globals",url:"globals.html",children:[ +{text:"All",url:"globals.html",children:[ +{text:"l",url:"globals.html#index_l"}]}, +{text:"Functions",url:"globals_func.html",children:[ +{text:"l",url:"globals_func.html#index_l"}]}]}]}]} diff --git a/doc/C/html/nav_f.png b/doc/C/html/nav_f.png new file mode 100644 index 0000000000000000000000000000000000000000..72a58a529ed3a9ed6aa0c51a79cf207e026deee2 GIT binary patch literal 153 zcmeAS@N?(olHy`uVBq!ia0vp^j6iI`!2~2XGqLUlQVE_ejv*C{Z|{2ZH7M}7UYxc) zn!W8uqtnIQ>_z8U literal 0 HcmV?d00001 diff --git a/doc/C/html/nav_fd.png b/doc/C/html/nav_fd.png new file mode 100644 index 0000000000000000000000000000000000000000..032fbdd4c54f54fa9a2e6423b94ef4b2ebdfaceb GIT binary patch literal 169 zcmeAS@N?(olHy`uVBq!ia0vp^j6iI`!2~2XGqLUlQU#tajv*C{Z|C~*H7f|XvG1G8 zt7aS*L7xwMeS}!z6R#{C5tIw-s~AJ==F^i}x3XyJseHR@yF& zerFf(Zf;Dd{+(0lDIROL@Sj-Ju2JQ8&-n%4%q?>|^bShc&lR?}7HeMo@BDl5N(aHY Uj$gdr1MOz;boFyt=akR{0D!zeaR2}S literal 0 HcmV?d00001 diff --git a/doc/C/html/nav_g.png b/doc/C/html/nav_g.png new file mode 100644 index 0000000000000000000000000000000000000000..2093a237a94f6c83e19ec6e5fd42f7ddabdafa81 GIT binary patch literal 95 zcmeAS@N?(olHy`uVBq!ia0vp^j6lrB!3HFm1ilyoDK$?Q$B+ufw|5PB85lU25BhtE tr?otc=hd~V+ws&_A@j8Fiv!KF$B+ufw|5=67#uj90@pIL wZ=Q8~_Ju`#59=RjDrmm`tMD@M=!-l18IR?&vFVdQ&MBb@0HFXL6W-eg#Jd_@e6*DPn)w;=|1H}Zvm9l6xXXB%>yL=NQU;mg M>FVdQ&MBb@0Bdt1Qvd(} literal 0 HcmV?d00001 diff --git a/doc/C/html/navtree.css b/doc/C/html/navtree.css new file mode 100644 index 00000000..c8a7766a --- /dev/null +++ b/doc/C/html/navtree.css @@ -0,0 +1,150 @@ +#nav-tree .children_ul { + margin:0; + padding:4px; +} + +#nav-tree ul { + list-style:none outside none; + margin:0px; + padding:0px; +} + +#nav-tree li { + white-space:nowrap; + margin:0px; + padding:0px; +} + +#nav-tree .plus { + margin:0px; +} + +#nav-tree .selected { + background-image: url('tab_a.png'); + background-repeat:repeat-x; + color: var(--nav-text-active-color); + text-shadow: var(--nav-text-active-shadow); +} + +#nav-tree .selected .arrow { + color: var(--nav-arrow-selected-color); + text-shadow: none; +} + +#nav-tree img { + margin:0px; + padding:0px; + border:0px; + vertical-align: middle; +} + +#nav-tree a { + text-decoration:none; + padding:0px; + margin:0px; + outline:none; +} + +#nav-tree .label { + margin:0px; + padding:0px; + font: 12px var(--font-family-nav); +} + +#nav-tree .label a { + padding:2px; +} + +#nav-tree .selected a { + text-decoration:none; + color:var(--nav-text-active-color); +} + +#nav-tree .children_ul { + margin:0px; + padding:0px; +} + +#nav-tree .item { + margin:0px; + padding:0px; +} + +#nav-tree { + padding: 0px 0px; + font-size:14px; + overflow:auto; +} + +#doc-content { + overflow:auto; + display:block; + padding:0px; + margin:0px; + -webkit-overflow-scrolling : touch; /* iOS 5+ */ +} + +#side-nav { + padding:0 6px 0 0; + margin: 0px; + display:block; + position: absolute; + left: 0px; + width: $width; + overflow : hidden; +} + +.ui-resizable .ui-resizable-handle { + display:block; +} + +.ui-resizable-e { + background-image:var(--nav-splitbar-image); + background-size:100%; + background-repeat:repeat-y; + background-attachment: scroll; + cursor:ew-resize; + height:100%; + right:0; + top:0; + width:6px; +} + +.ui-resizable-handle { + display:none; + font-size:0.1px; + position:absolute; + z-index:1; +} + +#nav-tree-contents { + margin: 6px 0px 0px 0px; +} + +#nav-tree { + background-repeat:repeat-x; + background-color: var(--nav-background-color); + -webkit-overflow-scrolling : touch; /* iOS 5+ */ +} + +#nav-sync { + position:absolute; + top:5px; + right:24px; + z-index:0; +} + +#nav-sync img { + opacity:0.3; +} + +#nav-sync img:hover { + opacity:0.9; +} + +@media print +{ + #nav-tree { display: none; } + div.ui-resizable-handle { display: none; position: relative; } +} + diff --git a/doc/C/html/navtree.js b/doc/C/html/navtree.js new file mode 100644 index 00000000..27983687 --- /dev/null +++ b/doc/C/html/navtree.js @@ -0,0 +1,549 @@ +/* + @licstart The following is the entire license notice for the JavaScript code in this file. + + The MIT License (MIT) + + Copyright (C) 1997-2020 by Dimitri van Heesch + + Permission is hereby granted, free of charge, to any person obtaining a copy of this software + and associated documentation files (the "Software"), to deal in the Software without restriction, + including without limitation the rights to use, copy, modify, merge, publish, distribute, + sublicense, and/or sell copies of the Software, and to permit persons to whom the Software is + furnished to do so, subject to the following conditions: + + The above copyright notice and this permission notice shall be included in all copies or + substantial portions of the Software. + + THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING + BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND + NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, + DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, + OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. + + @licend The above is the entire license notice for the JavaScript code in this file + */ +var navTreeSubIndices = new Array(); +var arrowDown = '▼'; +var arrowRight = '►'; + +function getData(varName) +{ + var i = varName.lastIndexOf('/'); + var n = i>=0 ? varName.substring(i+1) : varName; + return eval(n.replace(/\-/g,'_')); +} + +function stripPath(uri) +{ + return uri.substring(uri.lastIndexOf('/')+1); +} + +function stripPath2(uri) +{ + var i = uri.lastIndexOf('/'); + var s = uri.substring(i+1); + var m = uri.substring(0,i+1).match(/\/d\w\/d\w\w\/$/); + return m ? uri.substring(i-6) : s; +} + +function hashValue() +{ + return $(location).attr('hash').substring(1).replace(/[^\w\-]/g,''); +} + +function hashUrl() +{ + return '#'+hashValue(); +} + +function pathName() +{ + return $(location).attr('pathname').replace(/[^-A-Za-z0-9+&@#/%?=~_|!:,.;\(\)]/g, ''); +} + +function localStorageSupported() +{ + try { + return 'localStorage' in window && window['localStorage'] !== null && window.localStorage.getItem; + } + catch(e) { + return false; + } +} + +function storeLink(link) +{ + if (!$("#nav-sync").hasClass('sync') && localStorageSupported()) { + window.localStorage.setItem('navpath',link); + } +} + +function deleteLink() +{ + if (localStorageSupported()) { + window.localStorage.setItem('navpath',''); + } +} + +function cachedLink() +{ + if (localStorageSupported()) { + return window.localStorage.getItem('navpath'); + } else { + return ''; + } +} + +function getScript(scriptName,func,show) +{ + var head = document.getElementsByTagName("head")[0]; + var script = document.createElement('script'); + script.id = scriptName; + script.type = 'text/javascript'; + script.onload = func; + script.src = scriptName+'.js'; + head.appendChild(script); +} + +function createIndent(o,domNode,node,level) +{ + var level=-1; + var n = node; + while (n.parentNode) { level++; n=n.parentNode; } + if (node.childrenData) { + var imgNode = document.createElement("span"); + imgNode.className = 'arrow'; + imgNode.style.paddingLeft=(16*level).toString()+'px'; + imgNode.innerHTML=arrowRight; + node.plus_img = imgNode; + node.expandToggle = document.createElement("a"); + node.expandToggle.href = "javascript:void(0)"; + node.expandToggle.onclick = function() { + if (node.expanded) { + $(node.getChildrenUL()).slideUp("fast"); + node.plus_img.innerHTML=arrowRight; + node.expanded = false; + } else { + expandNode(o, node, false, false); + } + } + node.expandToggle.appendChild(imgNode); + domNode.appendChild(node.expandToggle); + } else { + var span = document.createElement("span"); + span.className = 'arrow'; + span.style.width = 16*(level+1)+'px'; + span.innerHTML = ' '; + domNode.appendChild(span); + } +} + +var animationInProgress = false; + +function gotoAnchor(anchor,aname,updateLocation) +{ + var pos, docContent = $('#doc-content'); + var ancParent = $(anchor.parent()); + if (ancParent.hasClass('memItemLeft') || + ancParent.hasClass('memtitle') || + ancParent.hasClass('fieldname') || + ancParent.hasClass('fieldtype') || + ancParent.is(':header')) + { + pos = ancParent.position().top; + } else if (anchor.position()) { + pos = anchor.position().top; + } + if (pos) { + var dist = Math.abs(Math.min( + pos-docContent.offset().top, + docContent[0].scrollHeight- + docContent.height()-docContent.scrollTop())); + animationInProgress=true; + docContent.animate({ + scrollTop: pos + docContent.scrollTop() - docContent.offset().top + },Math.max(50,Math.min(500,dist)),function(){ + if (updateLocation) window.location.href=aname; + animationInProgress=false; + }); + } +} + +function newNode(o, po, text, link, childrenData, lastNode) +{ + var node = new Object(); + node.children = Array(); + node.childrenData = childrenData; + node.depth = po.depth + 1; + node.relpath = po.relpath; + node.isLast = lastNode; + + node.li = document.createElement("li"); + po.getChildrenUL().appendChild(node.li); + node.parentNode = po; + + node.itemDiv = document.createElement("div"); + node.itemDiv.className = "item"; + + node.labelSpan = document.createElement("span"); + node.labelSpan.className = "label"; + + createIndent(o,node.itemDiv,node,0); + node.itemDiv.appendChild(node.labelSpan); + node.li.appendChild(node.itemDiv); + + var a = document.createElement("a"); + node.labelSpan.appendChild(a); + node.label = document.createTextNode(text); + node.expanded = false; + a.appendChild(node.label); + if (link) { + var url; + if (link.substring(0,1)=='^') { + url = link.substring(1); + link = url; + } else { + url = node.relpath+link; + } + a.className = stripPath(link.replace('#',':')); + if (link.indexOf('#')!=-1) { + var aname = '#'+link.split('#')[1]; + var srcPage = stripPath(pathName()); + var targetPage = stripPath(link.split('#')[0]); + a.href = srcPage!=targetPage ? url : "javascript:void(0)"; + a.onclick = function(){ + storeLink(link); + if (!$(a).parent().parent().hasClass('selected')) + { + $('.item').removeClass('selected'); + $('.item').removeAttr('id'); + $(a).parent().parent().addClass('selected'); + $(a).parent().parent().attr('id','selected'); + } + var anchor = $(aname); + gotoAnchor(anchor,aname,true); + }; + } else { + a.href = url; + a.onclick = function() { storeLink(link); } + } + } else { + if (childrenData != null) + { + a.className = "nolink"; + a.href = "javascript:void(0)"; + a.onclick = node.expandToggle.onclick; + } + } + + node.childrenUL = null; + node.getChildrenUL = function() { + if (!node.childrenUL) { + node.childrenUL = document.createElement("ul"); + node.childrenUL.className = "children_ul"; + node.childrenUL.style.display = "none"; + node.li.appendChild(node.childrenUL); + } + return node.childrenUL; + }; + + return node; +} + +function showRoot() +{ + var headerHeight = $("#top").height(); + var footerHeight = $("#nav-path").height(); + var windowHeight = $(window).height() - headerHeight - footerHeight; + (function (){ // retry until we can scroll to the selected item + try { + var navtree=$('#nav-tree'); + navtree.scrollTo('#selected',100,{offset:-windowHeight/2}); + } catch (err) { + setTimeout(arguments.callee, 0); + } + })(); +} + +function expandNode(o, node, imm, showRoot) +{ + if (node.childrenData && !node.expanded) { + if (typeof(node.childrenData)==='string') { + var varName = node.childrenData; + getScript(node.relpath+varName,function(){ + node.childrenData = getData(varName); + expandNode(o, node, imm, showRoot); + }, showRoot); + } else { + if (!node.childrenVisited) { + getNode(o, node); + } + $(node.getChildrenUL()).slideDown("fast"); + node.plus_img.innerHTML = arrowDown; + node.expanded = true; + } + } +} + +function glowEffect(n,duration) +{ + n.addClass('glow').delay(duration).queue(function(next){ + $(this).removeClass('glow');next(); + }); +} + +function highlightAnchor() +{ + var aname = hashUrl(); + var anchor = $(aname); + if (anchor.parent().attr('class')=='memItemLeft'){ + var rows = $('.memberdecls tr[class$="'+hashValue()+'"]'); + glowEffect(rows.children(),300); // member without details + } else if (anchor.parent().attr('class')=='fieldname'){ + glowEffect(anchor.parent().parent(),1000); // enum value + } else if (anchor.parent().attr('class')=='fieldtype'){ + glowEffect(anchor.parent().parent(),1000); // struct field + } else if (anchor.parent().is(":header")) { + glowEffect(anchor.parent(),1000); // section header + } else { + glowEffect(anchor.next(),1000); // normal member + } +} + +function selectAndHighlight(hash,n) +{ + var a; + if (hash) { + var link=stripPath(pathName())+':'+hash.substring(1); + a=$('.item a[class$="'+link+'"]'); + } + if (a && a.length) { + a.parent().parent().addClass('selected'); + a.parent().parent().attr('id','selected'); + highlightAnchor(); + } else if (n) { + $(n.itemDiv).addClass('selected'); + $(n.itemDiv).attr('id','selected'); + } + var topOffset=5; + if (typeof page_layout!=='undefined' && page_layout==1) { + topOffset+=$('#top').outerHeight(); + } + if ($('#nav-tree-contents .item:first').hasClass('selected')) { + topOffset+=25; + } + $('#nav-sync').css('top',topOffset+'px'); + showRoot(); +} + +function showNode(o, node, index, hash) +{ + if (node && node.childrenData) { + if (typeof(node.childrenData)==='string') { + var varName = node.childrenData; + getScript(node.relpath+varName,function(){ + node.childrenData = getData(varName); + showNode(o,node,index,hash); + },true); + } else { + if (!node.childrenVisited) { + getNode(o, node); + } + $(node.getChildrenUL()).css({'display':'block'}); + node.plus_img.innerHTML = arrowDown; + node.expanded = true; + var n = node.children[o.breadcrumbs[index]]; + if (index+11) hash = '#'+parts[1].replace(/[^\w\-]/g,''); + else hash=''; + } + if (hash.match(/^#l\d+$/)) { + var anchor=$('a[name='+hash.substring(1)+']'); + glowEffect(anchor.parent(),1000); // line number + hash=''; // strip line number anchors + } + var url=root+hash; + var i=-1; + while (NAVTREEINDEX[i+1]<=url) i++; + if (i==-1) { i=0; root=NAVTREE[0][1]; } // fallback: show index + if (navTreeSubIndices[i]) { + gotoNode(o,i,root,hash,relpath) + } else { + getScript(relpath+'navtreeindex'+i,function(){ + navTreeSubIndices[i] = eval('NAVTREEINDEX'+i); + if (navTreeSubIndices[i]) { + gotoNode(o,i,root,hash,relpath); + } + },true); + } +} + +function showSyncOff(n,relpath) +{ + n.html(''); +} + +function showSyncOn(n,relpath) +{ + n.html(''); +} + +function toggleSyncButton(relpath) +{ + var navSync = $('#nav-sync'); + if (navSync.hasClass('sync')) { + navSync.removeClass('sync'); + showSyncOff(navSync,relpath); + storeLink(stripPath2(pathName())+hashUrl()); + } else { + navSync.addClass('sync'); + showSyncOn(navSync,relpath); + deleteLink(); + } +} + +var loadTriggered = false; +var readyTriggered = false; +var loadObject,loadToRoot,loadUrl,loadRelPath; + +$(window).on('load',function(){ + if (readyTriggered) { // ready first + navTo(loadObject,loadToRoot,loadUrl,loadRelPath); + showRoot(); + } + loadTriggered=true; +}); + +function initNavTree(toroot,relpath) +{ + var o = new Object(); + o.toroot = toroot; + o.node = new Object(); + o.node.li = document.getElementById("nav-tree-contents"); + o.node.childrenData = NAVTREE; + o.node.children = new Array(); + o.node.childrenUL = document.createElement("ul"); + o.node.getChildrenUL = function() { return o.node.childrenUL; }; + o.node.li.appendChild(o.node.childrenUL); + o.node.depth = 0; + o.node.relpath = relpath; + o.node.expanded = false; + o.node.isLast = true; + o.node.plus_img = document.createElement("span"); + o.node.plus_img.className = 'arrow'; + o.node.plus_img.innerHTML = arrowRight; + + if (localStorageSupported()) { + var navSync = $('#nav-sync'); + if (cachedLink()) { + showSyncOff(navSync,relpath); + navSync.removeClass('sync'); + } else { + showSyncOn(navSync,relpath); + } + navSync.click(function(){ toggleSyncButton(relpath); }); + } + + if (loadTriggered) { // load before ready + navTo(o,toroot,hashUrl(),relpath); + showRoot(); + } else { // ready before load + loadObject = o; + loadToRoot = toroot; + loadUrl = hashUrl(); + loadRelPath = relpath; + readyTriggered=true; + } + + $(window).bind('hashchange', function(){ + if (window.location.hash && window.location.hash.length>1){ + var a; + if ($(location).attr('hash')){ + var clslink=stripPath(pathName())+':'+hashValue(); + a=$('.item a[class$="'+clslink.replace(/1|%O$WD@{VPM$7~Ar*{o?;hlAFyLXmaDC0y znK1_#cQqJWPES%4Uujug^TE?jMft$}Eq^WaR~)%f)vSNs&gek&x%A9X9sM0) { + newWidth=0; + } + else { + var width = readSetting('width'); + newWidth = (width>250 && width<$(window).width()) ? width : 250; + } + restoreWidth(newWidth); + var sidenavWidth = $(sidenav).outerWidth(); + writeSetting('width',sidenavWidth-barWidth); + } + + header = $("#top"); + sidenav = $("#side-nav"); + content = $("#doc-content"); + navtree = $("#nav-tree"); + footer = $("#nav-path"); + $(".side-nav-resizable").resizable({resize: function(e, ui) { resizeWidth(); } }); + $(sidenav).resizable({ minWidth: 0 }); + $(window).resize(function() { resizeHeight(); }); + var device = navigator.userAgent.toLowerCase(); + var touch_device = device.match(/(iphone|ipod|ipad|android)/); + if (touch_device) { /* wider split bar for touch only devices */ + $(sidenav).css({ paddingRight:'20px' }); + $('.ui-resizable-e').css({ width:'20px' }); + $('#nav-sync').css({ right:'34px' }); + barWidth=20; + } + var width = readSetting('width'); + if (width) { restoreWidth(width); } else { resizeWidth(); } + resizeHeight(); + var url = location.href; + var i=url.indexOf("#"); + if (i>=0) window.location.hash=url.substr(i); + var _preventDefault = function(evt) { evt.preventDefault(); }; + $("#splitbar").bind("dragstart", _preventDefault).bind("selectstart", _preventDefault); + if (once) { + $(".ui-resizable-handle").dblclick(collapseExpand); + once=0 + } + $(window).on('load',resizeHeight); +} +/* @license-end */ diff --git a/doc/C/html/search/all_0.js b/doc/C/html/search/all_0.js new file mode 100644 index 00000000..fa3fa6d9 --- /dev/null +++ b/doc/C/html/search/all_0.js @@ -0,0 +1,65 @@ +var searchData= +[ + ['la_5fcholesky_5ffactor_0',['la_cholesky_factor',['../linalg_8h.html#a3967bc139cba341a513d1353bea62ac9',1,'linalg.h']]], + ['la_5fcholesky_5ffactor_5fcmplx_1',['la_cholesky_factor_cmplx',['../linalg_8h.html#a1734acc61ef569dfff9c83bcad566f67',1,'linalg.h']]], + ['la_5fcholesky_5frank1_5fdowndate_2',['la_cholesky_rank1_downdate',['../linalg_8h.html#a292e54c48a8e7f0203bf11f02844691f',1,'linalg.h']]], + ['la_5fcholesky_5frank1_5fdowndate_5fcmplx_3',['la_cholesky_rank1_downdate_cmplx',['../linalg_8h.html#a00c15ec713541d15eae1fd0b01897689',1,'linalg.h']]], + ['la_5fcholesky_5frank1_5fupdate_4',['la_cholesky_rank1_update',['../linalg_8h.html#abeb7ee58d4151498be96aa91432f296f',1,'linalg.h']]], + ['la_5fcholesky_5frank1_5fupdate_5fcmplx_5',['la_cholesky_rank1_update_cmplx',['../linalg_8h.html#af19ebf41be31ee92f657131a8fbf55a3',1,'linalg.h']]], + ['la_5fdet_6',['la_det',['../linalg_8h.html#ac7b4894cd929a106e02a8e37a4d52913',1,'linalg.h']]], + ['la_5fdet_5fcmplx_7',['la_det_cmplx',['../linalg_8h.html#ace9edf6a878ee4dd0b220b75b7db6431',1,'linalg.h']]], + ['la_5fdiag_5fmtx_5fmult_8',['la_diag_mtx_mult',['../linalg_8h.html#a4b74177a8914b109e1bf3aa56c9d9cb7',1,'linalg.h']]], + ['la_5fdiag_5fmtx_5fmult_5fcmplx_9',['la_diag_mtx_mult_cmplx',['../linalg_8h.html#a63bec2daa56fdc4bbf3f45b67ea14f65',1,'linalg.h']]], + ['la_5fdiag_5fmtx_5fmult_5fmixed_10',['la_diag_mtx_mult_mixed',['../linalg_8h.html#a4d5bad18dcc8a52d9594cc21954c572d',1,'linalg.h']]], + ['la_5feigen_5fasymm_11',['la_eigen_asymm',['../linalg_8h.html#a9491626ab4b3664771e1282b61eeaa74',1,'linalg.h']]], + ['la_5feigen_5fcmplx_12',['la_eigen_cmplx',['../linalg_8h.html#ae5a16375c14c924836c33bafa747a1cf',1,'linalg.h']]], + ['la_5feigen_5fgen_13',['la_eigen_gen',['../linalg_8h.html#af3c6f1a45aee2f275d4b109c9bb660d2',1,'linalg.h']]], + ['la_5feigen_5fsymm_14',['la_eigen_symm',['../linalg_8h.html#ac208d5e6849972a77ef261f2e368868c',1,'linalg.h']]], + ['la_5fform_5flu_15',['la_form_lu',['../linalg_8h.html#a15774f6323c34d307c99b32ac4f188a7',1,'linalg.h']]], + ['la_5fform_5flu_5fcmplx_16',['la_form_lu_cmplx',['../linalg_8h.html#a73bea3ca338925cfa4a58bcaea726a14',1,'linalg.h']]], + ['la_5fform_5fqr_17',['la_form_qr',['../linalg_8h.html#afe39765d805c1d9ae93e9aa2f20d8548',1,'linalg.h']]], + ['la_5fform_5fqr_5fcmplx_18',['la_form_qr_cmplx',['../linalg_8h.html#a0338870fe1142f88c96db63495fec615',1,'linalg.h']]], + ['la_5fform_5fqr_5fcmplx_5fpvt_19',['la_form_qr_cmplx_pvt',['../linalg_8h.html#ad76e25c5eb98075e83cc9df493be5b38',1,'linalg.h']]], + ['la_5fform_5fqr_5fpvt_20',['la_form_qr_pvt',['../linalg_8h.html#aace787c5b11959a457b936ace4995033',1,'linalg.h']]], + ['la_5finverse_21',['la_inverse',['../linalg_8h.html#a95d6ed56844c62d553b940091837014b',1,'linalg.h']]], + ['la_5finverse_5fcmplx_22',['la_inverse_cmplx',['../linalg_8h.html#a7a821b41c61670f5710214a4d9178998',1,'linalg.h']]], + ['la_5flu_5ffactor_23',['la_lu_factor',['../linalg_8h.html#a248142a5f0826cddac5daf1c74f234a6',1,'linalg.h']]], + ['la_5flu_5ffactor_5fcmplx_24',['la_lu_factor_cmplx',['../linalg_8h.html#ace554b62c12a5d9a2434c8171c756c47',1,'linalg.h']]], + ['la_5fmtx_5fmult_25',['la_mtx_mult',['../linalg_8h.html#a968b10545320af7bbe1030867ae88e8c',1,'linalg.h']]], + ['la_5fmtx_5fmult_5fcmplx_26',['la_mtx_mult_cmplx',['../linalg_8h.html#aefefe80e13f74470d5afaf44b3a45e76',1,'linalg.h']]], + ['la_5fmult_5fqr_27',['la_mult_qr',['../linalg_8h.html#a95f921847131eaedd62a439490d2a801',1,'linalg.h']]], + ['la_5fmult_5fqr_5fcmplx_28',['la_mult_qr_cmplx',['../linalg_8h.html#acc25c0daa53c10ace21a61d78b2e79f3',1,'linalg.h']]], + ['la_5fpinverse_29',['la_pinverse',['../linalg_8h.html#af7f8185c0f25ad3fb0b89cc98d77b3d6',1,'linalg.h']]], + ['la_5fpinverse_5fcmplx_30',['la_pinverse_cmplx',['../linalg_8h.html#a71ba1a09caca9d59a9d24b95c7ea749b',1,'linalg.h']]], + ['la_5fqr_5ffactor_31',['la_qr_factor',['../linalg_8h.html#a791d5221eb8ad4fcd106cb218590dfc9',1,'linalg.h']]], + ['la_5fqr_5ffactor_5fcmplx_32',['la_qr_factor_cmplx',['../linalg_8h.html#ae5ffa6e8d9c850bd41f43f7564bf6896',1,'linalg.h']]], + ['la_5fqr_5ffactor_5fcmplx_5fpvt_33',['la_qr_factor_cmplx_pvt',['../linalg_8h.html#a4a3f6dafe185c2985fc76aab3d0abb97',1,'linalg.h']]], + ['la_5fqr_5ffactor_5fpvt_34',['la_qr_factor_pvt',['../linalg_8h.html#a4bc671dad87b42ff285a4241322a3764',1,'linalg.h']]], + ['la_5fqr_5frank1_5fupdate_35',['la_qr_rank1_update',['../linalg_8h.html#a9b0639faf9ac0af9bbdb348b92746d5f',1,'linalg.h']]], + ['la_5fqr_5frank1_5fupdate_5fcmplx_36',['la_qr_rank1_update_cmplx',['../linalg_8h.html#acfbd42393c8b1931ff11bc4c7e858aef',1,'linalg.h']]], + ['la_5frank_37',['la_rank',['../linalg_8h.html#a089690d293303e30c6eef0bb1e982191',1,'linalg.h']]], + ['la_5frank1_5fupdate_38',['la_rank1_update',['../linalg_8h.html#ab346fed23fd61f02d65e09c795c26d74',1,'linalg.h']]], + ['la_5frank1_5fupdate_5fcmplx_39',['la_rank1_update_cmplx',['../linalg_8h.html#a3c958fe274f8d1663dd0188455a5fe15',1,'linalg.h']]], + ['la_5frank_5fcmplx_40',['la_rank_cmplx',['../linalg_8h.html#afdc9b7e6ffab89915a082c00ceac7258',1,'linalg.h']]], + ['la_5fsolve_5fcholesky_41',['la_solve_cholesky',['../linalg_8h.html#a0dc578507a0cb6ada776142476383590',1,'linalg.h']]], + ['la_5fsolve_5fcholesky_5fcmplx_42',['la_solve_cholesky_cmplx',['../linalg_8h.html#a719ffdff56c8fa0875409c4f4e5e95cf',1,'linalg.h']]], + ['la_5fsolve_5fleast_5fsquares_43',['la_solve_least_squares',['../linalg_8h.html#a02eb049983dd41f2307bb52594fb210e',1,'linalg.h']]], + ['la_5fsolve_5fleast_5fsquares_5fcmplx_44',['la_solve_least_squares_cmplx',['../linalg_8h.html#ac3bb7b959d8cc7400e9b13290a895b64',1,'linalg.h']]], + ['la_5fsolve_5flu_45',['la_solve_lu',['../linalg_8h.html#aae725d3247301d1163c58f89edff3d4b',1,'linalg.h']]], + ['la_5fsolve_5flu_5fcmplx_46',['la_solve_lu_cmplx',['../linalg_8h.html#aa067ac0d3f58e28371d413ab7419da74',1,'linalg.h']]], + ['la_5fsolve_5fqr_47',['la_solve_qr',['../linalg_8h.html#aefdc2e6758482d02a3aa7978f7d5efe0',1,'linalg.h']]], + ['la_5fsolve_5fqr_5fcmplx_48',['la_solve_qr_cmplx',['../linalg_8h.html#a0ff5f2519eb1d2af94e3b4a26dfb10fe',1,'linalg.h']]], + ['la_5fsolve_5fqr_5fcmplx_5fpvt_49',['la_solve_qr_cmplx_pvt',['../linalg_8h.html#ad0ee4a9c71de62911a71a342790f5070',1,'linalg.h']]], + ['la_5fsolve_5fqr_5fpvt_50',['la_solve_qr_pvt',['../linalg_8h.html#a62f97b4319f5574aef5e52bbacff14bb',1,'linalg.h']]], + ['la_5fsolve_5ftri_5fmtx_51',['la_solve_tri_mtx',['../linalg_8h.html#aed7b29bbff1472ebe805054eb9d8c6d4',1,'linalg.h']]], + ['la_5fsolve_5ftri_5fmtx_5fcmplx_52',['la_solve_tri_mtx_cmplx',['../linalg_8h.html#af87823d73fb5a319e4262594d147e38c',1,'linalg.h']]], + ['la_5fsort_5feigen_53',['la_sort_eigen',['../linalg_8h.html#abf5918abab8f97fc2ac5887e051ff493',1,'linalg.h']]], + ['la_5fsort_5feigen_5fcmplx_54',['la_sort_eigen_cmplx',['../linalg_8h.html#a090178a5f99a4b400da80481aad77757',1,'linalg.h']]], + ['la_5fsvd_55',['la_svd',['../linalg_8h.html#a56c0cea99a066e74c8fff9682d5ca92d',1,'linalg.h']]], + ['la_5fsvd_5fcmplx_56',['la_svd_cmplx',['../linalg_8h.html#afbffa0856d75c607a03d3dc7b5b1076e',1,'linalg.h']]], + ['la_5ftrace_57',['la_trace',['../linalg_8h.html#a7f611f8f3de7d56120c78e70671c7112',1,'linalg.h']]], + ['la_5ftrace_5fcmplx_58',['la_trace_cmplx',['../linalg_8h.html#a021fbb7fdccf557ec407a86bace43d85',1,'linalg.h']]], + ['la_5ftri_5fmtx_5fmult_59',['la_tri_mtx_mult',['../linalg_8h.html#ae7d70f1ef2a2824772e1bf0f726c257e',1,'linalg.h']]], + ['la_5ftri_5fmtx_5fmult_5fcmplx_60',['la_tri_mtx_mult_cmplx',['../linalg_8h.html#a02c464a9dd95298c91f431ae4d0773e9',1,'linalg.h']]], + ['linalg_2eh_61',['linalg.h',['../linalg_8h.html',1,'']]] +]; diff --git a/doc/C/html/search/close.svg b/doc/C/html/search/close.svg new file mode 100644 index 00000000..a933eea1 --- /dev/null +++ b/doc/C/html/search/close.svg @@ -0,0 +1,31 @@ + + + + + + image/svg+xml + + + + + + + + diff --git a/doc/C/html/search/files_0.js b/doc/C/html/search/files_0.js new file mode 100644 index 00000000..0afbecf1 --- /dev/null +++ b/doc/C/html/search/files_0.js @@ -0,0 +1,4 @@ +var searchData= +[ + ['linalg_2eh_0',['linalg.h',['../linalg_8h.html',1,'']]] +]; diff --git a/doc/C/html/search/functions_0.js b/doc/C/html/search/functions_0.js new file mode 100644 index 00000000..50c950b0 --- /dev/null +++ b/doc/C/html/search/functions_0.js @@ -0,0 +1,64 @@ +var searchData= +[ + ['la_5fcholesky_5ffactor_0',['la_cholesky_factor',['../linalg_8h.html#a3967bc139cba341a513d1353bea62ac9',1,'linalg.h']]], + ['la_5fcholesky_5ffactor_5fcmplx_1',['la_cholesky_factor_cmplx',['../linalg_8h.html#a1734acc61ef569dfff9c83bcad566f67',1,'linalg.h']]], + ['la_5fcholesky_5frank1_5fdowndate_2',['la_cholesky_rank1_downdate',['../linalg_8h.html#a292e54c48a8e7f0203bf11f02844691f',1,'linalg.h']]], + ['la_5fcholesky_5frank1_5fdowndate_5fcmplx_3',['la_cholesky_rank1_downdate_cmplx',['../linalg_8h.html#a00c15ec713541d15eae1fd0b01897689',1,'linalg.h']]], + ['la_5fcholesky_5frank1_5fupdate_4',['la_cholesky_rank1_update',['../linalg_8h.html#abeb7ee58d4151498be96aa91432f296f',1,'linalg.h']]], + ['la_5fcholesky_5frank1_5fupdate_5fcmplx_5',['la_cholesky_rank1_update_cmplx',['../linalg_8h.html#af19ebf41be31ee92f657131a8fbf55a3',1,'linalg.h']]], + ['la_5fdet_6',['la_det',['../linalg_8h.html#ac7b4894cd929a106e02a8e37a4d52913',1,'linalg.h']]], + ['la_5fdet_5fcmplx_7',['la_det_cmplx',['../linalg_8h.html#ace9edf6a878ee4dd0b220b75b7db6431',1,'linalg.h']]], + ['la_5fdiag_5fmtx_5fmult_8',['la_diag_mtx_mult',['../linalg_8h.html#a4b74177a8914b109e1bf3aa56c9d9cb7',1,'linalg.h']]], + ['la_5fdiag_5fmtx_5fmult_5fcmplx_9',['la_diag_mtx_mult_cmplx',['../linalg_8h.html#a63bec2daa56fdc4bbf3f45b67ea14f65',1,'linalg.h']]], + ['la_5fdiag_5fmtx_5fmult_5fmixed_10',['la_diag_mtx_mult_mixed',['../linalg_8h.html#a4d5bad18dcc8a52d9594cc21954c572d',1,'linalg.h']]], + ['la_5feigen_5fasymm_11',['la_eigen_asymm',['../linalg_8h.html#a9491626ab4b3664771e1282b61eeaa74',1,'linalg.h']]], + ['la_5feigen_5fcmplx_12',['la_eigen_cmplx',['../linalg_8h.html#ae5a16375c14c924836c33bafa747a1cf',1,'linalg.h']]], + ['la_5feigen_5fgen_13',['la_eigen_gen',['../linalg_8h.html#af3c6f1a45aee2f275d4b109c9bb660d2',1,'linalg.h']]], + ['la_5feigen_5fsymm_14',['la_eigen_symm',['../linalg_8h.html#ac208d5e6849972a77ef261f2e368868c',1,'linalg.h']]], + ['la_5fform_5flu_15',['la_form_lu',['../linalg_8h.html#a15774f6323c34d307c99b32ac4f188a7',1,'linalg.h']]], + ['la_5fform_5flu_5fcmplx_16',['la_form_lu_cmplx',['../linalg_8h.html#a73bea3ca338925cfa4a58bcaea726a14',1,'linalg.h']]], + ['la_5fform_5fqr_17',['la_form_qr',['../linalg_8h.html#afe39765d805c1d9ae93e9aa2f20d8548',1,'linalg.h']]], + ['la_5fform_5fqr_5fcmplx_18',['la_form_qr_cmplx',['../linalg_8h.html#a0338870fe1142f88c96db63495fec615',1,'linalg.h']]], + ['la_5fform_5fqr_5fcmplx_5fpvt_19',['la_form_qr_cmplx_pvt',['../linalg_8h.html#ad76e25c5eb98075e83cc9df493be5b38',1,'linalg.h']]], + ['la_5fform_5fqr_5fpvt_20',['la_form_qr_pvt',['../linalg_8h.html#aace787c5b11959a457b936ace4995033',1,'linalg.h']]], + ['la_5finverse_21',['la_inverse',['../linalg_8h.html#a95d6ed56844c62d553b940091837014b',1,'linalg.h']]], + ['la_5finverse_5fcmplx_22',['la_inverse_cmplx',['../linalg_8h.html#a7a821b41c61670f5710214a4d9178998',1,'linalg.h']]], + ['la_5flu_5ffactor_23',['la_lu_factor',['../linalg_8h.html#a248142a5f0826cddac5daf1c74f234a6',1,'linalg.h']]], + ['la_5flu_5ffactor_5fcmplx_24',['la_lu_factor_cmplx',['../linalg_8h.html#ace554b62c12a5d9a2434c8171c756c47',1,'linalg.h']]], + ['la_5fmtx_5fmult_25',['la_mtx_mult',['../linalg_8h.html#a968b10545320af7bbe1030867ae88e8c',1,'linalg.h']]], + ['la_5fmtx_5fmult_5fcmplx_26',['la_mtx_mult_cmplx',['../linalg_8h.html#aefefe80e13f74470d5afaf44b3a45e76',1,'linalg.h']]], + ['la_5fmult_5fqr_27',['la_mult_qr',['../linalg_8h.html#a95f921847131eaedd62a439490d2a801',1,'linalg.h']]], + ['la_5fmult_5fqr_5fcmplx_28',['la_mult_qr_cmplx',['../linalg_8h.html#acc25c0daa53c10ace21a61d78b2e79f3',1,'linalg.h']]], + ['la_5fpinverse_29',['la_pinverse',['../linalg_8h.html#af7f8185c0f25ad3fb0b89cc98d77b3d6',1,'linalg.h']]], + ['la_5fpinverse_5fcmplx_30',['la_pinverse_cmplx',['../linalg_8h.html#a71ba1a09caca9d59a9d24b95c7ea749b',1,'linalg.h']]], + ['la_5fqr_5ffactor_31',['la_qr_factor',['../linalg_8h.html#a791d5221eb8ad4fcd106cb218590dfc9',1,'linalg.h']]], + ['la_5fqr_5ffactor_5fcmplx_32',['la_qr_factor_cmplx',['../linalg_8h.html#ae5ffa6e8d9c850bd41f43f7564bf6896',1,'linalg.h']]], + ['la_5fqr_5ffactor_5fcmplx_5fpvt_33',['la_qr_factor_cmplx_pvt',['../linalg_8h.html#a4a3f6dafe185c2985fc76aab3d0abb97',1,'linalg.h']]], + ['la_5fqr_5ffactor_5fpvt_34',['la_qr_factor_pvt',['../linalg_8h.html#a4bc671dad87b42ff285a4241322a3764',1,'linalg.h']]], + ['la_5fqr_5frank1_5fupdate_35',['la_qr_rank1_update',['../linalg_8h.html#a9b0639faf9ac0af9bbdb348b92746d5f',1,'linalg.h']]], + ['la_5fqr_5frank1_5fupdate_5fcmplx_36',['la_qr_rank1_update_cmplx',['../linalg_8h.html#acfbd42393c8b1931ff11bc4c7e858aef',1,'linalg.h']]], + ['la_5frank_37',['la_rank',['../linalg_8h.html#a089690d293303e30c6eef0bb1e982191',1,'linalg.h']]], + ['la_5frank1_5fupdate_38',['la_rank1_update',['../linalg_8h.html#ab346fed23fd61f02d65e09c795c26d74',1,'linalg.h']]], + ['la_5frank1_5fupdate_5fcmplx_39',['la_rank1_update_cmplx',['../linalg_8h.html#a3c958fe274f8d1663dd0188455a5fe15',1,'linalg.h']]], + ['la_5frank_5fcmplx_40',['la_rank_cmplx',['../linalg_8h.html#afdc9b7e6ffab89915a082c00ceac7258',1,'linalg.h']]], + ['la_5fsolve_5fcholesky_41',['la_solve_cholesky',['../linalg_8h.html#a0dc578507a0cb6ada776142476383590',1,'linalg.h']]], + ['la_5fsolve_5fcholesky_5fcmplx_42',['la_solve_cholesky_cmplx',['../linalg_8h.html#a719ffdff56c8fa0875409c4f4e5e95cf',1,'linalg.h']]], + ['la_5fsolve_5fleast_5fsquares_43',['la_solve_least_squares',['../linalg_8h.html#a02eb049983dd41f2307bb52594fb210e',1,'linalg.h']]], + ['la_5fsolve_5fleast_5fsquares_5fcmplx_44',['la_solve_least_squares_cmplx',['../linalg_8h.html#ac3bb7b959d8cc7400e9b13290a895b64',1,'linalg.h']]], + ['la_5fsolve_5flu_45',['la_solve_lu',['../linalg_8h.html#aae725d3247301d1163c58f89edff3d4b',1,'linalg.h']]], + ['la_5fsolve_5flu_5fcmplx_46',['la_solve_lu_cmplx',['../linalg_8h.html#aa067ac0d3f58e28371d413ab7419da74',1,'linalg.h']]], + ['la_5fsolve_5fqr_47',['la_solve_qr',['../linalg_8h.html#aefdc2e6758482d02a3aa7978f7d5efe0',1,'linalg.h']]], + ['la_5fsolve_5fqr_5fcmplx_48',['la_solve_qr_cmplx',['../linalg_8h.html#a0ff5f2519eb1d2af94e3b4a26dfb10fe',1,'linalg.h']]], + ['la_5fsolve_5fqr_5fcmplx_5fpvt_49',['la_solve_qr_cmplx_pvt',['../linalg_8h.html#ad0ee4a9c71de62911a71a342790f5070',1,'linalg.h']]], + ['la_5fsolve_5fqr_5fpvt_50',['la_solve_qr_pvt',['../linalg_8h.html#a62f97b4319f5574aef5e52bbacff14bb',1,'linalg.h']]], + ['la_5fsolve_5ftri_5fmtx_51',['la_solve_tri_mtx',['../linalg_8h.html#aed7b29bbff1472ebe805054eb9d8c6d4',1,'linalg.h']]], + ['la_5fsolve_5ftri_5fmtx_5fcmplx_52',['la_solve_tri_mtx_cmplx',['../linalg_8h.html#af87823d73fb5a319e4262594d147e38c',1,'linalg.h']]], + ['la_5fsort_5feigen_53',['la_sort_eigen',['../linalg_8h.html#abf5918abab8f97fc2ac5887e051ff493',1,'linalg.h']]], + ['la_5fsort_5feigen_5fcmplx_54',['la_sort_eigen_cmplx',['../linalg_8h.html#a090178a5f99a4b400da80481aad77757',1,'linalg.h']]], + ['la_5fsvd_55',['la_svd',['../linalg_8h.html#a56c0cea99a066e74c8fff9682d5ca92d',1,'linalg.h']]], + ['la_5fsvd_5fcmplx_56',['la_svd_cmplx',['../linalg_8h.html#afbffa0856d75c607a03d3dc7b5b1076e',1,'linalg.h']]], + ['la_5ftrace_57',['la_trace',['../linalg_8h.html#a7f611f8f3de7d56120c78e70671c7112',1,'linalg.h']]], + ['la_5ftrace_5fcmplx_58',['la_trace_cmplx',['../linalg_8h.html#a021fbb7fdccf557ec407a86bace43d85',1,'linalg.h']]], + ['la_5ftri_5fmtx_5fmult_59',['la_tri_mtx_mult',['../linalg_8h.html#ae7d70f1ef2a2824772e1bf0f726c257e',1,'linalg.h']]], + ['la_5ftri_5fmtx_5fmult_5fcmplx_60',['la_tri_mtx_mult_cmplx',['../linalg_8h.html#a02c464a9dd95298c91f431ae4d0773e9',1,'linalg.h']]] +]; diff --git a/doc/C/html/search/mag.svg b/doc/C/html/search/mag.svg new file mode 100644 index 00000000..9f46b301 --- /dev/null +++ b/doc/C/html/search/mag.svg @@ -0,0 +1,37 @@ + + + + + + image/svg+xml + + + + + + + + + diff --git a/doc/C/html/search/mag_d.svg b/doc/C/html/search/mag_d.svg new file mode 100644 index 00000000..b9a814c7 --- /dev/null +++ b/doc/C/html/search/mag_d.svg @@ -0,0 +1,37 @@ + + + + + + image/svg+xml + + + + + + + + + diff --git a/doc/C/html/search/mag_sel.svg b/doc/C/html/search/mag_sel.svg new file mode 100644 index 00000000..03626f64 --- /dev/null +++ b/doc/C/html/search/mag_sel.svg @@ -0,0 +1,74 @@ + + + + + + + + image/svg+xml + + + + + + + + + + + diff --git a/doc/C/html/search/mag_seld.svg b/doc/C/html/search/mag_seld.svg new file mode 100644 index 00000000..6e720dcc --- /dev/null +++ b/doc/C/html/search/mag_seld.svg @@ -0,0 +1,74 @@ + + + + + + + + image/svg+xml + + + + + + + + + + + diff --git a/doc/C/html/search/search.css b/doc/C/html/search/search.css new file mode 100644 index 00000000..19f76f9d --- /dev/null +++ b/doc/C/html/search/search.css @@ -0,0 +1,291 @@ +/*---------------- Search Box positioning */ + +#main-menu > li:last-child { + /* This
  • object is the parent of the search bar */ + display: flex; + justify-content: center; + align-items: center; + height: 36px; + margin-right: 1em; +} + +/*---------------- Search box styling */ + +.SRPage * { + font-weight: normal; + line-height: normal; +} + +dark-mode-toggle { + margin-left: 5px; + display: flex; + float: right; +} + +#MSearchBox { + display: inline-block; + white-space : nowrap; + background: var(--search-background-color); + border-radius: 0.65em; + box-shadow: var(--search-box-shadow); + z-index: 102; +} + +#MSearchBox .left { + display: inline-block; + vertical-align: middle; + height: 1.4em; +} + +#MSearchSelect { + display: inline-block; + vertical-align: middle; + width: 20px; + height: 19px; + background-image: var(--search-magnification-select-image); + margin: 0 0 0 0.3em; + padding: 0; +} + +#MSearchSelectExt { + display: inline-block; + vertical-align: middle; + width: 10px; + height: 19px; + background-image: var(--search-magnification-image); + margin: 0 0 0 0.5em; + padding: 0; +} + + +#MSearchField { + display: inline-block; + vertical-align: middle; + width: 7.5em; + height: 19px; + margin: 0 0.15em; + padding: 0; + line-height: 1em; + border:none; + color: var(--search-foreground-color); + outline: none; + font-family: var(--font-family-search); + -webkit-border-radius: 0px; + border-radius: 0px; + background: none; +} + +@media(hover: none) { + /* to avoid zooming on iOS */ + #MSearchField { + font-size: 16px; + } +} + +#MSearchBox .right { + display: inline-block; + vertical-align: middle; + width: 1.4em; + height: 1.4em; +} + +#MSearchClose { + display: none; + font-size: inherit; + background : none; + border: none; + margin: 0; + padding: 0; + outline: none; + +} + +#MSearchCloseImg { + padding: 0.3em; + margin: 0; +} + +.MSearchBoxActive #MSearchField { + color: var(--search-active-color); +} + + + +/*---------------- Search filter selection */ + +#MSearchSelectWindow { + display: none; + position: absolute; + left: 0; top: 0; + border: 1px solid var(--search-filter-border-color); + background-color: var(--search-filter-background-color); + z-index: 10001; + padding-top: 4px; + padding-bottom: 4px; + -moz-border-radius: 4px; + -webkit-border-top-left-radius: 4px; + -webkit-border-top-right-radius: 4px; + -webkit-border-bottom-left-radius: 4px; + -webkit-border-bottom-right-radius: 4px; + -webkit-box-shadow: 5px 5px 5px rgba(0, 0, 0, 0.15); +} + +.SelectItem { + font: 8pt var(--font-family-search); + padding-left: 2px; + padding-right: 12px; + border: 0px; +} + +span.SelectionMark { + margin-right: 4px; + font-family: var(--font-family-monospace); + outline-style: none; + text-decoration: none; +} + +a.SelectItem { + display: block; + outline-style: none; + color: var(--search-filter-foreground-color); + text-decoration: none; + padding-left: 6px; + padding-right: 12px; +} + +a.SelectItem:focus, +a.SelectItem:active { + color: var(--search-filter-foreground-color); + outline-style: none; + text-decoration: none; +} + +a.SelectItem:hover { + color: var(--search-filter-highlight-text-color); + background-color: var(--search-filter-highlight-bg-color); + outline-style: none; + text-decoration: none; + cursor: pointer; + display: block; +} + +/*---------------- Search results window */ + +iframe#MSearchResults { + /*width: 60ex;*/ + height: 15em; +} + +#MSearchResultsWindow { + display: none; + position: absolute; + left: 0; top: 0; + border: 1px solid var(--search-results-border-color); + background-color: var(--search-results-background-color); + z-index:10000; + width: 300px; + height: 400px; + overflow: auto; +} + +/* ----------------------------------- */ + + +#SRIndex { + clear:both; +} + +.SREntry { + font-size: 10pt; + padding-left: 1ex; +} + +.SRPage .SREntry { + font-size: 8pt; + padding: 1px 5px; +} + +div.SRPage { + margin: 5px 2px; + background-color: var(--search-results-background-color); +} + +.SRChildren { + padding-left: 3ex; padding-bottom: .5em +} + +.SRPage .SRChildren { + display: none; +} + +.SRSymbol { + font-weight: bold; + color: var(--search-results-foreground-color); + font-family: var(--font-family-search); + text-decoration: none; + outline: none; +} + +a.SRScope { + display: block; + color: var(--search-results-foreground-color); + font-family: var(--font-family-search); + font-size: 8pt; + text-decoration: none; + outline: none; +} + +a.SRSymbol:focus, a.SRSymbol:active, +a.SRScope:focus, a.SRScope:active { + text-decoration: underline; +} + +span.SRScope { + padding-left: 4px; + font-family: var(--font-family-search); +} + +.SRPage .SRStatus { + padding: 2px 5px; + font-size: 8pt; + font-style: italic; + font-family: var(--font-family-search); +} + +.SRResult { + display: none; +} + +div.searchresults { + margin-left: 10px; + margin-right: 10px; +} + +/*---------------- External search page results */ + +.pages b { + color: white; + padding: 5px 5px 3px 5px; + background-image: var(--nav-gradient-active-image-parent); + background-repeat: repeat-x; + text-shadow: 0 1px 1px #000000; +} + +.pages { + line-height: 17px; + margin-left: 4px; + text-decoration: none; +} + +.hl { + font-weight: bold; +} + +#searchresults { + margin-bottom: 20px; +} + +.searchpages { + margin-top: 10px; +} + diff --git a/doc/C/html/search/search.js b/doc/C/html/search/search.js new file mode 100644 index 00000000..e103a262 --- /dev/null +++ b/doc/C/html/search/search.js @@ -0,0 +1,816 @@ +/* + @licstart The following is the entire license notice for the JavaScript code in this file. + + The MIT License (MIT) + + Copyright (C) 1997-2020 by Dimitri van Heesch + + Permission is hereby granted, free of charge, to any person obtaining a copy of this software + and associated documentation files (the "Software"), to deal in the Software without restriction, + including without limitation the rights to use, copy, modify, merge, publish, distribute, + sublicense, and/or sell copies of the Software, and to permit persons to whom the Software is + furnished to do so, subject to the following conditions: + + The above copyright notice and this permission notice shall be included in all copies or + substantial portions of the Software. + + THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING + BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND + NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, + DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, + OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. + + @licend The above is the entire license notice for the JavaScript code in this file + */ +function convertToId(search) +{ + var result = ''; + for (i=0;i do a search + { + this.Search(); + } + } + + this.OnSearchSelectKey = function(evt) + { + var e = (evt) ? evt : window.event; // for IE + if (e.keyCode==40 && this.searchIndex0) // Up + { + this.searchIndex--; + this.OnSelectItem(this.searchIndex); + } + else if (e.keyCode==13 || e.keyCode==27) + { + this.OnSelectItem(this.searchIndex); + this.CloseSelectionWindow(); + this.DOMSearchField().focus(); + } + return false; + } + + // --------- Actions + + // Closes the results window. + this.CloseResultsWindow = function() + { + this.DOMPopupSearchResultsWindow().style.display = 'none'; + this.DOMSearchClose().style.display = 'none'; + this.Activate(false); + } + + this.CloseSelectionWindow = function() + { + this.DOMSearchSelectWindow().style.display = 'none'; + } + + // Performs a search. + this.Search = function() + { + this.keyTimeout = 0; + + // strip leading whitespace + var searchValue = this.DOMSearchField().value.replace(/^ +/, ""); + + var code = searchValue.toLowerCase().charCodeAt(0); + var idxChar = searchValue.substr(0, 1).toLowerCase(); + if ( 0xD800 <= code && code <= 0xDBFF && searchValue > 1) // surrogate pair + { + idxChar = searchValue.substr(0, 2); + } + + var jsFile; + + var idx = indexSectionsWithContent[this.searchIndex].indexOf(idxChar); + if (idx!=-1) + { + var hexCode=idx.toString(16); + jsFile = this.resultsPath + indexSectionNames[this.searchIndex] + '_' + hexCode + '.js'; + } + + var loadJS = function(url, impl, loc){ + var scriptTag = document.createElement('script'); + scriptTag.src = url; + scriptTag.onload = impl; + scriptTag.onreadystatechange = impl; + loc.appendChild(scriptTag); + } + + var domPopupSearchResultsWindow = this.DOMPopupSearchResultsWindow(); + var domSearchBox = this.DOMSearchBox(); + var domPopupSearchResults = this.DOMPopupSearchResults(); + var domSearchClose = this.DOMSearchClose(); + var resultsPath = this.resultsPath; + + var handleResults = function() { + document.getElementById("Loading").style.display="none"; + if (typeof searchData !== 'undefined') { + createResults(resultsPath); + document.getElementById("NoMatches").style.display="none"; + } + + searchResults.Search(searchValue); + + if (domPopupSearchResultsWindow.style.display!='block') + { + domSearchClose.style.display = 'inline-block'; + var left = getXPos(domSearchBox) + 150; + var top = getYPos(domSearchBox) + 20; + domPopupSearchResultsWindow.style.display = 'block'; + left -= domPopupSearchResults.offsetWidth; + var maxWidth = document.body.clientWidth; + var maxHeight = document.body.clientHeight; + var width = 300; + if (left<10) left=10; + if (width+left+8>maxWidth) width=maxWidth-left-8; + var height = 400; + if (height+top+8>maxHeight) height=maxHeight-top-8; + domPopupSearchResultsWindow.style.top = top + 'px'; + domPopupSearchResultsWindow.style.left = left + 'px'; + domPopupSearchResultsWindow.style.width = width + 'px'; + domPopupSearchResultsWindow.style.height = height + 'px'; + } + } + + if (jsFile) { + loadJS(jsFile, handleResults, this.DOMPopupSearchResultsWindow()); + } else { + handleResults(); + } + + this.lastSearchValue = searchValue; + } + + // -------- Activation Functions + + // Activates or deactivates the search panel, resetting things to + // their default values if necessary. + this.Activate = function(isActive) + { + if (isActive || // open it + this.DOMPopupSearchResultsWindow().style.display == 'block' + ) + { + this.DOMSearchBox().className = 'MSearchBoxActive'; + this.searchActive = true; + } + else if (!isActive) // directly remove the panel + { + this.DOMSearchBox().className = 'MSearchBoxInactive'; + this.searchActive = false; + this.lastSearchValue = '' + this.lastResultsPage = ''; + this.DOMSearchField().value = ''; + } + } +} + +// ----------------------------------------------------------------------- + +// The class that handles everything on the search results page. +function SearchResults(name) +{ + // The number of matches from the last run of . + this.lastMatchCount = 0; + this.lastKey = 0; + this.repeatOn = false; + + // Toggles the visibility of the passed element ID. + this.FindChildElement = function(id) + { + var parentElement = document.getElementById(id); + var element = parentElement.firstChild; + + while (element && element!=parentElement) + { + if (element.nodeName.toLowerCase() == 'div' && element.className == 'SRChildren') + { + return element; + } + + if (element.nodeName.toLowerCase() == 'div' && element.hasChildNodes()) + { + element = element.firstChild; + } + else if (element.nextSibling) + { + element = element.nextSibling; + } + else + { + do + { + element = element.parentNode; + } + while (element && element!=parentElement && !element.nextSibling); + + if (element && element!=parentElement) + { + element = element.nextSibling; + } + } + } + } + + this.Toggle = function(id) + { + var element = this.FindChildElement(id); + if (element) + { + if (element.style.display == 'block') + { + element.style.display = 'none'; + } + else + { + element.style.display = 'block'; + } + } + } + + // Searches for the passed string. If there is no parameter, + // it takes it from the URL query. + // + // Always returns true, since other documents may try to call it + // and that may or may not be possible. + this.Search = function(search) + { + if (!search) // get search word from URL + { + search = window.location.search; + search = search.substring(1); // Remove the leading '?' + search = unescape(search); + } + + search = search.replace(/^ +/, ""); // strip leading spaces + search = search.replace(/ +$/, ""); // strip trailing spaces + search = search.toLowerCase(); + search = convertToId(search); + + var resultRows = document.getElementsByTagName("div"); + var matches = 0; + + var i = 0; + while (i < resultRows.length) + { + var row = resultRows.item(i); + if (row.className == "SRResult") + { + var rowMatchName = row.id.toLowerCase(); + rowMatchName = rowMatchName.replace(/^sr\d*_/, ''); // strip 'sr123_' + + if (search.length<=rowMatchName.length && + rowMatchName.substr(0, search.length)==search) + { + row.style.display = 'block'; + matches++; + } + else + { + row.style.display = 'none'; + } + } + i++; + } + document.getElementById("Searching").style.display='none'; + if (matches == 0) // no results + { + document.getElementById("NoMatches").style.display='block'; + } + else // at least one result + { + document.getElementById("NoMatches").style.display='none'; + } + this.lastMatchCount = matches; + return true; + } + + // return the first item with index index or higher that is visible + this.NavNext = function(index) + { + var focusItem; + while (1) + { + var focusName = 'Item'+index; + focusItem = document.getElementById(focusName); + if (focusItem && focusItem.parentNode.parentNode.style.display=='block') + { + break; + } + else if (!focusItem) // last element + { + break; + } + focusItem=null; + index++; + } + return focusItem; + } + + this.NavPrev = function(index) + { + var focusItem; + while (1) + { + var focusName = 'Item'+index; + focusItem = document.getElementById(focusName); + if (focusItem && focusItem.parentNode.parentNode.style.display=='block') + { + break; + } + else if (!focusItem) // last element + { + break; + } + focusItem=null; + index--; + } + return focusItem; + } + + this.ProcessKeys = function(e) + { + if (e.type == "keydown") + { + this.repeatOn = false; + this.lastKey = e.keyCode; + } + else if (e.type == "keypress") + { + if (!this.repeatOn) + { + if (this.lastKey) this.repeatOn = true; + return false; // ignore first keypress after keydown + } + } + else if (e.type == "keyup") + { + this.lastKey = 0; + this.repeatOn = false; + } + return this.lastKey!=0; + } + + this.Nav = function(evt,itemIndex) + { + var e = (evt) ? evt : window.event; // for IE + if (e.keyCode==13) return true; + if (!this.ProcessKeys(e)) return false; + + if (this.lastKey==38) // Up + { + var newIndex = itemIndex-1; + var focusItem = this.NavPrev(newIndex); + if (focusItem) + { + var child = this.FindChildElement(focusItem.parentNode.parentNode.id); + if (child && child.style.display == 'block') // children visible + { + var n=0; + var tmpElem; + while (1) // search for last child + { + tmpElem = document.getElementById('Item'+newIndex+'_c'+n); + if (tmpElem) + { + focusItem = tmpElem; + } + else // found it! + { + break; + } + n++; + } + } + } + if (focusItem) + { + focusItem.focus(); + } + else // return focus to search field + { + document.getElementById("MSearchField").focus(); + } + } + else if (this.lastKey==40) // Down + { + var newIndex = itemIndex+1; + var focusItem; + var item = document.getElementById('Item'+itemIndex); + var elem = this.FindChildElement(item.parentNode.parentNode.id); + if (elem && elem.style.display == 'block') // children visible + { + focusItem = document.getElementById('Item'+itemIndex+'_c0'); + } + if (!focusItem) focusItem = this.NavNext(newIndex); + if (focusItem) focusItem.focus(); + } + else if (this.lastKey==39) // Right + { + var item = document.getElementById('Item'+itemIndex); + var elem = this.FindChildElement(item.parentNode.parentNode.id); + if (elem) elem.style.display = 'block'; + } + else if (this.lastKey==37) // Left + { + var item = document.getElementById('Item'+itemIndex); + var elem = this.FindChildElement(item.parentNode.parentNode.id); + if (elem) elem.style.display = 'none'; + } + else if (this.lastKey==27) // Escape + { + searchBox.CloseResultsWindow(); + document.getElementById("MSearchField").focus(); + } + else if (this.lastKey==13) // Enter + { + return true; + } + return false; + } + + this.NavChild = function(evt,itemIndex,childIndex) + { + var e = (evt) ? evt : window.event; // for IE + if (e.keyCode==13) return true; + if (!this.ProcessKeys(e)) return false; + + if (this.lastKey==38) // Up + { + if (childIndex>0) + { + var newIndex = childIndex-1; + document.getElementById('Item'+itemIndex+'_c'+newIndex).focus(); + } + else // already at first child, jump to parent + { + document.getElementById('Item'+itemIndex).focus(); + } + } + else if (this.lastKey==40) // Down + { + var newIndex = childIndex+1; + var elem = document.getElementById('Item'+itemIndex+'_c'+newIndex); + if (!elem) // last child, jump to parent next parent + { + elem = this.NavNext(itemIndex+1); + } + if (elem) + { + elem.focus(); + } + } + else if (this.lastKey==27) // Escape + { + searchBox.CloseResultsWindow(); + document.getElementById("MSearchField").focus(); + } + else if (this.lastKey==13) // Enter + { + return true; + } + return false; + } +} + +function setKeyActions(elem,action) +{ + elem.setAttribute('onkeydown',action); + elem.setAttribute('onkeypress',action); + elem.setAttribute('onkeyup',action); +} + +function setClassAttr(elem,attr) +{ + elem.setAttribute('class',attr); + elem.setAttribute('className',attr); +} + +function createResults(resultsPath) +{ + var results = document.getElementById("SRResults"); + results.innerHTML = ''; + for (var e=0; e-{AmhX=Jf(#6djGiuzAr*{o?=JLmPLyc> z_*`QK&+BH@jWrYJ7>r6%keRM@)Qyv8R=enp0jiI>aWlGyB58O zFVR20d+y`K7vDw(hJF3;>dD*3-?v=<8M)@x|EEGLnJsniYK!2U1 Y!`|5biEc?d1`HDhPgg&ebxsLQ02F6;9RL6T literal 0 HcmV?d00001 diff --git a/doc/C/html/splitbard.png b/doc/C/html/splitbard.png new file mode 100644 index 0000000000000000000000000000000000000000..8367416d757fd7b6dc4272b6432dc75a75abd068 GIT binary patch literal 282 zcmeAS@N?(olHy`uVBq!ia0vp^Yzz!63>-{AmhX=Jf@VhhFKy35^fiT zT~&lUj3=cDh^%3HDY9k5CEku}PHXNoNC(_$U3XPb&Q*ME25pT;2(*BOgAf<+R$lzakPG`kF31()Fx{L5Wrac|GQzjeE= zueY1`Ze{#x<8=S|`~MgGetGce)#vN&|J{Cd^tS%;tBYTo?+^d68<#n_Y_xx`J||4O V@QB{^CqU0Kc)I$ztaD0e0svEzbJzd? literal 0 HcmV?d00001 diff --git a/doc/C/html/sync_off.png b/doc/C/html/sync_off.png new file mode 100644 index 0000000000000000000000000000000000000000..3b443fc62892114406e3d399421b2a881b897acc GIT binary patch literal 853 zcmV-b1FHOqP)oT|#XixUYy%lpuf3i8{fX!o zUyDD0jOrAiT^tq>fLSOOABs-#u{dV^F$b{L9&!2=9&RmV;;8s^x&UqB$PCj4FdKbh zoB1WTskPUPu05XzFbA}=KZ-GP1fPpAfSs>6AHb12UlR%-i&uOlTpFNS7{jm@mkU1V zh`nrXr~+^lsV-s1dkZOaI|kYyVj3WBpPCY{n~yd%u%e+d=f%`N0FItMPtdgBb@py; zq@v6NVArhyTC7)ULw-Jy8y42S1~4n(3LkrW8mW(F-4oXUP3E`e#g**YyqI7h-J2zK zK{m9##m4ri!7N>CqQqCcnI3hqo1I;Yh&QLNY4T`*ptiQGozK>FF$!$+84Z`xwmeMh zJ0WT+OH$WYFALEaGj2_l+#DC3t7_S`vHpSivNeFbP6+r50cO8iu)`7i%Z4BTPh@_m3Tk!nAm^)5Bqnr%Ov|Baunj#&RPtRuK& z4RGz|D5HNrW83-#ydk}tVKJrNmyYt-sTxLGlJY5nc&Re zU4SgHNPx8~Yxwr$bsju?4q&%T1874xxzq+_%?h8_ofw~(bld=o3iC)LUNR*BY%c0y zWd_jX{Y8`l%z+ol1$@Qa?Cy!(0CVIEeYpKZ`(9{z>3$CIe;pJDQk$m3p}$>xBm4lb zKo{4S)`wdU9Ba9jJbVJ0C=SOefZe%d$8=2r={nu<_^a3~>c#t_U6dye5)JrR(_a^E f@}b6j1K9lwFJq@>o)+Ry00000NkvXXu0mjfWa5j* literal 0 HcmV?d00001 diff --git a/doc/C/html/sync_on.png b/doc/C/html/sync_on.png new file mode 100644 index 0000000000000000000000000000000000000000..e08320fb64e6fa33b573005ed6d8fe294e19db76 GIT binary patch literal 845 zcmV-T1G4;yP)Y;xxyHF2B5Wzm| zOOGupOTn@c(JmBOl)e;XMNnZuiTJP>rM8<|Q`7I_))aP?*T)ow&n59{}X4$3Goat zgjs?*aasfbrokzG5cT4K=uG`E14xZl@z)F={P0Y^?$4t z>v!teRnNZym<6h{7sLyF1V0HsfEl+l6TrZpsfr1}luH~F7L}ktXu|*uVX^RG$L0`K zWs3j|0tIvVe(N%_?2{(iCPFGf#B6Hjy6o&}D$A%W%jfO8_W%ZO#-mh}EM$LMn7joJ z05dHr!5Y92g+31l<%i1(=L1a1pXX+OYnalY>31V4K}BjyRe3)9n#;-cCVRD_IG1fT zOKGeNY8q;TL@K{dj@D^scf&VCs*-Jb>8b>|`b*osv52-!A?BpbYtTQBns5EAU**$m zSnVSm(teh>tQi*S*A>#ySc=n;`BHz`DuG4&g4Kf8lLhca+zvZ7t7RflD6-i-mcK=M z!=^P$*u2)bkY5asG4gsss!Hn%u~>}kIW`vMs%lJLH+u*9<4PaV_c6U`KqWXQH%+Nu zTv41O(^ZVi@qhjQdG!fbZw&y+2o!iYymO^?ud3{P*HdoX83YV*Uu_HB=?U&W9%AU# z80}k1SS-CXTU7dcQlsm<^oYLxVSseqY6NO}dc`Nj?8vrhNuCdm@^{a3AQ_>6myOj+ z`1RsLUXF|dm|3k7s2jD(B{rzE>WI2scH8i1;=O5Cc9xB3^aJk%fQjqsu+kH#0=_5a z0nCE8@dbQa-|YIuUVvG0L_IwHMEhOj$Mj4Uq05 X8=0q~qBNan00000NkvXXu0mjfptF>5 literal 0 HcmV?d00001 diff --git a/doc/C/html/tab_a.png b/doc/C/html/tab_a.png new file mode 100644 index 0000000000000000000000000000000000000000..3b725c41c5a527a3a3e40097077d0e206a681247 GIT binary patch literal 142 zcmeAS@N?(olHy`uVBq!ia0vp^j6kfy!2~3aiye;!QlXwMjv*C{Z|8b*H5dputLHD# z=<0|*y7z(Vor?d;H&?EG&cXR}?!j-Lm&u1OOI7AIF5&c)RFE;&p0MYK>*Kl@eiymD r@|NpwKX@^z+;{u_Z~trSBfrMKa%3`zocFjEXaR$#tDnm{r-UW|TZ1%4 literal 0 HcmV?d00001 diff --git a/doc/C/html/tab_ad.png b/doc/C/html/tab_ad.png new file mode 100644 index 0000000000000000000000000000000000000000..e34850acfc24be58da6d2fd1ccc6b29cc84fe34d GIT binary patch literal 135 zcmeAS@N?(olHy`uVBq!ia0vp^j6kfy!2~3aiye;!QhuH;jv*C{Z|5d*H3V=pKi{In zd2jxLclDRPylmD}^l7{QOtL{vUjO{-WqItb5sQp2h-99b8^^Scr-=2mblCdZuUm?4 jzOJvgvt3{(cjKLW5(A@0qPS@<&}0TrS3j3^P6y&q2{!U5bk+Tso_B!YCpDh>v z{CM*1U8YvQRyBUHt^Ju0W_sq-?;9@_4equ-bavTs=gk796zopr0EBT&m;e9( literal 0 HcmV?d00001 diff --git a/doc/C/html/tab_s.png b/doc/C/html/tab_s.png new file mode 100644 index 0000000000000000000000000000000000000000..ab478c95b67371d700a20869f7de1ddd73522d50 GIT binary patch literal 184 zcmeAS@N?(olHy`uVBq!ia0vp^j6kfy!2~3aiye;!QuUrLjv*C{Z|^p8HaRdjTwH7) zC?wLlL}}I{)n%R&r+1}IGmDnq;&J#%V6)9VsYhS`O^BVBQlxOUep0c$RENLq#g8A$ z)z7%K_bI&n@J+X_=x}fJoEKed-$<>=ZI-;YrdjIl`U`uzuDWSP?o#Dmo{%SgM#oan kX~E1%D-|#H#QbHoIja2U-MgvsK&LQxy85}Sb4q9e0Efg%P5=M^ literal 0 HcmV?d00001 diff --git a/doc/C/html/tab_sd.png b/doc/C/html/tab_sd.png new file mode 100644 index 0000000000000000000000000000000000000000..757a565ced4730f85c833fb2547d8e199ae68f19 GIT binary patch literal 188 zcmeAS@N?(olHy`uVBq!ia0vp^j6kfy!2~3aiye;!Qq7(&jv*C{Z|_!fH5o7*c=%9% zcILh!EA=pAQKdx-Cdiev=v{eg{8Ht<{e8_NAN~b=)%W>-WDCE0PyDHGemi$BoXwcK z{>e9^za6*c1ilttWw&V+U;WCPlV9{LdC~Ey%_H(qj`xgfES(4Yz5jSTZfCt`4E$0YRsR*S^mTCR^;V&sxC8{l_Cp7w8-YPgg&ebxsLQ00$vXK>z>% literal 0 HcmV?d00001 diff --git a/doc/C/html/tabs.css b/doc/C/html/tabs.css new file mode 100644 index 00000000..71c8a470 --- /dev/null +++ b/doc/C/html/tabs.css @@ -0,0 +1 @@ +.sm{position:relative;z-index:9999}.sm,.sm ul,.sm li{display:block;list-style:none;margin:0;padding:0;line-height:normal;direction:ltr;text-align:left;-webkit-tap-highlight-color:rgba(0,0,0,0)}.sm-rtl,.sm-rtl ul,.sm-rtl li{direction:rtl;text-align:right}.sm>li>h1,.sm>li>h2,.sm>li>h3,.sm>li>h4,.sm>li>h5,.sm>li>h6{margin:0;padding:0}.sm ul{display:none}.sm li,.sm a{position:relative}.sm a{display:block}.sm a.disabled{cursor:not-allowed}.sm:after{content:"\00a0";display:block;height:0;font:0/0 serif;clear:both;visibility:hidden;overflow:hidden}.sm,.sm *,.sm *:before,.sm *:after{-moz-box-sizing:border-box;-webkit-box-sizing:border-box;box-sizing:border-box}.main-menu-btn{position:relative;display:inline-block;width:36px;height:36px;text-indent:36px;margin-left:8px;white-space:nowrap;overflow:hidden;cursor:pointer;-webkit-tap-highlight-color:rgba(0,0,0,0)}.main-menu-btn-icon,.main-menu-btn-icon:before,.main-menu-btn-icon:after{position:absolute;top:50%;left:2px;height:2px;width:24px;background:var(--nav-menu-button-color);-webkit-transition:all .25s;transition:all .25s}.main-menu-btn-icon:before{content:'';top:-7px;left:0}.main-menu-btn-icon:after{content:'';top:7px;left:0}#main-menu-state:checked ~ .main-menu-btn .main-menu-btn-icon{height:0}#main-menu-state:checked ~ .main-menu-btn .main-menu-btn-icon:before{top:0;-webkit-transform:rotate(-45deg);transform:rotate(-45deg)}#main-menu-state:checked ~ .main-menu-btn .main-menu-btn-icon:after{top:0;-webkit-transform:rotate(45deg);transform:rotate(45deg)}#main-menu-state{position:absolute;width:1px;height:1px;margin:-1px;border:0;padding:0;overflow:hidden;clip:rect(1px,1px,1px,1px)}#main-menu-state:not(:checked) ~ #main-menu{display:none}#main-menu-state:checked ~ #main-menu{display:block}@media(min-width:768px){.main-menu-btn{position:absolute;top:-99999px}#main-menu-state:not(:checked) ~ #main-menu{display:block}}.sm-dox{background-image:var(--nav-gradient-image)}.sm-dox a,.sm-dox a:focus,.sm-dox a:hover,.sm-dox a:active{padding:0 12px;padding-right:43px;font-family:var(--font-family-nav);font-size:13px;font-weight:bold;line-height:36px;text-decoration:none;text-shadow:var(--nav-text-normal-shadow);color:var(--nav-text-normal-color);outline:0}.sm-dox a:hover{background-image:var(--nav-gradient-active-image);background-repeat:repeat-x;color:var(--nav-text-hover-color);text-shadow:var(--nav-text-hover-shadow)}.sm-dox a.current{color:#d23600}.sm-dox a.disabled{color:#bbb}.sm-dox a span.sub-arrow{position:absolute;top:50%;margin-top:-14px;left:auto;right:3px;width:28px;height:28px;overflow:hidden;font:bold 12px/28px monospace !important;text-align:center;text-shadow:none;background:var(--nav-menu-toggle-color);-moz-border-radius:5px;-webkit-border-radius:5px;border-radius:5px}.sm-dox a span.sub-arrow:before{display:block;content:'+'}.sm-dox a.highlighted span.sub-arrow:before{display:block;content:'-'}.sm-dox>li:first-child>a,.sm-dox>li:first-child>:not(ul) a{-moz-border-radius:5px 5px 0 0;-webkit-border-radius:5px;border-radius:5px 5px 0 0}.sm-dox>li:last-child>a,.sm-dox>li:last-child>*:not(ul) a,.sm-dox>li:last-child>ul,.sm-dox>li:last-child>ul>li:last-child>a,.sm-dox>li:last-child>ul>li:last-child>*:not(ul) a,.sm-dox>li:last-child>ul>li:last-child>ul,.sm-dox>li:last-child>ul>li:last-child>ul>li:last-child>a,.sm-dox>li:last-child>ul>li:last-child>ul>li:last-child>*:not(ul) a,.sm-dox>li:last-child>ul>li:last-child>ul>li:last-child>ul,.sm-dox>li:last-child>ul>li:last-child>ul>li:last-child>ul>li:last-child>a,.sm-dox>li:last-child>ul>li:last-child>ul>li:last-child>ul>li:last-child>*:not(ul) a,.sm-dox>li:last-child>ul>li:last-child>ul>li:last-child>ul>li:last-child>ul,.sm-dox>li:last-child>ul>li:last-child>ul>li:last-child>ul>li:last-child>ul>li:last-child>a,.sm-dox>li:last-child>ul>li:last-child>ul>li:last-child>ul>li:last-child>ul>li:last-child>*:not(ul) a,.sm-dox>li:last-child>ul>li:last-child>ul>li:last-child>ul>li:last-child>ul>li:last-child>ul{-moz-border-radius:0 0 5px 5px;-webkit-border-radius:0;border-radius:0 0 5px 5px}.sm-dox>li:last-child>a.highlighted,.sm-dox>li:last-child>*:not(ul) a.highlighted,.sm-dox>li:last-child>ul>li:last-child>a.highlighted,.sm-dox>li:last-child>ul>li:last-child>*:not(ul) a.highlighted,.sm-dox>li:last-child>ul>li:last-child>ul>li:last-child>a.highlighted,.sm-dox>li:last-child>ul>li:last-child>ul>li:last-child>*:not(ul) a.highlighted,.sm-dox>li:last-child>ul>li:last-child>ul>li:last-child>ul>li:last-child>a.highlighted,.sm-dox>li:last-child>ul>li:last-child>ul>li:last-child>ul>li:last-child>*:not(ul) a.highlighted,.sm-dox>li:last-child>ul>li:last-child>ul>li:last-child>ul>li:last-child>ul>li:last-child>a.highlighted,.sm-dox>li:last-child>ul>li:last-child>ul>li:last-child>ul>li:last-child>ul>li:last-child>*:not(ul) a.highlighted{-moz-border-radius:0;-webkit-border-radius:0;border-radius:0}.sm-dox ul{background:var(--nav-menu-background-color)}.sm-dox ul a,.sm-dox ul a:focus,.sm-dox ul a:hover,.sm-dox ul a:active{font-size:12px;border-left:8px solid transparent;line-height:36px;text-shadow:none;background-color:var(--nav-menu-background-color);background-image:none}.sm-dox ul a:hover{background-image:var(--nav-gradient-active-image);background-repeat:repeat-x;color:var(--nav-text-hover-color);text-shadow:0 1px 1px black}.sm-dox ul ul a,.sm-dox ul ul a:hover,.sm-dox ul ul a:focus,.sm-dox ul ul a:active{border-left:16px solid transparent}.sm-dox ul ul ul a,.sm-dox ul ul ul a:hover,.sm-dox ul ul ul a:focus,.sm-dox ul ul ul a:active{border-left:24px solid transparent}.sm-dox ul ul ul ul a,.sm-dox ul ul ul ul a:hover,.sm-dox ul ul ul ul a:focus,.sm-dox ul ul ul ul a:active{border-left:32px solid transparent}.sm-dox ul ul ul ul ul a,.sm-dox ul ul ul ul ul a:hover,.sm-dox ul ul ul ul ul a:focus,.sm-dox ul ul ul ul ul a:active{border-left:40px solid transparent}@media(min-width:768px){.sm-dox ul{position:absolute;width:12em}.sm-dox li{float:left}.sm-dox.sm-rtl li{float:right}.sm-dox ul li,.sm-dox.sm-rtl ul li,.sm-dox.sm-vertical li{float:none}.sm-dox a{white-space:nowrap}.sm-dox ul a,.sm-dox.sm-vertical a{white-space:normal}.sm-dox .sm-nowrap>li>a,.sm-dox .sm-nowrap>li>:not(ul) a{white-space:nowrap}.sm-dox{padding:0 10px;background-image:var(--nav-gradient-image);line-height:36px}.sm-dox a span.sub-arrow{top:50%;margin-top:-2px;right:12px;width:0;height:0;border-width:4px;border-style:solid dashed dashed dashed;border-color:var(--nav-text-normal-color) transparent transparent transparent;background:transparent;-moz-border-radius:0;-webkit-border-radius:0;border-radius:0}.sm-dox a,.sm-dox a:focus,.sm-dox a:active,.sm-dox a:hover,.sm-dox a.highlighted{padding:0 12px;background-image:var(--nav-separator-image);background-repeat:no-repeat;background-position:right;-moz-border-radius:0 !important;-webkit-border-radius:0;border-radius:0 !important}.sm-dox a:hover{background-image:var(--nav-gradient-active-image);background-repeat:repeat-x;color:var(--nav-text-hover-color);text-shadow:var(--nav-text-hover-shadow)}.sm-dox a:hover span.sub-arrow{border-color:var(--nav-text-hover-color) transparent transparent transparent}.sm-dox a.has-submenu{padding-right:24px}.sm-dox li{border-top:0}.sm-dox>li>ul:before,.sm-dox>li>ul:after{content:'';position:absolute;top:-18px;left:30px;width:0;height:0;overflow:hidden;border-width:9px;border-style:dashed dashed solid dashed;border-color:transparent transparent #bbb transparent}.sm-dox>li>ul:after{top:-16px;left:31px;border-width:8px;border-color:transparent transparent var(--nav-menu-background-color) transparent}.sm-dox ul{border:1px solid #bbb;padding:5px 0;background:var(--nav-menu-background-color);-moz-border-radius:5px !important;-webkit-border-radius:5px;border-radius:5px !important;-moz-box-shadow:0 5px 9px rgba(0,0,0,0.2);-webkit-box-shadow:0 5px 9px rgba(0,0,0,0.2);box-shadow:0 5px 9px rgba(0,0,0,0.2)}.sm-dox ul a span.sub-arrow{right:8px;top:50%;margin-top:-5px;border-width:5px;border-color:transparent transparent transparent var(--nav-menu-foreground-color);border-style:dashed dashed dashed solid}.sm-dox ul a,.sm-dox ul a:hover,.sm-dox ul a:focus,.sm-dox ul a:active,.sm-dox ul a.highlighted{color:var(--nav-menu-foreground-color);background-image:none;border:0 !important;color:var(--nav-menu-foreground-color);background-image:none}.sm-dox ul a:hover{background-image:var(--nav-gradient-active-image);background-repeat:repeat-x;color:var(--nav-text-hover-color);text-shadow:var(--nav-text-hover-shadow)}.sm-dox ul a:hover span.sub-arrow{border-color:transparent transparent transparent var(--nav-text-hover-color)}.sm-dox span.scroll-up,.sm-dox span.scroll-down{position:absolute;display:none;visibility:hidden;overflow:hidden;background:var(--nav-menu-background-color);height:36px}.sm-dox span.scroll-up:hover,.sm-dox span.scroll-down:hover{background:#eee}.sm-dox span.scroll-up:hover span.scroll-up-arrow,.sm-dox span.scroll-up:hover span.scroll-down-arrow{border-color:transparent transparent #d23600 transparent}.sm-dox span.scroll-down:hover span.scroll-down-arrow{border-color:#d23600 transparent transparent transparent}.sm-dox span.scroll-up-arrow,.sm-dox span.scroll-down-arrow{position:absolute;top:0;left:50%;margin-left:-6px;width:0;height:0;overflow:hidden;border-width:6px;border-style:dashed dashed solid dashed;border-color:transparent transparent var(--nav-menu-foreground-color) transparent}.sm-dox span.scroll-down-arrow{top:8px;border-style:solid dashed dashed dashed;border-color:var(--nav-menu-foreground-color) transparent transparent transparent}.sm-dox.sm-rtl a.has-submenu{padding-right:12px;padding-left:24px}.sm-dox.sm-rtl a span.sub-arrow{right:auto;left:12px}.sm-dox.sm-rtl.sm-vertical a.has-submenu{padding:10px 20px}.sm-dox.sm-rtl.sm-vertical a span.sub-arrow{right:auto;left:8px;border-style:dashed solid dashed dashed;border-color:transparent #555 transparent transparent}.sm-dox.sm-rtl>li>ul:before{left:auto;right:30px}.sm-dox.sm-rtl>li>ul:after{left:auto;right:31px}.sm-dox.sm-rtl ul a.has-submenu{padding:10px 20px !important}.sm-dox.sm-rtl ul a span.sub-arrow{right:auto;left:8px;border-style:dashed solid dashed dashed;border-color:transparent #555 transparent transparent}.sm-dox.sm-vertical{padding:10px 0;-moz-border-radius:5px;-webkit-border-radius:5px;border-radius:5px}.sm-dox.sm-vertical a{padding:10px 20px}.sm-dox.sm-vertical a:hover,.sm-dox.sm-vertical a:focus,.sm-dox.sm-vertical a:active,.sm-dox.sm-vertical a.highlighted{background:#fff}.sm-dox.sm-vertical a.disabled{background-image:var(--nav-gradient-image)}.sm-dox.sm-vertical a span.sub-arrow{right:8px;top:50%;margin-top:-5px;border-width:5px;border-style:dashed dashed dashed solid;border-color:transparent transparent transparent #555}.sm-dox.sm-vertical>li>ul:before,.sm-dox.sm-vertical>li>ul:after{display:none}.sm-dox.sm-vertical ul a{padding:10px 20px}.sm-dox.sm-vertical ul a:hover,.sm-dox.sm-vertical ul a:focus,.sm-dox.sm-vertical ul a:active,.sm-dox.sm-vertical ul a.highlighted{background:#eee}.sm-dox.sm-vertical ul a.disabled{background:var(--nav-menu-background-color)}} \ No newline at end of file diff --git a/doc/html/interfacelinalg_1_1cholesky__factor.html b/doc/html/interfacelinalg_1_1cholesky__factor.html index d1566a59..5f28fefc 100644 --- a/doc/html/interfacelinalg_1_1cholesky__factor.html +++ b/doc/html/interfacelinalg_1_1cholesky__factor.html @@ -173,9 +173,9 @@
    print '(A)', "Cholesky Solution (Manual Approach): X = "
    print '(F8.4)', (bu(i), i = 1, size(bu))
    end program
    -
    Computes the Cholesky factorization of a symmetric, positive definite matrix.
    Definition: linalg.f90:1433
    -
    Solves a system of Cholesky factored equations.
    Definition: linalg.f90:2390
    -
    Solves a triangular system of equations.
    Definition: linalg.f90:2061
    +
    Computes the Cholesky factorization of a symmetric, positive definite matrix.
    Definition: linalg.f90:1432
    +
    Solves a system of Cholesky factored equations.
    Definition: linalg.f90:2389
    +
    Solves a triangular system of equations.
    Definition: linalg.f90:2060
    Provides a set of common linear algebra routines.
    Definition: linalg.f90:15
  • The above program produces the following output.
    Cholesky Solution: X =
    239.5833
    @@ -187,7 +187,7 @@
    10.3333
    -

    Definition at line 1433 of file linalg.f90.

    +

    Definition at line 1432 of file linalg.f90.


    The documentation for this interface was generated from the following file: diff --git a/doc/html/interfacelinalg_1_1cholesky__rank1__downdate.html b/doc/html/interfacelinalg_1_1cholesky__rank1__downdate.html index d3438bd8..250c1cbb 100644 --- a/doc/html/interfacelinalg_1_1cholesky__rank1__downdate.html +++ b/doc/html/interfacelinalg_1_1cholesky__rank1__downdate.html @@ -174,8 +174,8 @@
    print *, ad(i,:)
    end do
    end program
    -
    Computes the Cholesky factorization of a symmetric, positive definite matrix.
    Definition: linalg.f90:1433
    -
    Computes the rank 1 downdate to a Cholesky factored matrix (upper triangular).
    Definition: linalg.f90:1639
    +
    Computes the Cholesky factorization of a symmetric, positive definite matrix.
    Definition: linalg.f90:1432
    +
    Computes the rank 1 downdate to a Cholesky factored matrix (upper triangular).
    Definition: linalg.f90:1638
    Performs the rank-1 update to matrix A such that: , where is an M-by-N matrix, is a scalar,...
    Definition: linalg.f90:194
    Provides a set of common linear algebra routines.
    Definition: linalg.f90:15
    The above program produces the following output.
    Downdating the Factored Form:
    @@ -188,7 +188,7 @@
    0.0000000000000000 0.0000000000000000 3.0000000000000000
    -

    Definition at line 1639 of file linalg.f90.

    +

    Definition at line 1638 of file linalg.f90.


    The documentation for this interface was generated from the following file: diff --git a/doc/html/interfacelinalg_1_1cholesky__rank1__update.html b/doc/html/interfacelinalg_1_1cholesky__rank1__update.html index f2ede644..91e5e629 100644 --- a/doc/html/interfacelinalg_1_1cholesky__rank1__update.html +++ b/doc/html/interfacelinalg_1_1cholesky__rank1__update.html @@ -168,8 +168,8 @@
    print *, au(i,:)
    end do
    end program
    -
    Computes the Cholesky factorization of a symmetric, positive definite matrix.
    Definition: linalg.f90:1433
    -
    Computes the rank 1 update to a Cholesky factored matrix (upper triangular).
    Definition: linalg.f90:1532
    +
    Computes the Cholesky factorization of a symmetric, positive definite matrix.
    Definition: linalg.f90:1432
    +
    Computes the rank 1 update to a Cholesky factored matrix (upper triangular).
    Definition: linalg.f90:1531
    Performs the rank-1 update to matrix A such that: , where is an M-by-N matrix, is a scalar,...
    Definition: linalg.f90:194
    Provides a set of common linear algebra routines.
    Definition: linalg.f90:15
    The above program produces the following output.
    Updating the Factored Form:
    @@ -182,7 +182,7 @@
    0.0000000000000000 0.0000000000000000 6.6989384530323557

    -

    Definition at line 1532 of file linalg.f90.

    +

    Definition at line 1531 of file linalg.f90.


    The documentation for this interface was generated from the following file: diff --git a/doc/html/interfacelinalg_1_1diag__mtx__mult.html b/doc/html/interfacelinalg_1_1diag__mtx__mult.html index 978eaf7b..7cc9aac2 100644 --- a/doc/html/interfacelinalg_1_1diag__mtx__mult.html +++ b/doc/html/interfacelinalg_1_1diag__mtx__mult.html @@ -194,7 +194,7 @@
    end do
    end program
    Multiplies a diagonal matrix with another matrix or array.
    Definition: linalg.f90:329
    -
    Computes the singular value decomposition of a matrix A. The SVD is defined as: , where is an M-by-M...
    Definition: linalg.f90:1927
    +
    Computes the singular value decomposition of a matrix A. The SVD is defined as: , where is an M-by-M...
    Definition: linalg.f90:1926
    Provides a set of common linear algebra routines.
    Definition: linalg.f90:15
    The above program produces the following output.
    U =
    -0.47411577501825380 -0.81850539032073777 -0.32444284226152509
    diff --git a/doc/html/interfacelinalg_1_1eigen.html b/doc/html/interfacelinalg_1_1eigen.html index 586dcd53..de5e607f 100644 --- a/doc/html/interfacelinalg_1_1eigen.html +++ b/doc/html/interfacelinalg_1_1eigen.html @@ -225,7 +225,7 @@
    print '(F10.3)', (real(modeshapes(j,i)), j = 1, size(natfreq))
    end do
    end program
    -
    Computes the eigenvalues, and optionally the eigenvectors, of a matrix.
    Definition: linalg.f90:3098
    +
    Computes the eigenvalues, and optionally the eigenvectors, of a matrix.
    Definition: linalg.f90:3097
    Provides a set of common linear algebra routines.
    Definition: linalg.f90:15
    The above program produces the following output.
    Modal Information:
    Mode 1: (232.9225 Hz)
    @@ -248,7 +248,7 @@ -

    Definition at line 3098 of file linalg.f90.

    +

    Definition at line 3097 of file linalg.f90.


    The documentation for this interface was generated from the following file: diff --git a/doc/html/interfacelinalg_1_1form__lu.html b/doc/html/interfacelinalg_1_1form__lu.html index 6bb3acc5..9cdb2245 100644 --- a/doc/html/interfacelinalg_1_1form__lu.html +++ b/doc/html/interfacelinalg_1_1form__lu.html @@ -199,7 +199,7 @@
    end program
    Extracts the L and U matrices from the condensed [L\U] storage format used by the lu_factor.
    Definition: linalg.f90:717
    Computes the LU factorization of an M-by-N matrix.
    Definition: linalg.f90:595
    -
    Solves a triangular system of equations.
    Definition: linalg.f90:2061
    +
    Solves a triangular system of equations.
    Definition: linalg.f90:2060
    Provides a set of common linear algebra routines.
    Definition: linalg.f90:15
    The above program produces the following output.
    LU Solution: X =
    0.3333
    diff --git a/doc/html/interfacelinalg_1_1form__qr.html b/doc/html/interfacelinalg_1_1form__qr.html index 280aa722..8856168c 100644 --- a/doc/html/interfacelinalg_1_1form__qr.html +++ b/doc/html/interfacelinalg_1_1form__qr.html @@ -204,7 +204,7 @@
    end program
    Forms the full M-by-M orthogonal matrix Q from the elementary reflectors returned by the base QR fact...
    Definition: linalg.f90:1031
    Computes the QR factorization of an M-by-N matrix.
    Definition: linalg.f90:871
    -
    Solves a triangular system of equations.
    Definition: linalg.f90:2061
    +
    Solves a triangular system of equations.
    Definition: linalg.f90:2060
    Provides a set of common linear algebra routines.
    Definition: linalg.f90:15
    The above program produces the following output.
    QR Solution: X =
    0.3333
    diff --git a/doc/html/interfacelinalg_1_1lu__factor.html b/doc/html/interfacelinalg_1_1lu__factor.html index 03723a01..f0fb5e3c 100644 --- a/doc/html/interfacelinalg_1_1lu__factor.html +++ b/doc/html/interfacelinalg_1_1lu__factor.html @@ -167,7 +167,7 @@
    print '(F8.4)', (b(i), i = 1, size(b))
    end program
    Computes the LU factorization of an M-by-N matrix.
    Definition: linalg.f90:595
    -
    Solves a system of LU-factored equations.
    Definition: linalg.f90:2149
    +
    Solves a system of LU-factored equations.
    Definition: linalg.f90:2148
    Provides a set of common linear algebra routines.
    Definition: linalg.f90:15
    The program generates the following output.
    LU Solution: X =
    0.3333
    diff --git a/doc/html/interfacelinalg_1_1mtx__inverse.html b/doc/html/interfacelinalg_1_1mtx__inverse.html index 534bffdf..25e4eb89 100644 --- a/doc/html/interfacelinalg_1_1mtx__inverse.html +++ b/doc/html/interfacelinalg_1_1mtx__inverse.html @@ -167,7 +167,7 @@
    print *, c(i,:)
    end do
    end program
    -
    Computes the inverse of a square matrix.
    Definition: linalg.f90:2778
    +
    Computes the inverse of a square matrix.
    Definition: linalg.f90:2777
    Provides a set of common linear algebra routines.
    Definition: linalg.f90:15
    The above program produces the following output.
    Inverse:
    -1.7777777777777777 0.88888888888888884 -0.11111111111111110
    @@ -179,7 +179,7 @@
    1.7763568394002505E-015 -8.8817841970012523E-016 1.0000000000000000
    -

    Definition at line 2778 of file linalg.f90.

    +

    Definition at line 2777 of file linalg.f90.


    The documentation for this interface was generated from the following file: diff --git a/doc/html/interfacelinalg_1_1mtx__pinverse.html b/doc/html/interfacelinalg_1_1mtx__pinverse.html index c0f4f1c5..dd75c5c1 100644 --- a/doc/html/interfacelinalg_1_1mtx__pinverse.html +++ b/doc/html/interfacelinalg_1_1mtx__pinverse.html @@ -171,7 +171,7 @@
    print *, c(i,:)
    end do
    end program
    -
    Computes the Moore-Penrose pseudo-inverse of a M-by-N matrix using the singular value decomposition o...
    Definition: linalg.f90:2884
    +
    Computes the Moore-Penrose pseudo-inverse of a M-by-N matrix using the singular value decomposition o...
    Definition: linalg.f90:2883
    Provides a set of common linear algebra routines.
    Definition: linalg.f90:15
    The above program produces the following output.
    Inverse:
    1.0000000000000000 0.0000000000000000 0.0000000000000000
    @@ -181,7 +181,7 @@
    0.0000000000000000 0.99999999999999967
    -

    Definition at line 2884 of file linalg.f90.

    +

    Definition at line 2883 of file linalg.f90.


    The documentation for this interface was generated from the following file: diff --git a/doc/html/interfacelinalg_1_1mult__qr.html b/doc/html/interfacelinalg_1_1mult__qr.html index 7a7d468a..ba37aa88 100644 --- a/doc/html/interfacelinalg_1_1mult__qr.html +++ b/doc/html/interfacelinalg_1_1mult__qr.html @@ -119,7 +119,7 @@ [in,out]cOn input, the M-by-N matrix C. On output, the product of the orthogonal matrix Q and the original matrix C. [out]workAn optional input, that if provided, prevents any local memory allocation. If not provided, the memory required is allocated within. If provided, the length of the array must be at least olwork. [in,out]olworkAn optional output used to determine workspace size. If supplied, the routine determines the optimal size for work, and returns without performing any actual calculations. - [out]errAn optional errors-based object that if provided can be used to retrieve information relating to any errors encountered during execution. If not provided, a default implementation of the errors class is used internally to provide error handling. Possible errors and warning messages that may be encountered are as follows.
      + [in,out]errAn optional errors-based object that if provided can be used to retrieve information relating to any errors encountered during execution. If not provided, a default implementation of the errors class is used internally to provide error handling. Possible errors and warning messages that may be encountered are as follows.
      • LA_ARRAY_SIZE_ERROR: Occurs if any of the input arrays are not sized appropriately.
      • LA_OUT_OF_MEMORY_ERROR: Occurs if local memory must be allocated, and there is insufficient memory available.
      @@ -201,9 +201,9 @@
      ! for by noting that Q * R = A * P, where P is an N-by-N matrix describing
      ! the column pivoting operations.
      end program
      -
      Multiplies a general matrix by the orthogonal matrix Q from a QR factorization.
      Definition: linalg.f90:1185
      +
      Multiplies a general matrix by the orthogonal matrix Q from a QR factorization.
      Definition: linalg.f90:1184
      Computes the QR factorization of an M-by-N matrix.
      Definition: linalg.f90:871
      -
      Solves a triangular system of equations.
      Definition: linalg.f90:2061
      +
      Solves a triangular system of equations.
      Definition: linalg.f90:2060
      Provides a set of common linear algebra routines.
      Definition: linalg.f90:15
      The above program produces the following output.
      QR Solution: X =
      0.3333
      @@ -211,7 +211,7 @@
      0.0000
      -

      Definition at line 1185 of file linalg.f90.

      +

      Definition at line 1184 of file linalg.f90.


      The documentation for this interface was generated from the following file: diff --git a/doc/html/interfacelinalg_1_1mult__rz.html b/doc/html/interfacelinalg_1_1mult__rz.html index 9be04921..d78a3e8d 100644 --- a/doc/html/interfacelinalg_1_1mult__rz.html +++ b/doc/html/interfacelinalg_1_1mult__rz.html @@ -150,7 +150,7 @@
      Notes
      This routine utilizes the LAPACK routine DORMRZ (ZUNMRZ in the complex case).
      -

      Definition at line 1803 of file linalg.f90.

      +

      Definition at line 1802 of file linalg.f90.


      The documentation for this interface was generated from the following file: diff --git a/doc/html/interfacelinalg_1_1qr__factor.html b/doc/html/interfacelinalg_1_1qr__factor.html index 1e43ecfd..17522652 100644 --- a/doc/html/interfacelinalg_1_1qr__factor.html +++ b/doc/html/interfacelinalg_1_1qr__factor.html @@ -190,7 +190,7 @@
      ! tracking array).
      end program
      Computes the QR factorization of an M-by-N matrix.
      Definition: linalg.f90:871
      -
      Solves a system of M QR-factored equations of N unknowns.
      Definition: linalg.f90:2284
      +
      Solves a system of M QR-factored equations of N unknowns.
      Definition: linalg.f90:2283
      Provides a set of common linear algebra routines.
      Definition: linalg.f90:15
      The above program produces the following output.
      QR Solution: X =
      0.3333
      diff --git a/doc/html/interfacelinalg_1_1qr__rank1__update.html b/doc/html/interfacelinalg_1_1qr__rank1__update.html index 1d305795..9c9a7a0a 100644 --- a/doc/html/interfacelinalg_1_1qr__rank1__update.html +++ b/doc/html/interfacelinalg_1_1qr__rank1__update.html @@ -196,7 +196,7 @@
      end program
      Forms the full M-by-M orthogonal matrix Q from the elementary reflectors returned by the base QR fact...
      Definition: linalg.f90:1031
      Computes the QR factorization of an M-by-N matrix.
      Definition: linalg.f90:871
      -
      Computes the rank 1 update to an M-by-N QR factored matrix A (M >= N) where , and such that .
      Definition: linalg.f90:1334
      +
      Computes the rank 1 update to an M-by-N QR factored matrix A (M >= N) where , and such that .
      Definition: linalg.f90:1333
      Performs the rank-1 update to matrix A such that: , where is an M-by-N matrix, is a scalar,...
      Definition: linalg.f90:194
      Provides a set of common linear algebra routines.
      Definition: linalg.f90:15
      The above program produces the following output.
      Updating the Factored Form:
      @@ -219,7 +219,7 @@
      0.0000000000000000 0.0000000000000000 -5.2929341121113058
      -

      Definition at line 1334 of file linalg.f90.

      +

      Definition at line 1333 of file linalg.f90.


      The documentation for this interface was generated from the following file: diff --git a/doc/html/interfacelinalg_1_1rz__factor.html b/doc/html/interfacelinalg_1_1rz__factor.html index ca79b4a2..6222c96c 100644 --- a/doc/html/interfacelinalg_1_1rz__factor.html +++ b/doc/html/interfacelinalg_1_1rz__factor.html @@ -135,7 +135,7 @@
    -

    Definition at line 1712 of file linalg.f90.

    +

    Definition at line 1711 of file linalg.f90.


    The documentation for this interface was generated from the following file: diff --git a/doc/html/interfacelinalg_1_1solve__cholesky.html b/doc/html/interfacelinalg_1_1solve__cholesky.html index 249a5320..7998995c 100644 --- a/doc/html/interfacelinalg_1_1solve__cholesky.html +++ b/doc/html/interfacelinalg_1_1solve__cholesky.html @@ -175,9 +175,9 @@
    print '(A)', "Cholesky Solution (Manual Approach): X = "
    print '(F8.4)', (bu(i), i = 1, size(bu))
    end program
    -
    Computes the Cholesky factorization of a symmetric, positive definite matrix.
    Definition: linalg.f90:1433
    -
    Solves a system of Cholesky factored equations.
    Definition: linalg.f90:2390
    -
    Solves a triangular system of equations.
    Definition: linalg.f90:2061
    +
    Computes the Cholesky factorization of a symmetric, positive definite matrix.
    Definition: linalg.f90:1432
    +
    Solves a system of Cholesky factored equations.
    Definition: linalg.f90:2389
    +
    Solves a triangular system of equations.
    Definition: linalg.f90:2060
    Provides a set of common linear algebra routines.
    Definition: linalg.f90:15
    The above program produces the following output.
    Cholesky Solution: X =
    239.5833
    @@ -189,7 +189,7 @@
    10.3333
    -

    Definition at line 2390 of file linalg.f90.

    +

    Definition at line 2389 of file linalg.f90.


    The documentation for this interface was generated from the following file: diff --git a/doc/html/interfacelinalg_1_1solve__least__squares.html b/doc/html/interfacelinalg_1_1solve__least__squares.html index 778e1c31..6485f161 100644 --- a/doc/html/interfacelinalg_1_1solve__least__squares.html +++ b/doc/html/interfacelinalg_1_1solve__least__squares.html @@ -160,14 +160,14 @@
    print '(A)', "Least Squares Solution: X = "
    print '(F9.5)', (b(i), i = 1, size(a, 2))
    end program
    -
    Solves the overdetermined or underdetermined system of M equations of N unknowns....
    Definition: linalg.f90:2480
    +
    Solves the overdetermined or underdetermined system of M equations of N unknowns....
    Definition: linalg.f90:2479
    Provides a set of common linear algebra routines.
    Definition: linalg.f90:15
    The above program produces the following output.
    Least Squares Solution: X =
    0.13158
    -0.57895
    -

    Definition at line 2480 of file linalg.f90.

    +

    Definition at line 2479 of file linalg.f90.


    The documentation for this interface was generated from the following file: diff --git a/doc/html/interfacelinalg_1_1solve__least__squares__full.html b/doc/html/interfacelinalg_1_1solve__least__squares__full.html index 9ec2eba9..eaf4868a 100644 --- a/doc/html/interfacelinalg_1_1solve__least__squares__full.html +++ b/doc/html/interfacelinalg_1_1solve__least__squares__full.html @@ -162,14 +162,14 @@
    print '(A)', "Least Squares Solution: X = "
    print '(F9.5)', (b(i), i = 1, size(a, 2))
    end program
    -
    Solves the overdetermined or underdetermined system of M equations of N unknowns,...
    Definition: linalg.f90:2581
    +
    Solves the overdetermined or underdetermined system of M equations of N unknowns,...
    Definition: linalg.f90:2580
    Provides a set of common linear algebra routines.
    Definition: linalg.f90:15
    The above program produces the following output.
    Least Squares Solution: X =
    0.13158
    -0.57895
    -

    Definition at line 2581 of file linalg.f90.

    +

    Definition at line 2580 of file linalg.f90.


    The documentation for this interface was generated from the following file: diff --git a/doc/html/interfacelinalg_1_1solve__least__squares__svd.html b/doc/html/interfacelinalg_1_1solve__least__squares__svd.html index 6a04cec4..b725644d 100644 --- a/doc/html/interfacelinalg_1_1solve__least__squares__svd.html +++ b/doc/html/interfacelinalg_1_1solve__least__squares__svd.html @@ -164,14 +164,14 @@
    print '(A)', "Least Squares Solution: X = "
    print '(F9.5)', (b(i), i = 1, size(a, 2))
    end program
    -
    Solves the overdetermined or underdetermined system of M equations of N unknowns using a singular va...
    Definition: linalg.f90:2683
    +
    Solves the overdetermined or underdetermined system of M equations of N unknowns using a singular va...
    Definition: linalg.f90:2682
    Provides a set of common linear algebra routines.
    Definition: linalg.f90:15
    The above program produces the following output.
    Least Squares Solution: X =
    0.13158
    -0.57895
    -

    Definition at line 2683 of file linalg.f90.

    +

    Definition at line 2682 of file linalg.f90.


    The documentation for this interface was generated from the following file: diff --git a/doc/html/interfacelinalg_1_1solve__lu.html b/doc/html/interfacelinalg_1_1solve__lu.html index 8f39bdc5..561cf898 100644 --- a/doc/html/interfacelinalg_1_1solve__lu.html +++ b/doc/html/interfacelinalg_1_1solve__lu.html @@ -164,7 +164,7 @@
    print '(F8.4)', (b(i), i = 1, size(b))
    end program
    Computes the LU factorization of an M-by-N matrix.
    Definition: linalg.f90:595
    -
    Solves a system of LU-factored equations.
    Definition: linalg.f90:2149
    +
    Solves a system of LU-factored equations.
    Definition: linalg.f90:2148
    Provides a set of common linear algebra routines.
    Definition: linalg.f90:15
    The program generates the following output.
    LU Solution: X =
    0.3333
    @@ -177,7 +177,7 @@ -

    Definition at line 2149 of file linalg.f90.

    +

    Definition at line 2148 of file linalg.f90.


    The documentation for this interface was generated from the following file: diff --git a/doc/html/interfacelinalg_1_1solve__qr.html b/doc/html/interfacelinalg_1_1solve__qr.html index f03c1c53..01dcdac9 100644 --- a/doc/html/interfacelinalg_1_1solve__qr.html +++ b/doc/html/interfacelinalg_1_1solve__qr.html @@ -192,7 +192,7 @@
    ! tracking array).
    end program
    Computes the QR factorization of an M-by-N matrix.
    Definition: linalg.f90:871
    -
    Solves a system of M QR-factored equations of N unknowns.
    Definition: linalg.f90:2284
    +
    Solves a system of M QR-factored equations of N unknowns.
    Definition: linalg.f90:2283
    Provides a set of common linear algebra routines.
    Definition: linalg.f90:15
    The above program produces the following output.
    QR Solution: X =
    0.3333
    @@ -205,7 +205,7 @@ -

    Definition at line 2284 of file linalg.f90.

    +

    Definition at line 2283 of file linalg.f90.


    The documentation for this interface was generated from the following file: diff --git a/doc/html/interfacelinalg_1_1solve__triangular__system.html b/doc/html/interfacelinalg_1_1solve__triangular__system.html index e9d1de84..e26ad015 100644 --- a/doc/html/interfacelinalg_1_1solve__triangular__system.html +++ b/doc/html/interfacelinalg_1_1solve__triangular__system.html @@ -137,7 +137,7 @@ [in]nounitSet to true if A is not a unit-diagonal matrix (ones on every diagonal element); else, set to false if A is a unit-diagonal matrix. [in]aThe N-by-N triangular matrix. [in,out]xOn input, the N-element right-hand-side array. On output, the N-element solution array. - [out]errAn optional errors-based object that if provided can be used to retrieve information relating to any errors encountered during execution. If not provided, a default implementation of the errors class is used internally to provide error handling. Possible errors and warning messages that may be encountered are as follows.
      + [in,out]errAn optional errors-based object that if provided can be used to retrieve information relating to any errors encountered during execution. If not provided, a default implementation of the errors class is used internally to provide error handling. Possible errors and warning messages that may be encountered are as follows.
      • LA_ARRAY_SIZE_ERROR: Occurs if a is not square, or if the sizes of a and b are not compatible.
      @@ -196,7 +196,7 @@
      end program
      Extracts the L and U matrices from the condensed [L\U] storage format used by the lu_factor.
      Definition: linalg.f90:717
      Computes the LU factorization of an M-by-N matrix.
      Definition: linalg.f90:595
      -
      Solves a triangular system of equations.
      Definition: linalg.f90:2061
      +
      Solves a triangular system of equations.
      Definition: linalg.f90:2060
      Provides a set of common linear algebra routines.
      Definition: linalg.f90:15
      The above program produces the following output.
      LU Solution: X =
      0.3333
      @@ -204,7 +204,7 @@
      0.0000
      -

      Definition at line 2061 of file linalg.f90.

      +

      Definition at line 2060 of file linalg.f90.


      The documentation for this interface was generated from the following file: diff --git a/doc/html/interfacelinalg_1_1sort.html b/doc/html/interfacelinalg_1_1sort.html index d039497d..ebed27e9 100644 --- a/doc/html/interfacelinalg_1_1sort.html +++ b/doc/html/interfacelinalg_1_1sort.html @@ -152,7 +152,7 @@ -

      Definition at line 3181 of file linalg.f90.

      +

      Definition at line 3180 of file linalg.f90.


      The documentation for this interface was generated from the following file: diff --git a/doc/html/interfacelinalg_1_1svd.html b/doc/html/interfacelinalg_1_1svd.html index 4fd0a468..48b23470 100644 --- a/doc/html/interfacelinalg_1_1svd.html +++ b/doc/html/interfacelinalg_1_1svd.html @@ -176,7 +176,7 @@
      end do
      end program
      Multiplies a diagonal matrix with another matrix or array.
      Definition: linalg.f90:329
      -
      Computes the singular value decomposition of a matrix A. The SVD is defined as: , where is an M-by-M...
      Definition: linalg.f90:1927
      +
      Computes the singular value decomposition of a matrix A. The SVD is defined as: , where is an M-by-M...
      Definition: linalg.f90:1926
      Provides a set of common linear algebra routines.
      Definition: linalg.f90:15
      The above program produces the following output.
      U =
      -0.47411577501825380 -0.81850539032073777 -0.32444284226152509
      @@ -194,7 +194,7 @@
      -1.0000000000000000 0.99999999999999967
      -

      Definition at line 1927 of file linalg.f90.

      +

      Definition at line 1926 of file linalg.f90.


      The documentation for this interface was generated from the following file: diff --git a/doc/html/linalg_8f90_source.html b/doc/html/linalg_8f90_source.html index ae9ae262..d126b8cf 100644 --- a/doc/html/linalg_8f90_source.html +++ b/doc/html/linalg_8f90_source.html @@ -267,1062 +267,1061 @@
      1036end interface
      1037
      1038! ------------------------------------------------------------------------------
      -
      1185interface mult_qr
      -
      1186 module procedure :: mult_qr_mtx
      -
      1187 module procedure :: mult_qr_mtx_cmplx
      -
      1188 module procedure :: mult_qr_vec
      -
      1189 module procedure :: mult_qr_vec_cmplx
      -
      1190end interface
      -
      1191
      -
      1192! ------------------------------------------------------------------------------
      - -
      1335 module procedure :: qr_rank1_update_dbl
      -
      1336 module procedure :: qr_rank1_update_cmplx
      -
      1337end interface
      -
      1338
      -
      1339! ------------------------------------------------------------------------------
      - -
      1434 module procedure :: cholesky_factor_dbl
      -
      1435 module procedure :: cholesky_factor_cmplx
      -
      1436end interface
      -
      1437
      -
      1438! ------------------------------------------------------------------------------
      - -
      1533 module procedure :: cholesky_rank1_update_dbl
      -
      1534 module procedure :: cholesky_rank1_update_cmplx
      -
      1535end interface
      -
      1536
      -
      1537! ------------------------------------------------------------------------------
      - -
      1640 module procedure :: cholesky_rank1_downdate_dbl
      -
      1641 module procedure :: cholesky_rank1_downdate_cmplx
      -
      1642end interface
      -
      1643
      -
      1644! ------------------------------------------------------------------------------
      -
      1712interface rz_factor
      -
      1713 module procedure :: rz_factor_dbl
      -
      1714 module procedure :: rz_factor_cmplx
      -
      1715end interface
      -
      1716
      -
      1717! ------------------------------------------------------------------------------
      -
      1803interface mult_rz
      -
      1804 module procedure :: mult_rz_mtx
      -
      1805 module procedure :: mult_rz_mtx_cmplx
      -
      1806 module procedure :: mult_rz_vec
      -
      1807 module procedure :: mult_rz_vec_cmplx
      -
      1808end interface
      -
      1809
      -
      1810! ------------------------------------------------------------------------------
      -
      1927interface svd
      -
      1928 module procedure :: svd_dbl
      -
      1929 module procedure :: svd_cmplx
      -
      1930end interface
      -
      1931
      -
      1932! ------------------------------------------------------------------------------
      - -
      2062 module procedure :: solve_tri_mtx
      -
      2063 module procedure :: solve_tri_mtx_cmplx
      -
      2064 module procedure :: solve_tri_vec
      -
      2065 module procedure :: solve_tri_vec_cmplx
      -
      2066end interface
      -
      2067
      -
      2068! ------------------------------------------------------------------------------
      -
      2149interface solve_lu
      -
      2150 module procedure :: solve_lu_mtx
      -
      2151 module procedure :: solve_lu_mtx_cmplx
      -
      2152 module procedure :: solve_lu_vec
      -
      2153 module procedure :: solve_lu_vec_cmplx
      -
      2154end interface
      -
      2155
      -
      2156! ------------------------------------------------------------------------------
      -
      2284interface solve_qr
      -
      2285 module procedure :: solve_qr_no_pivot_mtx
      -
      2286 module procedure :: solve_qr_no_pivot_mtx_cmplx
      -
      2287 module procedure :: solve_qr_no_pivot_vec
      -
      2288 module procedure :: solve_qr_no_pivot_vec_cmplx
      -
      2289 module procedure :: solve_qr_pivot_mtx
      -
      2290 module procedure :: solve_qr_pivot_mtx_cmplx
      -
      2291 module procedure :: solve_qr_pivot_vec
      -
      2292 module procedure :: solve_qr_pivot_vec_cmplx
      -
      2293end interface
      -
      2294
      -
      2295! ------------------------------------------------------------------------------
      - -
      2391 module procedure :: solve_cholesky_mtx
      -
      2392 module procedure :: solve_cholesky_mtx_cmplx
      -
      2393 module procedure :: solve_cholesky_vec
      -
      2394 module procedure :: solve_cholesky_vec_cmplx
      -
      2395end interface
      -
      2396
      -
      2397! ------------------------------------------------------------------------------
      - -
      2481 module procedure :: solve_least_squares_mtx
      -
      2482 module procedure :: solve_least_squares_mtx_cmplx
      -
      2483 module procedure :: solve_least_squares_vec
      -
      2484 module procedure :: solve_least_squares_vec_cmplx
      -
      2485end interface
      -
      2486
      -
      2487! ------------------------------------------------------------------------------
      - -
      2582 module procedure :: solve_least_squares_mtx_pvt
      -
      2583 module procedure :: solve_least_squares_mtx_pvt_cmplx
      -
      2584 module procedure :: solve_least_squares_vec_pvt
      -
      2585 module procedure :: solve_least_squares_vec_pvt_cmplx
      -
      2586end interface
      -
      2587
      -
      2588! ------------------------------------------------------------------------------
      - -
      2684 module procedure :: solve_least_squares_mtx_svd
      -
      2685 module procedure :: solve_least_squares_vec_svd
      -
      2686end interface
      -
      2687
      -
      2688! ------------------------------------------------------------------------------
      - -
      2779 module procedure :: mtx_inverse_dbl
      -
      2780 module procedure :: mtx_inverse_cmplx
      -
      2781end interface
      -
      2782
      -
      2783! ------------------------------------------------------------------------------
      - -
      2885 module procedure :: mtx_pinverse_dbl
      -
      2886 module procedure :: mtx_pinverse_cmplx
      -
      2887end interface
      -
      2888
      -
      2889! ------------------------------------------------------------------------------
      -
      3098interface eigen
      -
      3099 module procedure :: eigen_symm
      -
      3100 module procedure :: eigen_asymm
      -
      3101 module procedure :: eigen_gen
      -
      3102 module procedure :: eigen_cmplx
      -
      3103end interface
      -
      3104
      -
      3105! ------------------------------------------------------------------------------
      -
      3181interface sort
      -
      3182 module procedure :: sort_dbl_array
      -
      3183 module procedure :: sort_dbl_array_ind
      -
      3184 module procedure :: sort_cmplx_array
      -
      3185 module procedure :: sort_cmplx_array_ind
      -
      3186 module procedure :: sort_eigen_cmplx
      -
      3187 module procedure :: sort_eigen_dbl
      -
      3188end interface
      -
      3189
      -
      3190
      -
      3191! ******************************************************************************
      -
      3192! LINALG_BASIC.F90
      -
      3193! ------------------------------------------------------------------------------
      -
      3194interface
      -
      3195 module subroutine mtx_mult_mtx(transa, transb, alpha, a, b, beta, c, err)
      -
      3196 logical, intent(in) :: transa, transb
      -
      3197 real(real64), intent(in) :: alpha, beta
      -
      3198 real(real64), intent(in), dimension(:,:) :: a, b
      -
      3199 real(real64), intent(inout), dimension(:,:) :: c
      -
      3200 class(errors), intent(inout), optional, target :: err
      -
      3201 end subroutine
      -
      3202
      -
      3203 module subroutine mtx_mult_vec(trans, alpha, a, b, beta, c, err)
      -
      3204 logical, intent(in) :: trans
      -
      3205 real(real64), intent(in) :: alpha, beta
      -
      3206 real(real64), intent(in), dimension(:,:) :: a
      -
      3207 real(real64), intent(in), dimension(:) :: b
      -
      3208 real(real64), intent(inout), dimension(:) :: c
      -
      3209 class(errors), intent(inout), optional, target :: err
      -
      3210 end subroutine
      -
      3211
      -
      3212 module subroutine cmtx_mult_mtx(opa, opb, alpha, a, b, beta, c, err)
      -
      3213 integer(int32), intent(in) :: opa, opb
      -
      3214 complex(real64), intent(in) :: alpha, beta
      -
      3215 complex(real64), intent(in), dimension(:,:) :: a, b
      -
      3216 complex(real64), intent(inout), dimension(:,:) :: c
      -
      3217 class(errors), intent(inout), optional, target :: err
      -
      3218 end subroutine
      -
      3219
      -
      3220 module subroutine cmtx_mult_vec(opa, alpha, a, b, beta, c, err)
      -
      3221 integer(int32), intent(in) :: opa
      -
      3222 complex(real64), intent(in) :: alpha, beta
      -
      3223 complex(real64), intent(in), dimension(:,:) :: a
      -
      3224 complex(real64), intent(in), dimension(:) :: b
      -
      3225 complex(real64), intent(inout), dimension(:) :: c
      -
      3226 class(errors), intent(inout), optional, target :: err
      -
      3227 end subroutine
      -
      3228
      -
      3229 module subroutine rank1_update_dbl(alpha, x, y, a, err)
      -
      3230 real(real64), intent(in) :: alpha
      -
      3231 real(real64), intent(in), dimension(:) :: x, y
      -
      3232 real(real64), intent(inout), dimension(:,:) :: a
      -
      3233 class(errors), intent(inout), optional, target :: err
      -
      3234 end subroutine
      -
      3235
      -
      3236 module subroutine rank1_update_cmplx(alpha, x, y, a, err)
      -
      3237 complex(real64), intent(in) :: alpha
      -
      3238 complex(real64), intent(in), dimension(:) :: x, y
      -
      3239 complex(real64), intent(inout), dimension(:,:) :: a
      -
      3240 class(errors), intent(inout), optional, target :: err
      -
      3241 end subroutine
      -
      3242
      -
      3243 module subroutine diag_mtx_mult_mtx(lside, trans, alpha, a, b, beta, c, err)
      -
      3244 logical, intent(in) :: lside, trans
      -
      3245 real(real64) :: alpha, beta
      -
      3246 real(real64), intent(in), dimension(:) :: a
      -
      3247 real(real64), intent(in), dimension(:,:) :: b
      -
      3248 real(real64), intent(inout), dimension(:,:) :: c
      -
      3249 class(errors), intent(inout), optional, target :: err
      -
      3250 end subroutine
      -
      3251
      -
      3252 module subroutine diag_mtx_mult_mtx2(lside, alpha, a, b, err)
      -
      3253 logical, intent(in) :: lside
      -
      3254 real(real64), intent(in) :: alpha
      -
      3255 real(real64), intent(in), dimension(:) :: a
      -
      3256 real(real64), intent(inout), dimension(:,:) :: b
      -
      3257 class(errors), intent(inout), optional, target :: err
      -
      3258 end subroutine
      -
      3259
      -
      3260 module subroutine diag_mtx_mult_mtx3(lside, trans, alpha, a, b, beta, c, err)
      -
      3261 logical, intent(in) :: lside, trans
      -
      3262 real(real64) :: alpha, beta
      -
      3263 complex(real64), intent(in), dimension(:) :: a
      -
      3264 real(real64), intent(in), dimension(:,:) :: b
      -
      3265 complex(real64), intent(inout), dimension(:,:) :: c
      -
      3266 class(errors), intent(inout), optional, target :: err
      -
      3267 end subroutine
      -
      3268
      -
      3269 module subroutine diag_mtx_mult_mtx4(lside, opb, alpha, a, b, beta, c, err)
      -
      3270 logical, intent(in) :: lside
      -
      3271 integer(int32), intent(in) :: opb
      -
      3272 real(real64) :: alpha, beta
      -
      3273 complex(real64), intent(in), dimension(:) :: a
      -
      3274 complex(real64), intent(in), dimension(:,:) :: b
      -
      3275 complex(real64), intent(inout), dimension(:,:) :: c
      -
      3276 class(errors), intent(inout), optional, target :: err
      -
      3277 end subroutine
      -
      3278
      -
      3279 module subroutine diag_mtx_mult_mtx_cmplx(lside, opb, alpha, a, b, beta, c, err)
      -
      3280 logical, intent(in) :: lside
      -
      3281 integer(int32), intent(in) :: opb
      -
      3282 complex(real64) :: alpha, beta
      -
      3283 complex(real64), intent(in), dimension(:) :: a
      -
      3284 complex(real64), intent(in), dimension(:,:) :: b
      -
      3285 complex(real64), intent(inout), dimension(:,:) :: c
      -
      3286 class(errors), intent(inout), optional, target :: err
      -
      3287 end subroutine
      -
      3288
      -
      3289 module subroutine diag_mtx_mult_mtx2_cmplx(lside, alpha, a, b, err)
      -
      3290 logical, intent(in) :: lside
      -
      3291 complex(real64), intent(in) :: alpha
      -
      3292 complex(real64), intent(in), dimension(:) :: a
      -
      3293 complex(real64), intent(inout), dimension(:,:) :: b
      -
      3294 class(errors), intent(inout), optional, target :: err
      -
      3295 end subroutine
      -
      3296
      -
      3297 module subroutine diag_mtx_mult_mtx_mix(lside, opb, alpha, a, b, beta, c, err)
      -
      3298 logical, intent(in) :: lside
      -
      3299 integer(int32), intent(in) :: opb
      -
      3300 complex(real64) :: alpha, beta
      -
      3301 real(real64), intent(in), dimension(:) :: a
      -
      3302 complex(real64), intent(in), dimension(:,:) :: b
      -
      3303 complex(real64), intent(inout), dimension(:,:) :: c
      -
      3304 class(errors), intent(inout), optional, target :: err
      -
      3305 end subroutine
      -
      3306
      -
      3307 module subroutine diag_mtx_mult_mtx2_mix(lside, alpha, a, b, err)
      -
      3308 logical, intent(in) :: lside
      -
      3309 complex(real64), intent(in) :: alpha
      -
      3310 real(real64), intent(in), dimension(:) :: a
      -
      3311 complex(real64), intent(inout), dimension(:,:) :: b
      -
      3312 class(errors), intent(inout), optional, target :: err
      -
      3313 end subroutine
      -
      3314
      -
      3315 pure module function trace_dbl(x) result(y)
      -
      3316 real(real64), intent(in), dimension(:,:) :: x
      -
      3317 real(real64) :: y
      -
      3318 end function
      -
      3319
      -
      3320 pure module function trace_cmplx(x) result(y)
      -
      3321 complex(real64), intent(in), dimension(:,:) :: x
      -
      3322 complex(real64) :: y
      -
      3323 end function
      -
      3324
      -
      3325 module function mtx_rank_dbl(a, tol, work, olwork, err) result(rnk)
      -
      3326 real(real64), intent(inout), dimension(:,:) :: a
      -
      3327 real(real64), intent(in), optional :: tol
      -
      3328 real(real64), intent(out), target, optional, dimension(:) :: work
      -
      3329 integer(int32), intent(out), optional :: olwork
      -
      3330 class(errors), intent(inout), optional, target :: err
      -
      3331 integer(int32) :: rnk
      -
      3332 end function
      -
      3333
      -
      3334 module function mtx_rank_cmplx(a, tol, work, olwork, rwork, err) result(rnk)
      -
      3335 complex(real64), intent(inout), dimension(:,:) :: a
      -
      3336 real(real64), intent(in), optional :: tol
      -
      3337 complex(real64), intent(out), target, optional, dimension(:) :: work
      -
      3338 integer(int32), intent(out), optional :: olwork
      -
      3339 real(real64), intent(out), target, optional, dimension(:) :: rwork
      -
      3340 class(errors), intent(inout), optional, target :: err
      -
      3341 integer(int32) :: rnk
      -
      3342 end function
      -
      3343
      -
      3344 module function det_dbl(a, iwork, err) result(x)
      -
      3345 real(real64), intent(inout), dimension(:,:) :: a
      -
      3346 integer(int32), intent(out), target, optional, dimension(:) :: iwork
      -
      3347 class(errors), intent(inout), optional, target :: err
      -
      3348 real(real64) :: x
      -
      3349 end function
      -
      3350
      -
      3351 module function det_cmplx(a, iwork, err) result(x)
      -
      3352 complex(real64), intent(inout), dimension(:,:) :: a
      -
      3353 integer(int32), intent(out), target, optional, dimension(:) :: iwork
      -
      3354 class(errors), intent(inout), optional, target :: err
      -
      3355 complex(real64) :: x
      -
      3356 end function
      -
      3357
      -
      3358 module subroutine swap_dbl(x, y, err)
      -
      3359 real(real64), intent(inout), dimension(:) :: x, y
      -
      3360 class(errors), intent(inout), optional, target :: err
      -
      3361 end subroutine
      -
      3362
      -
      3363 module subroutine swap_cmplx(x, y, err)
      -
      3364 complex(real64), intent(inout), dimension(:) :: x, y
      -
      3365 class(errors), intent(inout), optional, target :: err
      -
      3366 end subroutine
      -
      3367
      -
      3368 module subroutine recip_mult_array_dbl(a, x)
      -
      3369 real(real64), intent(in) :: a
      -
      3370 real(real64), intent(inout), dimension(:) :: x
      -
      3371 end subroutine
      -
      3372
      -
      3373 module subroutine tri_mtx_mult_dbl(upper, alpha, a, beta, b, err)
      -
      3374 logical, intent(in) :: upper
      -
      3375 real(real64), intent(in) :: alpha, beta
      -
      3376 real(real64), intent(in), dimension(:,:) :: a
      -
      3377 real(real64), intent(inout), dimension(:,:) :: b
      -
      3378 class(errors), intent(inout), optional, target :: err
      -
      3379 end subroutine
      -
      3380
      -
      3381 module subroutine tri_mtx_mult_cmplx(upper, alpha, a, beta, b, err)
      -
      3382 logical, intent(in) :: upper
      -
      3383 complex(real64), intent(in) :: alpha, beta
      -
      3384 complex(real64), intent(in), dimension(:,:) :: a
      -
      3385 complex(real64), intent(inout), dimension(:,:) :: b
      -
      3386 class(errors), intent(inout), optional, target :: err
      -
      3387 end subroutine
      +
      1184interface mult_qr
      +
      1185 module procedure :: mult_qr_mtx
      +
      1186 module procedure :: mult_qr_mtx_cmplx
      +
      1187 module procedure :: mult_qr_vec
      +
      1188 module procedure :: mult_qr_vec_cmplx
      +
      1189end interface
      +
      1190
      +
      1191! ------------------------------------------------------------------------------
      + +
      1334 module procedure :: qr_rank1_update_dbl
      +
      1335 module procedure :: qr_rank1_update_cmplx
      +
      1336end interface
      +
      1337
      +
      1338! ------------------------------------------------------------------------------
      + +
      1433 module procedure :: cholesky_factor_dbl
      +
      1434 module procedure :: cholesky_factor_cmplx
      +
      1435end interface
      +
      1436
      +
      1437! ------------------------------------------------------------------------------
      + +
      1532 module procedure :: cholesky_rank1_update_dbl
      +
      1533 module procedure :: cholesky_rank1_update_cmplx
      +
      1534end interface
      +
      1535
      +
      1536! ------------------------------------------------------------------------------
      + +
      1639 module procedure :: cholesky_rank1_downdate_dbl
      +
      1640 module procedure :: cholesky_rank1_downdate_cmplx
      +
      1641end interface
      +
      1642
      +
      1643! ------------------------------------------------------------------------------
      +
      1711interface rz_factor
      +
      1712 module procedure :: rz_factor_dbl
      +
      1713 module procedure :: rz_factor_cmplx
      +
      1714end interface
      +
      1715
      +
      1716! ------------------------------------------------------------------------------
      +
      1802interface mult_rz
      +
      1803 module procedure :: mult_rz_mtx
      +
      1804 module procedure :: mult_rz_mtx_cmplx
      +
      1805 module procedure :: mult_rz_vec
      +
      1806 module procedure :: mult_rz_vec_cmplx
      +
      1807end interface
      +
      1808
      +
      1809! ------------------------------------------------------------------------------
      +
      1926interface svd
      +
      1927 module procedure :: svd_dbl
      +
      1928 module procedure :: svd_cmplx
      +
      1929end interface
      +
      1930
      +
      1931! ------------------------------------------------------------------------------
      + +
      2061 module procedure :: solve_tri_mtx
      +
      2062 module procedure :: solve_tri_mtx_cmplx
      +
      2063 module procedure :: solve_tri_vec
      +
      2064 module procedure :: solve_tri_vec_cmplx
      +
      2065end interface
      +
      2066
      +
      2067! ------------------------------------------------------------------------------
      +
      2148interface solve_lu
      +
      2149 module procedure :: solve_lu_mtx
      +
      2150 module procedure :: solve_lu_mtx_cmplx
      +
      2151 module procedure :: solve_lu_vec
      +
      2152 module procedure :: solve_lu_vec_cmplx
      +
      2153end interface
      +
      2154
      +
      2155! ------------------------------------------------------------------------------
      +
      2283interface solve_qr
      +
      2284 module procedure :: solve_qr_no_pivot_mtx
      +
      2285 module procedure :: solve_qr_no_pivot_mtx_cmplx
      +
      2286 module procedure :: solve_qr_no_pivot_vec
      +
      2287 module procedure :: solve_qr_no_pivot_vec_cmplx
      +
      2288 module procedure :: solve_qr_pivot_mtx
      +
      2289 module procedure :: solve_qr_pivot_mtx_cmplx
      +
      2290 module procedure :: solve_qr_pivot_vec
      +
      2291 module procedure :: solve_qr_pivot_vec_cmplx
      +
      2292end interface
      +
      2293
      +
      2294! ------------------------------------------------------------------------------
      + +
      2390 module procedure :: solve_cholesky_mtx
      +
      2391 module procedure :: solve_cholesky_mtx_cmplx
      +
      2392 module procedure :: solve_cholesky_vec
      +
      2393 module procedure :: solve_cholesky_vec_cmplx
      +
      2394end interface
      +
      2395
      +
      2396! ------------------------------------------------------------------------------
      + +
      2480 module procedure :: solve_least_squares_mtx
      +
      2481 module procedure :: solve_least_squares_mtx_cmplx
      +
      2482 module procedure :: solve_least_squares_vec
      +
      2483 module procedure :: solve_least_squares_vec_cmplx
      +
      2484end interface
      +
      2485
      +
      2486! ------------------------------------------------------------------------------
      + +
      2581 module procedure :: solve_least_squares_mtx_pvt
      +
      2582 module procedure :: solve_least_squares_mtx_pvt_cmplx
      +
      2583 module procedure :: solve_least_squares_vec_pvt
      +
      2584 module procedure :: solve_least_squares_vec_pvt_cmplx
      +
      2585end interface
      +
      2586
      +
      2587! ------------------------------------------------------------------------------
      + +
      2683 module procedure :: solve_least_squares_mtx_svd
      +
      2684 module procedure :: solve_least_squares_vec_svd
      +
      2685end interface
      +
      2686
      +
      2687! ------------------------------------------------------------------------------
      + +
      2778 module procedure :: mtx_inverse_dbl
      +
      2779 module procedure :: mtx_inverse_cmplx
      +
      2780end interface
      +
      2781
      +
      2782! ------------------------------------------------------------------------------
      + +
      2884 module procedure :: mtx_pinverse_dbl
      +
      2885 module procedure :: mtx_pinverse_cmplx
      +
      2886end interface
      +
      2887
      +
      2888! ------------------------------------------------------------------------------
      +
      3097interface eigen
      +
      3098 module procedure :: eigen_symm
      +
      3099 module procedure :: eigen_asymm
      +
      3100 module procedure :: eigen_gen
      +
      3101 module procedure :: eigen_cmplx
      +
      3102end interface
      +
      3103
      +
      3104! ------------------------------------------------------------------------------
      +
      3180interface sort
      +
      3181 module procedure :: sort_dbl_array
      +
      3182 module procedure :: sort_dbl_array_ind
      +
      3183 module procedure :: sort_cmplx_array
      +
      3184 module procedure :: sort_cmplx_array_ind
      +
      3185 module procedure :: sort_eigen_cmplx
      +
      3186 module procedure :: sort_eigen_dbl
      +
      3187end interface
      +
      3188
      +
      3189! ******************************************************************************
      +
      3190! LINALG_BASIC.F90
      +
      3191! ------------------------------------------------------------------------------
      +
      3192interface
      +
      3193 module subroutine mtx_mult_mtx(transa, transb, alpha, a, b, beta, c, err)
      +
      3194 logical, intent(in) :: transa, transb
      +
      3195 real(real64), intent(in) :: alpha, beta
      +
      3196 real(real64), intent(in), dimension(:,:) :: a, b
      +
      3197 real(real64), intent(inout), dimension(:,:) :: c
      +
      3198 class(errors), intent(inout), optional, target :: err
      +
      3199 end subroutine
      +
      3200
      +
      3201 module subroutine mtx_mult_vec(trans, alpha, a, b, beta, c, err)
      +
      3202 logical, intent(in) :: trans
      +
      3203 real(real64), intent(in) :: alpha, beta
      +
      3204 real(real64), intent(in), dimension(:,:) :: a
      +
      3205 real(real64), intent(in), dimension(:) :: b
      +
      3206 real(real64), intent(inout), dimension(:) :: c
      +
      3207 class(errors), intent(inout), optional, target :: err
      +
      3208 end subroutine
      +
      3209
      +
      3210 module subroutine cmtx_mult_mtx(opa, opb, alpha, a, b, beta, c, err)
      +
      3211 integer(int32), intent(in) :: opa, opb
      +
      3212 complex(real64), intent(in) :: alpha, beta
      +
      3213 complex(real64), intent(in), dimension(:,:) :: a, b
      +
      3214 complex(real64), intent(inout), dimension(:,:) :: c
      +
      3215 class(errors), intent(inout), optional, target :: err
      +
      3216 end subroutine
      +
      3217
      +
      3218 module subroutine cmtx_mult_vec(opa, alpha, a, b, beta, c, err)
      +
      3219 integer(int32), intent(in) :: opa
      +
      3220 complex(real64), intent(in) :: alpha, beta
      +
      3221 complex(real64), intent(in), dimension(:,:) :: a
      +
      3222 complex(real64), intent(in), dimension(:) :: b
      +
      3223 complex(real64), intent(inout), dimension(:) :: c
      +
      3224 class(errors), intent(inout), optional, target :: err
      +
      3225 end subroutine
      +
      3226
      +
      3227 module subroutine rank1_update_dbl(alpha, x, y, a, err)
      +
      3228 real(real64), intent(in) :: alpha
      +
      3229 real(real64), intent(in), dimension(:) :: x, y
      +
      3230 real(real64), intent(inout), dimension(:,:) :: a
      +
      3231 class(errors), intent(inout), optional, target :: err
      +
      3232 end subroutine
      +
      3233
      +
      3234 module subroutine rank1_update_cmplx(alpha, x, y, a, err)
      +
      3235 complex(real64), intent(in) :: alpha
      +
      3236 complex(real64), intent(in), dimension(:) :: x, y
      +
      3237 complex(real64), intent(inout), dimension(:,:) :: a
      +
      3238 class(errors), intent(inout), optional, target :: err
      +
      3239 end subroutine
      +
      3240
      +
      3241 module subroutine diag_mtx_mult_mtx(lside, trans, alpha, a, b, beta, c, err)
      +
      3242 logical, intent(in) :: lside, trans
      +
      3243 real(real64) :: alpha, beta
      +
      3244 real(real64), intent(in), dimension(:) :: a
      +
      3245 real(real64), intent(in), dimension(:,:) :: b
      +
      3246 real(real64), intent(inout), dimension(:,:) :: c
      +
      3247 class(errors), intent(inout), optional, target :: err
      +
      3248 end subroutine
      +
      3249
      +
      3250 module subroutine diag_mtx_mult_mtx2(lside, alpha, a, b, err)
      +
      3251 logical, intent(in) :: lside
      +
      3252 real(real64), intent(in) :: alpha
      +
      3253 real(real64), intent(in), dimension(:) :: a
      +
      3254 real(real64), intent(inout), dimension(:,:) :: b
      +
      3255 class(errors), intent(inout), optional, target :: err
      +
      3256 end subroutine
      +
      3257
      +
      3258 module subroutine diag_mtx_mult_mtx3(lside, trans, alpha, a, b, beta, c, err)
      +
      3259 logical, intent(in) :: lside, trans
      +
      3260 real(real64) :: alpha, beta
      +
      3261 complex(real64), intent(in), dimension(:) :: a
      +
      3262 real(real64), intent(in), dimension(:,:) :: b
      +
      3263 complex(real64), intent(inout), dimension(:,:) :: c
      +
      3264 class(errors), intent(inout), optional, target :: err
      +
      3265 end subroutine
      +
      3266
      +
      3267 module subroutine diag_mtx_mult_mtx4(lside, opb, alpha, a, b, beta, c, err)
      +
      3268 logical, intent(in) :: lside
      +
      3269 integer(int32), intent(in) :: opb
      +
      3270 real(real64) :: alpha, beta
      +
      3271 complex(real64), intent(in), dimension(:) :: a
      +
      3272 complex(real64), intent(in), dimension(:,:) :: b
      +
      3273 complex(real64), intent(inout), dimension(:,:) :: c
      +
      3274 class(errors), intent(inout), optional, target :: err
      +
      3275 end subroutine
      +
      3276
      +
      3277 module subroutine diag_mtx_mult_mtx_cmplx(lside, opb, alpha, a, b, beta, c, err)
      +
      3278 logical, intent(in) :: lside
      +
      3279 integer(int32), intent(in) :: opb
      +
      3280 complex(real64) :: alpha, beta
      +
      3281 complex(real64), intent(in), dimension(:) :: a
      +
      3282 complex(real64), intent(in), dimension(:,:) :: b
      +
      3283 complex(real64), intent(inout), dimension(:,:) :: c
      +
      3284 class(errors), intent(inout), optional, target :: err
      +
      3285 end subroutine
      +
      3286
      +
      3287 module subroutine diag_mtx_mult_mtx2_cmplx(lside, alpha, a, b, err)
      +
      3288 logical, intent(in) :: lside
      +
      3289 complex(real64), intent(in) :: alpha
      +
      3290 complex(real64), intent(in), dimension(:) :: a
      +
      3291 complex(real64), intent(inout), dimension(:,:) :: b
      +
      3292 class(errors), intent(inout), optional, target :: err
      +
      3293 end subroutine
      +
      3294
      +
      3295 module subroutine diag_mtx_mult_mtx_mix(lside, opb, alpha, a, b, beta, c, err)
      +
      3296 logical, intent(in) :: lside
      +
      3297 integer(int32), intent(in) :: opb
      +
      3298 complex(real64) :: alpha, beta
      +
      3299 real(real64), intent(in), dimension(:) :: a
      +
      3300 complex(real64), intent(in), dimension(:,:) :: b
      +
      3301 complex(real64), intent(inout), dimension(:,:) :: c
      +
      3302 class(errors), intent(inout), optional, target :: err
      +
      3303 end subroutine
      +
      3304
      +
      3305 module subroutine diag_mtx_mult_mtx2_mix(lside, alpha, a, b, err)
      +
      3306 logical, intent(in) :: lside
      +
      3307 complex(real64), intent(in) :: alpha
      +
      3308 real(real64), intent(in), dimension(:) :: a
      +
      3309 complex(real64), intent(inout), dimension(:,:) :: b
      +
      3310 class(errors), intent(inout), optional, target :: err
      +
      3311 end subroutine
      +
      3312
      +
      3313 pure module function trace_dbl(x) result(y)
      +
      3314 real(real64), intent(in), dimension(:,:) :: x
      +
      3315 real(real64) :: y
      +
      3316 end function
      +
      3317
      +
      3318 pure module function trace_cmplx(x) result(y)
      +
      3319 complex(real64), intent(in), dimension(:,:) :: x
      +
      3320 complex(real64) :: y
      +
      3321 end function
      +
      3322
      +
      3323 module function mtx_rank_dbl(a, tol, work, olwork, err) result(rnk)
      +
      3324 real(real64), intent(inout), dimension(:,:) :: a
      +
      3325 real(real64), intent(in), optional :: tol
      +
      3326 real(real64), intent(out), target, optional, dimension(:) :: work
      +
      3327 integer(int32), intent(out), optional :: olwork
      +
      3328 class(errors), intent(inout), optional, target :: err
      +
      3329 integer(int32) :: rnk
      +
      3330 end function
      +
      3331
      +
      3332 module function mtx_rank_cmplx(a, tol, work, olwork, rwork, err) result(rnk)
      +
      3333 complex(real64), intent(inout), dimension(:,:) :: a
      +
      3334 real(real64), intent(in), optional :: tol
      +
      3335 complex(real64), intent(out), target, optional, dimension(:) :: work
      +
      3336 integer(int32), intent(out), optional :: olwork
      +
      3337 real(real64), intent(out), target, optional, dimension(:) :: rwork
      +
      3338 class(errors), intent(inout), optional, target :: err
      +
      3339 integer(int32) :: rnk
      +
      3340 end function
      +
      3341
      +
      3342 module function det_dbl(a, iwork, err) result(x)
      +
      3343 real(real64), intent(inout), dimension(:,:) :: a
      +
      3344 integer(int32), intent(out), target, optional, dimension(:) :: iwork
      +
      3345 class(errors), intent(inout), optional, target :: err
      +
      3346 real(real64) :: x
      +
      3347 end function
      +
      3348
      +
      3349 module function det_cmplx(a, iwork, err) result(x)
      +
      3350 complex(real64), intent(inout), dimension(:,:) :: a
      +
      3351 integer(int32), intent(out), target, optional, dimension(:) :: iwork
      +
      3352 class(errors), intent(inout), optional, target :: err
      +
      3353 complex(real64) :: x
      +
      3354 end function
      +
      3355
      +
      3356 module subroutine swap_dbl(x, y, err)
      +
      3357 real(real64), intent(inout), dimension(:) :: x, y
      +
      3358 class(errors), intent(inout), optional, target :: err
      +
      3359 end subroutine
      +
      3360
      +
      3361 module subroutine swap_cmplx(x, y, err)
      +
      3362 complex(real64), intent(inout), dimension(:) :: x, y
      +
      3363 class(errors), intent(inout), optional, target :: err
      +
      3364 end subroutine
      +
      3365
      +
      3366 module subroutine recip_mult_array_dbl(a, x)
      +
      3367 real(real64), intent(in) :: a
      +
      3368 real(real64), intent(inout), dimension(:) :: x
      +
      3369 end subroutine
      +
      3370
      +
      3371 module subroutine tri_mtx_mult_dbl(upper, alpha, a, beta, b, err)
      +
      3372 logical, intent(in) :: upper
      +
      3373 real(real64), intent(in) :: alpha, beta
      +
      3374 real(real64), intent(in), dimension(:,:) :: a
      +
      3375 real(real64), intent(inout), dimension(:,:) :: b
      +
      3376 class(errors), intent(inout), optional, target :: err
      +
      3377 end subroutine
      +
      3378
      +
      3379 module subroutine tri_mtx_mult_cmplx(upper, alpha, a, beta, b, err)
      +
      3380 logical, intent(in) :: upper
      +
      3381 complex(real64), intent(in) :: alpha, beta
      +
      3382 complex(real64), intent(in), dimension(:,:) :: a
      +
      3383 complex(real64), intent(inout), dimension(:,:) :: b
      +
      3384 class(errors), intent(inout), optional, target :: err
      +
      3385 end subroutine
      +
      3386
      +
      3387end interface
      3388
      -
      3389end interface
      -
      3390
      -
      3391! ******************************************************************************
      -
      3392! LINALG_FACTOR.F90
      -
      3393! ------------------------------------------------------------------------------
      -
      3394interface
      -
      3395 module subroutine lu_factor_dbl(a, ipvt, err)
      -
      3396 real(real64), intent(inout), dimension(:,:) :: a
      -
      3397 integer(int32), intent(out), dimension(:) :: ipvt
      -
      3398 class(errors), intent(inout), optional, target :: err
      -
      3399 end subroutine
      -
      3400
      -
      3401 module subroutine lu_factor_cmplx(a, ipvt, err)
      -
      3402 complex(real64), intent(inout), dimension(:,:) :: a
      -
      3403 integer(int32), intent(out), dimension(:) :: ipvt
      -
      3404 class(errors), intent(inout), optional, target :: err
      -
      3405 end subroutine
      -
      3406
      -
      3407 module subroutine form_lu_all(lu, ipvt, u, p, err)
      -
      3408 real(real64), intent(inout), dimension(:,:) :: lu
      -
      3409 integer(int32), intent(in), dimension(:) :: ipvt
      -
      3410 real(real64), intent(out), dimension(:,:) :: u, p
      -
      3411 class(errors), intent(inout), optional, target :: err
      -
      3412 end subroutine
      -
      3413
      -
      3414 module subroutine form_lu_all_cmplx(lu, ipvt, u, p, err)
      -
      3415 complex(real64), intent(inout), dimension(:,:) :: lu
      -
      3416 integer(int32), intent(in), dimension(:) :: ipvt
      -
      3417 complex(real64), intent(out), dimension(:,:) :: u
      -
      3418 real(real64), intent(out), dimension(:,:) :: p
      -
      3419 class(errors), intent(inout), optional, target :: err
      -
      3420 end subroutine
      -
      3421
      -
      3422 module subroutine form_lu_only(lu, u, err)
      -
      3423 real(real64), intent(inout), dimension(:,:) :: lu
      -
      3424 real(real64), intent(out), dimension(:,:) :: u
      -
      3425 class(errors), intent(inout), optional, target :: err
      -
      3426 end subroutine
      -
      3427
      -
      3428 module subroutine form_lu_only_cmplx(lu, u, err)
      -
      3429 complex(real64), intent(inout), dimension(:,:) :: lu
      -
      3430 complex(real64), intent(out), dimension(:,:) :: u
      -
      3431 class(errors), intent(inout), optional, target :: err
      -
      3432 end subroutine
      -
      3433
      -
      3434 module subroutine qr_factor_no_pivot(a, tau, work, olwork, err)
      -
      3435 real(real64), intent(inout), dimension(:,:) :: a
      -
      3436 real(real64), intent(out), dimension(:) :: tau
      -
      3437 real(real64), intent(out), target, dimension(:), optional :: work
      -
      3438 integer(int32), intent(out), optional :: olwork
      -
      3439 class(errors), intent(inout), optional, target :: err
      -
      3440 end subroutine
      -
      3441
      -
      3442 module subroutine qr_factor_no_pivot_cmplx(a, tau, work, olwork, err)
      -
      3443 complex(real64), intent(inout), dimension(:,:) :: a
      -
      3444 complex(real64), intent(out), dimension(:) :: tau
      -
      3445 complex(real64), intent(out), target, dimension(:), optional :: work
      -
      3446 integer(int32), intent(out), optional :: olwork
      -
      3447 class(errors), intent(inout), optional, target :: err
      -
      3448 end subroutine
      -
      3449
      -
      3450 module subroutine qr_factor_pivot(a, tau, jpvt, work, olwork, err)
      -
      3451 real(real64), intent(inout), dimension(:,:) :: a
      -
      3452 real(real64), intent(out), dimension(:) :: tau
      -
      3453 integer(int32), intent(inout), dimension(:) :: jpvt
      -
      3454 real(real64), intent(out), target, dimension(:), optional :: work
      -
      3455 integer(int32), intent(out), optional :: olwork
      -
      3456 class(errors), intent(inout), optional, target :: err
      -
      3457 end subroutine
      -
      3458
      -
      3459 module subroutine qr_factor_pivot_cmplx(a, tau, jpvt, work, olwork, rwork, &
      -
      3460 err)
      -
      3461 complex(real64), intent(inout), dimension(:,:) :: a
      -
      3462 complex(real64), intent(out), dimension(:) :: tau
      -
      3463 integer(int32), intent(inout), dimension(:) :: jpvt
      -
      3464 complex(real64), intent(out), target, dimension(:), optional :: work
      -
      3465 integer(int32), intent(out), optional :: olwork
      -
      3466 real(real64), intent(out), target, dimension(:), optional :: rwork
      -
      3467 class(errors), intent(inout), optional, target :: err
      -
      3468 end subroutine
      -
      3469
      -
      3470 module subroutine form_qr_no_pivot(r, tau, q, work, olwork, err)
      -
      3471 real(real64), intent(inout), dimension(:,:) :: r
      -
      3472 real(real64), intent(in), dimension(:) :: tau
      -
      3473 real(real64), intent(out), dimension(:,:) :: q
      -
      3474 real(real64), intent(out), target, dimension(:), optional :: work
      -
      3475 integer(int32), intent(out), optional :: olwork
      -
      3476 class(errors), intent(inout), optional, target :: err
      -
      3477 end subroutine
      -
      3478
      -
      3479 module subroutine form_qr_no_pivot_cmplx(r, tau, q, work, olwork, err)
      -
      3480 complex(real64), intent(inout), dimension(:,:) :: r
      -
      3481 complex(real64), intent(in), dimension(:) :: tau
      -
      3482 complex(real64), intent(out), dimension(:,:) :: q
      -
      3483 complex(real64), intent(out), target, dimension(:), optional :: work
      -
      3484 integer(int32), intent(out), optional :: olwork
      -
      3485 class(errors), intent(inout), optional, target :: err
      -
      3486 end subroutine
      -
      3487
      -
      3488 module subroutine form_qr_pivot(r, tau, pvt, q, p, work, olwork, err)
      -
      3489 real(real64), intent(inout), dimension(:,:) :: r
      -
      3490 real(real64), intent(in), dimension(:) :: tau
      -
      3491 integer(int32), intent(in), dimension(:) :: pvt
      -
      3492 real(real64), intent(out), dimension(:,:) :: q, p
      -
      3493 real(real64), intent(out), target, dimension(:), optional :: work
      -
      3494 integer(int32), intent(out), optional :: olwork
      -
      3495 class(errors), intent(inout), optional, target :: err
      -
      3496 end subroutine
      -
      3497
      -
      3498 module subroutine form_qr_pivot_cmplx(r, tau, pvt, q, p, work, olwork, err)
      -
      3499 complex(real64), intent(inout), dimension(:,:) :: r
      -
      3500 complex(real64), intent(in), dimension(:) :: tau
      -
      3501 integer(int32), intent(in), dimension(:) :: pvt
      -
      3502 complex(real64), intent(out), dimension(:,:) :: q, p
      -
      3503 complex(real64), intent(out), target, dimension(:), optional :: work
      -
      3504 integer(int32), intent(out), optional :: olwork
      -
      3505 class(errors), intent(inout), optional, target :: err
      -
      3506 end subroutine
      -
      3507
      -
      3508 module subroutine mult_qr_mtx(lside, trans, a, tau, c, work, olwork, err)
      -
      3509 logical, intent(in) :: lside, trans
      -
      3510 real(real64), intent(in), dimension(:) :: tau
      -
      3511 real(real64), intent(inout), dimension(:,:) :: a, c
      -
      3512 real(real64), intent(out), target, dimension(:), optional :: work
      -
      3513 integer(int32), intent(out), optional :: olwork
      -
      3514 class(errors), intent(inout), optional, target :: err
      -
      3515 end subroutine
      -
      3516
      -
      3517 module subroutine mult_qr_mtx_cmplx(lside, trans, a, tau, c, work, olwork, err)
      -
      3518 logical, intent(in) :: lside, trans
      -
      3519 complex(real64), intent(in), dimension(:) :: tau
      -
      3520 complex(real64), intent(inout), dimension(:,:) :: a, c
      -
      3521 complex(real64), intent(out), target, dimension(:), optional :: work
      -
      3522 integer(int32), intent(out), optional :: olwork
      -
      3523 class(errors), intent(inout), optional, target :: err
      -
      3524 end subroutine
      -
      3525
      -
      3526 module subroutine mult_qr_vec(trans, a, tau, c, work, olwork, err)
      -
      3527 logical, intent(in) :: trans
      -
      3528 real(real64), intent(inout), dimension(:,:) :: a
      -
      3529 real(real64), intent(in), dimension(:) :: tau
      -
      3530 real(real64), intent(inout), dimension(:) :: c
      -
      3531 real(real64), intent(out), target, dimension(:), optional :: work
      -
      3532 integer(int32), intent(out), optional :: olwork
      -
      3533 class(errors), intent(inout), optional, target :: err
      -
      3534 end subroutine
      -
      3535
      -
      3536 module subroutine mult_qr_vec_cmplx(trans, a, tau, c, work, olwork, err)
      -
      3537 logical, intent(in) :: trans
      -
      3538 complex(real64), intent(inout), dimension(:,:) :: a
      -
      3539 complex(real64), intent(in), dimension(:) :: tau
      -
      3540 complex(real64), intent(inout), dimension(:) :: c
      -
      3541 complex(real64), intent(out), target, dimension(:), optional :: work
      -
      3542 integer(int32), intent(out), optional :: olwork
      -
      3543 class(errors), intent(inout), optional, target :: err
      -
      3544 end subroutine
      -
      3545
      -
      3546 module subroutine qr_rank1_update_dbl(q, r, u, v, work, err)
      -
      3547 real(real64), intent(inout), dimension(:,:) :: q, r
      -
      3548 real(real64), intent(inout), dimension(:) :: u, v
      -
      3549 real(real64), intent(out), target, optional, dimension(:) :: work
      -
      3550 class(errors), intent(inout), optional, target :: err
      -
      3551 end subroutine
      -
      3552
      -
      3553 module subroutine qr_rank1_update_cmplx(q, r, u, v, work, rwork, err)
      -
      3554 complex(real64), intent(inout), dimension(:,:) :: q, r
      -
      3555 complex(real64), intent(inout), dimension(:) :: u, v
      -
      3556 complex(real64), intent(out), target, optional, dimension(:) :: work
      -
      3557 real(real64), intent(out), target, optional, dimension(:) :: rwork
      -
      3558 class(errors), intent(inout), optional, target :: err
      -
      3559 end subroutine
      -
      3560
      -
      3561 module subroutine cholesky_factor_dbl(a, upper, err)
      -
      3562 real(real64), intent(inout), dimension(:,:) :: a
      -
      3563 logical, intent(in), optional :: upper
      -
      3564 class(errors), intent(inout), optional, target :: err
      -
      3565 end subroutine
      -
      3566
      -
      3567 module subroutine cholesky_factor_cmplx(a, upper, err)
      -
      3568 complex(real64), intent(inout), dimension(:,:) :: a
      -
      3569 logical, intent(in), optional :: upper
      -
      3570 class(errors), intent(inout), optional, target :: err
      -
      3571 end subroutine
      -
      3572
      -
      3573 module subroutine cholesky_rank1_update_dbl(r, u, work, err)
      -
      3574 real(real64), intent(inout), dimension(:,:) :: r
      -
      3575 real(real64), intent(inout), dimension(:) :: u
      -
      3576 real(real64), intent(out), target, optional, dimension(:) :: work
      -
      3577 class(errors), intent(inout), optional, target :: err
      -
      3578 end subroutine
      -
      3579
      -
      3580 module subroutine cholesky_rank1_update_cmplx(r, u, work, err)
      -
      3581 complex(real64), intent(inout), dimension(:,:) :: r
      -
      3582 complex(real64), intent(inout), dimension(:) :: u
      -
      3583 real(real64), intent(out), target, optional, dimension(:) :: work
      -
      3584 class(errors), intent(inout), optional, target :: err
      -
      3585 end subroutine
      -
      3586
      -
      3587 module subroutine cholesky_rank1_downdate_dbl(r, u, work, err)
      -
      3588 real(real64), intent(inout), dimension(:,:) :: r
      -
      3589 real(real64), intent(inout), dimension(:) :: u
      -
      3590 real(real64), intent(out), target, optional, dimension(:) :: work
      -
      3591 class(errors), intent(inout), optional, target :: err
      -
      3592 end subroutine
      -
      3593
      -
      3594 module subroutine cholesky_rank1_downdate_cmplx(r, u, work, err)
      -
      3595 complex(real64), intent(inout), dimension(:,:) :: r
      -
      3596 complex(real64), intent(inout), dimension(:) :: u
      -
      3597 real(real64), intent(out), target, optional, dimension(:) :: work
      -
      3598 class(errors), intent(inout), optional, target :: err
      -
      3599 end subroutine
      -
      3600
      -
      3601 module subroutine rz_factor_dbl(a, tau, work, olwork, err)
      -
      3602 real(real64), intent(inout), dimension(:,:) :: a
      -
      3603 real(real64), intent(out), dimension(:) :: tau
      -
      3604 real(real64), intent(out), target, optional, dimension(:) :: work
      -
      3605 integer(int32), intent(out), optional :: olwork
      -
      3606 class(errors), intent(inout), optional, target :: err
      -
      3607 end subroutine
      -
      3608
      -
      3609 module subroutine rz_factor_cmplx(a, tau, work, olwork, err)
      -
      3610 complex(real64), intent(inout), dimension(:,:) :: a
      -
      3611 complex(real64), intent(out), dimension(:) :: tau
      -
      3612 complex(real64), intent(out), target, optional, dimension(:) :: work
      -
      3613 integer(int32), intent(out), optional :: olwork
      -
      3614 class(errors), intent(inout), optional, target :: err
      -
      3615 end subroutine
      -
      3616
      -
      3617 module subroutine mult_rz_mtx(lside, trans, l, a, tau, c, work, olwork, err)
      -
      3618 logical, intent(in) :: lside, trans
      -
      3619 integer(int32), intent(in) :: l
      -
      3620 real(real64), intent(inout), dimension(:,:) :: a, c
      -
      3621 real(real64), intent(in), dimension(:) :: tau
      -
      3622 real(real64), intent(out), target, optional, dimension(:) :: work
      -
      3623 integer(int32), intent(out), optional :: olwork
      -
      3624 class(errors), intent(inout), optional, target :: err
      -
      3625 end subroutine
      -
      3626
      -
      3627 module subroutine mult_rz_mtx_cmplx(lside, trans, l, a, tau, c, work, olwork, err)
      -
      3628 logical, intent(in) :: lside, trans
      -
      3629 integer(int32), intent(in) :: l
      -
      3630 complex(real64), intent(inout), dimension(:,:) :: a, c
      -
      3631 complex(real64), intent(in), dimension(:) :: tau
      -
      3632 complex(real64), intent(out), target, optional, dimension(:) :: work
      -
      3633 integer(int32), intent(out), optional :: olwork
      -
      3634 class(errors), intent(inout), optional, target :: err
      -
      3635 end subroutine
      -
      3636
      -
      3637 module subroutine mult_rz_vec(trans, l, a, tau, c, work, olwork, err)
      -
      3638 logical, intent(in) :: trans
      -
      3639 integer(int32), intent(in) :: l
      -
      3640 real(real64), intent(inout), dimension(:,:) :: a
      -
      3641 real(real64), intent(in), dimension(:) :: tau
      -
      3642 real(real64), intent(inout), dimension(:) :: c
      -
      3643 real(real64), intent(out), target, optional, dimension(:) :: work
      -
      3644 integer(int32), intent(out), optional :: olwork
      -
      3645 class(errors), intent(inout), optional, target :: err
      -
      3646 end subroutine
      -
      3647
      -
      3648 module subroutine mult_rz_vec_cmplx(trans, l, a, tau, c, work, olwork, err)
      -
      3649 logical, intent(in) :: trans
      -
      3650 integer(int32), intent(in) :: l
      -
      3651 complex(real64), intent(inout), dimension(:,:) :: a
      -
      3652 complex(real64), intent(in), dimension(:) :: tau
      -
      3653 complex(real64), intent(inout), dimension(:) :: c
      -
      3654 complex(real64), intent(out), target, optional, dimension(:) :: work
      -
      3655 integer(int32), intent(out), optional :: olwork
      -
      3656 class(errors), intent(inout), optional, target :: err
      -
      3657 end subroutine
      -
      3658
      -
      3659 module subroutine svd_dbl(a, s, u, vt, work, olwork, err)
      -
      3660 real(real64), intent(inout), dimension(:,:) :: a
      -
      3661 real(real64), intent(out), dimension(:) :: s
      -
      3662 real(real64), intent(out), optional, dimension(:,:) :: u, vt
      -
      3663 real(real64), intent(out), target, optional, dimension(:) :: work
      -
      3664 integer(int32), intent(out), optional :: olwork
      -
      3665 class(errors), intent(inout), optional, target :: err
      -
      3666 end subroutine
      -
      3667
      -
      3668 module subroutine svd_cmplx(a, s, u, vt, work, olwork, rwork, err)
      -
      3669 complex(real64), intent(inout), dimension(:,:) :: a
      -
      3670 real(real64), intent(out), dimension(:) :: s
      -
      3671 complex(real64), intent(out), optional, dimension(:,:) :: u, vt
      -
      3672 complex(real64), intent(out), target, optional, dimension(:) :: work
      -
      3673 integer(int32), intent(out), optional :: olwork
      -
      3674 real(real64), intent(out), target, optional, dimension(:) :: rwork
      -
      3675 class(errors), intent(inout), optional, target :: err
      -
      3676 end subroutine
      -
      3677end interface
      -
      3678
      -
      3679! ******************************************************************************
      -
      3680! LINALG_SOLVE.F90
      -
      3681! ------------------------------------------------------------------------------
      -
      3682interface
      -
      3683 module subroutine solve_tri_mtx(lside, upper, trans, nounit, alpha, a, b, err)
      -
      3684 logical, intent(in) :: lside, upper, trans, nounit
      -
      3685 real(real64), intent(in) :: alpha
      -
      3686 real(real64), intent(in), dimension(:,:) :: a
      -
      3687 real(real64), intent(inout), dimension(:,:) :: b
      -
      3688 class(errors), intent(inout), optional, target :: err
      -
      3689 end subroutine
      -
      3690
      -
      3691 module subroutine solve_tri_mtx_cmplx(lside, upper, trans, nounit, alpha, a, b, err)
      -
      3692 logical, intent(in) :: lside, upper, trans, nounit
      -
      3693 complex(real64), intent(in) :: alpha
      -
      3694 complex(real64), intent(in), dimension(:,:) :: a
      -
      3695 complex(real64), intent(inout), dimension(:,:) :: b
      -
      3696 class(errors), intent(inout), optional, target :: err
      -
      3697 end subroutine
      -
      3698
      -
      3699 module subroutine solve_tri_vec(upper, trans, nounit, a, x, err)
      -
      3700 logical, intent(in) :: upper, trans, nounit
      -
      3701 real(real64), intent(in), dimension(:,:) :: a
      -
      3702 real(real64), intent(inout), dimension(:) :: x
      -
      3703 class(errors), intent(inout), optional, target :: err
      -
      3704 end subroutine
      -
      3705
      -
      3706 module subroutine solve_tri_vec_cmplx(upper, trans, nounit, a, x, err)
      -
      3707 logical, intent(in) :: upper, trans, nounit
      -
      3708 complex(real64), intent(in), dimension(:,:) :: a
      -
      3709 complex(real64), intent(inout), dimension(:) :: x
      -
      3710 class(errors), intent(inout), optional, target :: err
      -
      3711 end subroutine
      -
      3712
      -
      3713 module subroutine solve_lu_mtx(a, ipvt, b, err)
      -
      3714 real(real64), intent(in), dimension(:,:) :: a
      -
      3715 integer(int32), intent(in), dimension(:) :: ipvt
      -
      3716 real(real64), intent(inout), dimension(:,:) :: b
      -
      3717 class(errors), intent(inout), optional, target :: err
      -
      3718 end subroutine
      -
      3719
      -
      3720 module subroutine solve_lu_mtx_cmplx(a, ipvt, b, err)
      -
      3721 complex(real64), intent(in), dimension(:,:) :: a
      -
      3722 integer(int32), intent(in), dimension(:) :: ipvt
      -
      3723 complex(real64), intent(inout), dimension(:,:) :: b
      -
      3724 class(errors), intent(inout), optional, target :: err
      -
      3725 end subroutine
      -
      3726
      -
      3727 module subroutine solve_lu_vec(a, ipvt, b, err)
      -
      3728 real(real64), intent(in), dimension(:,:) :: a
      -
      3729 integer(int32), intent(in), dimension(:) :: ipvt
      -
      3730 real(real64), intent(inout), dimension(:) :: b
      -
      3731 class(errors), intent(inout), optional, target :: err
      -
      3732 end subroutine
      -
      3733
      -
      3734 module subroutine solve_lu_vec_cmplx(a, ipvt, b, err)
      -
      3735 complex(real64), intent(in), dimension(:,:) :: a
      -
      3736 integer(int32), intent(in), dimension(:) :: ipvt
      -
      3737 complex(real64), intent(inout), dimension(:) :: b
      -
      3738 class(errors), intent(inout), optional, target :: err
      -
      3739 end subroutine
      -
      3740
      -
      3741 module subroutine solve_qr_no_pivot_mtx(a, tau, b, work, olwork, err)
      -
      3742 real(real64), intent(inout), dimension(:,:) :: a, b
      -
      3743 real(real64), intent(in), dimension(:) :: tau
      -
      3744 real(real64), intent(out), target, optional, dimension(:) :: work
      -
      3745 integer(int32), intent(out), optional :: olwork
      -
      3746 class(errors), intent(inout), optional, target :: err
      -
      3747 end subroutine
      -
      3748
      -
      3749 module subroutine solve_qr_no_pivot_mtx_cmplx(a, tau, b, work, olwork, err)
      -
      3750 complex(real64), intent(inout), dimension(:,:) :: a, b
      -
      3751 complex(real64), intent(in), dimension(:) :: tau
      -
      3752 complex(real64), intent(out), target, optional, dimension(:) :: work
      -
      3753 integer(int32), intent(out), optional :: olwork
      -
      3754 class(errors), intent(inout), optional, target :: err
      -
      3755 end subroutine
      -
      3756
      -
      3757 module subroutine solve_qr_no_pivot_vec(a, tau, b, work, olwork, err)
      -
      3758 real(real64), intent(inout), dimension(:,:) :: a
      -
      3759 real(real64), intent(in), dimension(:) :: tau
      -
      3760 real(real64), intent(inout), dimension(:) :: b
      -
      3761 real(real64), intent(out), target, optional, dimension(:) :: work
      -
      3762 integer(int32), intent(out), optional :: olwork
      -
      3763 class(errors), intent(inout), optional, target :: err
      -
      3764 end subroutine
      -
      3765
      -
      3766 module subroutine solve_qr_no_pivot_vec_cmplx(a, tau, b, work, olwork, err)
      -
      3767 complex(real64), intent(inout), dimension(:,:) :: a
      -
      3768 complex(real64), intent(in), dimension(:) :: tau
      -
      3769 complex(real64), intent(inout), dimension(:) :: b
      -
      3770 complex(real64), intent(out), target, optional, dimension(:) :: work
      -
      3771 integer(int32), intent(out), optional :: olwork
      -
      3772 class(errors), intent(inout), optional, target :: err
      -
      3773 end subroutine
      -
      3774
      -
      3775 module subroutine solve_qr_pivot_mtx(a, tau, jpvt, b, work, olwork, err)
      -
      3776 real(real64), intent(inout), dimension(:,:) :: a
      -
      3777 real(real64), intent(in), dimension(:) :: tau
      -
      3778 integer(int32), intent(in), dimension(:) :: jpvt
      -
      3779 real(real64), intent(inout), dimension(:,:) :: b
      -
      3780 real(real64), intent(out), target, optional, dimension(:) :: work
      -
      3781 integer(int32), intent(out), optional :: olwork
      -
      3782 class(errors), intent(inout), optional, target :: err
      -
      3783 end subroutine
      -
      3784
      -
      3785 module subroutine solve_qr_pivot_mtx_cmplx(a, tau, jpvt, b, work, olwork, err)
      -
      3786 complex(real64), intent(inout), dimension(:,:) :: a
      -
      3787 complex(real64), intent(in), dimension(:) :: tau
      -
      3788 integer(int32), intent(in), dimension(:) :: jpvt
      -
      3789 complex(real64), intent(inout), dimension(:,:) :: b
      -
      3790 complex(real64), intent(out), target, optional, dimension(:) :: work
      -
      3791 integer(int32), intent(out), optional :: olwork
      -
      3792 class(errors), intent(inout), optional, target :: err
      -
      3793 end subroutine
      -
      3794
      -
      3795 module subroutine solve_qr_pivot_vec(a, tau, jpvt, b, work, olwork, err)
      -
      3796 real(real64), intent(inout), dimension(:,:) :: a
      -
      3797 real(real64), intent(in), dimension(:) :: tau
      -
      3798 integer(int32), intent(in), dimension(:) :: jpvt
      -
      3799 real(real64), intent(inout), dimension(:) :: b
      -
      3800 real(real64), intent(out), target, optional, dimension(:) :: work
      -
      3801 integer(int32), intent(out), optional :: olwork
      -
      3802 class(errors), intent(inout), optional, target :: err
      -
      3803 end subroutine
      -
      3804
      -
      3805 module subroutine solve_qr_pivot_vec_cmplx(a, tau, jpvt, b, work, olwork, err)
      -
      3806 complex(real64), intent(inout), dimension(:,:) :: a
      -
      3807 complex(real64), intent(in), dimension(:) :: tau
      -
      3808 integer(int32), intent(in), dimension(:) :: jpvt
      -
      3809 complex(real64), intent(inout), dimension(:) :: b
      -
      3810 complex(real64), intent(out), target, optional, dimension(:) :: work
      -
      3811 integer(int32), intent(out), optional :: olwork
      -
      3812 class(errors), intent(inout), optional, target :: err
      -
      3813 end subroutine
      -
      3814
      -
      3815 module subroutine solve_cholesky_mtx(upper, a, b, err)
      -
      3816 logical, intent(in) :: upper
      -
      3817 real(real64), intent(in), dimension(:,:) :: a
      -
      3818 real(real64), intent(inout), dimension(:,:) :: b
      -
      3819 class(errors), intent(inout), optional, target :: err
      -
      3820 end subroutine
      -
      3821
      -
      3822 module subroutine solve_cholesky_mtx_cmplx(upper, a, b, err)
      -
      3823 logical, intent(in) :: upper
      -
      3824 complex(real64), intent(in), dimension(:,:) :: a
      -
      3825 complex(real64), intent(inout), dimension(:,:) :: b
      -
      3826 class(errors), intent(inout), optional, target :: err
      -
      3827 end subroutine
      -
      3828
      -
      3829 module subroutine solve_cholesky_vec(upper, a, b, err)
      -
      3830 logical, intent(in) :: upper
      -
      3831 real(real64), intent(in), dimension(:,:) :: a
      -
      3832 real(real64), intent(inout), dimension(:) :: b
      -
      3833 class(errors), intent(inout), optional, target :: err
      -
      3834 end subroutine
      -
      3835
      -
      3836 module subroutine solve_cholesky_vec_cmplx(upper, a, b, err)
      -
      3837 logical, intent(in) :: upper
      -
      3838 complex(real64), intent(in), dimension(:,:) :: a
      -
      3839 complex(real64), intent(inout), dimension(:) :: b
      -
      3840 class(errors), intent(inout), optional, target :: err
      -
      3841 end subroutine
      -
      3842
      -
      3843 module subroutine solve_least_squares_mtx(a, b, work, olwork, err)
      -
      3844 real(real64), intent(inout), dimension(:,:) :: a, b
      -
      3845 real(real64), intent(out), target, optional, dimension(:) :: work
      -
      3846 integer(int32), intent(out), optional :: olwork
      -
      3847 class(errors), intent(inout), optional, target :: err
      -
      3848 end subroutine
      -
      3849
      -
      3850 module subroutine solve_least_squares_mtx_cmplx(a, b, work, olwork, err)
      -
      3851 complex(real64), intent(inout), dimension(:,:) :: a, b
      -
      3852 complex(real64), intent(out), target, optional, dimension(:) :: work
      -
      3853 integer(int32), intent(out), optional :: olwork
      -
      3854 class(errors), intent(inout), optional, target :: err
      -
      3855 end subroutine
      -
      3856
      -
      3857 module subroutine solve_least_squares_vec(a, b, work, olwork, err)
      -
      3858 real(real64), intent(inout), dimension(:,:) :: a
      -
      3859 real(real64), intent(inout), dimension(:) :: b
      -
      3860 real(real64), intent(out), target, optional, dimension(:) :: work
      -
      3861 integer(int32), intent(out), optional :: olwork
      -
      3862 class(errors), intent(inout), optional, target :: err
      -
      3863 end subroutine
      -
      3864
      -
      3865 module subroutine solve_least_squares_vec_cmplx(a, b, work, olwork, err)
      -
      3866 complex(real64), intent(inout), dimension(:,:) :: a
      -
      3867 complex(real64), intent(inout), dimension(:) :: b
      -
      3868 complex(real64), intent(out), target, optional, dimension(:) :: work
      -
      3869 integer(int32), intent(out), optional :: olwork
      -
      3870 class(errors), intent(inout), optional, target :: err
      -
      3871 end subroutine
      -
      3872
      -
      3873 module subroutine solve_least_squares_mtx_pvt(a, b, ipvt, arnk, work, olwork, err)
      -
      3874 real(real64), intent(inout), dimension(:,:) :: a, b
      -
      3875 integer(int32), intent(inout), target, optional, dimension(:) :: ipvt
      -
      3876 integer(int32), intent(out), optional :: arnk
      -
      3877 real(real64), intent(out), target, optional, dimension(:) :: work
      -
      3878 integer(int32), intent(out), optional :: olwork
      -
      3879 class(errors), intent(inout), optional, target :: err
      -
      3880 end subroutine
      -
      3881
      -
      3882 module subroutine solve_least_squares_mtx_pvt_cmplx(a, b, ipvt, arnk, &
      -
      3883 work, olwork, rwork, err)
      -
      3884 complex(real64), intent(inout), dimension(:,:) :: a, b
      -
      3885 integer(int32), intent(inout), target, optional, dimension(:) :: ipvt
      -
      3886 integer(int32), intent(out), optional :: arnk
      -
      3887 complex(real64), intent(out), target, optional, dimension(:) :: work
      -
      3888 integer(int32), intent(out), optional :: olwork
      -
      3889 real(real64), intent(out), target, optional, dimension(:) :: rwork
      -
      3890 class(errors), intent(inout), optional, target :: err
      -
      3891 end subroutine
      -
      3892
      -
      3893 module subroutine solve_least_squares_vec_pvt(a, b, ipvt, arnk, work, olwork, err)
      -
      3894 real(real64), intent(inout), dimension(:,:) :: a
      -
      3895 real(real64), intent(inout), dimension(:) :: b
      -
      3896 integer(int32), intent(inout), target, optional, dimension(:) :: ipvt
      -
      3897 integer(int32), intent(out), optional :: arnk
      -
      3898 real(real64), intent(out), target, optional, dimension(:) :: work
      -
      3899 integer(int32), intent(out), optional :: olwork
      -
      3900 class(errors), intent(inout), optional, target :: err
      -
      3901 end subroutine
      -
      3902
      -
      3903 module subroutine solve_least_squares_vec_pvt_cmplx(a, b, ipvt, arnk, &
      -
      3904 work, olwork, rwork, err)
      -
      3905 complex(real64), intent(inout), dimension(:,:) :: a
      -
      3906 complex(real64), intent(inout), dimension(:) :: b
      -
      3907 integer(int32), intent(inout), target, optional, dimension(:) :: ipvt
      -
      3908 integer(int32), intent(out), optional :: arnk
      -
      3909 complex(real64), intent(out), target, optional, dimension(:) :: work
      -
      3910 integer(int32), intent(out), optional :: olwork
      -
      3911 real(real64), intent(out), target, optional, dimension(:) :: rwork
      -
      3912 class(errors), intent(inout), optional, target :: err
      -
      3913 end subroutine
      -
      3914
      -
      3915 module subroutine solve_least_squares_mtx_svd(a, b, s, arnk, work, olwork, err)
      -
      3916 real(real64), intent(inout), dimension(:,:) :: a, b
      -
      3917 integer(int32), intent(out), optional :: arnk
      -
      3918 real(real64), intent(out), target, optional, dimension(:) :: work, s
      -
      3919 integer(int32), intent(out), optional :: olwork
      -
      3920 class(errors), intent(inout), optional, target :: err
      -
      3921 end subroutine
      -
      3922
      -
      3923 module subroutine solve_least_squares_mtx_svd_cmplx(a, b, s, arnk, work, &
      -
      3924 olwork, rwork, err)
      -
      3925 complex(real64), intent(inout), dimension(:,:) :: a, b
      -
      3926 integer(int32), intent(out), optional :: arnk
      -
      3927 complex(real64), intent(out), target, optional, dimension(:) :: work
      -
      3928 real(real64), intent(out), target, optional, dimension(:) :: rwork, s
      -
      3929 integer(int32), intent(out), optional :: olwork
      -
      3930 class(errors), intent(inout), optional, target :: err
      -
      3931 end subroutine
      -
      3932
      -
      3933 module subroutine solve_least_squares_vec_svd(a, b, s, arnk, work, olwork, err)
      -
      3934 real(real64), intent(inout), dimension(:,:) :: a
      -
      3935 real(real64), intent(inout), dimension(:) :: b
      -
      3936 integer(int32), intent(out), optional :: arnk
      -
      3937 real(real64), intent(out), target, optional, dimension(:) :: work, s
      -
      3938 integer(int32), intent(out), optional :: olwork
      -
      3939 class(errors), intent(inout), optional, target :: err
      -
      3940 end subroutine
      -
      3941
      -
      3942 module subroutine solve_least_squares_vec_svd_cmplx(a, b, s, arnk, work, &
      -
      3943 olwork, rwork, err)
      -
      3944 complex(real64), intent(inout), dimension(:,:) :: a
      -
      3945 complex(real64), intent(inout), dimension(:) :: b
      -
      3946 integer(int32), intent(out), optional :: arnk
      -
      3947 complex(real64), intent(out), target, optional, dimension(:) :: work
      -
      3948 real(real64), intent(out), target, optional, dimension(:) :: rwork, s
      -
      3949 integer(int32), intent(out), optional :: olwork
      -
      3950 class(errors), intent(inout), optional, target :: err
      -
      3951 end subroutine
      -
      3952
      -
      3953 module subroutine mtx_inverse_dbl(a, iwork, work, olwork, err)
      -
      3954 real(real64), intent(inout), dimension(:,:) :: a
      -
      3955 integer(int32), intent(out), target, optional, dimension(:) :: iwork
      -
      3956 real(real64), intent(out), target, optional, dimension(:) :: work
      -
      3957 integer(int32), intent(out), optional :: olwork
      -
      3958 class(errors), intent(inout), optional, target :: err
      -
      3959 end subroutine
      -
      3960
      -
      3961 module subroutine mtx_inverse_cmplx(a, iwork, work, olwork, err)
      -
      3962 complex(real64), intent(inout), dimension(:,:) :: a
      -
      3963 integer(int32), intent(out), target, optional, dimension(:) :: iwork
      -
      3964 complex(real64), intent(out), target, optional, dimension(:) :: work
      -
      3965 integer(int32), intent(out), optional :: olwork
      -
      3966 class(errors), intent(inout), optional, target :: err
      -
      3967 end subroutine
      -
      3968
      -
      3969 module subroutine mtx_pinverse_dbl(a, ainv, tol, work, olwork, err)
      -
      3970 real(real64), intent(inout), dimension(:,:) :: a
      -
      3971 real(real64), intent(out), dimension(:,:) :: ainv
      -
      3972 real(real64), intent(in), optional :: tol
      -
      3973 real(real64), intent(out), target, dimension(:), optional :: work
      -
      3974 integer(int32), intent(out), optional :: olwork
      -
      3975 class(errors), intent(inout), optional, target :: err
      -
      3976 end subroutine
      -
      3977
      -
      3978 module subroutine mtx_pinverse_cmplx(a, ainv, tol, work, olwork, rwork, err)
      -
      3979 complex(real64), intent(inout), dimension(:,:) :: a
      -
      3980 complex(real64), intent(out), dimension(:,:) :: ainv
      -
      3981 real(real64), intent(in), optional :: tol
      -
      3982 complex(real64), intent(out), target, dimension(:), optional :: work
      -
      3983 integer(int32), intent(out), optional :: olwork
      -
      3984 real(real64), intent(out), target, dimension(:), optional :: rwork
      -
      3985 class(errors), intent(inout), optional, target :: err
      -
      3986 end subroutine
      +
      3389! ******************************************************************************
      +
      3390! LINALG_FACTOR.F90
      +
      3391! ------------------------------------------------------------------------------
      +
      3392interface
      +
      3393 module subroutine lu_factor_dbl(a, ipvt, err)
      +
      3394 real(real64), intent(inout), dimension(:,:) :: a
      +
      3395 integer(int32), intent(out), dimension(:) :: ipvt
      +
      3396 class(errors), intent(inout), optional, target :: err
      +
      3397 end subroutine
      +
      3398
      +
      3399 module subroutine lu_factor_cmplx(a, ipvt, err)
      +
      3400 complex(real64), intent(inout), dimension(:,:) :: a
      +
      3401 integer(int32), intent(out), dimension(:) :: ipvt
      +
      3402 class(errors), intent(inout), optional, target :: err
      +
      3403 end subroutine
      +
      3404
      +
      3405 module subroutine form_lu_all(lu, ipvt, u, p, err)
      +
      3406 real(real64), intent(inout), dimension(:,:) :: lu
      +
      3407 integer(int32), intent(in), dimension(:) :: ipvt
      +
      3408 real(real64), intent(out), dimension(:,:) :: u, p
      +
      3409 class(errors), intent(inout), optional, target :: err
      +
      3410 end subroutine
      +
      3411
      +
      3412 module subroutine form_lu_all_cmplx(lu, ipvt, u, p, err)
      +
      3413 complex(real64), intent(inout), dimension(:,:) :: lu
      +
      3414 integer(int32), intent(in), dimension(:) :: ipvt
      +
      3415 complex(real64), intent(out), dimension(:,:) :: u
      +
      3416 real(real64), intent(out), dimension(:,:) :: p
      +
      3417 class(errors), intent(inout), optional, target :: err
      +
      3418 end subroutine
      +
      3419
      +
      3420 module subroutine form_lu_only(lu, u, err)
      +
      3421 real(real64), intent(inout), dimension(:,:) :: lu
      +
      3422 real(real64), intent(out), dimension(:,:) :: u
      +
      3423 class(errors), intent(inout), optional, target :: err
      +
      3424 end subroutine
      +
      3425
      +
      3426 module subroutine form_lu_only_cmplx(lu, u, err)
      +
      3427 complex(real64), intent(inout), dimension(:,:) :: lu
      +
      3428 complex(real64), intent(out), dimension(:,:) :: u
      +
      3429 class(errors), intent(inout), optional, target :: err
      +
      3430 end subroutine
      +
      3431
      +
      3432 module subroutine qr_factor_no_pivot(a, tau, work, olwork, err)
      +
      3433 real(real64), intent(inout), dimension(:,:) :: a
      +
      3434 real(real64), intent(out), dimension(:) :: tau
      +
      3435 real(real64), intent(out), target, dimension(:), optional :: work
      +
      3436 integer(int32), intent(out), optional :: olwork
      +
      3437 class(errors), intent(inout), optional, target :: err
      +
      3438 end subroutine
      +
      3439
      +
      3440 module subroutine qr_factor_no_pivot_cmplx(a, tau, work, olwork, err)
      +
      3441 complex(real64), intent(inout), dimension(:,:) :: a
      +
      3442 complex(real64), intent(out), dimension(:) :: tau
      +
      3443 complex(real64), intent(out), target, dimension(:), optional :: work
      +
      3444 integer(int32), intent(out), optional :: olwork
      +
      3445 class(errors), intent(inout), optional, target :: err
      +
      3446 end subroutine
      +
      3447
      +
      3448 module subroutine qr_factor_pivot(a, tau, jpvt, work, olwork, err)
      +
      3449 real(real64), intent(inout), dimension(:,:) :: a
      +
      3450 real(real64), intent(out), dimension(:) :: tau
      +
      3451 integer(int32), intent(inout), dimension(:) :: jpvt
      +
      3452 real(real64), intent(out), target, dimension(:), optional :: work
      +
      3453 integer(int32), intent(out), optional :: olwork
      +
      3454 class(errors), intent(inout), optional, target :: err
      +
      3455 end subroutine
      +
      3456
      +
      3457 module subroutine qr_factor_pivot_cmplx(a, tau, jpvt, work, olwork, rwork, &
      +
      3458 err)
      +
      3459 complex(real64), intent(inout), dimension(:,:) :: a
      +
      3460 complex(real64), intent(out), dimension(:) :: tau
      +
      3461 integer(int32), intent(inout), dimension(:) :: jpvt
      +
      3462 complex(real64), intent(out), target, dimension(:), optional :: work
      +
      3463 integer(int32), intent(out), optional :: olwork
      +
      3464 real(real64), intent(out), target, dimension(:), optional :: rwork
      +
      3465 class(errors), intent(inout), optional, target :: err
      +
      3466 end subroutine
      +
      3467
      +
      3468 module subroutine form_qr_no_pivot(r, tau, q, work, olwork, err)
      +
      3469 real(real64), intent(inout), dimension(:,:) :: r
      +
      3470 real(real64), intent(in), dimension(:) :: tau
      +
      3471 real(real64), intent(out), dimension(:,:) :: q
      +
      3472 real(real64), intent(out), target, dimension(:), optional :: work
      +
      3473 integer(int32), intent(out), optional :: olwork
      +
      3474 class(errors), intent(inout), optional, target :: err
      +
      3475 end subroutine
      +
      3476
      +
      3477 module subroutine form_qr_no_pivot_cmplx(r, tau, q, work, olwork, err)
      +
      3478 complex(real64), intent(inout), dimension(:,:) :: r
      +
      3479 complex(real64), intent(in), dimension(:) :: tau
      +
      3480 complex(real64), intent(out), dimension(:,:) :: q
      +
      3481 complex(real64), intent(out), target, dimension(:), optional :: work
      +
      3482 integer(int32), intent(out), optional :: olwork
      +
      3483 class(errors), intent(inout), optional, target :: err
      +
      3484 end subroutine
      +
      3485
      +
      3486 module subroutine form_qr_pivot(r, tau, pvt, q, p, work, olwork, err)
      +
      3487 real(real64), intent(inout), dimension(:,:) :: r
      +
      3488 real(real64), intent(in), dimension(:) :: tau
      +
      3489 integer(int32), intent(in), dimension(:) :: pvt
      +
      3490 real(real64), intent(out), dimension(:,:) :: q, p
      +
      3491 real(real64), intent(out), target, dimension(:), optional :: work
      +
      3492 integer(int32), intent(out), optional :: olwork
      +
      3493 class(errors), intent(inout), optional, target :: err
      +
      3494 end subroutine
      +
      3495
      +
      3496 module subroutine form_qr_pivot_cmplx(r, tau, pvt, q, p, work, olwork, err)
      +
      3497 complex(real64), intent(inout), dimension(:,:) :: r
      +
      3498 complex(real64), intent(in), dimension(:) :: tau
      +
      3499 integer(int32), intent(in), dimension(:) :: pvt
      +
      3500 complex(real64), intent(out), dimension(:,:) :: q, p
      +
      3501 complex(real64), intent(out), target, dimension(:), optional :: work
      +
      3502 integer(int32), intent(out), optional :: olwork
      +
      3503 class(errors), intent(inout), optional, target :: err
      +
      3504 end subroutine
      +
      3505
      +
      3506 module subroutine mult_qr_mtx(lside, trans, a, tau, c, work, olwork, err)
      +
      3507 logical, intent(in) :: lside, trans
      +
      3508 real(real64), intent(in), dimension(:) :: tau
      +
      3509 real(real64), intent(inout), dimension(:,:) :: a, c
      +
      3510 real(real64), intent(out), target, dimension(:), optional :: work
      +
      3511 integer(int32), intent(out), optional :: olwork
      +
      3512 class(errors), intent(inout), optional, target :: err
      +
      3513 end subroutine
      +
      3514
      +
      3515 module subroutine mult_qr_mtx_cmplx(lside, trans, a, tau, c, work, olwork, err)
      +
      3516 logical, intent(in) :: lside, trans
      +
      3517 complex(real64), intent(in), dimension(:) :: tau
      +
      3518 complex(real64), intent(inout), dimension(:,:) :: a, c
      +
      3519 complex(real64), intent(out), target, dimension(:), optional :: work
      +
      3520 integer(int32), intent(out), optional :: olwork
      +
      3521 class(errors), intent(inout), optional, target :: err
      +
      3522 end subroutine
      +
      3523
      +
      3524 module subroutine mult_qr_vec(trans, a, tau, c, work, olwork, err)
      +
      3525 logical, intent(in) :: trans
      +
      3526 real(real64), intent(inout), dimension(:,:) :: a
      +
      3527 real(real64), intent(in), dimension(:) :: tau
      +
      3528 real(real64), intent(inout), dimension(:) :: c
      +
      3529 real(real64), intent(out), target, dimension(:), optional :: work
      +
      3530 integer(int32), intent(out), optional :: olwork
      +
      3531 class(errors), intent(inout), optional, target :: err
      +
      3532 end subroutine
      +
      3533
      +
      3534 module subroutine mult_qr_vec_cmplx(trans, a, tau, c, work, olwork, err)
      +
      3535 logical, intent(in) :: trans
      +
      3536 complex(real64), intent(inout), dimension(:,:) :: a
      +
      3537 complex(real64), intent(in), dimension(:) :: tau
      +
      3538 complex(real64), intent(inout), dimension(:) :: c
      +
      3539 complex(real64), intent(out), target, dimension(:), optional :: work
      +
      3540 integer(int32), intent(out), optional :: olwork
      +
      3541 class(errors), intent(inout), optional, target :: err
      +
      3542 end subroutine
      +
      3543
      +
      3544 module subroutine qr_rank1_update_dbl(q, r, u, v, work, err)
      +
      3545 real(real64), intent(inout), dimension(:,:) :: q, r
      +
      3546 real(real64), intent(inout), dimension(:) :: u, v
      +
      3547 real(real64), intent(out), target, optional, dimension(:) :: work
      +
      3548 class(errors), intent(inout), optional, target :: err
      +
      3549 end subroutine
      +
      3550
      +
      3551 module subroutine qr_rank1_update_cmplx(q, r, u, v, work, rwork, err)
      +
      3552 complex(real64), intent(inout), dimension(:,:) :: q, r
      +
      3553 complex(real64), intent(inout), dimension(:) :: u, v
      +
      3554 complex(real64), intent(out), target, optional, dimension(:) :: work
      +
      3555 real(real64), intent(out), target, optional, dimension(:) :: rwork
      +
      3556 class(errors), intent(inout), optional, target :: err
      +
      3557 end subroutine
      +
      3558
      +
      3559 module subroutine cholesky_factor_dbl(a, upper, err)
      +
      3560 real(real64), intent(inout), dimension(:,:) :: a
      +
      3561 logical, intent(in), optional :: upper
      +
      3562 class(errors), intent(inout), optional, target :: err
      +
      3563 end subroutine
      +
      3564
      +
      3565 module subroutine cholesky_factor_cmplx(a, upper, err)
      +
      3566 complex(real64), intent(inout), dimension(:,:) :: a
      +
      3567 logical, intent(in), optional :: upper
      +
      3568 class(errors), intent(inout), optional, target :: err
      +
      3569 end subroutine
      +
      3570
      +
      3571 module subroutine cholesky_rank1_update_dbl(r, u, work, err)
      +
      3572 real(real64), intent(inout), dimension(:,:) :: r
      +
      3573 real(real64), intent(inout), dimension(:) :: u
      +
      3574 real(real64), intent(out), target, optional, dimension(:) :: work
      +
      3575 class(errors), intent(inout), optional, target :: err
      +
      3576 end subroutine
      +
      3577
      +
      3578 module subroutine cholesky_rank1_update_cmplx(r, u, work, err)
      +
      3579 complex(real64), intent(inout), dimension(:,:) :: r
      +
      3580 complex(real64), intent(inout), dimension(:) :: u
      +
      3581 real(real64), intent(out), target, optional, dimension(:) :: work
      +
      3582 class(errors), intent(inout), optional, target :: err
      +
      3583 end subroutine
      +
      3584
      +
      3585 module subroutine cholesky_rank1_downdate_dbl(r, u, work, err)
      +
      3586 real(real64), intent(inout), dimension(:,:) :: r
      +
      3587 real(real64), intent(inout), dimension(:) :: u
      +
      3588 real(real64), intent(out), target, optional, dimension(:) :: work
      +
      3589 class(errors), intent(inout), optional, target :: err
      +
      3590 end subroutine
      +
      3591
      +
      3592 module subroutine cholesky_rank1_downdate_cmplx(r, u, work, err)
      +
      3593 complex(real64), intent(inout), dimension(:,:) :: r
      +
      3594 complex(real64), intent(inout), dimension(:) :: u
      +
      3595 real(real64), intent(out), target, optional, dimension(:) :: work
      +
      3596 class(errors), intent(inout), optional, target :: err
      +
      3597 end subroutine
      +
      3598
      +
      3599 module subroutine rz_factor_dbl(a, tau, work, olwork, err)
      +
      3600 real(real64), intent(inout), dimension(:,:) :: a
      +
      3601 real(real64), intent(out), dimension(:) :: tau
      +
      3602 real(real64), intent(out), target, optional, dimension(:) :: work
      +
      3603 integer(int32), intent(out), optional :: olwork
      +
      3604 class(errors), intent(inout), optional, target :: err
      +
      3605 end subroutine
      +
      3606
      +
      3607 module subroutine rz_factor_cmplx(a, tau, work, olwork, err)
      +
      3608 complex(real64), intent(inout), dimension(:,:) :: a
      +
      3609 complex(real64), intent(out), dimension(:) :: tau
      +
      3610 complex(real64), intent(out), target, optional, dimension(:) :: work
      +
      3611 integer(int32), intent(out), optional :: olwork
      +
      3612 class(errors), intent(inout), optional, target :: err
      +
      3613 end subroutine
      +
      3614
      +
      3615 module subroutine mult_rz_mtx(lside, trans, l, a, tau, c, work, olwork, err)
      +
      3616 logical, intent(in) :: lside, trans
      +
      3617 integer(int32), intent(in) :: l
      +
      3618 real(real64), intent(inout), dimension(:,:) :: a, c
      +
      3619 real(real64), intent(in), dimension(:) :: tau
      +
      3620 real(real64), intent(out), target, optional, dimension(:) :: work
      +
      3621 integer(int32), intent(out), optional :: olwork
      +
      3622 class(errors), intent(inout), optional, target :: err
      +
      3623 end subroutine
      +
      3624
      +
      3625 module subroutine mult_rz_mtx_cmplx(lside, trans, l, a, tau, c, work, olwork, err)
      +
      3626 logical, intent(in) :: lside, trans
      +
      3627 integer(int32), intent(in) :: l
      +
      3628 complex(real64), intent(inout), dimension(:,:) :: a, c
      +
      3629 complex(real64), intent(in), dimension(:) :: tau
      +
      3630 complex(real64), intent(out), target, optional, dimension(:) :: work
      +
      3631 integer(int32), intent(out), optional :: olwork
      +
      3632 class(errors), intent(inout), optional, target :: err
      +
      3633 end subroutine
      +
      3634
      +
      3635 module subroutine mult_rz_vec(trans, l, a, tau, c, work, olwork, err)
      +
      3636 logical, intent(in) :: trans
      +
      3637 integer(int32), intent(in) :: l
      +
      3638 real(real64), intent(inout), dimension(:,:) :: a
      +
      3639 real(real64), intent(in), dimension(:) :: tau
      +
      3640 real(real64), intent(inout), dimension(:) :: c
      +
      3641 real(real64), intent(out), target, optional, dimension(:) :: work
      +
      3642 integer(int32), intent(out), optional :: olwork
      +
      3643 class(errors), intent(inout), optional, target :: err
      +
      3644 end subroutine
      +
      3645
      +
      3646 module subroutine mult_rz_vec_cmplx(trans, l, a, tau, c, work, olwork, err)
      +
      3647 logical, intent(in) :: trans
      +
      3648 integer(int32), intent(in) :: l
      +
      3649 complex(real64), intent(inout), dimension(:,:) :: a
      +
      3650 complex(real64), intent(in), dimension(:) :: tau
      +
      3651 complex(real64), intent(inout), dimension(:) :: c
      +
      3652 complex(real64), intent(out), target, optional, dimension(:) :: work
      +
      3653 integer(int32), intent(out), optional :: olwork
      +
      3654 class(errors), intent(inout), optional, target :: err
      +
      3655 end subroutine
      +
      3656
      +
      3657 module subroutine svd_dbl(a, s, u, vt, work, olwork, err)
      +
      3658 real(real64), intent(inout), dimension(:,:) :: a
      +
      3659 real(real64), intent(out), dimension(:) :: s
      +
      3660 real(real64), intent(out), optional, dimension(:,:) :: u, vt
      +
      3661 real(real64), intent(out), target, optional, dimension(:) :: work
      +
      3662 integer(int32), intent(out), optional :: olwork
      +
      3663 class(errors), intent(inout), optional, target :: err
      +
      3664 end subroutine
      +
      3665
      +
      3666 module subroutine svd_cmplx(a, s, u, vt, work, olwork, rwork, err)
      +
      3667 complex(real64), intent(inout), dimension(:,:) :: a
      +
      3668 real(real64), intent(out), dimension(:) :: s
      +
      3669 complex(real64), intent(out), optional, dimension(:,:) :: u, vt
      +
      3670 complex(real64), intent(out), target, optional, dimension(:) :: work
      +
      3671 integer(int32), intent(out), optional :: olwork
      +
      3672 real(real64), intent(out), target, optional, dimension(:) :: rwork
      +
      3673 class(errors), intent(inout), optional, target :: err
      +
      3674 end subroutine
      +
      3675end interface
      +
      3676
      +
      3677! ******************************************************************************
      +
      3678! LINALG_SOLVE.F90
      +
      3679! ------------------------------------------------------------------------------
      +
      3680interface
      +
      3681 module subroutine solve_tri_mtx(lside, upper, trans, nounit, alpha, a, b, err)
      +
      3682 logical, intent(in) :: lside, upper, trans, nounit
      +
      3683 real(real64), intent(in) :: alpha
      +
      3684 real(real64), intent(in), dimension(:,:) :: a
      +
      3685 real(real64), intent(inout), dimension(:,:) :: b
      +
      3686 class(errors), intent(inout), optional, target :: err
      +
      3687 end subroutine
      +
      3688
      +
      3689 module subroutine solve_tri_mtx_cmplx(lside, upper, trans, nounit, alpha, a, b, err)
      +
      3690 logical, intent(in) :: lside, upper, trans, nounit
      +
      3691 complex(real64), intent(in) :: alpha
      +
      3692 complex(real64), intent(in), dimension(:,:) :: a
      +
      3693 complex(real64), intent(inout), dimension(:,:) :: b
      +
      3694 class(errors), intent(inout), optional, target :: err
      +
      3695 end subroutine
      +
      3696
      +
      3697 module subroutine solve_tri_vec(upper, trans, nounit, a, x, err)
      +
      3698 logical, intent(in) :: upper, trans, nounit
      +
      3699 real(real64), intent(in), dimension(:,:) :: a
      +
      3700 real(real64), intent(inout), dimension(:) :: x
      +
      3701 class(errors), intent(inout), optional, target :: err
      +
      3702 end subroutine
      +
      3703
      +
      3704 module subroutine solve_tri_vec_cmplx(upper, trans, nounit, a, x, err)
      +
      3705 logical, intent(in) :: upper, trans, nounit
      +
      3706 complex(real64), intent(in), dimension(:,:) :: a
      +
      3707 complex(real64), intent(inout), dimension(:) :: x
      +
      3708 class(errors), intent(inout), optional, target :: err
      +
      3709 end subroutine
      +
      3710
      +
      3711 module subroutine solve_lu_mtx(a, ipvt, b, err)
      +
      3712 real(real64), intent(in), dimension(:,:) :: a
      +
      3713 integer(int32), intent(in), dimension(:) :: ipvt
      +
      3714 real(real64), intent(inout), dimension(:,:) :: b
      +
      3715 class(errors), intent(inout), optional, target :: err
      +
      3716 end subroutine
      +
      3717
      +
      3718 module subroutine solve_lu_mtx_cmplx(a, ipvt, b, err)
      +
      3719 complex(real64), intent(in), dimension(:,:) :: a
      +
      3720 integer(int32), intent(in), dimension(:) :: ipvt
      +
      3721 complex(real64), intent(inout), dimension(:,:) :: b
      +
      3722 class(errors), intent(inout), optional, target :: err
      +
      3723 end subroutine
      +
      3724
      +
      3725 module subroutine solve_lu_vec(a, ipvt, b, err)
      +
      3726 real(real64), intent(in), dimension(:,:) :: a
      +
      3727 integer(int32), intent(in), dimension(:) :: ipvt
      +
      3728 real(real64), intent(inout), dimension(:) :: b
      +
      3729 class(errors), intent(inout), optional, target :: err
      +
      3730 end subroutine
      +
      3731
      +
      3732 module subroutine solve_lu_vec_cmplx(a, ipvt, b, err)
      +
      3733 complex(real64), intent(in), dimension(:,:) :: a
      +
      3734 integer(int32), intent(in), dimension(:) :: ipvt
      +
      3735 complex(real64), intent(inout), dimension(:) :: b
      +
      3736 class(errors), intent(inout), optional, target :: err
      +
      3737 end subroutine
      +
      3738
      +
      3739 module subroutine solve_qr_no_pivot_mtx(a, tau, b, work, olwork, err)
      +
      3740 real(real64), intent(inout), dimension(:,:) :: a, b
      +
      3741 real(real64), intent(in), dimension(:) :: tau
      +
      3742 real(real64), intent(out), target, optional, dimension(:) :: work
      +
      3743 integer(int32), intent(out), optional :: olwork
      +
      3744 class(errors), intent(inout), optional, target :: err
      +
      3745 end subroutine
      +
      3746
      +
      3747 module subroutine solve_qr_no_pivot_mtx_cmplx(a, tau, b, work, olwork, err)
      +
      3748 complex(real64), intent(inout), dimension(:,:) :: a, b
      +
      3749 complex(real64), intent(in), dimension(:) :: tau
      +
      3750 complex(real64), intent(out), target, optional, dimension(:) :: work
      +
      3751 integer(int32), intent(out), optional :: olwork
      +
      3752 class(errors), intent(inout), optional, target :: err
      +
      3753 end subroutine
      +
      3754
      +
      3755 module subroutine solve_qr_no_pivot_vec(a, tau, b, work, olwork, err)
      +
      3756 real(real64), intent(inout), dimension(:,:) :: a
      +
      3757 real(real64), intent(in), dimension(:) :: tau
      +
      3758 real(real64), intent(inout), dimension(:) :: b
      +
      3759 real(real64), intent(out), target, optional, dimension(:) :: work
      +
      3760 integer(int32), intent(out), optional :: olwork
      +
      3761 class(errors), intent(inout), optional, target :: err
      +
      3762 end subroutine
      +
      3763
      +
      3764 module subroutine solve_qr_no_pivot_vec_cmplx(a, tau, b, work, olwork, err)
      +
      3765 complex(real64), intent(inout), dimension(:,:) :: a
      +
      3766 complex(real64), intent(in), dimension(:) :: tau
      +
      3767 complex(real64), intent(inout), dimension(:) :: b
      +
      3768 complex(real64), intent(out), target, optional, dimension(:) :: work
      +
      3769 integer(int32), intent(out), optional :: olwork
      +
      3770 class(errors), intent(inout), optional, target :: err
      +
      3771 end subroutine
      +
      3772
      +
      3773 module subroutine solve_qr_pivot_mtx(a, tau, jpvt, b, work, olwork, err)
      +
      3774 real(real64), intent(inout), dimension(:,:) :: a
      +
      3775 real(real64), intent(in), dimension(:) :: tau
      +
      3776 integer(int32), intent(in), dimension(:) :: jpvt
      +
      3777 real(real64), intent(inout), dimension(:,:) :: b
      +
      3778 real(real64), intent(out), target, optional, dimension(:) :: work
      +
      3779 integer(int32), intent(out), optional :: olwork
      +
      3780 class(errors), intent(inout), optional, target :: err
      +
      3781 end subroutine
      +
      3782
      +
      3783 module subroutine solve_qr_pivot_mtx_cmplx(a, tau, jpvt, b, work, olwork, err)
      +
      3784 complex(real64), intent(inout), dimension(:,:) :: a
      +
      3785 complex(real64), intent(in), dimension(:) :: tau
      +
      3786 integer(int32), intent(in), dimension(:) :: jpvt
      +
      3787 complex(real64), intent(inout), dimension(:,:) :: b
      +
      3788 complex(real64), intent(out), target, optional, dimension(:) :: work
      +
      3789 integer(int32), intent(out), optional :: olwork
      +
      3790 class(errors), intent(inout), optional, target :: err
      +
      3791 end subroutine
      +
      3792
      +
      3793 module subroutine solve_qr_pivot_vec(a, tau, jpvt, b, work, olwork, err)
      +
      3794 real(real64), intent(inout), dimension(:,:) :: a
      +
      3795 real(real64), intent(in), dimension(:) :: tau
      +
      3796 integer(int32), intent(in), dimension(:) :: jpvt
      +
      3797 real(real64), intent(inout), dimension(:) :: b
      +
      3798 real(real64), intent(out), target, optional, dimension(:) :: work
      +
      3799 integer(int32), intent(out), optional :: olwork
      +
      3800 class(errors), intent(inout), optional, target :: err
      +
      3801 end subroutine
      +
      3802
      +
      3803 module subroutine solve_qr_pivot_vec_cmplx(a, tau, jpvt, b, work, olwork, err)
      +
      3804 complex(real64), intent(inout), dimension(:,:) :: a
      +
      3805 complex(real64), intent(in), dimension(:) :: tau
      +
      3806 integer(int32), intent(in), dimension(:) :: jpvt
      +
      3807 complex(real64), intent(inout), dimension(:) :: b
      +
      3808 complex(real64), intent(out), target, optional, dimension(:) :: work
      +
      3809 integer(int32), intent(out), optional :: olwork
      +
      3810 class(errors), intent(inout), optional, target :: err
      +
      3811 end subroutine
      +
      3812
      +
      3813 module subroutine solve_cholesky_mtx(upper, a, b, err)
      +
      3814 logical, intent(in) :: upper
      +
      3815 real(real64), intent(in), dimension(:,:) :: a
      +
      3816 real(real64), intent(inout), dimension(:,:) :: b
      +
      3817 class(errors), intent(inout), optional, target :: err
      +
      3818 end subroutine
      +
      3819
      +
      3820 module subroutine solve_cholesky_mtx_cmplx(upper, a, b, err)
      +
      3821 logical, intent(in) :: upper
      +
      3822 complex(real64), intent(in), dimension(:,:) :: a
      +
      3823 complex(real64), intent(inout), dimension(:,:) :: b
      +
      3824 class(errors), intent(inout), optional, target :: err
      +
      3825 end subroutine
      +
      3826
      +
      3827 module subroutine solve_cholesky_vec(upper, a, b, err)
      +
      3828 logical, intent(in) :: upper
      +
      3829 real(real64), intent(in), dimension(:,:) :: a
      +
      3830 real(real64), intent(inout), dimension(:) :: b
      +
      3831 class(errors), intent(inout), optional, target :: err
      +
      3832 end subroutine
      +
      3833
      +
      3834 module subroutine solve_cholesky_vec_cmplx(upper, a, b, err)
      +
      3835 logical, intent(in) :: upper
      +
      3836 complex(real64), intent(in), dimension(:,:) :: a
      +
      3837 complex(real64), intent(inout), dimension(:) :: b
      +
      3838 class(errors), intent(inout), optional, target :: err
      +
      3839 end subroutine
      +
      3840
      +
      3841 module subroutine solve_least_squares_mtx(a, b, work, olwork, err)
      +
      3842 real(real64), intent(inout), dimension(:,:) :: a, b
      +
      3843 real(real64), intent(out), target, optional, dimension(:) :: work
      +
      3844 integer(int32), intent(out), optional :: olwork
      +
      3845 class(errors), intent(inout), optional, target :: err
      +
      3846 end subroutine
      +
      3847
      +
      3848 module subroutine solve_least_squares_mtx_cmplx(a, b, work, olwork, err)
      +
      3849 complex(real64), intent(inout), dimension(:,:) :: a, b
      +
      3850 complex(real64), intent(out), target, optional, dimension(:) :: work
      +
      3851 integer(int32), intent(out), optional :: olwork
      +
      3852 class(errors), intent(inout), optional, target :: err
      +
      3853 end subroutine
      +
      3854
      +
      3855 module subroutine solve_least_squares_vec(a, b, work, olwork, err)
      +
      3856 real(real64), intent(inout), dimension(:,:) :: a
      +
      3857 real(real64), intent(inout), dimension(:) :: b
      +
      3858 real(real64), intent(out), target, optional, dimension(:) :: work
      +
      3859 integer(int32), intent(out), optional :: olwork
      +
      3860 class(errors), intent(inout), optional, target :: err
      +
      3861 end subroutine
      +
      3862
      +
      3863 module subroutine solve_least_squares_vec_cmplx(a, b, work, olwork, err)
      +
      3864 complex(real64), intent(inout), dimension(:,:) :: a
      +
      3865 complex(real64), intent(inout), dimension(:) :: b
      +
      3866 complex(real64), intent(out), target, optional, dimension(:) :: work
      +
      3867 integer(int32), intent(out), optional :: olwork
      +
      3868 class(errors), intent(inout), optional, target :: err
      +
      3869 end subroutine
      +
      3870
      +
      3871 module subroutine solve_least_squares_mtx_pvt(a, b, ipvt, arnk, work, olwork, err)
      +
      3872 real(real64), intent(inout), dimension(:,:) :: a, b
      +
      3873 integer(int32), intent(inout), target, optional, dimension(:) :: ipvt
      +
      3874 integer(int32), intent(out), optional :: arnk
      +
      3875 real(real64), intent(out), target, optional, dimension(:) :: work
      +
      3876 integer(int32), intent(out), optional :: olwork
      +
      3877 class(errors), intent(inout), optional, target :: err
      +
      3878 end subroutine
      +
      3879
      +
      3880 module subroutine solve_least_squares_mtx_pvt_cmplx(a, b, ipvt, arnk, &
      +
      3881 work, olwork, rwork, err)
      +
      3882 complex(real64), intent(inout), dimension(:,:) :: a, b
      +
      3883 integer(int32), intent(inout), target, optional, dimension(:) :: ipvt
      +
      3884 integer(int32), intent(out), optional :: arnk
      +
      3885 complex(real64), intent(out), target, optional, dimension(:) :: work
      +
      3886 integer(int32), intent(out), optional :: olwork
      +
      3887 real(real64), intent(out), target, optional, dimension(:) :: rwork
      +
      3888 class(errors), intent(inout), optional, target :: err
      +
      3889 end subroutine
      +
      3890
      +
      3891 module subroutine solve_least_squares_vec_pvt(a, b, ipvt, arnk, work, olwork, err)
      +
      3892 real(real64), intent(inout), dimension(:,:) :: a
      +
      3893 real(real64), intent(inout), dimension(:) :: b
      +
      3894 integer(int32), intent(inout), target, optional, dimension(:) :: ipvt
      +
      3895 integer(int32), intent(out), optional :: arnk
      +
      3896 real(real64), intent(out), target, optional, dimension(:) :: work
      +
      3897 integer(int32), intent(out), optional :: olwork
      +
      3898 class(errors), intent(inout), optional, target :: err
      +
      3899 end subroutine
      +
      3900
      +
      3901 module subroutine solve_least_squares_vec_pvt_cmplx(a, b, ipvt, arnk, &
      +
      3902 work, olwork, rwork, err)
      +
      3903 complex(real64), intent(inout), dimension(:,:) :: a
      +
      3904 complex(real64), intent(inout), dimension(:) :: b
      +
      3905 integer(int32), intent(inout), target, optional, dimension(:) :: ipvt
      +
      3906 integer(int32), intent(out), optional :: arnk
      +
      3907 complex(real64), intent(out), target, optional, dimension(:) :: work
      +
      3908 integer(int32), intent(out), optional :: olwork
      +
      3909 real(real64), intent(out), target, optional, dimension(:) :: rwork
      +
      3910 class(errors), intent(inout), optional, target :: err
      +
      3911 end subroutine
      +
      3912
      +
      3913 module subroutine solve_least_squares_mtx_svd(a, b, s, arnk, work, olwork, err)
      +
      3914 real(real64), intent(inout), dimension(:,:) :: a, b
      +
      3915 integer(int32), intent(out), optional :: arnk
      +
      3916 real(real64), intent(out), target, optional, dimension(:) :: work, s
      +
      3917 integer(int32), intent(out), optional :: olwork
      +
      3918 class(errors), intent(inout), optional, target :: err
      +
      3919 end subroutine
      +
      3920
      +
      3921 module subroutine solve_least_squares_mtx_svd_cmplx(a, b, s, arnk, work, &
      +
      3922 olwork, rwork, err)
      +
      3923 complex(real64), intent(inout), dimension(:,:) :: a, b
      +
      3924 integer(int32), intent(out), optional :: arnk
      +
      3925 complex(real64), intent(out), target, optional, dimension(:) :: work
      +
      3926 real(real64), intent(out), target, optional, dimension(:) :: rwork, s
      +
      3927 integer(int32), intent(out), optional :: olwork
      +
      3928 class(errors), intent(inout), optional, target :: err
      +
      3929 end subroutine
      +
      3930
      +
      3931 module subroutine solve_least_squares_vec_svd(a, b, s, arnk, work, olwork, err)
      +
      3932 real(real64), intent(inout), dimension(:,:) :: a
      +
      3933 real(real64), intent(inout), dimension(:) :: b
      +
      3934 integer(int32), intent(out), optional :: arnk
      +
      3935 real(real64), intent(out), target, optional, dimension(:) :: work, s
      +
      3936 integer(int32), intent(out), optional :: olwork
      +
      3937 class(errors), intent(inout), optional, target :: err
      +
      3938 end subroutine
      +
      3939
      +
      3940 module subroutine solve_least_squares_vec_svd_cmplx(a, b, s, arnk, work, &
      +
      3941 olwork, rwork, err)
      +
      3942 complex(real64), intent(inout), dimension(:,:) :: a
      +
      3943 complex(real64), intent(inout), dimension(:) :: b
      +
      3944 integer(int32), intent(out), optional :: arnk
      +
      3945 complex(real64), intent(out), target, optional, dimension(:) :: work
      +
      3946 real(real64), intent(out), target, optional, dimension(:) :: rwork, s
      +
      3947 integer(int32), intent(out), optional :: olwork
      +
      3948 class(errors), intent(inout), optional, target :: err
      +
      3949 end subroutine
      +
      3950
      +
      3951 module subroutine mtx_inverse_dbl(a, iwork, work, olwork, err)
      +
      3952 real(real64), intent(inout), dimension(:,:) :: a
      +
      3953 integer(int32), intent(out), target, optional, dimension(:) :: iwork
      +
      3954 real(real64), intent(out), target, optional, dimension(:) :: work
      +
      3955 integer(int32), intent(out), optional :: olwork
      +
      3956 class(errors), intent(inout), optional, target :: err
      +
      3957 end subroutine
      +
      3958
      +
      3959 module subroutine mtx_inverse_cmplx(a, iwork, work, olwork, err)
      +
      3960 complex(real64), intent(inout), dimension(:,:) :: a
      +
      3961 integer(int32), intent(out), target, optional, dimension(:) :: iwork
      +
      3962 complex(real64), intent(out), target, optional, dimension(:) :: work
      +
      3963 integer(int32), intent(out), optional :: olwork
      +
      3964 class(errors), intent(inout), optional, target :: err
      +
      3965 end subroutine
      +
      3966
      +
      3967 module subroutine mtx_pinverse_dbl(a, ainv, tol, work, olwork, err)
      +
      3968 real(real64), intent(inout), dimension(:,:) :: a
      +
      3969 real(real64), intent(out), dimension(:,:) :: ainv
      +
      3970 real(real64), intent(in), optional :: tol
      +
      3971 real(real64), intent(out), target, dimension(:), optional :: work
      +
      3972 integer(int32), intent(out), optional :: olwork
      +
      3973 class(errors), intent(inout), optional, target :: err
      +
      3974 end subroutine
      +
      3975
      +
      3976 module subroutine mtx_pinverse_cmplx(a, ainv, tol, work, olwork, rwork, err)
      +
      3977 complex(real64), intent(inout), dimension(:,:) :: a
      +
      3978 complex(real64), intent(out), dimension(:,:) :: ainv
      +
      3979 real(real64), intent(in), optional :: tol
      +
      3980 complex(real64), intent(out), target, dimension(:), optional :: work
      +
      3981 integer(int32), intent(out), optional :: olwork
      +
      3982 real(real64), intent(out), target, dimension(:), optional :: rwork
      +
      3983 class(errors), intent(inout), optional, target :: err
      +
      3984 end subroutine
      +
      3985
      +
      3986end interface
      3987
      -
      3988end interface
      -
      3989
      -
      3990! ******************************************************************************
      -
      3991! LINALG_EIGEN.F90
      -
      3992! ------------------------------------------------------------------------------
      -
      3993interface
      -
      3994 module subroutine eigen_symm(vecs, a, vals, work, olwork, err)
      -
      3995 logical, intent(in) :: vecs
      -
      3996 real(real64), intent(inout), dimension(:,:) :: a
      -
      3997 real(real64), intent(out), dimension(:) :: vals
      -
      3998 real(real64), intent(out), pointer, optional, dimension(:) :: work
      -
      3999 integer(int32), intent(out), optional :: olwork
      -
      4000 class(errors), intent(inout), optional, target :: err
      -
      4001 end subroutine
      -
      4002
      -
      4003 module subroutine eigen_asymm(a, vals, vecs, work, olwork, err)
      -
      4004 real(real64), intent(inout), dimension(:,:) :: a
      -
      4005 complex(real64), intent(out), dimension(:) :: vals
      -
      4006 complex(real64), intent(out), optional, dimension(:,:) :: vecs
      -
      4007 real(real64), intent(out), pointer, optional, dimension(:) :: work
      -
      4008 integer(int32), intent(out), optional :: olwork
      -
      4009 class(errors), intent(inout), optional, target :: err
      -
      4010 end subroutine
      -
      4011
      -
      4012 module subroutine eigen_gen(a, b, alpha, beta, vecs, work, olwork, err)
      -
      4013 real(real64), intent(inout), dimension(:,:) :: a, b
      -
      4014 complex(real64), intent(out), dimension(:) :: alpha
      -
      4015 real(real64), intent(out), optional, dimension(:) :: beta
      -
      4016 complex(real64), intent(out), optional, dimension(:,:) :: vecs
      -
      4017 real(real64), intent(out), optional, pointer, dimension(:) :: work
      -
      4018 integer(int32), intent(out), optional :: olwork
      -
      4019 class(errors), intent(inout), optional, target :: err
      -
      4020 end subroutine
      -
      4021
      -
      4022 module subroutine eigen_cmplx(a, vals, vecs, work, olwork, rwork, err)
      -
      4023 complex(real64), intent(inout), dimension(:,:) :: a
      -
      4024 complex(real64), intent(out), dimension(:) :: vals
      -
      4025 complex(real64), intent(out), optional, dimension(:,:) :: vecs
      -
      4026 complex(real64), intent(out), target, optional, dimension(:) :: work
      -
      4027 real(real64), intent(out), target, optional, dimension(:) :: rwork
      -
      4028 integer(int32), intent(out), optional :: olwork
      -
      4029 class(errors), intent(inout), optional, target :: err
      -
      4030 end subroutine
      -
      4031end interface
      -
      4032
      -
      4033! ******************************************************************************
      -
      4034! LINALG_SORTING.F90
      -
      4035! ------------------------------------------------------------------------------
      -
      4036interface
      -
      4037 module subroutine sort_dbl_array(x, ascend)
      -
      4038 real(real64), intent(inout), dimension(:) :: x
      -
      4039 logical, intent(in), optional :: ascend
      -
      4040 end subroutine
      -
      4041
      -
      4042 module subroutine sort_dbl_array_ind(x, ind, ascend, err)
      -
      4043 real(real64), intent(inout), dimension(:) :: x
      -
      4044 integer(int32), intent(inout), dimension(:) :: ind
      -
      4045 logical, intent(in), optional :: ascend
      -
      4046 class(errors), intent(inout), optional, target :: err
      -
      4047 end subroutine
      -
      4048
      -
      4049 module subroutine sort_cmplx_array(x, ascend)
      -
      4050 complex(real64), intent(inout), dimension(:) :: x
      -
      4051 logical, intent(in), optional :: ascend
      -
      4052 end subroutine
      -
      4053
      -
      4054 module subroutine sort_cmplx_array_ind(x, ind, ascend, err)
      -
      4055 complex(real64), intent(inout), dimension(:) :: x
      -
      4056 integer(int32), intent(inout), dimension(:) :: ind
      -
      4057 logical, intent(in), optional :: ascend
      -
      4058 class(errors), intent(inout), optional, target :: err
      -
      4059 end subroutine
      -
      4060
      -
      4061 module subroutine sort_eigen_cmplx(vals, vecs, ascend, err)
      -
      4062 complex(real64), intent(inout), dimension(:) :: vals
      -
      4063 complex(real64), intent(inout), dimension(:,:) :: vecs
      -
      4064 logical, intent(in), optional :: ascend
      -
      4065 class(errors), intent(inout), optional, target :: err
      -
      4066 end subroutine
      -
      4067
      -
      4068 module subroutine sort_eigen_dbl(vals, vecs, ascend, err)
      -
      4069 real(real64), intent(inout), dimension(:) :: vals
      -
      4070 real(real64), intent(inout), dimension(:,:) :: vecs
      -
      4071 logical, intent(in), optional :: ascend
      -
      4072 class(errors), intent(inout), optional, target :: err
      -
      4073 end subroutine
      +
      3988! ******************************************************************************
      +
      3989! LINALG_EIGEN.F90
      +
      3990! ------------------------------------------------------------------------------
      +
      3991interface
      +
      3992 module subroutine eigen_symm(vecs, a, vals, work, olwork, err)
      +
      3993 logical, intent(in) :: vecs
      +
      3994 real(real64), intent(inout), dimension(:,:) :: a
      +
      3995 real(real64), intent(out), dimension(:) :: vals
      +
      3996 real(real64), intent(out), pointer, optional, dimension(:) :: work
      +
      3997 integer(int32), intent(out), optional :: olwork
      +
      3998 class(errors), intent(inout), optional, target :: err
      +
      3999 end subroutine
      +
      4000
      +
      4001 module subroutine eigen_asymm(a, vals, vecs, work, olwork, err)
      +
      4002 real(real64), intent(inout), dimension(:,:) :: a
      +
      4003 complex(real64), intent(out), dimension(:) :: vals
      +
      4004 complex(real64), intent(out), optional, dimension(:,:) :: vecs
      +
      4005 real(real64), intent(out), pointer, optional, dimension(:) :: work
      +
      4006 integer(int32), intent(out), optional :: olwork
      +
      4007 class(errors), intent(inout), optional, target :: err
      +
      4008 end subroutine
      +
      4009
      +
      4010 module subroutine eigen_gen(a, b, alpha, beta, vecs, work, olwork, err)
      +
      4011 real(real64), intent(inout), dimension(:,:) :: a, b
      +
      4012 complex(real64), intent(out), dimension(:) :: alpha
      +
      4013 real(real64), intent(out), optional, dimension(:) :: beta
      +
      4014 complex(real64), intent(out), optional, dimension(:,:) :: vecs
      +
      4015 real(real64), intent(out), optional, pointer, dimension(:) :: work
      +
      4016 integer(int32), intent(out), optional :: olwork
      +
      4017 class(errors), intent(inout), optional, target :: err
      +
      4018 end subroutine
      +
      4019
      +
      4020 module subroutine eigen_cmplx(a, vals, vecs, work, olwork, rwork, err)
      +
      4021 complex(real64), intent(inout), dimension(:,:) :: a
      +
      4022 complex(real64), intent(out), dimension(:) :: vals
      +
      4023 complex(real64), intent(out), optional, dimension(:,:) :: vecs
      +
      4024 complex(real64), intent(out), target, optional, dimension(:) :: work
      +
      4025 real(real64), intent(out), target, optional, dimension(:) :: rwork
      +
      4026 integer(int32), intent(out), optional :: olwork
      +
      4027 class(errors), intent(inout), optional, target :: err
      +
      4028 end subroutine
      +
      4029end interface
      +
      4030
      +
      4031! ******************************************************************************
      +
      4032! LINALG_SORTING.F90
      +
      4033! ------------------------------------------------------------------------------
      +
      4034interface
      +
      4035 module subroutine sort_dbl_array(x, ascend)
      +
      4036 real(real64), intent(inout), dimension(:) :: x
      +
      4037 logical, intent(in), optional :: ascend
      +
      4038 end subroutine
      +
      4039
      +
      4040 module subroutine sort_dbl_array_ind(x, ind, ascend, err)
      +
      4041 real(real64), intent(inout), dimension(:) :: x
      +
      4042 integer(int32), intent(inout), dimension(:) :: ind
      +
      4043 logical, intent(in), optional :: ascend
      +
      4044 class(errors), intent(inout), optional, target :: err
      +
      4045 end subroutine
      +
      4046
      +
      4047 module subroutine sort_cmplx_array(x, ascend)
      +
      4048 complex(real64), intent(inout), dimension(:) :: x
      +
      4049 logical, intent(in), optional :: ascend
      +
      4050 end subroutine
      +
      4051
      +
      4052 module subroutine sort_cmplx_array_ind(x, ind, ascend, err)
      +
      4053 complex(real64), intent(inout), dimension(:) :: x
      +
      4054 integer(int32), intent(inout), dimension(:) :: ind
      +
      4055 logical, intent(in), optional :: ascend
      +
      4056 class(errors), intent(inout), optional, target :: err
      +
      4057 end subroutine
      +
      4058
      +
      4059 module subroutine sort_eigen_cmplx(vals, vecs, ascend, err)
      +
      4060 complex(real64), intent(inout), dimension(:) :: vals
      +
      4061 complex(real64), intent(inout), dimension(:,:) :: vecs
      +
      4062 logical, intent(in), optional :: ascend
      +
      4063 class(errors), intent(inout), optional, target :: err
      +
      4064 end subroutine
      +
      4065
      +
      4066 module subroutine sort_eigen_dbl(vals, vecs, ascend, err)
      +
      4067 real(real64), intent(inout), dimension(:) :: vals
      +
      4068 real(real64), intent(inout), dimension(:,:) :: vecs
      +
      4069 logical, intent(in), optional :: ascend
      +
      4070 class(errors), intent(inout), optional, target :: err
      +
      4071 end subroutine
      +
      4072
      +
      4073end interface
      4074
      -
      4075end interface
      -
      4076
      -
      4077end module
      -
      Computes the Cholesky factorization of a symmetric, positive definite matrix.
      Definition: linalg.f90:1433
      -
      Computes the rank 1 downdate to a Cholesky factored matrix (upper triangular).
      Definition: linalg.f90:1639
      -
      Computes the rank 1 update to a Cholesky factored matrix (upper triangular).
      Definition: linalg.f90:1532
      +
      4075end module
      +
      Computes the Cholesky factorization of a symmetric, positive definite matrix.
      Definition: linalg.f90:1432
      +
      Computes the rank 1 downdate to a Cholesky factored matrix (upper triangular).
      Definition: linalg.f90:1638
      +
      Computes the rank 1 update to a Cholesky factored matrix (upper triangular).
      Definition: linalg.f90:1531
      Computes the determinant of a square matrix.
      Definition: linalg.f90:434
      Multiplies a diagonal matrix with another matrix or array.
      Definition: linalg.f90:329
      -
      Computes the eigenvalues, and optionally the eigenvectors, of a matrix.
      Definition: linalg.f90:3098
      +
      Computes the eigenvalues, and optionally the eigenvectors, of a matrix.
      Definition: linalg.f90:3097
      Extracts the L and U matrices from the condensed [L\U] storage format used by the lu_factor.
      Definition: linalg.f90:717
      Forms the full M-by-M orthogonal matrix Q from the elementary reflectors returned by the base QR fact...
      Definition: linalg.f90:1031
      Computes the LU factorization of an M-by-N matrix.
      Definition: linalg.f90:595
      -
      Computes the inverse of a square matrix.
      Definition: linalg.f90:2778
      +
      Computes the inverse of a square matrix.
      Definition: linalg.f90:2777
      Performs the matrix operation: .
      Definition: linalg.f90:159
      -
      Computes the Moore-Penrose pseudo-inverse of a M-by-N matrix using the singular value decomposition o...
      Definition: linalg.f90:2884
      +
      Computes the Moore-Penrose pseudo-inverse of a M-by-N matrix using the singular value decomposition o...
      Definition: linalg.f90:2883
      Computes the rank of a matrix.
      Definition: linalg.f90:401
      -
      Multiplies a general matrix by the orthogonal matrix Q from a QR factorization.
      Definition: linalg.f90:1185
      -
      Multiplies a general matrix by the orthogonal matrix Z from an RZ factorization.
      Definition: linalg.f90:1803
      +
      Multiplies a general matrix by the orthogonal matrix Q from a QR factorization.
      Definition: linalg.f90:1184
      +
      Multiplies a general matrix by the orthogonal matrix Z from an RZ factorization.
      Definition: linalg.f90:1802
      Computes the QR factorization of an M-by-N matrix.
      Definition: linalg.f90:871
      -
      Computes the rank 1 update to an M-by-N QR factored matrix A (M >= N) where , and such that .
      Definition: linalg.f90:1334
      +
      Computes the rank 1 update to an M-by-N QR factored matrix A (M >= N) where , and such that .
      Definition: linalg.f90:1333
      Performs the rank-1 update to matrix A such that: , where is an M-by-N matrix, is a scalar,...
      Definition: linalg.f90:194
      Multiplies a vector by the reciprocal of a real scalar.
      Definition: linalg.f90:475
      -
      Factors an upper trapezoidal matrix by means of orthogonal transformations such that ....
      Definition: linalg.f90:1712
      -
      Solves a system of Cholesky factored equations.
      Definition: linalg.f90:2390
      -
      Solves the overdetermined or underdetermined system of M equations of N unknowns,...
      Definition: linalg.f90:2581
      -
      Solves the overdetermined or underdetermined system of M equations of N unknowns using a singular va...
      Definition: linalg.f90:2683
      -
      Solves the overdetermined or underdetermined system of M equations of N unknowns....
      Definition: linalg.f90:2480
      -
      Solves a system of LU-factored equations.
      Definition: linalg.f90:2149
      -
      Solves a system of M QR-factored equations of N unknowns.
      Definition: linalg.f90:2284
      -
      Solves a triangular system of equations.
      Definition: linalg.f90:2061
      -
      Sorts an array.
      Definition: linalg.f90:3181
      -
      Computes the singular value decomposition of a matrix A. The SVD is defined as: , where is an M-by-M...
      Definition: linalg.f90:1927
      +
      Factors an upper trapezoidal matrix by means of orthogonal transformations such that ....
      Definition: linalg.f90:1711
      +
      Solves a system of Cholesky factored equations.
      Definition: linalg.f90:2389
      +
      Solves the overdetermined or underdetermined system of M equations of N unknowns,...
      Definition: linalg.f90:2580
      +
      Solves the overdetermined or underdetermined system of M equations of N unknowns using a singular va...
      Definition: linalg.f90:2682
      +
      Solves the overdetermined or underdetermined system of M equations of N unknowns....
      Definition: linalg.f90:2479
      +
      Solves a system of LU-factored equations.
      Definition: linalg.f90:2148
      +
      Solves a system of M QR-factored equations of N unknowns.
      Definition: linalg.f90:2283
      +
      Solves a triangular system of equations.
      Definition: linalg.f90:2060
      +
      Sorts an array.
      Definition: linalg.f90:3180
      +
      Computes the singular value decomposition of a matrix A. The SVD is defined as: , where is an M-by-M...
      Definition: linalg.f90:1926
      Swaps the contents of two arrays.
      Definition: linalg.f90:456
      Computes the trace of a matrix (the sum of the main diagonal elements).
      Definition: linalg.f90:353
      Computes the triangular matrix operation: , or , where A is a triangular matrix.
      Definition: linalg.f90:509
      diff --git a/doc/html/linalg__basic_8f90_source.html b/doc/html/linalg__basic_8f90_source.html index 710e7651..c502fe6c 100644 --- a/doc/html/linalg__basic_8f90_source.html +++ b/doc/html/linalg__basic_8f90_source.html @@ -165,7 +165,7 @@
      63 end if
      64 if (flag /= 0) then
      65 ! ERROR: Matrix dimensions mismatch
      -
      66 write(errmsg, '(AI0A)') &
      +
      66 write(errmsg, 100) &
      67 "Matrix dimension mismatch. Input number ", flag, &
      68 " was not sized correctly."
      69 call errmgr%report_error("mtx_mult_mtx", errmsg, &
      @@ -175,2112 +175,2151 @@
      73
      74 ! Call DGEMM
      75 call dgemm(ta, tb, m, n, k, alpha, a, lda, b, ldb, beta, c, m)
      -
      76 end subroutine
      -
      77
      -
      78! ------------------------------------------------------------------------------
      -
      79 module subroutine mtx_mult_vec(trans, alpha, a, b, beta, c, err)
      -
      80 ! Arguments
      -
      81 logical, intent(in) :: trans
      -
      82 real(real64), intent(in) :: alpha, beta
      -
      83 real(real64), intent(in), dimension(:,:) :: a
      -
      84 real(real64), intent(in), dimension(:) :: b
      -
      85 real(real64), intent(inout), dimension(:) :: c
      -
      86 class(errors), intent(inout), optional, target :: err
      -
      87
      -
      88 ! Local Variables
      -
      89 character :: t
      -
      90 integer(int32) :: m, n, flag
      -
      91 class(errors), pointer :: errmgr
      -
      92 type(errors), target :: deferr
      -
      93 character(len = 128) :: errmsg
      -
      94
      -
      95 ! Initialization
      -
      96 m = size(a, 1)
      -
      97 n = size(a, 2)
      -
      98 t = 'N'
      -
      99 if (trans) t = 'T'
      -
      100 if (present(err)) then
      -
      101 errmgr => err
      -
      102 else
      -
      103 errmgr => deferr
      -
      104 end if
      -
      105
      -
      106 ! Input Check
      -
      107 flag = 0
      -
      108 if (trans) then
      -
      109 if (size(b) /= m) then
      -
      110 flag = 4
      -
      111 else if (size(c) /= n) then
      -
      112 flag = 6
      -
      113 end if
      -
      114 else
      -
      115 if (size(b) /= n) then
      -
      116 flag = 4
      -
      117 else if (size(c) /= m) then
      -
      118 flag = 6
      -
      119 end if
      -
      120 end if
      -
      121 if (flag /= 0) then
      -
      122 ! ERROR: Matrix dimensions mismatch
      -
      123 write(errmsg, '(AI0A)') &
      -
      124 "Matrix dimension mismatch. Input number ", flag, &
      -
      125 " was not sized correctly."
      -
      126 call errmgr%report_error("mtx_mult_vec", errmsg, &
      -
      127 la_array_size_error)
      -
      128 return
      -
      129 end if
      -
      130
      -
      131 ! Call DGEMV
      -
      132 call dgemv(t, m, n, alpha, a, m, b, 1, beta, c, 1)
      -
      133 end subroutine
      -
      134
      -
      135! xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx !
      -
      136! COMPLEX VALUED VERSIONS !
      -
      137! xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx !
      -
      138 module subroutine cmtx_mult_mtx(opa, opb, alpha, a, b, beta, c, err)
      -
      139 ! Arguments
      -
      140 integer(int32), intent(in) :: opa, opb
      -
      141 complex(real64), intent(in) :: alpha, beta
      -
      142 complex(real64), intent(in), dimension(:,:) :: a, b
      -
      143 complex(real64), intent(inout), dimension(:,:) :: c
      -
      144 class(errors), intent(inout), optional, target :: err
      -
      145
      -
      146 ! Parameters
      -
      147 real(real64), parameter :: zero = 0.0d0
      -
      148 real(real64), parameter :: one = 1.0d0
      -
      149
      -
      150 ! Local Variables
      -
      151 character :: ta, tb
      -
      152 integer(int32) :: m, n, k, lda, ldb, flag
      -
      153 class(errors), pointer :: errmgr
      -
      154 type(errors), target :: deferr
      -
      155 character(len = 128) :: errmsg
      -
      156
      -
      157 ! Initialization
      -
      158 m = size(c, 1)
      -
      159 n = size(c, 2)
      -
      160 if (opa == la_transpose) then ! K = # of columns in op(A) (# of rows in op(B))
      -
      161 k = size(a, 1)
      -
      162 ta = 'T'
      -
      163 lda = k
      -
      164 else if (opa == la_hermitian_transpose) then
      -
      165 k = size(a, 1)
      -
      166 ta = 'H'
      -
      167 lda = k
      -
      168 else
      -
      169 k = size(a, 2)
      -
      170 ta = 'N'
      -
      171 lda = m
      -
      172 end if
      -
      173 if (opb == la_transpose) then
      -
      174 tb = 'T'
      -
      175 ldb = n
      -
      176 else if (opb == la_hermitian_transpose) then
      -
      177 tb = 'H'
      -
      178 ldb = n
      -
      179 else
      -
      180 tb = 'N'
      -
      181 ldb = k
      -
      182 end if
      -
      183 if (present(err)) then
      -
      184 errmgr => err
      +
      76
      +
      77 ! Formatting
      +
      78100 format(a, i0, a)
      +
      79 end subroutine
      +
      80
      +
      81! ------------------------------------------------------------------------------
      +
      82 module subroutine mtx_mult_vec(trans, alpha, a, b, beta, c, err)
      +
      83 ! Arguments
      +
      84 logical, intent(in) :: trans
      +
      85 real(real64), intent(in) :: alpha, beta
      +
      86 real(real64), intent(in), dimension(:,:) :: a
      +
      87 real(real64), intent(in), dimension(:) :: b
      +
      88 real(real64), intent(inout), dimension(:) :: c
      +
      89 class(errors), intent(inout), optional, target :: err
      +
      90
      +
      91 ! Local Variables
      +
      92 character :: t
      +
      93 integer(int32) :: m, n, flag
      +
      94 class(errors), pointer :: errmgr
      +
      95 type(errors), target :: deferr
      +
      96 character(len = 128) :: errmsg
      +
      97
      +
      98 ! Initialization
      +
      99 m = size(a, 1)
      +
      100 n = size(a, 2)
      +
      101 t = 'N'
      +
      102 if (trans) t = 'T'
      +
      103 if (present(err)) then
      +
      104 errmgr => err
      +
      105 else
      +
      106 errmgr => deferr
      +
      107 end if
      +
      108
      +
      109 ! Input Check
      +
      110 flag = 0
      +
      111 if (trans) then
      +
      112 if (size(b) /= m) then
      +
      113 flag = 4
      +
      114 else if (size(c) /= n) then
      +
      115 flag = 6
      +
      116 end if
      +
      117 else
      +
      118 if (size(b) /= n) then
      +
      119 flag = 4
      +
      120 else if (size(c) /= m) then
      +
      121 flag = 6
      +
      122 end if
      +
      123 end if
      +
      124 if (flag /= 0) then
      +
      125 ! ERROR: Matrix dimensions mismatch
      +
      126 write(errmsg, 100) &
      +
      127 "Matrix dimension mismatch. Input number ", flag, &
      +
      128 " was not sized correctly."
      +
      129 call errmgr%report_error("mtx_mult_vec", errmsg, &
      +
      130 la_array_size_error)
      +
      131 return
      +
      132 end if
      +
      133
      +
      134 ! Call DGEMV
      +
      135 call dgemv(t, m, n, alpha, a, m, b, 1, beta, c, 1)
      +
      136
      +
      137 ! Formatting
      +
      138100 format(a, i0, a)
      +
      139 end subroutine
      +
      140
      +
      141! xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx !
      +
      142! COMPLEX VALUED VERSIONS !
      +
      143! xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx !
      +
      144 module subroutine cmtx_mult_mtx(opa, opb, alpha, a, b, beta, c, err)
      +
      145 ! Arguments
      +
      146 integer(int32), intent(in) :: opa, opb
      +
      147 complex(real64), intent(in) :: alpha, beta
      +
      148 complex(real64), intent(in), dimension(:,:) :: a, b
      +
      149 complex(real64), intent(inout), dimension(:,:) :: c
      +
      150 class(errors), intent(inout), optional, target :: err
      +
      151
      +
      152 ! Parameters
      +
      153 real(real64), parameter :: zero = 0.0d0
      +
      154 real(real64), parameter :: one = 1.0d0
      +
      155
      +
      156 ! Local Variables
      +
      157 character :: ta, tb
      +
      158 integer(int32) :: m, n, k, lda, ldb, flag
      +
      159 class(errors), pointer :: errmgr
      +
      160 type(errors), target :: deferr
      +
      161 character(len = 128) :: errmsg
      +
      162
      +
      163 ! Initialization
      +
      164 m = size(c, 1)
      +
      165 n = size(c, 2)
      +
      166 if (opa == la_transpose) then ! K = # of columns in op(A) (# of rows in op(B))
      +
      167 k = size(a, 1)
      +
      168 ta = 'T'
      +
      169 lda = k
      +
      170 else if (opa == la_hermitian_transpose) then
      +
      171 k = size(a, 1)
      +
      172 ta = 'H'
      +
      173 lda = k
      +
      174 else
      +
      175 k = size(a, 2)
      +
      176 ta = 'N'
      +
      177 lda = m
      +
      178 end if
      +
      179 if (opb == la_transpose) then
      +
      180 tb = 'T'
      +
      181 ldb = n
      +
      182 else if (opb == la_hermitian_transpose) then
      +
      183 tb = 'H'
      +
      184 ldb = n
      185 else
      -
      186 errmgr => deferr
      -
      187 end if
      -
      188
      -
      189 ! Input Check
      -
      190 flag = 0
      -
      191 if (opa == la_transpose .or. opa == la_hermitian_transpose) then
      -
      192 if (size(a, 2) /= m) flag = 4
      -
      193 else
      -
      194 if (size(a, 1) /= m) flag = 4
      -
      195 end if
      -
      196 if (opb == la_transpose .or. opb == la_hermitian_transpose) then
      -
      197 if (size(b, 2) /= k .or. size(b, 1) /= n) flag = 5
      -
      198 else
      -
      199 if (size(b, 1) /= k .or. size(b, 2) /= n) flag = 5
      -
      200 end if
      -
      201 if (flag /= 0) then
      -
      202 ! ERROR: Matrix dimensions mismatch
      -
      203 write(errmsg, '(AI0A)') &
      -
      204 "Matrix dimension mismatch. Input number ", flag, &
      -
      205 " was not sized correctly."
      -
      206 call errmgr%report_error("cmtx_mult_mtx", errmsg, &
      -
      207 la_array_size_error)
      -
      208 return
      -
      209 end if
      -
      210
      -
      211 ! Call ZGEMM
      -
      212 call zgemm(ta, tb, m, n, k, alpha, a, lda, b, ldb, beta, c, m)
      -
      213 end subroutine
      -
      214
      -
      215! ------------------------------------------------------------------------------
      -
      216 module subroutine cmtx_mult_vec(opa, alpha, a, b, beta, c, err)
      -
      217 ! Arguments
      -
      218 integer(int32), intent(in) :: opa
      -
      219 complex(real64), intent(in) :: alpha, beta
      -
      220 complex(real64), intent(in), dimension(:,:) :: a
      -
      221 complex(real64), intent(in), dimension(:) :: b
      -
      222 complex(real64), intent(inout), dimension(:) :: c
      -
      223 class(errors), intent(inout), optional, target :: err
      -
      224
      -
      225 ! Local Variables
      -
      226 character :: t
      -
      227 integer(int32) :: m, n, flag
      -
      228 class(errors), pointer :: errmgr
      -
      229 type(errors), target :: deferr
      -
      230 character(len = 128) :: errmsg
      -
      231
      -
      232 ! Initialization
      -
      233 m = size(a, 1)
      -
      234 n = size(a, 2)
      -
      235 if (opa == la_transpose) then
      -
      236 t = 'T'
      -
      237 else if (opa == la_hermitian_transpose) then
      -
      238 t = 'H'
      -
      239 else
      -
      240 t = 'N'
      -
      241 end if
      -
      242 if (present(err)) then
      -
      243 errmgr => err
      -
      244 else
      -
      245 errmgr => deferr
      -
      246 end if
      -
      247
      -
      248 ! Input Check
      -
      249 flag = 0
      -
      250 if (opa == la_transpose .or. opa == la_hermitian_transpose) then
      -
      251 if (size(b) /= m) then
      -
      252 flag = 4
      -
      253 else if (size(c) /= n) then
      -
      254 flag = 6
      -
      255 end if
      -
      256 else
      -
      257 if (size(b) /= n) then
      -
      258 flag = 4
      -
      259 else if (size(c) /= m) then
      -
      260 flag = 6
      -
      261 end if
      -
      262 end if
      -
      263 if (flag /= 0) then
      -
      264 ! ERROR: Matrix dimensions mismatch
      -
      265 write(errmsg, '(AI0A)') &
      -
      266 "Matrix dimension mismatch. Input number ", flag, &
      -
      267 " was not sized correctly."
      -
      268 call errmgr%report_error("cmtx_mult_vec", errmsg, &
      -
      269 la_array_size_error)
      -
      270 return
      +
      186 tb = 'N'
      +
      187 ldb = k
      +
      188 end if
      +
      189 if (present(err)) then
      +
      190 errmgr => err
      +
      191 else
      +
      192 errmgr => deferr
      +
      193 end if
      +
      194
      +
      195 ! Input Check
      +
      196 flag = 0
      +
      197 if (opa == la_transpose .or. opa == la_hermitian_transpose) then
      +
      198 if (size(a, 2) /= m) flag = 4
      +
      199 else
      +
      200 if (size(a, 1) /= m) flag = 4
      +
      201 end if
      +
      202 if (opb == la_transpose .or. opb == la_hermitian_transpose) then
      +
      203 if (size(b, 2) /= k .or. size(b, 1) /= n) flag = 5
      +
      204 else
      +
      205 if (size(b, 1) /= k .or. size(b, 2) /= n) flag = 5
      +
      206 end if
      +
      207 if (flag /= 0) then
      +
      208 ! ERROR: Matrix dimensions mismatch
      +
      209 write(errmsg, 100) &
      +
      210 "Matrix dimension mismatch. Input number ", flag, &
      +
      211 " was not sized correctly."
      +
      212 call errmgr%report_error("cmtx_mult_mtx", errmsg, &
      +
      213 la_array_size_error)
      +
      214 return
      +
      215 end if
      +
      216
      +
      217 ! Call ZGEMM
      +
      218 call zgemm(ta, tb, m, n, k, alpha, a, lda, b, ldb, beta, c, m)
      +
      219
      +
      220 ! Formatting
      +
      221100 format(a, i0, a)
      +
      222 end subroutine
      +
      223
      +
      224! ------------------------------------------------------------------------------
      +
      225 module subroutine cmtx_mult_vec(opa, alpha, a, b, beta, c, err)
      +
      226 ! Arguments
      +
      227 integer(int32), intent(in) :: opa
      +
      228 complex(real64), intent(in) :: alpha, beta
      +
      229 complex(real64), intent(in), dimension(:,:) :: a
      +
      230 complex(real64), intent(in), dimension(:) :: b
      +
      231 complex(real64), intent(inout), dimension(:) :: c
      +
      232 class(errors), intent(inout), optional, target :: err
      +
      233
      +
      234 ! Local Variables
      +
      235 character :: t
      +
      236 integer(int32) :: m, n, flag
      +
      237 class(errors), pointer :: errmgr
      +
      238 type(errors), target :: deferr
      +
      239 character(len = 128) :: errmsg
      +
      240
      +
      241 ! Initialization
      +
      242 m = size(a, 1)
      +
      243 n = size(a, 2)
      +
      244 if (opa == la_transpose) then
      +
      245 t = 'T'
      +
      246 else if (opa == la_hermitian_transpose) then
      +
      247 t = 'H'
      +
      248 else
      +
      249 t = 'N'
      +
      250 end if
      +
      251 if (present(err)) then
      +
      252 errmgr => err
      +
      253 else
      +
      254 errmgr => deferr
      +
      255 end if
      +
      256
      +
      257 ! Input Check
      +
      258 flag = 0
      +
      259 if (opa == la_transpose .or. opa == la_hermitian_transpose) then
      +
      260 if (size(b) /= m) then
      +
      261 flag = 4
      +
      262 else if (size(c) /= n) then
      +
      263 flag = 6
      +
      264 end if
      +
      265 else
      +
      266 if (size(b) /= n) then
      +
      267 flag = 4
      +
      268 else if (size(c) /= m) then
      +
      269 flag = 6
      +
      270 end if
      271 end if
      -
      272
      -
      273 ! Call ZGEMV
      -
      274 call zgemv(t, m, n, alpha, a, m, b, 1, beta, c, 1)
      -
      275 end subroutine
      -
      276
      -
      277! ******************************************************************************
      -
      278! RANK 1 UPDATE
      -
      279! ------------------------------------------------------------------------------
      -
      280 module subroutine rank1_update_dbl(alpha, x, y, a, err)
      -
      281 ! Arguments
      -
      282 real(real64), intent(in) :: alpha
      -
      283 real(real64), intent(in), dimension(:) :: x, y
      -
      284 real(real64), intent(inout), dimension(:,:) :: a
      -
      285 class(errors), intent(inout), optional, target :: err
      -
      286
      -
      287 ! Parameters
      -
      288 real(real64), parameter :: zero = 0.0d0
      -
      289
      -
      290 ! Local Variables
      -
      291 integer(int32) :: j, m, n
      -
      292 real(real64) :: temp
      -
      293 class(errors), pointer :: errmgr
      -
      294 type(errors), target :: deferr
      -
      295
      -
      296 ! Initialization
      -
      297 m = size(x)
      -
      298 n = size(y)
      -
      299 if (present(err)) then
      -
      300 errmgr => err
      -
      301 else
      -
      302 errmgr => deferr
      -
      303 end if
      -
      304
      -
      305 ! Input Check
      -
      306 if (size(a, 1) /= m .or. size(a, 2) /= n) then
      -
      307 ! ERROR: Matrix dimension array
      -
      308 call errmgr%report_error("rank1_update_dbl", &
      -
      309 "Matrix dimension mismatch.", la_array_size_error)
      -
      310 return
      -
      311 end if
      -
      312
      -
      313 ! Process
      -
      314 do j = 1, n
      -
      315 if (y(j) /= zero) then
      -
      316 temp = alpha * y(j)
      -
      317 a(:,j) = a(:,j) + temp * x
      -
      318 end if
      -
      319 end do
      -
      320 end subroutine
      -
      321
      -
      322! xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx !
      -
      323! COMPLEX VALUED VERSIONS !
      -
      324! xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx !
      -
      325 module subroutine rank1_update_cmplx(alpha, x, y, a, err)
      -
      326 ! Arguments
      -
      327 complex(real64), intent(in) :: alpha
      -
      328 complex(real64), intent(in), dimension(:) :: x, y
      -
      329 complex(real64), intent(inout), dimension(:,:) :: a
      -
      330 class(errors), intent(inout), optional, target :: err
      -
      331
      -
      332 ! Parameters
      -
      333 complex(real64), parameter :: zero = (0.0d0, 0.0d0)
      -
      334
      -
      335 ! Local Variables
      -
      336 integer(int32) :: j, m, n
      -
      337 complex(real64) :: temp
      -
      338 class(errors), pointer :: errmgr
      -
      339 type(errors), target :: deferr
      -
      340
      -
      341 ! Initialization
      -
      342 m = size(x)
      -
      343 n = size(y)
      -
      344 if (present(err)) then
      -
      345 errmgr => err
      -
      346 else
      -
      347 errmgr => deferr
      -
      348 end if
      -
      349
      -
      350 ! Input Check
      -
      351 if (size(a, 1) /= m .or. size(a, 2) /= n) then
      -
      352 ! ERROR: Matrix dimension array
      -
      353 call errmgr%report_error("rank1_update_cmplx", &
      -
      354 "Matrix dimension mismatch.", la_array_size_error)
      -
      355 return
      -
      356 end if
      -
      357
      -
      358 ! Process
      -
      359 do j = 1, n
      -
      360 if (y(j) /= zero) then
      -
      361 temp = alpha * conjg(y(j))
      -
      362 a(:,j) = a(:,j) + temp * x
      -
      363 end if
      -
      364 end do
      -
      365 end subroutine
      -
      366
      -
      367! ******************************************************************************
      -
      368! DIAGONAL MATRIX MULTIPLICATION ROUTINES
      -
      369! ------------------------------------------------------------------------------
      -
      370 module subroutine diag_mtx_mult_mtx(lside, trans, alpha, a, b, beta, c, err)
      -
      371 ! Arguments
      -
      372 logical, intent(in) :: lside, trans
      -
      373 real(real64) :: alpha, beta
      -
      374 real(real64), intent(in), dimension(:) :: a
      -
      375 real(real64), intent(in), dimension(:,:) :: b
      -
      376 real(real64), intent(inout), dimension(:,:) :: c
      -
      377 class(errors), intent(inout), optional, target :: err
      +
      272 if (flag /= 0) then
      +
      273 ! ERROR: Matrix dimensions mismatch
      +
      274 write(errmsg, 100) &
      +
      275 "Matrix dimension mismatch. Input number ", flag, &
      +
      276 " was not sized correctly."
      +
      277 call errmgr%report_error("cmtx_mult_vec", errmsg, &
      +
      278 la_array_size_error)
      +
      279 return
      +
      280 end if
      +
      281
      +
      282 ! Call ZGEMV
      +
      283 call zgemv(t, m, n, alpha, a, m, b, 1, beta, c, 1)
      +
      284
      +
      285 ! Formatting
      +
      286100 format(a, i0, a)
      +
      287 end subroutine
      +
      288
      +
      289! ******************************************************************************
      +
      290! RANK 1 UPDATE
      +
      291! ------------------------------------------------------------------------------
      +
      292 module subroutine rank1_update_dbl(alpha, x, y, a, err)
      +
      293 ! Arguments
      +
      294 real(real64), intent(in) :: alpha
      +
      295 real(real64), intent(in), dimension(:) :: x, y
      +
      296 real(real64), intent(inout), dimension(:,:) :: a
      +
      297 class(errors), intent(inout), optional, target :: err
      +
      298
      +
      299 ! Parameters
      +
      300 real(real64), parameter :: zero = 0.0d0
      +
      301
      +
      302 ! Local Variables
      +
      303 integer(int32) :: j, m, n
      +
      304 real(real64) :: temp
      +
      305 class(errors), pointer :: errmgr
      +
      306 type(errors), target :: deferr
      +
      307
      +
      308 ! Initialization
      +
      309 m = size(x)
      +
      310 n = size(y)
      +
      311 if (present(err)) then
      +
      312 errmgr => err
      +
      313 else
      +
      314 errmgr => deferr
      +
      315 end if
      +
      316
      +
      317 ! Input Check
      +
      318 if (size(a, 1) /= m .or. size(a, 2) /= n) then
      +
      319 ! ERROR: Matrix dimension array
      +
      320 call errmgr%report_error("rank1_update_dbl", &
      +
      321 "Matrix dimension mismatch.", la_array_size_error)
      +
      322 return
      +
      323 end if
      +
      324
      +
      325 ! Process
      +
      326 do j = 1, n
      +
      327 if (y(j) /= zero) then
      +
      328 temp = alpha * y(j)
      +
      329 a(:,j) = a(:,j) + temp * x
      +
      330 end if
      +
      331 end do
      +
      332 end subroutine
      +
      333
      +
      334! xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx !
      +
      335! COMPLEX VALUED VERSIONS !
      +
      336! xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx !
      +
      337 module subroutine rank1_update_cmplx(alpha, x, y, a, err)
      +
      338 ! Arguments
      +
      339 complex(real64), intent(in) :: alpha
      +
      340 complex(real64), intent(in), dimension(:) :: x, y
      +
      341 complex(real64), intent(inout), dimension(:,:) :: a
      +
      342 class(errors), intent(inout), optional, target :: err
      +
      343
      +
      344 ! Parameters
      +
      345 complex(real64), parameter :: zero = (0.0d0, 0.0d0)
      +
      346
      +
      347 ! Local Variables
      +
      348 integer(int32) :: j, m, n
      +
      349 complex(real64) :: temp
      +
      350 class(errors), pointer :: errmgr
      +
      351 type(errors), target :: deferr
      +
      352
      +
      353 ! Initialization
      +
      354 m = size(x)
      +
      355 n = size(y)
      +
      356 if (present(err)) then
      +
      357 errmgr => err
      +
      358 else
      +
      359 errmgr => deferr
      +
      360 end if
      +
      361
      +
      362 ! Input Check
      +
      363 if (size(a, 1) /= m .or. size(a, 2) /= n) then
      +
      364 ! ERROR: Matrix dimension array
      +
      365 call errmgr%report_error("rank1_update_cmplx", &
      +
      366 "Matrix dimension mismatch.", la_array_size_error)
      +
      367 return
      +
      368 end if
      +
      369
      +
      370 ! Process
      +
      371 do j = 1, n
      +
      372 if (y(j) /= zero) then
      +
      373 temp = alpha * conjg(y(j))
      +
      374 a(:,j) = a(:,j) + temp * x
      +
      375 end if
      +
      376 end do
      +
      377 end subroutine
      378
      -
      379 ! Parameters
      -
      380 real(real64), parameter :: zero = 0.0d0
      -
      381 real(real64), parameter :: one = 1.0d0
      -
      382
      -
      383 ! Local Variables
      -
      384 integer(int32) :: i, m, n, k, nrowb, ncolb, flag
      -
      385 real(real64) :: temp
      -
      386 class(errors), pointer :: errmgr
      -
      387 type(errors), target :: deferr
      -
      388 character(len = 128) :: errmsg
      -
      389
      -
      390 ! Initialization
      -
      391 m = size(c, 1)
      -
      392 n = size(c, 2)
      -
      393 k = size(a)
      -
      394 nrowb = size(b, 1)
      -
      395 ncolb = size(b, 2)
      -
      396 if (present(err)) then
      -
      397 errmgr => err
      -
      398 else
      -
      399 errmgr => deferr
      -
      400 end if
      +
      379! ******************************************************************************
      +
      380! DIAGONAL MATRIX MULTIPLICATION ROUTINES
      +
      381! ------------------------------------------------------------------------------
      +
      382 module subroutine diag_mtx_mult_mtx(lside, trans, alpha, a, b, beta, c, err)
      +
      383 ! Arguments
      +
      384 logical, intent(in) :: lside, trans
      +
      385 real(real64) :: alpha, beta
      +
      386 real(real64), intent(in), dimension(:) :: a
      +
      387 real(real64), intent(in), dimension(:,:) :: b
      +
      388 real(real64), intent(inout), dimension(:,:) :: c
      +
      389 class(errors), intent(inout), optional, target :: err
      +
      390
      +
      391 ! Parameters
      +
      392 real(real64), parameter :: zero = 0.0d0
      +
      393 real(real64), parameter :: one = 1.0d0
      +
      394
      +
      395 ! Local Variables
      +
      396 integer(int32) :: i, m, n, k, nrowb, ncolb, flag
      +
      397 real(real64) :: temp
      +
      398 class(errors), pointer :: errmgr
      +
      399 type(errors), target :: deferr
      +
      400 character(len = 128) :: errmsg
      401
      -
      402 ! Input Check
      -
      403 flag = 0
      -
      404 if (lside) then
      -
      405 if (k > m) then
      -
      406 flag = 4
      -
      407 else
      -
      408 if (trans) then
      -
      409 ! Compute C = alpha * A * B**T + beta * C
      -
      410 if (nrowb /= n .or. ncolb < k) flag = 5
      -
      411 else
      -
      412 ! Compute C = alpha * A * B + beta * C
      -
      413 if (nrowb < k .or. ncolb /= n) flag = 5
      -
      414 end if
      -
      415 end if
      -
      416 else
      -
      417 if (k > n) then
      +
      402 ! Initialization
      +
      403 m = size(c, 1)
      +
      404 n = size(c, 2)
      +
      405 k = size(a)
      +
      406 nrowb = size(b, 1)
      +
      407 ncolb = size(b, 2)
      +
      408 if (present(err)) then
      +
      409 errmgr => err
      +
      410 else
      +
      411 errmgr => deferr
      +
      412 end if
      +
      413
      +
      414 ! Input Check
      +
      415 flag = 0
      +
      416 if (lside) then
      +
      417 if (k > m) then
      418 flag = 4
      419 else
      420 if (trans) then
      -
      421 ! Compute C = alpha * B**T * A + beta * C
      -
      422 if (ncolb /= m .or. nrowb < k) flag = 5
      +
      421 ! Compute C = alpha * A * B**T + beta * C
      +
      422 if (nrowb /= n .or. ncolb < k) flag = 5
      423 else
      -
      424 ! Compute C = alpha * B * A + beta * C
      -
      425 if (nrowb /= m .or. ncolb < k) flag = 5
      +
      424 ! Compute C = alpha * A * B + beta * C
      +
      425 if (nrowb < k .or. ncolb /= n) flag = 5
      426 end if
      427 end if
      -
      428 end if
      -
      429 if (flag /= 0) then
      -
      430 ! ERROR: One of the input arrays is not sized correctly
      -
      431 write(errmsg, '(AI0A)') "Input number ", flag, &
      -
      432 " is not sized correctly."
      -
      433 call errmgr%report_error("diag_mtx_mult_mtx", trim(errmsg), &
      -
      434 la_array_size_error)
      -
      435 return
      -
      436 end if
      -
      437
      -
      438 ! Deal with ALPHA == 0
      -
      439 if (alpha == 0) then
      -
      440 if (beta == zero) then
      -
      441 c = zero
      -
      442 else if (beta /= one) then
      -
      443 c = beta * c
      -
      444 end if
      -
      445 return
      -
      446 end if
      -
      447
      -
      448 ! Process
      -
      449 if (lside) then
      -
      450 if (trans) then
      -
      451 ! Compute C = alpha * A * B**T + beta * C
      -
      452 do i = 1, k
      -
      453 if (beta == zero) then
      -
      454 c(i,:) = zero
      -
      455 else if (beta /= one) then
      -
      456 c(i,:) = beta * c(i,:)
      -
      457 end if
      -
      458 temp = alpha * a(i)
      -
      459 if (temp /= one) c(i,:) = c(i,:) + temp * b(:,i)
      -
      460 end do
      -
      461 else
      -
      462 ! Compute C = alpha * A * B + beta * C
      -
      463 do i = 1, k
      -
      464 if (beta == zero) then
      -
      465 c(i,:) = zero
      -
      466 else if (beta /= one) then
      -
      467 c(i,:) = beta * c(i,:)
      -
      468 end if
      -
      469 temp = alpha * a(i)
      -
      470 if (temp /= one) c(i,:) = c(i,:) + temp * b(i,:)
      -
      471 end do
      -
      472 end if
      -
      473
      -
      474 ! Handle extra rows
      -
      475 if (m > k) then
      -
      476 if (beta == zero) then
      -
      477 c(k+1:m,:) = zero
      -
      478 else
      -
      479 c(k+1:m,:) = beta * c(k+1:m,:)
      -
      480 end if
      -
      481 end if
      -
      482 else
      -
      483 if (trans) then
      -
      484 ! Compute C = alpha * B**T * A + beta * C
      -
      485 do i = 1, k
      -
      486 if (beta == zero) then
      -
      487 c(:,i) = zero
      -
      488 else if (beta /= one) then
      -
      489 c(:,i) = beta * c(:,i)
      -
      490 end if
      -
      491 temp = alpha * a(i)
      -
      492 if (temp /= one) c(:,i) = c(:,i) + temp * b(i,:)
      -
      493 end do
      -
      494 else
      -
      495 ! Compute C = alpha * B * A + beta * C
      -
      496 do i = 1, k
      -
      497 if (beta == zero) then
      -
      498 c(:,i) = zero
      -
      499 else if (beta /= one) then
      -
      500 c(:,i) = beta * c(:,i)
      -
      501 end if
      -
      502 temp = alpha * a(i)
      -
      503 if (temp /= one) c(:,i) = c(:,i) + temp * b(:,i)
      -
      504 end do
      -
      505 end if
      -
      506
      -
      507 ! Handle extra columns
      -
      508 if (n > k) then
      -
      509 if (beta == zero) then
      -
      510 c(:,k+1:m) = zero
      -
      511 else if (beta /= one) then
      -
      512 c(:,k+1:m) = beta * c(:,k+1:m)
      -
      513 end if
      -
      514 end if
      -
      515 end if
      -
      516 end subroutine
      -
      517
      -
      518! ------------------------------------------------------------------------------
      -
      519 module subroutine diag_mtx_mult_mtx2(lside, alpha, a, b, err)
      -
      520 ! Arguments
      -
      521 logical, intent(in) :: lside
      -
      522 real(real64), intent(in) :: alpha
      -
      523 real(real64), intent(in), dimension(:) :: a
      -
      524 real(real64), intent(inout), dimension(:,:) :: b
      -
      525 class(errors), intent(inout), optional, target :: err
      -
      526
      -
      527 ! Parameters
      -
      528 real(real64), parameter :: zero = 0.0d0
      -
      529 real(real64), parameter :: one = 1.0d0
      -
      530
      -
      531 ! Local Variables
      -
      532 integer(int32) :: i, m, n, k
      -
      533 real(real64) :: temp
      -
      534 class(errors), pointer :: errmgr
      -
      535 type(errors), target :: deferr
      -
      536
      -
      537 ! Initialization
      -
      538 m = size(b, 1)
      -
      539 n = size(b, 2)
      -
      540 k = size(a)
      -
      541 if (present(err)) then
      -
      542 errmgr => err
      -
      543 else
      -
      544 errmgr => deferr
      -
      545 end if
      -
      546
      -
      547 ! Input Check
      -
      548 if ((lside .and. k > m) .or. (.not.lside .and. k > n)) then
      -
      549 ! ERROR: One of the input arrays is not sized correctly
      -
      550 call errmgr%report_error("diag_mtx_mult_mtx2", &
      -
      551 "Input number 3 is not sized correctly.", &
      -
      552 la_array_size_error)
      -
      553 return
      -
      554 end if
      -
      555
      -
      556 ! Process
      -
      557 if (lside) then
      -
      558 ! Compute B = alpha * A * B
      -
      559 do i = 1, k
      -
      560 temp = alpha * a(i)
      -
      561 if (temp /= one) b(i,:) = temp * b(i,:)
      -
      562 end do
      -
      563 if (m > k) b(k+1:m,:) = zero
      -
      564 else
      -
      565 ! Compute B = alpha * B * A
      -
      566 do i = 1, k
      -
      567 temp = alpha * a(i)
      -
      568 if (temp /= one) b(:,i) = temp * b(:,i)
      -
      569 end do
      -
      570 if (n > k) b(:,k+1:n) = zero
      -
      571 end if
      -
      572 end subroutine
      -
      573
      -
      574! ------------------------------------------------------------------------------
      -
      575 module subroutine diag_mtx_mult_mtx3(lside, trans, alpha, a, b, beta, c, err)
      -
      576 ! Arguments
      -
      577 logical, intent(in) :: lside, trans
      -
      578 real(real64) :: alpha, beta
      -
      579 complex(real64), intent(in), dimension(:) :: a
      -
      580 real(real64), intent(in), dimension(:,:) :: b
      -
      581 complex(real64), intent(inout), dimension(:,:) :: c
      -
      582 class(errors), intent(inout), optional, target :: err
      -
      583
      -
      584 ! Parameters
      -
      585 complex(real64), parameter :: zero = (0.0d0, 0.0d0)
      -
      586 complex(real64), parameter :: one = (1.0d0, 0.0d0)
      -
      587
      -
      588 ! Local Variables
      -
      589 integer(int32) :: i, m, n, k, nrowb, ncolb, flag
      -
      590 complex(real64) :: temp
      -
      591 class(errors), pointer :: errmgr
      -
      592 type(errors), target :: deferr
      -
      593 character(len = 128) :: errmsg
      -
      594
      -
      595 ! Initialization
      -
      596 m = size(c, 1)
      -
      597 n = size(c, 2)
      -
      598 k = size(a)
      -
      599 nrowb = size(b, 1)
      -
      600 ncolb = size(b, 2)
      -
      601 if (present(err)) then
      -
      602 errmgr => err
      -
      603 else
      -
      604 errmgr => deferr
      -
      605 end if
      -
      606
      -
      607 ! Input Check
      -
      608 flag = 0
      -
      609 if (lside) then
      -
      610 if (k > m) then
      -
      611 flag = 4
      -
      612 else
      -
      613 if (trans) then
      -
      614 ! Compute C = alpha * A * B**T + beta * C
      -
      615 if (nrowb /= n .or. ncolb < k) flag = 5
      -
      616 else
      -
      617 ! Compute C = alpha * A * B + beta * C
      -
      618 if (nrowb < k .or. ncolb /= n) flag = 5
      -
      619 end if
      -
      620 end if
      -
      621 else
      -
      622 if (k > n) then
      -
      623 flag = 4
      -
      624 else
      -
      625 if (trans) then
      -
      626 ! Compute C = alpha * B**T * A + beta * C
      -
      627 if (ncolb /= m .or. nrowb < k) flag = 5
      -
      628 else
      -
      629 ! Compute C = alpha * B * A + beta * C
      -
      630 if (nrowb /= m .or. ncolb < k) flag = 5
      -
      631 end if
      -
      632 end if
      -
      633 end if
      -
      634 if (flag /= 0) then
      -
      635 ! ERROR: One of the input arrays is not sized correctly
      -
      636 write(errmsg, '(AI0A)') "Input number ", flag, &
      -
      637 " is not sized correctly."
      -
      638 call errmgr%report_error("diag_mtx_mult_mtx3", trim(errmsg), &
      -
      639 la_array_size_error)
      -
      640 return
      -
      641 end if
      -
      642
      -
      643 ! Deal with ALPHA == 0
      -
      644 if (alpha == 0) then
      -
      645 if (beta == zero) then
      -
      646 c = zero
      -
      647 else if (beta /= one) then
      -
      648 c = beta * c
      -
      649 end if
      -
      650 return
      -
      651 end if
      -
      652
      -
      653 ! Process
      -
      654 if (lside) then
      -
      655 if (trans) then
      -
      656 ! Compute C = alpha * A * B**T + beta * C
      -
      657 do i = 1, k
      -
      658 if (beta == zero) then
      -
      659 c(i,:) = zero
      -
      660 else if (beta /= one) then
      -
      661 c(i,:) = beta * c(i,:)
      -
      662 end if
      -
      663 temp = alpha * a(i)
      -
      664 if (temp /= one) c(i,:) = c(i,:) + temp * b(:,i)
      -
      665 end do
      -
      666 else
      -
      667 ! Compute C = alpha * A * B + beta * C
      -
      668 do i = 1, k
      -
      669 if (beta == zero) then
      -
      670 c(i,:) = zero
      -
      671 else if (beta /= one) then
      -
      672 c(i,:) = beta * c(i,:)
      -
      673 end if
      -
      674 temp = alpha * a(i)
      -
      675 if (temp /= one) c(i,:) = c(i,:) + temp * b(i,:)
      -
      676 end do
      -
      677 end if
      -
      678
      -
      679 ! Handle extra rows
      -
      680 if (m > k) then
      -
      681 if (beta == zero) then
      -
      682 c(k+1:m,:) = zero
      -
      683 else
      -
      684 c(k+1:m,:) = beta * c(k+1:m,:)
      -
      685 end if
      -
      686 end if
      -
      687 else
      -
      688 if (trans) then
      -
      689 ! Compute C = alpha * B**T * A + beta * C
      -
      690 do i = 1, k
      -
      691 if (beta == zero) then
      -
      692 c(:,i) = zero
      -
      693 else if (beta /= one) then
      -
      694 c(:,i) = beta * c(:,i)
      -
      695 end if
      -
      696 temp = alpha * a(i)
      -
      697 if (temp /= one) c(:,i) = c(:,i) + temp * b(i,:)
      -
      698 end do
      -
      699 else
      -
      700 ! Compute C = alpha * B * A + beta * C
      -
      701 do i = 1, k
      -
      702 if (beta == zero) then
      -
      703 c(:,i) = zero
      -
      704 else if (beta /= one) then
      -
      705 c(:,i) = beta * c(:,i)
      -
      706 end if
      -
      707 temp = alpha * a(i)
      -
      708 if (temp /= one) c(:,i) = c(:,i) + temp * b(:,i)
      -
      709 end do
      -
      710 end if
      -
      711
      -
      712 ! Handle extra columns
      -
      713 if (n > k) then
      -
      714 if (beta == zero) then
      -
      715 c(:,k+1:m) = zero
      -
      716 else if (beta /= one) then
      -
      717 c(:,k+1:m) = beta * c(:,k+1:m)
      -
      718 end if
      -
      719 end if
      -
      720 end if
      -
      721 end subroutine
      -
      722
      -
      723! ------------------------------------------------------------------------------
      -
      724 module subroutine diag_mtx_mult_mtx4(lside, opb, alpha, a, b, beta, c, err)
      -
      725 ! Arguments
      -
      726 logical, intent(in) :: lside
      -
      727 integer(int32), intent(in) :: opb
      -
      728 real(real64) :: alpha, beta
      -
      729 complex(real64), intent(in), dimension(:) :: a
      -
      730 complex(real64), intent(in), dimension(:,:) :: b
      -
      731 complex(real64), intent(inout), dimension(:,:) :: c
      -
      732 class(errors), intent(inout), optional, target :: err
      -
      733
      -
      734 ! Parameters
      -
      735 complex(real64), parameter :: zero = (0.0d0, 0.0d0)
      -
      736 complex(real64), parameter :: one = (1.0d0, 0.0d0)
      -
      737
      -
      738 ! Local Variables
      -
      739 integer(int32) :: i, m, n, k, nrowb, ncolb, flag
      -
      740 complex(real64) :: temp
      -
      741 class(errors), pointer :: errmgr
      -
      742 type(errors), target :: deferr
      -
      743 character(len = 128) :: errmsg
      -
      744
      -
      745 ! Initialization
      -
      746 m = size(c, 1)
      -
      747 n = size(c, 2)
      -
      748 k = size(a)
      -
      749 nrowb = size(b, 1)
      -
      750 ncolb = size(b, 2)
      -
      751 if (present(err)) then
      -
      752 errmgr => err
      -
      753 else
      -
      754 errmgr => deferr
      -
      755 end if
      -
      756
      -
      757 ! Input Check
      -
      758 flag = 0
      -
      759 if (lside) then
      -
      760 if (k > m) then
      -
      761 flag = 4
      -
      762 else
      -
      763 if (opb == la_transpose .or. opb == la_hermitian_transpose) then
      -
      764 ! Compute C = alpha * A * B**T + beta * C
      -
      765 if (nrowb /= n .or. ncolb < k) flag = 5
      -
      766 else
      -
      767 ! Compute C = alpha * A * B + beta * C
      -
      768 if (nrowb < k .or. ncolb /= n) flag = 5
      -
      769 end if
      -
      770 end if
      +
      428 else
      +
      429 if (k > n) then
      +
      430 flag = 4
      +
      431 else
      +
      432 if (trans) then
      +
      433 ! Compute C = alpha * B**T * A + beta * C
      +
      434 if (ncolb /= m .or. nrowb < k) flag = 5
      +
      435 else
      +
      436 ! Compute C = alpha * B * A + beta * C
      +
      437 if (nrowb /= m .or. ncolb < k) flag = 5
      +
      438 end if
      +
      439 end if
      +
      440 end if
      +
      441 if (flag /= 0) then
      +
      442 ! ERROR: One of the input arrays is not sized correctly
      +
      443 write(errmsg, 100) "Input number ", flag, &
      +
      444 " is not sized correctly."
      +
      445 call errmgr%report_error("diag_mtx_mult_mtx", trim(errmsg), &
      +
      446 la_array_size_error)
      +
      447 return
      +
      448 end if
      +
      449
      +
      450 ! Deal with ALPHA == 0
      +
      451 if (alpha == 0) then
      +
      452 if (beta == zero) then
      +
      453 c = zero
      +
      454 else if (beta /= one) then
      +
      455 c = beta * c
      +
      456 end if
      +
      457 return
      +
      458 end if
      +
      459
      +
      460 ! Process
      +
      461 if (lside) then
      +
      462 if (trans) then
      +
      463 ! Compute C = alpha * A * B**T + beta * C
      +
      464 do i = 1, k
      +
      465 if (beta == zero) then
      +
      466 c(i,:) = zero
      +
      467 else if (beta /= one) then
      +
      468 c(i,:) = beta * c(i,:)
      +
      469 end if
      +
      470 temp = alpha * a(i)
      +
      471 if (temp /= one) c(i,:) = c(i,:) + temp * b(:,i)
      +
      472 end do
      +
      473 else
      +
      474 ! Compute C = alpha * A * B + beta * C
      +
      475 do i = 1, k
      +
      476 if (beta == zero) then
      +
      477 c(i,:) = zero
      +
      478 else if (beta /= one) then
      +
      479 c(i,:) = beta * c(i,:)
      +
      480 end if
      +
      481 temp = alpha * a(i)
      +
      482 if (temp /= one) c(i,:) = c(i,:) + temp * b(i,:)
      +
      483 end do
      +
      484 end if
      +
      485
      +
      486 ! Handle extra rows
      +
      487 if (m > k) then
      +
      488 if (beta == zero) then
      +
      489 c(k+1:m,:) = zero
      +
      490 else
      +
      491 c(k+1:m,:) = beta * c(k+1:m,:)
      +
      492 end if
      +
      493 end if
      +
      494 else
      +
      495 if (trans) then
      +
      496 ! Compute C = alpha * B**T * A + beta * C
      +
      497 do i = 1, k
      +
      498 if (beta == zero) then
      +
      499 c(:,i) = zero
      +
      500 else if (beta /= one) then
      +
      501 c(:,i) = beta * c(:,i)
      +
      502 end if
      +
      503 temp = alpha * a(i)
      +
      504 if (temp /= one) c(:,i) = c(:,i) + temp * b(i,:)
      +
      505 end do
      +
      506 else
      +
      507 ! Compute C = alpha * B * A + beta * C
      +
      508 do i = 1, k
      +
      509 if (beta == zero) then
      +
      510 c(:,i) = zero
      +
      511 else if (beta /= one) then
      +
      512 c(:,i) = beta * c(:,i)
      +
      513 end if
      +
      514 temp = alpha * a(i)
      +
      515 if (temp /= one) c(:,i) = c(:,i) + temp * b(:,i)
      +
      516 end do
      +
      517 end if
      +
      518
      +
      519 ! Handle extra columns
      +
      520 if (n > k) then
      +
      521 if (beta == zero) then
      +
      522 c(:,k+1:m) = zero
      +
      523 else if (beta /= one) then
      +
      524 c(:,k+1:m) = beta * c(:,k+1:m)
      +
      525 end if
      +
      526 end if
      +
      527 end if
      +
      528
      +
      529 ! Formatting
      +
      530100 format(a, i0, a)
      +
      531 end subroutine
      +
      532
      +
      533! ------------------------------------------------------------------------------
      +
      534 module subroutine diag_mtx_mult_mtx2(lside, alpha, a, b, err)
      +
      535 ! Arguments
      +
      536 logical, intent(in) :: lside
      +
      537 real(real64), intent(in) :: alpha
      +
      538 real(real64), intent(in), dimension(:) :: a
      +
      539 real(real64), intent(inout), dimension(:,:) :: b
      +
      540 class(errors), intent(inout), optional, target :: err
      +
      541
      +
      542 ! Parameters
      +
      543 real(real64), parameter :: zero = 0.0d0
      +
      544 real(real64), parameter :: one = 1.0d0
      +
      545
      +
      546 ! Local Variables
      +
      547 integer(int32) :: i, m, n, k
      +
      548 real(real64) :: temp
      +
      549 class(errors), pointer :: errmgr
      +
      550 type(errors), target :: deferr
      +
      551
      +
      552 ! Initialization
      +
      553 m = size(b, 1)
      +
      554 n = size(b, 2)
      +
      555 k = size(a)
      +
      556 if (present(err)) then
      +
      557 errmgr => err
      +
      558 else
      +
      559 errmgr => deferr
      +
      560 end if
      +
      561
      +
      562 ! Input Check
      +
      563 if ((lside .and. k > m) .or. (.not.lside .and. k > n)) then
      +
      564 ! ERROR: One of the input arrays is not sized correctly
      +
      565 call errmgr%report_error("diag_mtx_mult_mtx2", &
      +
      566 "Input number 3 is not sized correctly.", &
      +
      567 la_array_size_error)
      +
      568 return
      +
      569 end if
      +
      570
      +
      571 ! Process
      +
      572 if (lside) then
      +
      573 ! Compute B = alpha * A * B
      +
      574 do i = 1, k
      +
      575 temp = alpha * a(i)
      +
      576 if (temp /= one) b(i,:) = temp * b(i,:)
      +
      577 end do
      +
      578 if (m > k) b(k+1:m,:) = zero
      +
      579 else
      +
      580 ! Compute B = alpha * B * A
      +
      581 do i = 1, k
      +
      582 temp = alpha * a(i)
      +
      583 if (temp /= one) b(:,i) = temp * b(:,i)
      +
      584 end do
      +
      585 if (n > k) b(:,k+1:n) = zero
      +
      586 end if
      +
      587 end subroutine
      +
      588
      +
      589! ------------------------------------------------------------------------------
      +
      590 module subroutine diag_mtx_mult_mtx3(lside, trans, alpha, a, b, beta, c, err)
      +
      591 ! Arguments
      +
      592 logical, intent(in) :: lside, trans
      +
      593 real(real64) :: alpha, beta
      +
      594 complex(real64), intent(in), dimension(:) :: a
      +
      595 real(real64), intent(in), dimension(:,:) :: b
      +
      596 complex(real64), intent(inout), dimension(:,:) :: c
      +
      597 class(errors), intent(inout), optional, target :: err
      +
      598
      +
      599 ! Parameters
      +
      600 complex(real64), parameter :: zero = (0.0d0, 0.0d0)
      +
      601 complex(real64), parameter :: one = (1.0d0, 0.0d0)
      +
      602
      +
      603 ! Local Variables
      +
      604 integer(int32) :: i, m, n, k, nrowb, ncolb, flag
      +
      605 complex(real64) :: temp
      +
      606 class(errors), pointer :: errmgr
      +
      607 type(errors), target :: deferr
      +
      608 character(len = 128) :: errmsg
      +
      609
      +
      610 ! Initialization
      +
      611 m = size(c, 1)
      +
      612 n = size(c, 2)
      +
      613 k = size(a)
      +
      614 nrowb = size(b, 1)
      +
      615 ncolb = size(b, 2)
      +
      616 if (present(err)) then
      +
      617 errmgr => err
      +
      618 else
      +
      619 errmgr => deferr
      +
      620 end if
      +
      621
      +
      622 ! Input Check
      +
      623 flag = 0
      +
      624 if (lside) then
      +
      625 if (k > m) then
      +
      626 flag = 4
      +
      627 else
      +
      628 if (trans) then
      +
      629 ! Compute C = alpha * A * B**T + beta * C
      +
      630 if (nrowb /= n .or. ncolb < k) flag = 5
      +
      631 else
      +
      632 ! Compute C = alpha * A * B + beta * C
      +
      633 if (nrowb < k .or. ncolb /= n) flag = 5
      +
      634 end if
      +
      635 end if
      +
      636 else
      +
      637 if (k > n) then
      +
      638 flag = 4
      +
      639 else
      +
      640 if (trans) then
      +
      641 ! Compute C = alpha * B**T * A + beta * C
      +
      642 if (ncolb /= m .or. nrowb < k) flag = 5
      +
      643 else
      +
      644 ! Compute C = alpha * B * A + beta * C
      +
      645 if (nrowb /= m .or. ncolb < k) flag = 5
      +
      646 end if
      +
      647 end if
      +
      648 end if
      +
      649 if (flag /= 0) then
      +
      650 ! ERROR: One of the input arrays is not sized correctly
      +
      651 write(errmsg, 100) "Input number ", flag, &
      +
      652 " is not sized correctly."
      +
      653 call errmgr%report_error("diag_mtx_mult_mtx3", trim(errmsg), &
      +
      654 la_array_size_error)
      +
      655 return
      +
      656 end if
      +
      657
      +
      658 ! Deal with ALPHA == 0
      +
      659 if (alpha == 0) then
      +
      660 if (beta == zero) then
      +
      661 c = zero
      +
      662 else if (beta /= one) then
      +
      663 c = beta * c
      +
      664 end if
      +
      665 return
      +
      666 end if
      +
      667
      +
      668 ! Process
      +
      669 if (lside) then
      +
      670 if (trans) then
      +
      671 ! Compute C = alpha * A * B**T + beta * C
      +
      672 do i = 1, k
      +
      673 if (beta == zero) then
      +
      674 c(i,:) = zero
      +
      675 else if (beta /= one) then
      +
      676 c(i,:) = beta * c(i,:)
      +
      677 end if
      +
      678 temp = alpha * a(i)
      +
      679 if (temp /= one) c(i,:) = c(i,:) + temp * b(:,i)
      +
      680 end do
      +
      681 else
      +
      682 ! Compute C = alpha * A * B + beta * C
      +
      683 do i = 1, k
      +
      684 if (beta == zero) then
      +
      685 c(i,:) = zero
      +
      686 else if (beta /= one) then
      +
      687 c(i,:) = beta * c(i,:)
      +
      688 end if
      +
      689 temp = alpha * a(i)
      +
      690 if (temp /= one) c(i,:) = c(i,:) + temp * b(i,:)
      +
      691 end do
      +
      692 end if
      +
      693
      +
      694 ! Handle extra rows
      +
      695 if (m > k) then
      +
      696 if (beta == zero) then
      +
      697 c(k+1:m,:) = zero
      +
      698 else
      +
      699 c(k+1:m,:) = beta * c(k+1:m,:)
      +
      700 end if
      +
      701 end if
      +
      702 else
      +
      703 if (trans) then
      +
      704 ! Compute C = alpha * B**T * A + beta * C
      +
      705 do i = 1, k
      +
      706 if (beta == zero) then
      +
      707 c(:,i) = zero
      +
      708 else if (beta /= one) then
      +
      709 c(:,i) = beta * c(:,i)
      +
      710 end if
      +
      711 temp = alpha * a(i)
      +
      712 if (temp /= one) c(:,i) = c(:,i) + temp * b(i,:)
      +
      713 end do
      +
      714 else
      +
      715 ! Compute C = alpha * B * A + beta * C
      +
      716 do i = 1, k
      +
      717 if (beta == zero) then
      +
      718 c(:,i) = zero
      +
      719 else if (beta /= one) then
      +
      720 c(:,i) = beta * c(:,i)
      +
      721 end if
      +
      722 temp = alpha * a(i)
      +
      723 if (temp /= one) c(:,i) = c(:,i) + temp * b(:,i)
      +
      724 end do
      +
      725 end if
      +
      726
      +
      727 ! Handle extra columns
      +
      728 if (n > k) then
      +
      729 if (beta == zero) then
      +
      730 c(:,k+1:m) = zero
      +
      731 else if (beta /= one) then
      +
      732 c(:,k+1:m) = beta * c(:,k+1:m)
      +
      733 end if
      +
      734 end if
      +
      735 end if
      +
      736
      +
      737 ! Formatting
      +
      738100 format(a, i0, a)
      +
      739 end subroutine
      +
      740
      +
      741! ------------------------------------------------------------------------------
      +
      742 module subroutine diag_mtx_mult_mtx4(lside, opb, alpha, a, b, beta, c, err)
      +
      743 ! Arguments
      +
      744 logical, intent(in) :: lside
      +
      745 integer(int32), intent(in) :: opb
      +
      746 real(real64) :: alpha, beta
      +
      747 complex(real64), intent(in), dimension(:) :: a
      +
      748 complex(real64), intent(in), dimension(:,:) :: b
      +
      749 complex(real64), intent(inout), dimension(:,:) :: c
      +
      750 class(errors), intent(inout), optional, target :: err
      +
      751
      +
      752 ! Parameters
      +
      753 complex(real64), parameter :: zero = (0.0d0, 0.0d0)
      +
      754 complex(real64), parameter :: one = (1.0d0, 0.0d0)
      +
      755
      +
      756 ! Local Variables
      +
      757 integer(int32) :: i, m, n, k, nrowb, ncolb, flag
      +
      758 complex(real64) :: temp
      +
      759 class(errors), pointer :: errmgr
      +
      760 type(errors), target :: deferr
      +
      761 character(len = 128) :: errmsg
      +
      762
      +
      763 ! Initialization
      +
      764 m = size(c, 1)
      +
      765 n = size(c, 2)
      +
      766 k = size(a)
      +
      767 nrowb = size(b, 1)
      +
      768 ncolb = size(b, 2)
      +
      769 if (present(err)) then
      +
      770 errmgr => err
      771 else
      -
      772 if (k > n) then
      -
      773 flag = 4
      -
      774 else
      -
      775 if (opb == la_transpose .or. opb == la_hermitian_transpose) then
      -
      776 ! Compute C = alpha * B**T * A + beta * C
      -
      777 if (ncolb /= m .or. nrowb < k) flag = 5
      -
      778 else
      -
      779 ! Compute C = alpha * B * A + beta * C
      -
      780 if (nrowb /= m .or. ncolb < k) flag = 5
      -
      781 end if
      -
      782 end if
      -
      783 end if
      -
      784 if (flag /= 0) then
      -
      785 ! ERROR: One of the input arrays is not sized correctly
      -
      786 write(errmsg, '(AI0A)') "Input number ", flag, &
      -
      787 " is not sized correctly."
      -
      788 call errmgr%report_error("diag_mtx_mult_mtx4", trim(errmsg), &
      -
      789 la_array_size_error)
      -
      790 return
      -
      791 end if
      -
      792
      -
      793 ! Deal with ALPHA == 0
      -
      794 if (alpha == 0) then
      -
      795 if (beta == zero) then
      -
      796 c = zero
      -
      797 else if (beta /= one) then
      -
      798 c = beta * c
      -
      799 end if
      -
      800 return
      +
      772 errmgr => deferr
      +
      773 end if
      +
      774
      +
      775 ! Input Check
      +
      776 flag = 0
      +
      777 if (lside) then
      +
      778 if (k > m) then
      +
      779 flag = 4
      +
      780 else
      +
      781 if (opb == la_transpose .or. opb == la_hermitian_transpose) then
      +
      782 ! Compute C = alpha * A * B**T + beta * C
      +
      783 if (nrowb /= n .or. ncolb < k) flag = 5
      +
      784 else
      +
      785 ! Compute C = alpha * A * B + beta * C
      +
      786 if (nrowb < k .or. ncolb /= n) flag = 5
      +
      787 end if
      +
      788 end if
      +
      789 else
      +
      790 if (k > n) then
      +
      791 flag = 4
      +
      792 else
      +
      793 if (opb == la_transpose .or. opb == la_hermitian_transpose) then
      +
      794 ! Compute C = alpha * B**T * A + beta * C
      +
      795 if (ncolb /= m .or. nrowb < k) flag = 5
      +
      796 else
      +
      797 ! Compute C = alpha * B * A + beta * C
      +
      798 if (nrowb /= m .or. ncolb < k) flag = 5
      +
      799 end if
      +
      800 end if
      801 end if
      -
      802
      -
      803 ! Process
      -
      804 if (lside) then
      -
      805 if (opb == la_transpose) then
      -
      806 ! Compute C = alpha * A * B**T + beta * C
      -
      807 do i = 1, k
      -
      808 if (beta == zero) then
      -
      809 c(i,:) = zero
      -
      810 else if (beta /= one) then
      -
      811 c(i,:) = beta * c(i,:)
      -
      812 end if
      -
      813 temp = alpha * a(i)
      -
      814 if (temp /= one) c(i,:) = c(i,:) + temp * b(:,i)
      -
      815 end do
      -
      816 else if (opb == la_hermitian_transpose) then
      -
      817 ! Compute C = alpha * A * B**H + beta * C
      -
      818 do i = 1, k
      -
      819 if (beta == zero) then
      -
      820 c(i,:) = zero
      -
      821 else if (beta /= one) then
      -
      822 c(i,:) = beta * c(i,:)
      -
      823 end if
      -
      824 temp = alpha * a(i)
      -
      825 if (temp /= one) c(i,:) = c(i,:) + temp * conjg(b(:,i))
      -
      826 end do
      -
      827 else
      -
      828 ! Compute C = alpha * A * B + beta * C
      -
      829 do i = 1, k
      -
      830 if (beta == zero) then
      -
      831 c(i,:) = zero
      -
      832 else if (beta /= one) then
      -
      833 c(i,:) = beta * c(i,:)
      -
      834 end if
      -
      835 temp = alpha * a(i)
      -
      836 if (temp /= one) c(i,:) = c(i,:) + temp * b(i,:)
      -
      837 end do
      -
      838 end if
      -
      839
      -
      840 ! Handle extra rows
      -
      841 if (m > k) then
      -
      842 if (beta == zero) then
      -
      843 c(k+1:m,:) = zero
      -
      844 else
      -
      845 c(k+1:m,:) = beta * c(k+1:m,:)
      -
      846 end if
      -
      847 end if
      -
      848 else
      -
      849 if (opb == la_transpose) then
      -
      850 ! Compute C = alpha * B**T * A + beta * C
      -
      851 do i = 1, k
      -
      852 if (beta == zero) then
      -
      853 c(:,i) = zero
      -
      854 else if (beta /= one) then
      -
      855 c(:,i) = beta * c(:,i)
      -
      856 end if
      -
      857 temp = alpha * a(i)
      -
      858 if (temp /= one) c(:,i) = c(:,i) + temp * b(i,:)
      -
      859 end do
      -
      860 else if (opb == la_hermitian_transpose) then
      -
      861 ! Compute C = alpha * B**H * A + beta * C
      -
      862 do i = 1, k
      -
      863 if (beta == zero) then
      -
      864 c(:,i) = zero
      -
      865 else if (beta /= one) then
      -
      866 c(:,i) = beta * c(:,i)
      -
      867 end if
      -
      868 temp = alpha * a(i)
      -
      869 if (temp /= one) c(:,i) = c(:,i) + temp * conjg(b(i,:))
      -
      870 end do
      -
      871 else
      -
      872 ! Compute C = alpha * B * A + beta * C
      -
      873 do i = 1, k
      -
      874 if (beta == zero) then
      -
      875 c(:,i) = zero
      -
      876 else if (beta /= one) then
      -
      877 c(:,i) = beta * c(:,i)
      -
      878 end if
      -
      879 temp = alpha * a(i)
      -
      880 if (temp /= one) c(:,i) = c(:,i) + temp * b(:,i)
      -
      881 end do
      -
      882 end if
      -
      883
      -
      884 ! Handle extra columns
      -
      885 if (n > k) then
      -
      886 if (beta == zero) then
      -
      887 c(:,k+1:m) = zero
      -
      888 else if (beta /= one) then
      -
      889 c(:,k+1:m) = beta * c(:,k+1:m)
      -
      890 end if
      -
      891 end if
      -
      892 end if
      -
      893 end subroutine
      -
      894
      -
      895! ------------------------------------------------------------------------------
      -
      896 module subroutine diag_mtx_mult_mtx_cmplx(lside, opb, alpha, a, b, beta, c, err)
      -
      897 ! Arguments
      -
      898 logical, intent(in) :: lside
      -
      899 integer(int32), intent(in) :: opb
      -
      900 complex(real64) :: alpha, beta
      -
      901 complex(real64), intent(in), dimension(:) :: a
      -
      902 complex(real64), intent(in), dimension(:,:) :: b
      -
      903 complex(real64), intent(inout), dimension(:,:) :: c
      -
      904 class(errors), intent(inout), optional, target :: err
      -
      905
      -
      906 ! Parameters
      -
      907 complex(real64), parameter :: zero = (0.0d0, 0.0d0)
      -
      908 complex(real64), parameter :: one = (1.0d0, 0.0d0)
      -
      909
      -
      910 ! Local Variables
      -
      911 integer(int32) :: i, m, n, k, nrowb, ncolb, flag
      -
      912 complex(real64) :: temp
      -
      913 class(errors), pointer :: errmgr
      -
      914 type(errors), target :: deferr
      -
      915 character(len = 128) :: errmsg
      -
      916
      -
      917 ! Initialization
      -
      918 m = size(c, 1)
      -
      919 n = size(c, 2)
      -
      920 k = size(a)
      -
      921 nrowb = size(b, 1)
      -
      922 ncolb = size(b, 2)
      -
      923 if (present(err)) then
      -
      924 errmgr => err
      -
      925 else
      -
      926 errmgr => deferr
      -
      927 end if
      -
      928
      -
      929 ! Input Check
      -
      930 flag = 0
      -
      931 if (lside) then
      -
      932 if (k > m) then
      -
      933 flag = 4
      -
      934 else
      -
      935 if (opb == la_transpose .or. opb == la_hermitian_transpose) then
      -
      936 ! Compute C = alpha * A * B**T + beta * C
      -
      937 if (nrowb /= n .or. ncolb < k) flag = 5
      -
      938 else
      -
      939 ! Compute C = alpha * A * B + beta * C
      -
      940 if (nrowb < k .or. ncolb /= n) flag = 5
      -
      941 end if
      -
      942 end if
      -
      943 else
      -
      944 if (k > n) then
      -
      945 flag = 4
      -
      946 else
      -
      947 if (opb == la_transpose .or. opb == la_hermitian_transpose) then
      -
      948 ! Compute C = alpha * B**T * A + beta * C
      -
      949 if (ncolb /= m .or. nrowb < k) flag = 5
      -
      950 else
      -
      951 ! Compute C = alpha * B * A + beta * C
      -
      952 if (nrowb /= m .or. ncolb < k) flag = 5
      -
      953 end if
      -
      954 end if
      -
      955 end if
      -
      956 if (flag /= 0) then
      -
      957 ! ERROR: One of the input arrays is not sized correctly
      -
      958 write(errmsg, '(AI0A)') "Input number ", flag, &
      -
      959 " is not sized correctly."
      -
      960 call errmgr%report_error("diag_mtx_mult_mtx_cmplx", trim(errmsg), &
      -
      961 la_array_size_error)
      -
      962 return
      -
      963 end if
      -
      964
      -
      965 ! Deal with ALPHA == 0
      -
      966 if (alpha == 0) then
      -
      967 if (beta == zero) then
      -
      968 c = zero
      -
      969 else if (beta /= one) then
      -
      970 c = beta * c
      -
      971 end if
      -
      972 return
      -
      973 end if
      -
      974
      -
      975 ! Process
      -
      976 if (lside) then
      -
      977 if (opb == la_transpose) then
      -
      978 ! Compute C = alpha * A * B**T + beta * C
      -
      979 do i = 1, k
      -
      980 if (beta == zero) then
      -
      981 c(i,:) = zero
      -
      982 else if (beta /= one) then
      -
      983 c(i,:) = beta * c(i,:)
      -
      984 end if
      -
      985 temp = alpha * a(i)
      -
      986 if (temp /= one) c(i,:) = c(i,:) + temp * b(:,i)
      -
      987 end do
      -
      988 else if (opb == la_hermitian_transpose) then
      -
      989 ! Compute C = alpha * A * B**H + beta * C
      -
      990 do i = 1, k
      -
      991 if (beta == zero) then
      -
      992 c(i,:) = zero
      -
      993 else if (beta /= one) then
      -
      994 c(i,:) = beta * c(i,:)
      -
      995 end if
      -
      996 temp = alpha * a(i)
      -
      997 if (temp /= one) c(i,:) = c(i,:) + temp * conjg(b(:,i))
      -
      998 end do
      -
      999 else
      -
      1000 ! Compute C = alpha * A * B + beta * C
      -
      1001 do i = 1, k
      -
      1002 if (beta == zero) then
      -
      1003 c(i,:) = zero
      -
      1004 else if (beta /= one) then
      -
      1005 c(i,:) = beta * c(i,:)
      -
      1006 end if
      -
      1007 temp = alpha * a(i)
      -
      1008 if (temp /= one) c(i,:) = c(i,:) + temp * b(i,:)
      -
      1009 end do
      -
      1010 end if
      -
      1011
      -
      1012 ! Handle extra rows
      -
      1013 if (m > k) then
      -
      1014 if (beta == zero) then
      -
      1015 c(k+1:m,:) = zero
      -
      1016 else
      -
      1017 c(k+1:m,:) = beta * c(k+1:m,:)
      -
      1018 end if
      -
      1019 end if
      -
      1020 else
      -
      1021 if (opb == la_transpose) then
      -
      1022 ! Compute C = alpha * B**T * A + beta * C
      -
      1023 do i = 1, k
      -
      1024 if (beta == zero) then
      -
      1025 c(:,i) = zero
      -
      1026 else if (beta /= one) then
      -
      1027 c(:,i) = beta * c(:,i)
      -
      1028 end if
      -
      1029 temp = alpha * a(i)
      -
      1030 if (temp /= one) c(:,i) = c(:,i) + temp * b(i,:)
      -
      1031 end do
      -
      1032 else if (opb == la_hermitian_transpose) then
      -
      1033 ! Compute C = alpha * B**H * A + beta * C
      -
      1034 do i = 1, k
      -
      1035 if (beta == zero) then
      -
      1036 c(:,i) = zero
      -
      1037 else if (beta /= one) then
      -
      1038 c(:,i) = beta * c(:,i)
      -
      1039 end if
      -
      1040 temp = alpha * a(i)
      -
      1041 if (temp /= one) c(:,i) = c(:,i) + temp * conjg(b(i,:))
      -
      1042 end do
      -
      1043 else
      -
      1044 ! Compute C = alpha * B * A + beta * C
      -
      1045 do i = 1, k
      -
      1046 if (beta == zero) then
      -
      1047 c(:,i) = zero
      -
      1048 else if (beta /= one) then
      -
      1049 c(:,i) = beta * c(:,i)
      -
      1050 end if
      -
      1051 temp = alpha * a(i)
      -
      1052 if (temp /= one) c(:,i) = c(:,i) + temp * b(:,i)
      -
      1053 end do
      -
      1054 end if
      -
      1055
      -
      1056 ! Handle extra columns
      -
      1057 if (n > k) then
      -
      1058 if (beta == zero) then
      -
      1059 c(:,k+1:m) = zero
      -
      1060 else if (beta /= one) then
      -
      1061 c(:,k+1:m) = beta * c(:,k+1:m)
      -
      1062 end if
      -
      1063 end if
      -
      1064 end if
      -
      1065 end subroutine
      -
      1066
      -
      1067! ------------------------------------------------------------------------------
      -
      1068 module subroutine diag_mtx_mult_mtx2_cmplx(lside, alpha, a, b, err)
      -
      1069 ! Arguments
      -
      1070 logical, intent(in) :: lside
      -
      1071 complex(real64), intent(in) :: alpha
      -
      1072 complex(real64), intent(in), dimension(:) :: a
      -
      1073 complex(real64), intent(inout), dimension(:,:) :: b
      -
      1074 class(errors), intent(inout), optional, target :: err
      -
      1075
      -
      1076 ! Parameters
      -
      1077 complex(real64), parameter :: zero = (0.0d0, 0.0d0)
      -
      1078 complex(real64), parameter :: one = (1.0d0, 0.0d0)
      -
      1079
      -
      1080 ! Local Variables
      -
      1081 integer(int32) :: i, m, n, k
      -
      1082 complex(real64) :: temp
      -
      1083 class(errors), pointer :: errmgr
      -
      1084 type(errors), target :: deferr
      -
      1085
      -
      1086 ! Initialization
      -
      1087 m = size(b, 1)
      -
      1088 n = size(b, 2)
      -
      1089 k = size(a)
      -
      1090 if (present(err)) then
      -
      1091 errmgr => err
      -
      1092 else
      -
      1093 errmgr => deferr
      -
      1094 end if
      -
      1095
      -
      1096 ! Input Check
      -
      1097 if ((lside .and. k > m) .or. (.not.lside .and. k > n)) then
      -
      1098 ! ERROR: One of the input arrays is not sized correctly
      -
      1099 call errmgr%report_error("diag_mtx_mult_mtx2_cmplx", &
      -
      1100 "Input number 3 is not sized correctly.", &
      -
      1101 la_array_size_error)
      -
      1102 return
      -
      1103 end if
      -
      1104
      -
      1105 ! Process
      -
      1106 if (lside) then
      -
      1107 ! Compute B = alpha * A * B
      -
      1108 do i = 1, k
      -
      1109 temp = alpha * a(i)
      -
      1110 if (temp /= one) b(i,:) = temp * b(i,:)
      -
      1111 end do
      -
      1112 if (m > k) b(k+1:m,:) = zero
      -
      1113 else
      -
      1114 ! Compute B = alpha * B * A
      -
      1115 do i = 1, k
      -
      1116 temp = alpha * a(i)
      -
      1117 if (temp /= one) b(:,i) = temp * b(:,i)
      -
      1118 end do
      -
      1119 if (n > k) b(:,k+1:n) = zero
      -
      1120 end if
      -
      1121 end subroutine
      -
      1122
      -
      1123! ------------------------------------------------------------------------------
      -
      1124 module subroutine diag_mtx_mult_mtx_mix(lside, opb, alpha, a, b, beta, c, err)
      -
      1125 ! Arguments
      -
      1126 logical, intent(in) :: lside
      -
      1127 integer(int32), intent(in) :: opb
      -
      1128 complex(real64) :: alpha, beta
      -
      1129 real(real64), intent(in), dimension(:) :: a
      -
      1130 complex(real64), intent(in), dimension(:,:) :: b
      -
      1131 complex(real64), intent(inout), dimension(:,:) :: c
      -
      1132 class(errors), intent(inout), optional, target :: err
      -
      1133
      -
      1134 ! Parameters
      -
      1135 complex(real64), parameter :: zero = (0.0d0, 0.0d0)
      -
      1136 complex(real64), parameter :: one = (1.0d0, 0.0d0)
      -
      1137
      -
      1138 ! Local Variables
      -
      1139 integer(int32) :: i, m, n, k, nrowb, ncolb, flag
      -
      1140 complex(real64) :: temp
      -
      1141 class(errors), pointer :: errmgr
      -
      1142 type(errors), target :: deferr
      -
      1143 character(len = 128) :: errmsg
      -
      1144
      -
      1145 ! Initialization
      -
      1146 m = size(c, 1)
      -
      1147 n = size(c, 2)
      -
      1148 k = size(a)
      -
      1149 nrowb = size(b, 1)
      -
      1150 ncolb = size(b, 2)
      -
      1151 if (present(err)) then
      -
      1152 errmgr => err
      -
      1153 else
      -
      1154 errmgr => deferr
      -
      1155 end if
      -
      1156
      -
      1157 ! Input Check
      -
      1158 flag = 0
      -
      1159 if (lside) then
      -
      1160 if (k > m) then
      -
      1161 flag = 4
      -
      1162 else
      -
      1163 if (opb == la_transpose .or. opb == la_hermitian_transpose) then
      -
      1164 ! Compute C = alpha * A * B**T + beta * C
      -
      1165 if (nrowb /= n .or. ncolb < k) flag = 5
      -
      1166 else
      -
      1167 ! Compute C = alpha * A * B + beta * C
      -
      1168 if (nrowb < k .or. ncolb /= n) flag = 5
      -
      1169 end if
      -
      1170 end if
      -
      1171 else
      -
      1172 if (k > n) then
      -
      1173 flag = 4
      -
      1174 else
      -
      1175 if (opb == la_transpose .or. opb == la_hermitian_transpose) then
      -
      1176 ! Compute C = alpha * B**T * A + beta * C
      -
      1177 if (ncolb /= m .or. nrowb < k) flag = 5
      -
      1178 else
      -
      1179 ! Compute C = alpha * B * A + beta * C
      -
      1180 if (nrowb /= m .or. ncolb < k) flag = 5
      -
      1181 end if
      -
      1182 end if
      -
      1183 end if
      -
      1184 if (flag /= 0) then
      -
      1185 ! ERROR: One of the input arrays is not sized correctly
      -
      1186 write(errmsg, '(AI0A)') "Input number ", flag, &
      -
      1187 " is not sized correctly."
      -
      1188 call errmgr%report_error("diag_mtx_mult_mtx_mix", trim(errmsg), &
      -
      1189 la_array_size_error)
      -
      1190 return
      -
      1191 end if
      -
      1192
      -
      1193 ! Deal with ALPHA == 0
      -
      1194 if (alpha == 0) then
      -
      1195 if (beta == zero) then
      -
      1196 c = zero
      -
      1197 else if (beta /= one) then
      -
      1198 c = beta * c
      -
      1199 end if
      -
      1200 return
      -
      1201 end if
      -
      1202
      -
      1203 ! Process
      -
      1204 if (lside) then
      -
      1205 if (opb == la_transpose) then
      -
      1206 ! Compute C = alpha * A * B**T + beta * C
      -
      1207 do i = 1, k
      -
      1208 if (beta == zero) then
      -
      1209 c(i,:) = zero
      -
      1210 else if (beta /= one) then
      -
      1211 c(i,:) = beta * c(i,:)
      -
      1212 end if
      -
      1213 temp = alpha * a(i)
      -
      1214 if (temp /= one) c(i,:) = c(i,:) + temp * b(:,i)
      -
      1215 end do
      -
      1216 else if (opb == la_hermitian_transpose) then
      -
      1217 ! Compute C = alpha * A * B**H + beta * C
      -
      1218 do i = 1, k
      -
      1219 if (beta == zero) then
      -
      1220 c(i,:) = zero
      -
      1221 else if (beta /= one) then
      -
      1222 c(i,:) = beta * c(i,:)
      -
      1223 end if
      -
      1224 temp = alpha * a(i)
      -
      1225 if (temp /= one) c(i,:) = c(i,:) + temp * conjg(b(:,i))
      -
      1226 end do
      -
      1227 else
      -
      1228 ! Compute C = alpha * A * B + beta * C
      -
      1229 do i = 1, k
      -
      1230 if (beta == zero) then
      -
      1231 c(i,:) = zero
      -
      1232 else if (beta /= one) then
      -
      1233 c(i,:) = beta * c(i,:)
      -
      1234 end if
      -
      1235 temp = alpha * a(i)
      -
      1236 if (temp /= one) c(i,:) = c(i,:) + temp * b(i,:)
      -
      1237 end do
      -
      1238 end if
      -
      1239
      -
      1240 ! Handle extra rows
      -
      1241 if (m > k) then
      -
      1242 if (beta == zero) then
      -
      1243 c(k+1:m,:) = zero
      -
      1244 else
      -
      1245 c(k+1:m,:) = beta * c(k+1:m,:)
      -
      1246 end if
      -
      1247 end if
      -
      1248 else
      -
      1249 if (opb == la_transpose) then
      -
      1250 ! Compute C = alpha * B**T * A + beta * C
      -
      1251 do i = 1, k
      -
      1252 if (beta == zero) then
      -
      1253 c(:,i) = zero
      -
      1254 else if (beta /= one) then
      -
      1255 c(:,i) = beta * c(:,i)
      -
      1256 end if
      -
      1257 temp = alpha * a(i)
      -
      1258 if (temp /= one) c(:,i) = c(:,i) + temp * b(i,:)
      -
      1259 end do
      -
      1260 else if (opb == la_hermitian_transpose) then
      -
      1261 ! Compute C = alpha * B**H * A + beta * C
      -
      1262 do i = 1, k
      -
      1263 if (beta == zero) then
      -
      1264 c(:,i) = zero
      -
      1265 else if (beta /= one) then
      -
      1266 c(:,i) = beta * c(:,i)
      -
      1267 end if
      -
      1268 temp = alpha * a(i)
      -
      1269 if (temp /= one) c(:,i) = c(:,i) + temp * conjg(b(i,:))
      -
      1270 end do
      -
      1271 else
      -
      1272 ! Compute C = alpha * B * A + beta * C
      -
      1273 do i = 1, k
      -
      1274 if (beta == zero) then
      -
      1275 c(:,i) = zero
      -
      1276 else if (beta /= one) then
      -
      1277 c(:,i) = beta * c(:,i)
      -
      1278 end if
      -
      1279 temp = alpha * a(i)
      -
      1280 if (temp /= one) c(:,i) = c(:,i) + temp * b(:,i)
      -
      1281 end do
      -
      1282 end if
      -
      1283
      -
      1284 ! Handle extra columns
      -
      1285 if (n > k) then
      -
      1286 if (beta == zero) then
      -
      1287 c(:,k+1:m) = zero
      -
      1288 else if (beta /= one) then
      -
      1289 c(:,k+1:m) = beta * c(:,k+1:m)
      -
      1290 end if
      -
      1291 end if
      -
      1292 end if
      -
      1293 end subroutine
      -
      1294
      -
      1295! ------------------------------------------------------------------------------
      -
      1296 module subroutine diag_mtx_mult_mtx2_mix(lside, alpha, a, b, err)
      -
      1297 ! Arguments
      -
      1298 logical, intent(in) :: lside
      -
      1299 complex(real64), intent(in) :: alpha
      -
      1300 real(real64), intent(in), dimension(:) :: a
      -
      1301 complex(real64), intent(inout), dimension(:,:) :: b
      -
      1302 class(errors), intent(inout), optional, target :: err
      -
      1303
      -
      1304 ! Parameters
      -
      1305 complex(real64), parameter :: zero = (0.0d0, 0.0d0)
      -
      1306 complex(real64), parameter :: one = (1.0d0, 0.0d0)
      +
      802 if (flag /= 0) then
      +
      803 ! ERROR: One of the input arrays is not sized correctly
      +
      804 write(errmsg, 100) "Input number ", flag, &
      +
      805 " is not sized correctly."
      +
      806 call errmgr%report_error("diag_mtx_mult_mtx4", trim(errmsg), &
      +
      807 la_array_size_error)
      +
      808 return
      +
      809 end if
      +
      810
      +
      811 ! Deal with ALPHA == 0
      +
      812 if (alpha == 0) then
      +
      813 if (beta == zero) then
      +
      814 c = zero
      +
      815 else if (beta /= one) then
      +
      816 c = beta * c
      +
      817 end if
      +
      818 return
      +
      819 end if
      +
      820
      +
      821 ! Process
      +
      822 if (lside) then
      +
      823 if (opb == la_transpose) then
      +
      824 ! Compute C = alpha * A * B**T + beta * C
      +
      825 do i = 1, k
      +
      826 if (beta == zero) then
      +
      827 c(i,:) = zero
      +
      828 else if (beta /= one) then
      +
      829 c(i,:) = beta * c(i,:)
      +
      830 end if
      +
      831 temp = alpha * a(i)
      +
      832 if (temp /= one) c(i,:) = c(i,:) + temp * b(:,i)
      +
      833 end do
      +
      834 else if (opb == la_hermitian_transpose) then
      +
      835 ! Compute C = alpha * A * B**H + beta * C
      +
      836 do i = 1, k
      +
      837 if (beta == zero) then
      +
      838 c(i,:) = zero
      +
      839 else if (beta /= one) then
      +
      840 c(i,:) = beta * c(i,:)
      +
      841 end if
      +
      842 temp = alpha * a(i)
      +
      843 if (temp /= one) c(i,:) = c(i,:) + temp * conjg(b(:,i))
      +
      844 end do
      +
      845 else
      +
      846 ! Compute C = alpha * A * B + beta * C
      +
      847 do i = 1, k
      +
      848 if (beta == zero) then
      +
      849 c(i,:) = zero
      +
      850 else if (beta /= one) then
      +
      851 c(i,:) = beta * c(i,:)
      +
      852 end if
      +
      853 temp = alpha * a(i)
      +
      854 if (temp /= one) c(i,:) = c(i,:) + temp * b(i,:)
      +
      855 end do
      +
      856 end if
      +
      857
      +
      858 ! Handle extra rows
      +
      859 if (m > k) then
      +
      860 if (beta == zero) then
      +
      861 c(k+1:m,:) = zero
      +
      862 else
      +
      863 c(k+1:m,:) = beta * c(k+1:m,:)
      +
      864 end if
      +
      865 end if
      +
      866 else
      +
      867 if (opb == la_transpose) then
      +
      868 ! Compute C = alpha * B**T * A + beta * C
      +
      869 do i = 1, k
      +
      870 if (beta == zero) then
      +
      871 c(:,i) = zero
      +
      872 else if (beta /= one) then
      +
      873 c(:,i) = beta * c(:,i)
      +
      874 end if
      +
      875 temp = alpha * a(i)
      +
      876 if (temp /= one) c(:,i) = c(:,i) + temp * b(i,:)
      +
      877 end do
      +
      878 else if (opb == la_hermitian_transpose) then
      +
      879 ! Compute C = alpha * B**H * A + beta * C
      +
      880 do i = 1, k
      +
      881 if (beta == zero) then
      +
      882 c(:,i) = zero
      +
      883 else if (beta /= one) then
      +
      884 c(:,i) = beta * c(:,i)
      +
      885 end if
      +
      886 temp = alpha * a(i)
      +
      887 if (temp /= one) c(:,i) = c(:,i) + temp * conjg(b(i,:))
      +
      888 end do
      +
      889 else
      +
      890 ! Compute C = alpha * B * A + beta * C
      +
      891 do i = 1, k
      +
      892 if (beta == zero) then
      +
      893 c(:,i) = zero
      +
      894 else if (beta /= one) then
      +
      895 c(:,i) = beta * c(:,i)
      +
      896 end if
      +
      897 temp = alpha * a(i)
      +
      898 if (temp /= one) c(:,i) = c(:,i) + temp * b(:,i)
      +
      899 end do
      +
      900 end if
      +
      901
      +
      902 ! Handle extra columns
      +
      903 if (n > k) then
      +
      904 if (beta == zero) then
      +
      905 c(:,k+1:m) = zero
      +
      906 else if (beta /= one) then
      +
      907 c(:,k+1:m) = beta * c(:,k+1:m)
      +
      908 end if
      +
      909 end if
      +
      910 end if
      +
      911
      +
      912 ! Formatting
      +
      913100 format(a, i0, a)
      +
      914 end subroutine
      +
      915
      +
      916! ------------------------------------------------------------------------------
      +
      917 module subroutine diag_mtx_mult_mtx_cmplx(lside, opb, alpha, a, b, beta, c, err)
      +
      918 ! Arguments
      +
      919 logical, intent(in) :: lside
      +
      920 integer(int32), intent(in) :: opb
      +
      921 complex(real64) :: alpha, beta
      +
      922 complex(real64), intent(in), dimension(:) :: a
      +
      923 complex(real64), intent(in), dimension(:,:) :: b
      +
      924 complex(real64), intent(inout), dimension(:,:) :: c
      +
      925 class(errors), intent(inout), optional, target :: err
      +
      926
      +
      927 ! Parameters
      +
      928 complex(real64), parameter :: zero = (0.0d0, 0.0d0)
      +
      929 complex(real64), parameter :: one = (1.0d0, 0.0d0)
      +
      930
      +
      931 ! Local Variables
      +
      932 integer(int32) :: i, m, n, k, nrowb, ncolb, flag
      +
      933 complex(real64) :: temp
      +
      934 class(errors), pointer :: errmgr
      +
      935 type(errors), target :: deferr
      +
      936 character(len = 128) :: errmsg
      +
      937
      +
      938 ! Initialization
      +
      939 m = size(c, 1)
      +
      940 n = size(c, 2)
      +
      941 k = size(a)
      +
      942 nrowb = size(b, 1)
      +
      943 ncolb = size(b, 2)
      +
      944 if (present(err)) then
      +
      945 errmgr => err
      +
      946 else
      +
      947 errmgr => deferr
      +
      948 end if
      +
      949
      +
      950 ! Input Check
      +
      951 flag = 0
      +
      952 if (lside) then
      +
      953 if (k > m) then
      +
      954 flag = 4
      +
      955 else
      +
      956 if (opb == la_transpose .or. opb == la_hermitian_transpose) then
      +
      957 ! Compute C = alpha * A * B**T + beta * C
      +
      958 if (nrowb /= n .or. ncolb < k) flag = 5
      +
      959 else
      +
      960 ! Compute C = alpha * A * B + beta * C
      +
      961 if (nrowb < k .or. ncolb /= n) flag = 5
      +
      962 end if
      +
      963 end if
      +
      964 else
      +
      965 if (k > n) then
      +
      966 flag = 4
      +
      967 else
      +
      968 if (opb == la_transpose .or. opb == la_hermitian_transpose) then
      +
      969 ! Compute C = alpha * B**T * A + beta * C
      +
      970 if (ncolb /= m .or. nrowb < k) flag = 5
      +
      971 else
      +
      972 ! Compute C = alpha * B * A + beta * C
      +
      973 if (nrowb /= m .or. ncolb < k) flag = 5
      +
      974 end if
      +
      975 end if
      +
      976 end if
      +
      977 if (flag /= 0) then
      +
      978 ! ERROR: One of the input arrays is not sized correctly
      +
      979 write(errmsg, 100) "Input number ", flag, &
      +
      980 " is not sized correctly."
      +
      981 call errmgr%report_error("diag_mtx_mult_mtx_cmplx", trim(errmsg), &
      +
      982 la_array_size_error)
      +
      983 return
      +
      984 end if
      +
      985
      +
      986 ! Deal with ALPHA == 0
      +
      987 if (alpha == 0) then
      +
      988 if (beta == zero) then
      +
      989 c = zero
      +
      990 else if (beta /= one) then
      +
      991 c = beta * c
      +
      992 end if
      +
      993 return
      +
      994 end if
      +
      995
      +
      996 ! Process
      +
      997 if (lside) then
      +
      998 if (opb == la_transpose) then
      +
      999 ! Compute C = alpha * A * B**T + beta * C
      +
      1000 do i = 1, k
      +
      1001 if (beta == zero) then
      +
      1002 c(i,:) = zero
      +
      1003 else if (beta /= one) then
      +
      1004 c(i,:) = beta * c(i,:)
      +
      1005 end if
      +
      1006 temp = alpha * a(i)
      +
      1007 if (temp /= one) c(i,:) = c(i,:) + temp * b(:,i)
      +
      1008 end do
      +
      1009 else if (opb == la_hermitian_transpose) then
      +
      1010 ! Compute C = alpha * A * B**H + beta * C
      +
      1011 do i = 1, k
      +
      1012 if (beta == zero) then
      +
      1013 c(i,:) = zero
      +
      1014 else if (beta /= one) then
      +
      1015 c(i,:) = beta * c(i,:)
      +
      1016 end if
      +
      1017 temp = alpha * a(i)
      +
      1018 if (temp /= one) c(i,:) = c(i,:) + temp * conjg(b(:,i))
      +
      1019 end do
      +
      1020 else
      +
      1021 ! Compute C = alpha * A * B + beta * C
      +
      1022 do i = 1, k
      +
      1023 if (beta == zero) then
      +
      1024 c(i,:) = zero
      +
      1025 else if (beta /= one) then
      +
      1026 c(i,:) = beta * c(i,:)
      +
      1027 end if
      +
      1028 temp = alpha * a(i)
      +
      1029 if (temp /= one) c(i,:) = c(i,:) + temp * b(i,:)
      +
      1030 end do
      +
      1031 end if
      +
      1032
      +
      1033 ! Handle extra rows
      +
      1034 if (m > k) then
      +
      1035 if (beta == zero) then
      +
      1036 c(k+1:m,:) = zero
      +
      1037 else
      +
      1038 c(k+1:m,:) = beta * c(k+1:m,:)
      +
      1039 end if
      +
      1040 end if
      +
      1041 else
      +
      1042 if (opb == la_transpose) then
      +
      1043 ! Compute C = alpha * B**T * A + beta * C
      +
      1044 do i = 1, k
      +
      1045 if (beta == zero) then
      +
      1046 c(:,i) = zero
      +
      1047 else if (beta /= one) then
      +
      1048 c(:,i) = beta * c(:,i)
      +
      1049 end if
      +
      1050 temp = alpha * a(i)
      +
      1051 if (temp /= one) c(:,i) = c(:,i) + temp * b(i,:)
      +
      1052 end do
      +
      1053 else if (opb == la_hermitian_transpose) then
      +
      1054 ! Compute C = alpha * B**H * A + beta * C
      +
      1055 do i = 1, k
      +
      1056 if (beta == zero) then
      +
      1057 c(:,i) = zero
      +
      1058 else if (beta /= one) then
      +
      1059 c(:,i) = beta * c(:,i)
      +
      1060 end if
      +
      1061 temp = alpha * a(i)
      +
      1062 if (temp /= one) c(:,i) = c(:,i) + temp * conjg(b(i,:))
      +
      1063 end do
      +
      1064 else
      +
      1065 ! Compute C = alpha * B * A + beta * C
      +
      1066 do i = 1, k
      +
      1067 if (beta == zero) then
      +
      1068 c(:,i) = zero
      +
      1069 else if (beta /= one) then
      +
      1070 c(:,i) = beta * c(:,i)
      +
      1071 end if
      +
      1072 temp = alpha * a(i)
      +
      1073 if (temp /= one) c(:,i) = c(:,i) + temp * b(:,i)
      +
      1074 end do
      +
      1075 end if
      +
      1076
      +
      1077 ! Handle extra columns
      +
      1078 if (n > k) then
      +
      1079 if (beta == zero) then
      +
      1080 c(:,k+1:m) = zero
      +
      1081 else if (beta /= one) then
      +
      1082 c(:,k+1:m) = beta * c(:,k+1:m)
      +
      1083 end if
      +
      1084 end if
      +
      1085 end if
      +
      1086
      +
      1087 ! Formatting
      +
      1088100 format(a, i0, a)
      +
      1089 end subroutine
      +
      1090
      +
      1091! ------------------------------------------------------------------------------
      +
      1092 module subroutine diag_mtx_mult_mtx2_cmplx(lside, alpha, a, b, err)
      +
      1093 ! Arguments
      +
      1094 logical, intent(in) :: lside
      +
      1095 complex(real64), intent(in) :: alpha
      +
      1096 complex(real64), intent(in), dimension(:) :: a
      +
      1097 complex(real64), intent(inout), dimension(:,:) :: b
      +
      1098 class(errors), intent(inout), optional, target :: err
      +
      1099
      +
      1100 ! Parameters
      +
      1101 complex(real64), parameter :: zero = (0.0d0, 0.0d0)
      +
      1102 complex(real64), parameter :: one = (1.0d0, 0.0d0)
      +
      1103
      +
      1104 ! Local Variables
      +
      1105 integer(int32) :: i, m, n, k
      +
      1106 complex(real64) :: temp
      +
      1107 class(errors), pointer :: errmgr
      +
      1108 type(errors), target :: deferr
      +
      1109
      +
      1110 ! Initialization
      +
      1111 m = size(b, 1)
      +
      1112 n = size(b, 2)
      +
      1113 k = size(a)
      +
      1114 if (present(err)) then
      +
      1115 errmgr => err
      +
      1116 else
      +
      1117 errmgr => deferr
      +
      1118 end if
      +
      1119
      +
      1120 ! Input Check
      +
      1121 if ((lside .and. k > m) .or. (.not.lside .and. k > n)) then
      +
      1122 ! ERROR: One of the input arrays is not sized correctly
      +
      1123 call errmgr%report_error("diag_mtx_mult_mtx2_cmplx", &
      +
      1124 "Input number 3 is not sized correctly.", &
      +
      1125 la_array_size_error)
      +
      1126 return
      +
      1127 end if
      +
      1128
      +
      1129 ! Process
      +
      1130 if (lside) then
      +
      1131 ! Compute B = alpha * A * B
      +
      1132 do i = 1, k
      +
      1133 temp = alpha * a(i)
      +
      1134 if (temp /= one) b(i,:) = temp * b(i,:)
      +
      1135 end do
      +
      1136 if (m > k) b(k+1:m,:) = zero
      +
      1137 else
      +
      1138 ! Compute B = alpha * B * A
      +
      1139 do i = 1, k
      +
      1140 temp = alpha * a(i)
      +
      1141 if (temp /= one) b(:,i) = temp * b(:,i)
      +
      1142 end do
      +
      1143 if (n > k) b(:,k+1:n) = zero
      +
      1144 end if
      +
      1145 end subroutine
      +
      1146
      +
      1147! ------------------------------------------------------------------------------
      +
      1148 module subroutine diag_mtx_mult_mtx_mix(lside, opb, alpha, a, b, beta, c, err)
      +
      1149 ! Arguments
      +
      1150 logical, intent(in) :: lside
      +
      1151 integer(int32), intent(in) :: opb
      +
      1152 complex(real64) :: alpha, beta
      +
      1153 real(real64), intent(in), dimension(:) :: a
      +
      1154 complex(real64), intent(in), dimension(:,:) :: b
      +
      1155 complex(real64), intent(inout), dimension(:,:) :: c
      +
      1156 class(errors), intent(inout), optional, target :: err
      +
      1157
      +
      1158 ! Parameters
      +
      1159 complex(real64), parameter :: zero = (0.0d0, 0.0d0)
      +
      1160 complex(real64), parameter :: one = (1.0d0, 0.0d0)
      +
      1161
      +
      1162 ! Local Variables
      +
      1163 integer(int32) :: i, m, n, k, nrowb, ncolb, flag
      +
      1164 complex(real64) :: temp
      +
      1165 class(errors), pointer :: errmgr
      +
      1166 type(errors), target :: deferr
      +
      1167 character(len = 128) :: errmsg
      +
      1168
      +
      1169 ! Initialization
      +
      1170 m = size(c, 1)
      +
      1171 n = size(c, 2)
      +
      1172 k = size(a)
      +
      1173 nrowb = size(b, 1)
      +
      1174 ncolb = size(b, 2)
      +
      1175 if (present(err)) then
      +
      1176 errmgr => err
      +
      1177 else
      +
      1178 errmgr => deferr
      +
      1179 end if
      +
      1180
      +
      1181 ! Input Check
      +
      1182 flag = 0
      +
      1183 if (lside) then
      +
      1184 if (k > m) then
      +
      1185 flag = 4
      +
      1186 else
      +
      1187 if (opb == la_transpose .or. opb == la_hermitian_transpose) then
      +
      1188 ! Compute C = alpha * A * B**T + beta * C
      +
      1189 if (nrowb /= n .or. ncolb < k) flag = 5
      +
      1190 else
      +
      1191 ! Compute C = alpha * A * B + beta * C
      +
      1192 if (nrowb < k .or. ncolb /= n) flag = 5
      +
      1193 end if
      +
      1194 end if
      +
      1195 else
      +
      1196 if (k > n) then
      +
      1197 flag = 4
      +
      1198 else
      +
      1199 if (opb == la_transpose .or. opb == la_hermitian_transpose) then
      +
      1200 ! Compute C = alpha * B**T * A + beta * C
      +
      1201 if (ncolb /= m .or. nrowb < k) flag = 5
      +
      1202 else
      +
      1203 ! Compute C = alpha * B * A + beta * C
      +
      1204 if (nrowb /= m .or. ncolb < k) flag = 5
      +
      1205 end if
      +
      1206 end if
      +
      1207 end if
      +
      1208 if (flag /= 0) then
      +
      1209 ! ERROR: One of the input arrays is not sized correctly
      +
      1210 write(errmsg, 100) "Input number ", flag, &
      +
      1211 " is not sized correctly."
      +
      1212 call errmgr%report_error("diag_mtx_mult_mtx_mix", trim(errmsg), &
      +
      1213 la_array_size_error)
      +
      1214 return
      +
      1215 end if
      +
      1216
      +
      1217 ! Deal with ALPHA == 0
      +
      1218 if (alpha == 0) then
      +
      1219 if (beta == zero) then
      +
      1220 c = zero
      +
      1221 else if (beta /= one) then
      +
      1222 c = beta * c
      +
      1223 end if
      +
      1224 return
      +
      1225 end if
      +
      1226
      +
      1227 ! Process
      +
      1228 if (lside) then
      +
      1229 if (opb == la_transpose) then
      +
      1230 ! Compute C = alpha * A * B**T + beta * C
      +
      1231 do i = 1, k
      +
      1232 if (beta == zero) then
      +
      1233 c(i,:) = zero
      +
      1234 else if (beta /= one) then
      +
      1235 c(i,:) = beta * c(i,:)
      +
      1236 end if
      +
      1237 temp = alpha * a(i)
      +
      1238 if (temp /= one) c(i,:) = c(i,:) + temp * b(:,i)
      +
      1239 end do
      +
      1240 else if (opb == la_hermitian_transpose) then
      +
      1241 ! Compute C = alpha * A * B**H + beta * C
      +
      1242 do i = 1, k
      +
      1243 if (beta == zero) then
      +
      1244 c(i,:) = zero
      +
      1245 else if (beta /= one) then
      +
      1246 c(i,:) = beta * c(i,:)
      +
      1247 end if
      +
      1248 temp = alpha * a(i)
      +
      1249 if (temp /= one) c(i,:) = c(i,:) + temp * conjg(b(:,i))
      +
      1250 end do
      +
      1251 else
      +
      1252 ! Compute C = alpha * A * B + beta * C
      +
      1253 do i = 1, k
      +
      1254 if (beta == zero) then
      +
      1255 c(i,:) = zero
      +
      1256 else if (beta /= one) then
      +
      1257 c(i,:) = beta * c(i,:)
      +
      1258 end if
      +
      1259 temp = alpha * a(i)
      +
      1260 if (temp /= one) c(i,:) = c(i,:) + temp * b(i,:)
      +
      1261 end do
      +
      1262 end if
      +
      1263
      +
      1264 ! Handle extra rows
      +
      1265 if (m > k) then
      +
      1266 if (beta == zero) then
      +
      1267 c(k+1:m,:) = zero
      +
      1268 else
      +
      1269 c(k+1:m,:) = beta * c(k+1:m,:)
      +
      1270 end if
      +
      1271 end if
      +
      1272 else
      +
      1273 if (opb == la_transpose) then
      +
      1274 ! Compute C = alpha * B**T * A + beta * C
      +
      1275 do i = 1, k
      +
      1276 if (beta == zero) then
      +
      1277 c(:,i) = zero
      +
      1278 else if (beta /= one) then
      +
      1279 c(:,i) = beta * c(:,i)
      +
      1280 end if
      +
      1281 temp = alpha * a(i)
      +
      1282 if (temp /= one) c(:,i) = c(:,i) + temp * b(i,:)
      +
      1283 end do
      +
      1284 else if (opb == la_hermitian_transpose) then
      +
      1285 ! Compute C = alpha * B**H * A + beta * C
      +
      1286 do i = 1, k
      +
      1287 if (beta == zero) then
      +
      1288 c(:,i) = zero
      +
      1289 else if (beta /= one) then
      +
      1290 c(:,i) = beta * c(:,i)
      +
      1291 end if
      +
      1292 temp = alpha * a(i)
      +
      1293 if (temp /= one) c(:,i) = c(:,i) + temp * conjg(b(i,:))
      +
      1294 end do
      +
      1295 else
      +
      1296 ! Compute C = alpha * B * A + beta * C
      +
      1297 do i = 1, k
      +
      1298 if (beta == zero) then
      +
      1299 c(:,i) = zero
      +
      1300 else if (beta /= one) then
      +
      1301 c(:,i) = beta * c(:,i)
      +
      1302 end if
      +
      1303 temp = alpha * a(i)
      +
      1304 if (temp /= one) c(:,i) = c(:,i) + temp * b(:,i)
      +
      1305 end do
      +
      1306 end if
      1307
      -
      1308 ! Local Variables
      -
      1309 integer(int32) :: i, m, n, k
      -
      1310 complex(real64) :: temp
      -
      1311 class(errors), pointer :: errmgr
      -
      1312 type(errors), target :: deferr
      -
      1313
      -
      1314 ! Initialization
      -
      1315 m = size(b, 1)
      -
      1316 n = size(b, 2)
      -
      1317 k = size(a)
      -
      1318 if (present(err)) then
      -
      1319 errmgr => err
      -
      1320 else
      -
      1321 errmgr => deferr
      -
      1322 end if
      -
      1323
      -
      1324 ! Input Check
      -
      1325 if ((lside .and. k > m) .or. (.not.lside .and. k > n)) then
      -
      1326 ! ERROR: One of the input arrays is not sized correctly
      -
      1327 call errmgr%report_error("diag_mtx_mult_mtx2_cmplx", &
      -
      1328 "Input number 3 is not sized correctly.", &
      -
      1329 la_array_size_error)
      -
      1330 return
      -
      1331 end if
      -
      1332
      -
      1333 ! Process
      -
      1334 if (lside) then
      -
      1335 ! Compute B = alpha * A * B
      -
      1336 do i = 1, k
      -
      1337 temp = alpha * a(i)
      -
      1338 if (temp /= one) b(i,:) = temp * b(i,:)
      -
      1339 end do
      -
      1340 if (m > k) b(k+1:m,:) = zero
      -
      1341 else
      -
      1342 ! Compute B = alpha * B * A
      -
      1343 do i = 1, k
      -
      1344 temp = alpha * a(i)
      -
      1345 if (temp /= one) b(:,i) = temp * b(:,i)
      -
      1346 end do
      -
      1347 if (n > k) b(:,k+1:n) = zero
      -
      1348 end if
      -
      1349 end subroutine
      +
      1308 ! Handle extra columns
      +
      1309 if (n > k) then
      +
      1310 if (beta == zero) then
      +
      1311 c(:,k+1:m) = zero
      +
      1312 else if (beta /= one) then
      +
      1313 c(:,k+1:m) = beta * c(:,k+1:m)
      +
      1314 end if
      +
      1315 end if
      +
      1316 end if
      +
      1317
      +
      1318 ! Formatting
      +
      1319100 format(a, i0, a)
      +
      1320 end subroutine
      +
      1321
      +
      1322! ------------------------------------------------------------------------------
      +
      1323 module subroutine diag_mtx_mult_mtx2_mix(lside, alpha, a, b, err)
      +
      1324 ! Arguments
      +
      1325 logical, intent(in) :: lside
      +
      1326 complex(real64), intent(in) :: alpha
      +
      1327 real(real64), intent(in), dimension(:) :: a
      +
      1328 complex(real64), intent(inout), dimension(:,:) :: b
      +
      1329 class(errors), intent(inout), optional, target :: err
      +
      1330
      +
      1331 ! Parameters
      +
      1332 complex(real64), parameter :: zero = (0.0d0, 0.0d0)
      +
      1333 complex(real64), parameter :: one = (1.0d0, 0.0d0)
      +
      1334
      +
      1335 ! Local Variables
      +
      1336 integer(int32) :: i, m, n, k
      +
      1337 complex(real64) :: temp
      +
      1338 class(errors), pointer :: errmgr
      +
      1339 type(errors), target :: deferr
      +
      1340
      +
      1341 ! Initialization
      +
      1342 m = size(b, 1)
      +
      1343 n = size(b, 2)
      +
      1344 k = size(a)
      +
      1345 if (present(err)) then
      +
      1346 errmgr => err
      +
      1347 else
      +
      1348 errmgr => deferr
      +
      1349 end if
      1350
      -
      1351! ******************************************************************************
      -
      1352! BASIC OPERATION ROUTINES
      -
      1353! ------------------------------------------------------------------------------
      -
      1354 pure module function trace_dbl(x) result(y)
      -
      1355 ! Arguments
      -
      1356 real(real64), intent(in), dimension(:,:) :: x
      -
      1357 real(real64) :: y
      -
      1358
      -
      1359 ! Parameters
      -
      1360 real(real64), parameter :: zero = 0.0d0
      -
      1361
      -
      1362 ! Local Variables
      -
      1363 integer(int32) :: i, m, n, mn
      -
      1364
      -
      1365 ! Initialization
      -
      1366 y = zero
      -
      1367 m = size(x, 1)
      -
      1368 n = size(x, 2)
      -
      1369 mn = min(m, n)
      -
      1370
      -
      1371 ! Process
      -
      1372 do i = 1, mn
      -
      1373 y = y + x(i,i)
      -
      1374 end do
      -
      1375 end function
      -
      1376
      -
      1377! ------------------------------------------------------------------------------
      -
      1378 pure module function trace_cmplx(x) result(y)
      -
      1379 ! Arguments
      -
      1380 complex(real64), intent(in), dimension(:,:) :: x
      -
      1381 complex(real64) :: y
      -
      1382
      -
      1383 ! Parameters
      -
      1384 complex(real64), parameter :: zero = (0.0d0, 0.0d0)
      +
      1351 ! Input Check
      +
      1352 if ((lside .and. k > m) .or. (.not.lside .and. k > n)) then
      +
      1353 ! ERROR: One of the input arrays is not sized correctly
      +
      1354 call errmgr%report_error("diag_mtx_mult_mtx2_cmplx", &
      +
      1355 "Input number 3 is not sized correctly.", &
      +
      1356 la_array_size_error)
      +
      1357 return
      +
      1358 end if
      +
      1359
      +
      1360 ! Process
      +
      1361 if (lside) then
      +
      1362 ! Compute B = alpha * A * B
      +
      1363 do i = 1, k
      +
      1364 temp = alpha * a(i)
      +
      1365 if (temp /= one) b(i,:) = temp * b(i,:)
      +
      1366 end do
      +
      1367 if (m > k) b(k+1:m,:) = zero
      +
      1368 else
      +
      1369 ! Compute B = alpha * B * A
      +
      1370 do i = 1, k
      +
      1371 temp = alpha * a(i)
      +
      1372 if (temp /= one) b(:,i) = temp * b(:,i)
      +
      1373 end do
      +
      1374 if (n > k) b(:,k+1:n) = zero
      +
      1375 end if
      +
      1376 end subroutine
      +
      1377
      +
      1378! ******************************************************************************
      +
      1379! BASIC OPERATION ROUTINES
      +
      1380! ------------------------------------------------------------------------------
      +
      1381 pure module function trace_dbl(x) result(y)
      +
      1382 ! Arguments
      +
      1383 real(real64), intent(in), dimension(:,:) :: x
      +
      1384 real(real64) :: y
      1385
      -
      1386 ! Local Variables
      -
      1387 integer(int32) :: i, m, n, mn
      +
      1386 ! Parameters
      +
      1387 real(real64), parameter :: zero = 0.0d0
      1388
      -
      1389 ! Initialization
      -
      1390 y = zero
      -
      1391 m = size(x, 1)
      -
      1392 n = size(x, 2)
      -
      1393 mn = min(m, n)
      -
      1394
      -
      1395 ! Process
      -
      1396 do i = 1, mn
      -
      1397 y = y + x(i,i)
      -
      1398 end do
      -
      1399 end function
      -
      1400
      -
      1401! ------------------------------------------------------------------------------
      -
      1402 module function mtx_rank_dbl(a, tol, work, olwork, err) result(rnk)
      -
      1403 ! Arguments
      -
      1404 real(real64), intent(inout), dimension(:,:) :: a
      -
      1405 real(real64), intent(in), optional :: tol
      -
      1406 real(real64), intent(out), target, optional, dimension(:) :: work
      -
      1407 integer(int32), intent(out), optional :: olwork
      -
      1408 class(errors), intent(inout), optional, target :: err
      -
      1409 integer(int32) :: rnk
      -
      1410
      -
      1411 ! External Function Interfaces
      -
      1412 interface
      -
      1413 function dlamch(cmach) result(x)
      -
      1414 use, intrinsic :: iso_fortran_env, only : real64
      -
      1415 character, intent(in) :: cmach
      -
      1416 real(real64) :: x
      -
      1417 end function
      -
      1418 end interface
      -
      1419
      -
      1420 ! Local Variables
      -
      1421 integer(int32) :: i, m, n, mn, istat, lwork, flag
      -
      1422 real(real64), pointer, dimension(:) :: wptr, s, w
      -
      1423 real(real64), allocatable, target, dimension(:) :: wrk
      -
      1424 real(real64) :: t, tref, smlnum
      -
      1425 real(real64), dimension(1) :: dummy, temp
      -
      1426 class(errors), pointer :: errmgr
      -
      1427 type(errors), target :: deferr
      -
      1428 character(len = 128) :: errmsg
      -
      1429
      -
      1430 ! Initialization
      -
      1431 m = size(a, 1)
      -
      1432 n = size(a, 2)
      -
      1433 mn = min(m, n)
      -
      1434 smlnum = dlamch('s')
      -
      1435 rnk = 0
      -
      1436 if (present(err)) then
      -
      1437 errmgr => err
      -
      1438 else
      -
      1439 errmgr => deferr
      -
      1440 end if
      -
      1441
      -
      1442 ! Workspace Query
      -
      1443 !call svd(a, a(1:mn,1), olwork = lwork)
      -
      1444 call dgesvd('N', 'N', m, n, a, m, dummy, dummy, m, dummy, n, temp, &
      -
      1445 -1, flag)
      -
      1446 lwork = int(temp(1), int32) + mn
      -
      1447 if (present(olwork)) then
      -
      1448 olwork = lwork
      -
      1449 return
      -
      1450 end if
      -
      1451
      -
      1452 ! Local Memory Allocation
      -
      1453 if (present(work)) then
      -
      1454 if (size(work) < lwork) then
      -
      1455 ! ERROR: WORK not sized correctly
      -
      1456 call errmgr%report_error("mtx_rank", &
      -
      1457 "Incorrectly sized input array WORK, argument 5.", &
      -
      1458 la_array_size_error)
      -
      1459 return
      -
      1460 end if
      -
      1461 wptr => work(1:lwork)
      -
      1462 else
      -
      1463 allocate(wrk(lwork), stat = istat)
      -
      1464 if (istat /= 0) then
      -
      1465 ! ERROR: Out of memory
      -
      1466 call errmgr%report_error("mtx_rank", &
      -
      1467 "Insufficient memory available.", &
      -
      1468 la_out_of_memory_error)
      -
      1469 return
      -
      1470 end if
      -
      1471 wptr => wrk
      -
      1472 end if
      -
      1473 s => wptr(1:mn)
      -
      1474 w => wptr(mn+1:lwork)
      -
      1475
      -
      1476 ! Compute the singular values of A
      -
      1477 call dgesvd('N', 'N', m, n, a, m, s, dummy, m, dummy, n, w, &
      -
      1478 lwork - mn, flag)
      -
      1479 if (flag > 0) then
      -
      1480 write(errmsg, '(I0A)') flag, " superdiagonals could not " // &
      -
      1481 "converge to zero as part of the QR iteration process."
      -
      1482 call errmgr%report_warning("mtx_rank", errmsg, la_convergence_error)
      -
      1483 end if
      -
      1484
      -
      1485 ! Determine the threshold tolerance for the singular values such that
      -
      1486 ! singular values less than the threshold result in zero when inverted.
      -
      1487 tref = max(m, n) * epsilon(t) * s(1)
      -
      1488 if (present(tol)) then
      -
      1489 t = tol
      -
      1490 else
      -
      1491 t = tref
      -
      1492 end if
      -
      1493 if (t < smlnum) then
      -
      1494 ! ! The supplied tolerance is too small, simply fall back to the
      -
      1495 ! ! default, but issue a warning to the user
      -
      1496 ! t = tref
      -
      1497 ! call report_warning("mtx_rank", "The supplied tolerance was " // &
      -
      1498 ! "smaller than a value that would result in an overflow " // &
      -
      1499 ! "condition, or is negative; therefore, the tolerance has " // &
      -
      1500 ! "been reset to its default value.")
      -
      1501 end if
      +
      1389 ! Local Variables
      +
      1390 integer(int32) :: i, m, n, mn
      +
      1391
      +
      1392 ! Initialization
      +
      1393 y = zero
      +
      1394 m = size(x, 1)
      +
      1395 n = size(x, 2)
      +
      1396 mn = min(m, n)
      +
      1397
      +
      1398 ! Process
      +
      1399 do i = 1, mn
      +
      1400 y = y + x(i,i)
      +
      1401 end do
      +
      1402 end function
      +
      1403
      +
      1404! ------------------------------------------------------------------------------
      +
      1405 pure module function trace_cmplx(x) result(y)
      +
      1406 ! Arguments
      +
      1407 complex(real64), intent(in), dimension(:,:) :: x
      +
      1408 complex(real64) :: y
      +
      1409
      +
      1410 ! Parameters
      +
      1411 complex(real64), parameter :: zero = (0.0d0, 0.0d0)
      +
      1412
      +
      1413 ! Local Variables
      +
      1414 integer(int32) :: i, m, n, mn
      +
      1415
      +
      1416 ! Initialization
      +
      1417 y = zero
      +
      1418 m = size(x, 1)
      +
      1419 n = size(x, 2)
      +
      1420 mn = min(m, n)
      +
      1421
      +
      1422 ! Process
      +
      1423 do i = 1, mn
      +
      1424 y = y + x(i,i)
      +
      1425 end do
      +
      1426 end function
      +
      1427
      +
      1428! ------------------------------------------------------------------------------
      +
      1429 module function mtx_rank_dbl(a, tol, work, olwork, err) result(rnk)
      +
      1430 ! Arguments
      +
      1431 real(real64), intent(inout), dimension(:,:) :: a
      +
      1432 real(real64), intent(in), optional :: tol
      +
      1433 real(real64), intent(out), target, optional, dimension(:) :: work
      +
      1434 integer(int32), intent(out), optional :: olwork
      +
      1435 class(errors), intent(inout), optional, target :: err
      +
      1436 integer(int32) :: rnk
      +
      1437
      +
      1438 ! External Function Interfaces
      +
      1439 interface
      +
      1440 function dlamch(cmach) result(x)
      +
      1441 use, intrinsic :: iso_fortran_env, only : real64
      +
      1442 character, intent(in) :: cmach
      +
      1443 real(real64) :: x
      +
      1444 end function
      +
      1445 end interface
      +
      1446
      +
      1447 ! Local Variables
      +
      1448 integer(int32) :: i, m, n, mn, istat, lwork, flag
      +
      1449 real(real64), pointer, dimension(:) :: wptr, s, w
      +
      1450 real(real64), allocatable, target, dimension(:) :: wrk
      +
      1451 real(real64) :: t, tref, smlnum
      +
      1452 real(real64), dimension(1) :: dummy, temp
      +
      1453 class(errors), pointer :: errmgr
      +
      1454 type(errors), target :: deferr
      +
      1455 character(len = 128) :: errmsg
      +
      1456
      +
      1457 ! Initialization
      +
      1458 m = size(a, 1)
      +
      1459 n = size(a, 2)
      +
      1460 mn = min(m, n)
      +
      1461 smlnum = dlamch('s')
      +
      1462 rnk = 0
      +
      1463 if (present(err)) then
      +
      1464 errmgr => err
      +
      1465 else
      +
      1466 errmgr => deferr
      +
      1467 end if
      +
      1468
      +
      1469 ! Workspace Query
      +
      1470 !call svd(a, a(1:mn,1), olwork = lwork)
      +
      1471 call dgesvd('N', 'N', m, n, a, m, dummy, dummy, m, dummy, n, temp, &
      +
      1472 -1, flag)
      +
      1473 lwork = int(temp(1), int32) + mn
      +
      1474 if (present(olwork)) then
      +
      1475 olwork = lwork
      +
      1476 return
      +
      1477 end if
      +
      1478
      +
      1479 ! Local Memory Allocation
      +
      1480 if (present(work)) then
      +
      1481 if (size(work) < lwork) then
      +
      1482 ! ERROR: WORK not sized correctly
      +
      1483 call errmgr%report_error("mtx_rank", &
      +
      1484 "Incorrectly sized input array WORK, argument 5.", &
      +
      1485 la_array_size_error)
      +
      1486 return
      +
      1487 end if
      +
      1488 wptr => work(1:lwork)
      +
      1489 else
      +
      1490 allocate(wrk(lwork), stat = istat)
      +
      1491 if (istat /= 0) then
      +
      1492 ! ERROR: Out of memory
      +
      1493 call errmgr%report_error("mtx_rank", &
      +
      1494 "Insufficient memory available.", &
      +
      1495 la_out_of_memory_error)
      +
      1496 return
      +
      1497 end if
      +
      1498 wptr => wrk
      +
      1499 end if
      +
      1500 s => wptr(1:mn)
      +
      1501 w => wptr(mn+1:lwork)
      1502
      -
      1503 ! Count the singular values that are larger than the tolerance value
      -
      1504 do i = 1, mn
      -
      1505 if (s(i) < t) exit
      -
      1506 rnk = rnk + 1
      -
      1507 end do
      -
      1508 end function
      -
      1509
      -
      1510! ------------------------------------------------------------------------------
      -
      1511 module function mtx_rank_cmplx(a, tol, work, olwork, rwork, err) result(rnk)
      -
      1512 ! Arguments
      -
      1513 complex(real64), intent(inout), dimension(:,:) :: a
      -
      1514 real(real64), intent(in), optional :: tol
      -
      1515 complex(real64), intent(out), target, optional, dimension(:) :: work
      -
      1516 integer(int32), intent(out), optional :: olwork
      -
      1517 real(real64), intent(out), target, optional, dimension(:) :: rwork
      -
      1518 class(errors), intent(inout), optional, target :: err
      -
      1519 integer(int32) :: rnk
      -
      1520
      -
      1521 ! External Function Interfaces
      -
      1522 interface
      -
      1523 function dlamch(cmach) result(x)
      -
      1524 use, intrinsic :: iso_fortran_env, only : real64
      -
      1525 character, intent(in) :: cmach
      -
      1526 real(real64) :: x
      -
      1527 end function
      -
      1528 end interface
      +
      1503 ! Compute the singular values of A
      +
      1504 call dgesvd('N', 'N', m, n, a, m, s, dummy, m, dummy, n, w, &
      +
      1505 lwork - mn, flag)
      +
      1506 if (flag > 0) then
      +
      1507 write(errmsg, 100) flag, " superdiagonals could not " // &
      +
      1508 "converge to zero as part of the QR iteration process."
      +
      1509 call errmgr%report_warning("mtx_rank", errmsg, la_convergence_error)
      +
      1510 end if
      +
      1511
      +
      1512 ! Determine the threshold tolerance for the singular values such that
      +
      1513 ! singular values less than the threshold result in zero when inverted.
      +
      1514 tref = max(m, n) * epsilon(t) * s(1)
      +
      1515 if (present(tol)) then
      +
      1516 t = tol
      +
      1517 else
      +
      1518 t = tref
      +
      1519 end if
      +
      1520 if (t < smlnum) then
      +
      1521 ! ! The supplied tolerance is too small, simply fall back to the
      +
      1522 ! ! default, but issue a warning to the user
      +
      1523 ! t = tref
      +
      1524 ! call report_warning("mtx_rank", "The supplied tolerance was " // &
      +
      1525 ! "smaller than a value that would result in an overflow " // &
      +
      1526 ! "condition, or is negative; therefore, the tolerance has " // &
      +
      1527 ! "been reset to its default value.")
      +
      1528 end if
      1529
      -
      1530 ! Local Variables
      -
      1531 integer(int32) :: i, m, n, mn, istat, lwork, flag, lrwork
      -
      1532 real(real64), pointer, dimension(:) :: s, rwptr, rw
      -
      1533 real(real64), allocatable, target, dimension(:) :: rwrk
      -
      1534 complex(real64), allocatable, target, dimension(:) :: wrk
      -
      1535 complex(real64), pointer, dimension(:) :: wptr
      -
      1536 real(real64) :: t, tref, smlnum
      -
      1537 real(real64), dimension(1) :: dummy
      -
      1538 complex(real64), dimension(1) :: cdummy, temp
      -
      1539 class(errors), pointer :: errmgr
      -
      1540 type(errors), target :: deferr
      -
      1541 character(len = 128) :: errmsg
      -
      1542
      -
      1543 ! Initialization
      -
      1544 m = size(a, 1)
      -
      1545 n = size(a, 2)
      -
      1546 mn = min(m, n)
      -
      1547 lrwork = 6 * mn
      -
      1548 smlnum = dlamch('s')
      -
      1549 rnk = 0
      -
      1550 if (present(err)) then
      -
      1551 errmgr => err
      -
      1552 else
      -
      1553 errmgr => deferr
      -
      1554 end if
      -
      1555
      -
      1556 ! Workspace Query
      -
      1557 call zgesvd('N', 'N', m, n, a, m, dummy, cdummy, m, cdummy, n, temp, &
      -
      1558 -1, dummy, flag)
      -
      1559 lwork = int(temp(1), int32)
      -
      1560 if (present(olwork)) then
      -
      1561 olwork = lwork
      -
      1562 return
      -
      1563 end if
      -
      1564
      -
      1565 ! Local Memory Allocation
      -
      1566 if (present(work)) then
      -
      1567 if (size(work) < lwork) then
      -
      1568 ! ERROR: WORK not sized correctly
      -
      1569 call errmgr%report_error("mtx_rank_cmplx", &
      -
      1570 "Incorrectly sized input array WORK, argument 5.", &
      -
      1571 la_array_size_error)
      -
      1572 return
      -
      1573 end if
      -
      1574 wptr => work(1:lwork)
      -
      1575 else
      -
      1576 allocate(wrk(lwork), stat = istat)
      -
      1577 if (istat /= 0) then
      -
      1578 ! ERROR: Out of memory
      -
      1579 call errmgr%report_error("mtx_rank_cmplx", &
      -
      1580 "Insufficient memory available.", &
      -
      1581 la_out_of_memory_error)
      -
      1582 return
      -
      1583 end if
      -
      1584 wptr => wrk
      -
      1585 end if
      -
      1586
      -
      1587 if (present(rwork)) then
      -
      1588 if (size(rwork) < lrwork) then
      -
      1589 ! ERROR: RWORK not sized correctly
      -
      1590 call errmgr%report_error("mtx_rank_cmplx", &
      -
      1591 "Incorrectly sized input array RWORK.", &
      -
      1592 la_array_size_error)
      -
      1593 return
      -
      1594 end if
      -
      1595 rwptr => rwork(1:lrwork)
      -
      1596 else
      -
      1597 allocate(rwrk(lrwork), stat = istat)
      -
      1598 if (istat /= 0) then
      -
      1599 end if
      -
      1600 rwptr => rwrk
      -
      1601 end if
      -
      1602 s => rwptr(1:mn)
      -
      1603 rw => rwptr(mn+1:lrwork)
      -
      1604
      -
      1605 ! Compute the singular values of A
      -
      1606 call zgesvd('N', 'N', m, n, a, m, s, cdummy, m, cdummy, n, wptr, &
      -
      1607 lwork - mn, rw, flag)
      -
      1608 if (flag > 0) then
      -
      1609 write(errmsg, '(I0A)') flag, " superdiagonals could not " // &
      -
      1610 "converge to zero as part of the QR iteration process."
      -
      1611 call errmgr%report_warning("mtx_rank_cmplx", errmsg, la_convergence_error)
      -
      1612 end if
      -
      1613
      -
      1614 ! Determine the threshold tolerance for the singular values such that
      -
      1615 ! singular values less than the threshold result in zero when inverted.
      -
      1616 tref = max(m, n) * epsilon(t) * s(1)
      -
      1617 if (present(tol)) then
      -
      1618 t = tol
      -
      1619 else
      -
      1620 t = tref
      -
      1621 end if
      -
      1622 if (t < smlnum) then
      -
      1623 ! ! The supplied tolerance is too small, simply fall back to the
      -
      1624 ! ! default, but issue a warning to the user
      -
      1625 ! t = tref
      -
      1626 ! call report_warning("mtx_rank", "The supplied tolerance was " // &
      -
      1627 ! "smaller than a value that would result in an overflow " // &
      -
      1628 ! "condition, or is negative; therefore, the tolerance has " // &
      -
      1629 ! "been reset to its default value.")
      -
      1630 end if
      -
      1631
      -
      1632 ! Count the singular values that are larger than the tolerance value
      -
      1633 do i = 1, mn
      -
      1634 if (s(i) < t) exit
      -
      1635 rnk = rnk + 1
      -
      1636 end do
      -
      1637 end function
      -
      1638
      -
      1639! ------------------------------------------------------------------------------
      -
      1640 module function det_dbl(a, iwork, err) result(x)
      -
      1641 ! Arguments
      -
      1642 real(real64), intent(inout), dimension(:,:) :: a
      -
      1643 integer(int32), intent(out), target, optional, dimension(:) :: iwork
      -
      1644 class(errors), intent(inout), optional, target :: err
      -
      1645 real(real64) :: x
      -
      1646
      -
      1647 ! Parameters
      -
      1648 real(real64), parameter :: zero = 0.0d0
      -
      1649 real(real64), parameter :: one = 1.0d0
      -
      1650 real(real64), parameter :: ten = 1.0d1
      -
      1651 real(real64), parameter :: p1 = 1.0d-1
      -
      1652
      -
      1653 ! Local Variables
      -
      1654 integer(int32) :: i, ep, n, istat, flag
      -
      1655 integer(int32), pointer, dimension(:) :: ipvt
      -
      1656 integer(int32), allocatable, target, dimension(:) :: iwrk
      -
      1657 real(real64) :: temp
      -
      1658 class(errors), pointer :: errmgr
      -
      1659 type(errors), target :: deferr
      -
      1660
      -
      1661 ! Initialization
      -
      1662 n = size(a, 1)
      -
      1663 x = zero
      -
      1664 if (present(err)) then
      -
      1665 errmgr => err
      -
      1666 else
      -
      1667 errmgr => deferr
      -
      1668 end if
      -
      1669
      -
      1670 ! Input Check
      -
      1671 if (size(a, 2) /= n) then
      -
      1672 call errmgr%report_error("det", &
      -
      1673 "The supplied matrix must be square.", la_array_size_error)
      -
      1674 return
      -
      1675 end if
      -
      1676
      -
      1677 ! Local Memory Allocation
      -
      1678 if (present(iwork)) then
      -
      1679 if (size(iwork) < n) then
      -
      1680 ! ERROR: WORK not sized correctly
      -
      1681 call errmgr%report_error("det", &
      -
      1682 "Incorrectly sized input array IWORK, argument 2.", &
      -
      1683 la_array_size_error)
      -
      1684 return
      -
      1685 end if
      -
      1686 ipvt => iwork(1:n)
      -
      1687 else
      -
      1688 allocate(iwrk(n), stat = istat)
      -
      1689 if (istat /= 0) then
      -
      1690 ! ERROR: Out of memory
      -
      1691 call errmgr%report_error("det", &
      -
      1692 "Insufficient memory available.", &
      -
      1693 la_out_of_memory_error)
      -
      1694 return
      -
      1695 end if
      -
      1696 ipvt => iwrk
      -
      1697 end if
      -
      1698
      -
      1699 ! Compute the LU factorization of A
      -
      1700 call dgetrf(n, n, a, n, ipvt, flag)
      -
      1701 if (flag > 0) then
      -
      1702 ! A singular matrix has a determinant of zero
      -
      1703 x = zero
      -
      1704 return
      -
      1705 end if
      -
      1706
      -
      1707 ! Compute the product of the diagonal of A
      -
      1708 temp = one
      -
      1709 ep = 0
      -
      1710 do i = 1, n
      -
      1711 if (ipvt(i) /= i) temp = -temp
      -
      1712
      -
      1713 temp = a(i,i) * temp
      -
      1714 if (temp == zero) then
      -
      1715 x = zero
      -
      1716 exit
      -
      1717 end if
      -
      1718
      -
      1719 do while (abs(temp) < one)
      -
      1720 temp = ten * temp
      -
      1721 ep = ep - 1
      -
      1722 end do
      -
      1723
      -
      1724 do while (abs(temp) > ten)
      -
      1725 temp = p1 * temp
      -
      1726 ep = ep + 1
      -
      1727 end do
      -
      1728 end do
      -
      1729 x = temp * ten**ep
      -
      1730 end function
      +
      1530 ! Count the singular values that are larger than the tolerance value
      +
      1531 do i = 1, mn
      +
      1532 if (s(i) < t) exit
      +
      1533 rnk = rnk + 1
      +
      1534 end do
      +
      1535
      +
      1536 ! Formatting
      +
      1537100 format(i0, a)
      +
      1538 end function
      +
      1539
      +
      1540! ------------------------------------------------------------------------------
      +
      1541 module function mtx_rank_cmplx(a, tol, work, olwork, rwork, err) result(rnk)
      +
      1542 ! Arguments
      +
      1543 complex(real64), intent(inout), dimension(:,:) :: a
      +
      1544 real(real64), intent(in), optional :: tol
      +
      1545 complex(real64), intent(out), target, optional, dimension(:) :: work
      +
      1546 integer(int32), intent(out), optional :: olwork
      +
      1547 real(real64), intent(out), target, optional, dimension(:) :: rwork
      +
      1548 class(errors), intent(inout), optional, target :: err
      +
      1549 integer(int32) :: rnk
      +
      1550
      +
      1551 ! External Function Interfaces
      +
      1552 interface
      +
      1553 function dlamch(cmach) result(x)
      +
      1554 use, intrinsic :: iso_fortran_env, only : real64
      +
      1555 character, intent(in) :: cmach
      +
      1556 real(real64) :: x
      +
      1557 end function
      +
      1558 end interface
      +
      1559
      +
      1560 ! Local Variables
      +
      1561 integer(int32) :: i, m, n, mn, istat, lwork, flag, lrwork
      +
      1562 real(real64), pointer, dimension(:) :: s, rwptr, rw
      +
      1563 real(real64), allocatable, target, dimension(:) :: rwrk
      +
      1564 complex(real64), allocatable, target, dimension(:) :: wrk
      +
      1565 complex(real64), pointer, dimension(:) :: wptr
      +
      1566 real(real64) :: t, tref, smlnum
      +
      1567 real(real64), dimension(1) :: dummy
      +
      1568 complex(real64), dimension(1) :: cdummy, temp
      +
      1569 class(errors), pointer :: errmgr
      +
      1570 type(errors), target :: deferr
      +
      1571 character(len = 128) :: errmsg
      +
      1572
      +
      1573 ! Initialization
      +
      1574 m = size(a, 1)
      +
      1575 n = size(a, 2)
      +
      1576 mn = min(m, n)
      +
      1577 lrwork = 6 * mn
      +
      1578 smlnum = dlamch('s')
      +
      1579 rnk = 0
      +
      1580 if (present(err)) then
      +
      1581 errmgr => err
      +
      1582 else
      +
      1583 errmgr => deferr
      +
      1584 end if
      +
      1585
      +
      1586 ! Workspace Query
      +
      1587 call zgesvd('N', 'N', m, n, a, m, dummy, cdummy, m, cdummy, n, temp, &
      +
      1588 -1, dummy, flag)
      +
      1589 lwork = int(temp(1), int32)
      +
      1590 if (present(olwork)) then
      +
      1591 olwork = lwork
      +
      1592 return
      +
      1593 end if
      +
      1594
      +
      1595 ! Local Memory Allocation
      +
      1596 if (present(work)) then
      +
      1597 if (size(work) < lwork) then
      +
      1598 ! ERROR: WORK not sized correctly
      +
      1599 call errmgr%report_error("mtx_rank_cmplx", &
      +
      1600 "Incorrectly sized input array WORK, argument 5.", &
      +
      1601 la_array_size_error)
      +
      1602 return
      +
      1603 end if
      +
      1604 wptr => work(1:lwork)
      +
      1605 else
      +
      1606 allocate(wrk(lwork), stat = istat)
      +
      1607 if (istat /= 0) then
      +
      1608 ! ERROR: Out of memory
      +
      1609 call errmgr%report_error("mtx_rank_cmplx", &
      +
      1610 "Insufficient memory available.", &
      +
      1611 la_out_of_memory_error)
      +
      1612 return
      +
      1613 end if
      +
      1614 wptr => wrk
      +
      1615 end if
      +
      1616
      +
      1617 if (present(rwork)) then
      +
      1618 if (size(rwork) < lrwork) then
      +
      1619 ! ERROR: RWORK not sized correctly
      +
      1620 call errmgr%report_error("mtx_rank_cmplx", &
      +
      1621 "Incorrectly sized input array RWORK.", &
      +
      1622 la_array_size_error)
      +
      1623 return
      +
      1624 end if
      +
      1625 rwptr => rwork(1:lrwork)
      +
      1626 else
      +
      1627 allocate(rwrk(lrwork), stat = istat)
      +
      1628 if (istat /= 0) then
      +
      1629 end if
      +
      1630 rwptr => rwrk
      +
      1631 end if
      +
      1632 s => rwptr(1:mn)
      +
      1633 rw => rwptr(mn+1:lrwork)
      +
      1634
      +
      1635 ! Compute the singular values of A
      +
      1636 call zgesvd('N', 'N', m, n, a, m, s, cdummy, m, cdummy, n, wptr, &
      +
      1637 lwork - mn, rw, flag)
      +
      1638 if (flag > 0) then
      +
      1639 write(errmsg, 100) flag, " superdiagonals could not " // &
      +
      1640 "converge to zero as part of the QR iteration process."
      +
      1641 call errmgr%report_warning("mtx_rank_cmplx", errmsg, la_convergence_error)
      +
      1642 end if
      +
      1643
      +
      1644 ! Determine the threshold tolerance for the singular values such that
      +
      1645 ! singular values less than the threshold result in zero when inverted.
      +
      1646 tref = max(m, n) * epsilon(t) * s(1)
      +
      1647 if (present(tol)) then
      +
      1648 t = tol
      +
      1649 else
      +
      1650 t = tref
      +
      1651 end if
      +
      1652 if (t < smlnum) then
      +
      1653 ! ! The supplied tolerance is too small, simply fall back to the
      +
      1654 ! ! default, but issue a warning to the user
      +
      1655 ! t = tref
      +
      1656 ! call report_warning("mtx_rank", "The supplied tolerance was " // &
      +
      1657 ! "smaller than a value that would result in an overflow " // &
      +
      1658 ! "condition, or is negative; therefore, the tolerance has " // &
      +
      1659 ! "been reset to its default value.")
      +
      1660 end if
      +
      1661
      +
      1662 ! Count the singular values that are larger than the tolerance value
      +
      1663 do i = 1, mn
      +
      1664 if (s(i) < t) exit
      +
      1665 rnk = rnk + 1
      +
      1666 end do
      +
      1667
      +
      1668 ! Formatting
      +
      1669100 format(i0, a)
      +
      1670 end function
      +
      1671
      +
      1672! ------------------------------------------------------------------------------
      +
      1673 module function det_dbl(a, iwork, err) result(x)
      +
      1674 ! Arguments
      +
      1675 real(real64), intent(inout), dimension(:,:) :: a
      +
      1676 integer(int32), intent(out), target, optional, dimension(:) :: iwork
      +
      1677 class(errors), intent(inout), optional, target :: err
      +
      1678 real(real64) :: x
      +
      1679
      +
      1680 ! Parameters
      +
      1681 real(real64), parameter :: zero = 0.0d0
      +
      1682 real(real64), parameter :: one = 1.0d0
      +
      1683 real(real64), parameter :: ten = 1.0d1
      +
      1684 real(real64), parameter :: p1 = 1.0d-1
      +
      1685
      +
      1686 ! Local Variables
      +
      1687 integer(int32) :: i, ep, n, istat, flag
      +
      1688 integer(int32), pointer, dimension(:) :: ipvt
      +
      1689 integer(int32), allocatable, target, dimension(:) :: iwrk
      +
      1690 real(real64) :: temp
      +
      1691 class(errors), pointer :: errmgr
      +
      1692 type(errors), target :: deferr
      +
      1693
      +
      1694 ! Initialization
      +
      1695 n = size(a, 1)
      +
      1696 x = zero
      +
      1697 if (present(err)) then
      +
      1698 errmgr => err
      +
      1699 else
      +
      1700 errmgr => deferr
      +
      1701 end if
      +
      1702
      +
      1703 ! Input Check
      +
      1704 if (size(a, 2) /= n) then
      +
      1705 call errmgr%report_error("det", &
      +
      1706 "The supplied matrix must be square.", la_array_size_error)
      +
      1707 return
      +
      1708 end if
      +
      1709
      +
      1710 ! Local Memory Allocation
      +
      1711 if (present(iwork)) then
      +
      1712 if (size(iwork) < n) then
      +
      1713 ! ERROR: WORK not sized correctly
      +
      1714 call errmgr%report_error("det", &
      +
      1715 "Incorrectly sized input array IWORK, argument 2.", &
      +
      1716 la_array_size_error)
      +
      1717 return
      +
      1718 end if
      +
      1719 ipvt => iwork(1:n)
      +
      1720 else
      +
      1721 allocate(iwrk(n), stat = istat)
      +
      1722 if (istat /= 0) then
      +
      1723 ! ERROR: Out of memory
      +
      1724 call errmgr%report_error("det", &
      +
      1725 "Insufficient memory available.", &
      +
      1726 la_out_of_memory_error)
      +
      1727 return
      +
      1728 end if
      +
      1729 ipvt => iwrk
      +
      1730 end if
      1731
      -
      1732! ------------------------------------------------------------------------------
      -
      1733 module function det_cmplx(a, iwork, err) result(x)
      -
      1734 ! Arguments
      -
      1735 complex(real64), intent(inout), dimension(:,:) :: a
      -
      1736 integer(int32), intent(out), target, optional, dimension(:) :: iwork
      -
      1737 class(errors), intent(inout), optional, target :: err
      -
      1738 complex(real64) :: x
      +
      1732 ! Compute the LU factorization of A
      +
      1733 call dgetrf(n, n, a, n, ipvt, flag)
      +
      1734 if (flag > 0) then
      +
      1735 ! A singular matrix has a determinant of zero
      +
      1736 x = zero
      +
      1737 return
      +
      1738 end if
      1739
      -
      1740 ! Parameters
      -
      1741 complex(real64), parameter :: zero = (0.0d0, 0.0d0)
      -
      1742 complex(real64), parameter :: one = (1.0d0, 0.0d0)
      -
      1743 complex(real64), parameter :: ten = (1.0d1, 0.0d0)
      -
      1744 complex(real64), parameter :: p1 = (1.0d-1, 0.0d0)
      -
      1745 real(real64), parameter :: real_one = 1.0d0
      -
      1746 real(real64), parameter :: real_ten = 1.0d1
      -
      1747
      -
      1748 ! Local Variables
      -
      1749 integer(int32) :: i, ep, n, istat, flag
      -
      1750 integer(int32), pointer, dimension(:) :: ipvt
      -
      1751 integer(int32), allocatable, target, dimension(:) :: iwrk
      -
      1752 complex(real64) :: temp
      -
      1753 class(errors), pointer :: errmgr
      -
      1754 type(errors), target :: deferr
      -
      1755
      -
      1756 ! Initialization
      -
      1757 n = size(a, 1)
      -
      1758 x = zero
      -
      1759 if (present(err)) then
      -
      1760 errmgr => err
      -
      1761 else
      -
      1762 errmgr => deferr
      -
      1763 end if
      +
      1740 ! Compute the product of the diagonal of A
      +
      1741 temp = one
      +
      1742 ep = 0
      +
      1743 do i = 1, n
      +
      1744 if (ipvt(i) /= i) temp = -temp
      +
      1745
      +
      1746 temp = a(i,i) * temp
      +
      1747 if (temp == zero) then
      +
      1748 x = zero
      +
      1749 exit
      +
      1750 end if
      +
      1751
      +
      1752 do while (abs(temp) < one)
      +
      1753 temp = ten * temp
      +
      1754 ep = ep - 1
      +
      1755 end do
      +
      1756
      +
      1757 do while (abs(temp) > ten)
      +
      1758 temp = p1 * temp
      +
      1759 ep = ep + 1
      +
      1760 end do
      +
      1761 end do
      +
      1762 x = temp * ten**ep
      +
      1763 end function
      1764
      -
      1765 ! Input Check
      -
      1766 if (size(a, 2) /= n) then
      -
      1767 call errmgr%report_error("det_cmplx", &
      -
      1768 "The supplied matrix must be square.", la_array_size_error)
      -
      1769 return
      -
      1770 end if
      -
      1771
      -
      1772 ! Local Memory Allocation
      -
      1773 if (present(iwork)) then
      -
      1774 if (size(iwork) < n) then
      -
      1775 ! ERROR: WORK not sized correctly
      -
      1776 call errmgr%report_error("det_cmplx", &
      -
      1777 "Incorrectly sized input array IWORK, argument 2.", &
      -
      1778 la_array_size_error)
      -
      1779 return
      -
      1780 end if
      -
      1781 ipvt => iwork(1:n)
      -
      1782 else
      -
      1783 allocate(iwrk(n), stat = istat)
      -
      1784 if (istat /= 0) then
      -
      1785 ! ERROR: Out of memory
      -
      1786 call errmgr%report_error("det_cmplx", &
      -
      1787 "Insufficient memory available.", &
      -
      1788 la_out_of_memory_error)
      -
      1789 return
      -
      1790 end if
      -
      1791 ipvt => iwrk
      -
      1792 end if
      -
      1793
      -
      1794 ! Compute the LU factorization of A
      -
      1795 call zgetrf(n, n, a, n, ipvt, flag)
      -
      1796 if (flag > 0) then
      -
      1797 ! A singular matrix has a determinant of zero
      -
      1798 x = zero
      -
      1799 return
      -
      1800 end if
      -
      1801
      -
      1802 ! Compute the product of the diagonal of A
      -
      1803 temp = one
      -
      1804 ep = 0
      -
      1805 do i = 1, n
      -
      1806 if (ipvt(i) /= i) temp = -temp
      -
      1807
      -
      1808 temp = a(i,i) * temp
      -
      1809 if (temp == zero) then
      -
      1810 x = zero
      -
      1811 exit
      -
      1812 end if
      -
      1813
      -
      1814 do while (abs(temp) < real_one)
      -
      1815 temp = ten * temp
      -
      1816 ep = ep - 1
      -
      1817 end do
      -
      1818
      -
      1819 do while (abs(temp) > real_ten)
      -
      1820 temp = p1 * temp
      -
      1821 ep = ep + 1
      -
      1822 end do
      -
      1823 end do
      -
      1824 x = temp * ten**ep
      -
      1825 end function
      +
      1765! ------------------------------------------------------------------------------
      +
      1766 module function det_cmplx(a, iwork, err) result(x)
      +
      1767 ! Arguments
      +
      1768 complex(real64), intent(inout), dimension(:,:) :: a
      +
      1769 integer(int32), intent(out), target, optional, dimension(:) :: iwork
      +
      1770 class(errors), intent(inout), optional, target :: err
      +
      1771 complex(real64) :: x
      +
      1772
      +
      1773 ! Parameters
      +
      1774 complex(real64), parameter :: zero = (0.0d0, 0.0d0)
      +
      1775 complex(real64), parameter :: one = (1.0d0, 0.0d0)
      +
      1776 complex(real64), parameter :: ten = (1.0d1, 0.0d0)
      +
      1777 complex(real64), parameter :: p1 = (1.0d-1, 0.0d0)
      +
      1778 real(real64), parameter :: real_one = 1.0d0
      +
      1779 real(real64), parameter :: real_ten = 1.0d1
      +
      1780
      +
      1781 ! Local Variables
      +
      1782 integer(int32) :: i, ep, n, istat, flag
      +
      1783 integer(int32), pointer, dimension(:) :: ipvt
      +
      1784 integer(int32), allocatable, target, dimension(:) :: iwrk
      +
      1785 complex(real64) :: temp
      +
      1786 class(errors), pointer :: errmgr
      +
      1787 type(errors), target :: deferr
      +
      1788
      +
      1789 ! Initialization
      +
      1790 n = size(a, 1)
      +
      1791 x = zero
      +
      1792 if (present(err)) then
      +
      1793 errmgr => err
      +
      1794 else
      +
      1795 errmgr => deferr
      +
      1796 end if
      +
      1797
      +
      1798 ! Input Check
      +
      1799 if (size(a, 2) /= n) then
      +
      1800 call errmgr%report_error("det_cmplx", &
      +
      1801 "The supplied matrix must be square.", la_array_size_error)
      +
      1802 return
      +
      1803 end if
      +
      1804
      +
      1805 ! Local Memory Allocation
      +
      1806 if (present(iwork)) then
      +
      1807 if (size(iwork) < n) then
      +
      1808 ! ERROR: WORK not sized correctly
      +
      1809 call errmgr%report_error("det_cmplx", &
      +
      1810 "Incorrectly sized input array IWORK, argument 2.", &
      +
      1811 la_array_size_error)
      +
      1812 return
      +
      1813 end if
      +
      1814 ipvt => iwork(1:n)
      +
      1815 else
      +
      1816 allocate(iwrk(n), stat = istat)
      +
      1817 if (istat /= 0) then
      +
      1818 ! ERROR: Out of memory
      +
      1819 call errmgr%report_error("det_cmplx", &
      +
      1820 "Insufficient memory available.", &
      +
      1821 la_out_of_memory_error)
      +
      1822 return
      +
      1823 end if
      +
      1824 ipvt => iwrk
      +
      1825 end if
      1826
      -
      1827! ******************************************************************************
      -
      1828! ARRAY SWAPPING ROUTINE
      -
      1829! ------------------------------------------------------------------------------
      -
      1830 module subroutine swap_dbl(x, y, err)
      -
      1831 ! Arguments
      -
      1832 real(real64), intent(inout), dimension(:) :: x, y
      -
      1833 class(errors), intent(inout), optional, target :: err
      +
      1827 ! Compute the LU factorization of A
      +
      1828 call zgetrf(n, n, a, n, ipvt, flag)
      +
      1829 if (flag > 0) then
      +
      1830 ! A singular matrix has a determinant of zero
      +
      1831 x = zero
      +
      1832 return
      +
      1833 end if
      1834
      -
      1835 ! Local Variables
      -
      1836 integer(int32) :: i, n
      -
      1837 real(real64) :: temp
      -
      1838 class(errors), pointer :: errmgr
      -
      1839 type(errors), target :: deferr
      +
      1835 ! Compute the product of the diagonal of A
      +
      1836 temp = one
      +
      1837 ep = 0
      +
      1838 do i = 1, n
      +
      1839 if (ipvt(i) /= i) temp = -temp
      1840
      -
      1841 ! Initialization
      -
      1842 n = size(x)
      -
      1843 if (present(err)) then
      -
      1844 errmgr => err
      -
      1845 else
      -
      1846 errmgr => deferr
      -
      1847 end if
      -
      1848
      -
      1849 ! Input Check
      -
      1850 if (size(y) /= n) then
      -
      1851 call errmgr%report_error("swap", &
      -
      1852 "The input arrays are not the same size.", &
      -
      1853 la_array_size_error)
      -
      1854 return
      -
      1855 end if
      -
      1856
      -
      1857 ! Process
      -
      1858 do i = 1, n
      -
      1859 temp = x(i)
      -
      1860 x(i) = y(i)
      -
      1861 y(i) = temp
      -
      1862 end do
      -
      1863 end subroutine
      -
      1864
      -
      1865! ------------------------------------------------------------------------------
      -
      1866 module subroutine swap_cmplx(x, y, err)
      -
      1867 ! Arguments
      -
      1868 complex(real64), intent(inout), dimension(:) :: x, y
      -
      1869 class(errors), intent(inout), optional, target :: err
      -
      1870
      -
      1871 ! Local Variables
      -
      1872 integer(int32) :: i, n
      -
      1873 complex(real64) :: temp
      -
      1874 class(errors), pointer :: errmgr
      -
      1875 type(errors), target :: deferr
      -
      1876
      -
      1877 ! Initialization
      -
      1878 n = size(x)
      -
      1879 if (present(err)) then
      -
      1880 errmgr => err
      -
      1881 else
      -
      1882 errmgr => deferr
      -
      1883 end if
      -
      1884
      -
      1885 ! Input Check
      -
      1886 if (size(y) /= n) then
      -
      1887 call errmgr%report_error("swap_cmplx", &
      -
      1888 "The input arrays are not the same size.", &
      -
      1889 la_array_size_error)
      -
      1890 return
      -
      1891 end if
      -
      1892
      -
      1893 ! Process
      -
      1894 do i = 1, n
      -
      1895 temp = x(i)
      -
      1896 x(i) = y(i)
      -
      1897 y(i) = temp
      -
      1898 end do
      -
      1899 end subroutine
      -
      1900
      -
      1901! ******************************************************************************
      -
      1902! ARRAY MULTIPLICIATION ROUTINES
      -
      1903! ------------------------------------------------------------------------------
      -
      1904 module subroutine recip_mult_array_dbl(a, x)
      -
      1905 ! Arguments
      -
      1906 real(real64), intent(in) :: a
      -
      1907 real(real64), intent(inout), dimension(:) :: x
      -
      1908
      -
      1909 ! External Function Interfaces
      -
      1910 interface
      -
      1911 function dlamch(cmach) result(x)
      -
      1912 use, intrinsic :: iso_fortran_env, only : real64
      -
      1913 character, intent(in) :: cmach
      -
      1914 real(real64) :: x
      -
      1915 end function
      -
      1916 end interface
      +
      1841 temp = a(i,i) * temp
      +
      1842 if (temp == zero) then
      +
      1843 x = zero
      +
      1844 exit
      +
      1845 end if
      +
      1846
      +
      1847 do while (abs(temp) < real_one)
      +
      1848 temp = ten * temp
      +
      1849 ep = ep - 1
      +
      1850 end do
      +
      1851
      +
      1852 do while (abs(temp) > real_ten)
      +
      1853 temp = p1 * temp
      +
      1854 ep = ep + 1
      +
      1855 end do
      +
      1856 end do
      +
      1857 x = temp * ten**ep
      +
      1858 end function
      +
      1859
      +
      1860! ******************************************************************************
      +
      1861! ARRAY SWAPPING ROUTINE
      +
      1862! ------------------------------------------------------------------------------
      +
      1863 module subroutine swap_dbl(x, y, err)
      +
      1864 ! Arguments
      +
      1865 real(real64), intent(inout), dimension(:) :: x, y
      +
      1866 class(errors), intent(inout), optional, target :: err
      +
      1867
      +
      1868 ! Local Variables
      +
      1869 integer(int32) :: i, n
      +
      1870 real(real64) :: temp
      +
      1871 class(errors), pointer :: errmgr
      +
      1872 type(errors), target :: deferr
      +
      1873
      +
      1874 ! Initialization
      +
      1875 n = size(x)
      +
      1876 if (present(err)) then
      +
      1877 errmgr => err
      +
      1878 else
      +
      1879 errmgr => deferr
      +
      1880 end if
      +
      1881
      +
      1882 ! Input Check
      +
      1883 if (size(y) /= n) then
      +
      1884 call errmgr%report_error("swap", &
      +
      1885 "The input arrays are not the same size.", &
      +
      1886 la_array_size_error)
      +
      1887 return
      +
      1888 end if
      +
      1889
      +
      1890 ! Process
      +
      1891 do i = 1, n
      +
      1892 temp = x(i)
      +
      1893 x(i) = y(i)
      +
      1894 y(i) = temp
      +
      1895 end do
      +
      1896 end subroutine
      +
      1897
      +
      1898! ------------------------------------------------------------------------------
      +
      1899 module subroutine swap_cmplx(x, y, err)
      +
      1900 ! Arguments
      +
      1901 complex(real64), intent(inout), dimension(:) :: x, y
      +
      1902 class(errors), intent(inout), optional, target :: err
      +
      1903
      +
      1904 ! Local Variables
      +
      1905 integer(int32) :: i, n
      +
      1906 complex(real64) :: temp
      +
      1907 class(errors), pointer :: errmgr
      +
      1908 type(errors), target :: deferr
      +
      1909
      +
      1910 ! Initialization
      +
      1911 n = size(x)
      +
      1912 if (present(err)) then
      +
      1913 errmgr => err
      +
      1914 else
      +
      1915 errmgr => deferr
      +
      1916 end if
      1917
      -
      1918 ! Parameters
      -
      1919 real(real64), parameter :: zero = 0.0d0
      -
      1920 real(real64), parameter :: one = 1.0d0
      -
      1921 real(real64), parameter :: twotho = 2.0d3
      -
      1922
      -
      1923 ! Local Variables
      -
      1924 logical :: done
      -
      1925 real(real64) :: bignum, cden, cden1, cnum, cnum1, mul, smlnum
      -
      1926
      -
      1927 ! Initialization
      -
      1928 smlnum = dlamch('s')
      -
      1929 bignum = one / smlnum
      -
      1930 if (log10(bignum) > twotho) then
      -
      1931 smlnum = sqrt(smlnum)
      -
      1932 bignum = sqrt(bignum)
      -
      1933 end if
      -
      1934
      -
      1935 ! Initialize the denominator to A, and the numerator to ONE
      -
      1936 cden = a
      -
      1937 cnum = one
      -
      1938
      -
      1939 ! Process
      -
      1940 do
      -
      1941 cden1 = cden * smlnum
      -
      1942 cnum1 = cnum / bignum
      -
      1943 if (abs(cden1) > abs(cnum) .and. cnum /= zero) then
      -
      1944 mul = smlnum
      -
      1945 done = .false.
      -
      1946 cden = cden1
      -
      1947 else if (abs(cnum1) > abs(cden)) then
      -
      1948 mul = bignum
      -
      1949 done = .false.
      -
      1950 cnum = cnum1
      -
      1951 else
      -
      1952 mul = cnum / cden
      -
      1953 done = .true.
      -
      1954 end if
      +
      1918 ! Input Check
      +
      1919 if (size(y) /= n) then
      +
      1920 call errmgr%report_error("swap_cmplx", &
      +
      1921 "The input arrays are not the same size.", &
      +
      1922 la_array_size_error)
      +
      1923 return
      +
      1924 end if
      +
      1925
      +
      1926 ! Process
      +
      1927 do i = 1, n
      +
      1928 temp = x(i)
      +
      1929 x(i) = y(i)
      +
      1930 y(i) = temp
      +
      1931 end do
      +
      1932 end subroutine
      +
      1933
      +
      1934! ******************************************************************************
      +
      1935! ARRAY MULTIPLICIATION ROUTINES
      +
      1936! ------------------------------------------------------------------------------
      +
      1937 module subroutine recip_mult_array_dbl(a, x)
      +
      1938 ! Arguments
      +
      1939 real(real64), intent(in) :: a
      +
      1940 real(real64), intent(inout), dimension(:) :: x
      +
      1941
      +
      1942 ! External Function Interfaces
      +
      1943 interface
      +
      1944 function dlamch(cmach) result(x)
      +
      1945 use, intrinsic :: iso_fortran_env, only : real64
      +
      1946 character, intent(in) :: cmach
      +
      1947 real(real64) :: x
      +
      1948 end function
      +
      1949 end interface
      +
      1950
      +
      1951 ! Parameters
      +
      1952 real(real64), parameter :: zero = 0.0d0
      +
      1953 real(real64), parameter :: one = 1.0d0
      +
      1954 real(real64), parameter :: twotho = 2.0d3
      1955
      -
      1956 ! Scale the vector X by MUL
      -
      1957 x = mul * x
      -
      1958
      -
      1959 ! Exit if done
      -
      1960 if (done) exit
      -
      1961 end do
      -
      1962 end subroutine
      -
      1963
      -
      1964! ******************************************************************************
      -
      1965! TRIANGULAR MATRIX MULTIPLICATION ROUTINES
      -
      1966! ------------------------------------------------------------------------------
      -
      1967 module subroutine tri_mtx_mult_dbl(upper, alpha, a, beta, b, err)
      -
      1968 ! Arguments
      -
      1969 logical, intent(in) :: upper
      -
      1970 real(real64), intent(in) :: alpha, beta
      -
      1971 real(real64), intent(in), dimension(:,:) :: a
      -
      1972 real(real64), intent(inout), dimension(:,:) :: b
      -
      1973 class(errors), intent(inout), optional, target :: err
      -
      1974
      -
      1975 ! Parameters
      -
      1976 real(real64), parameter :: zero = 0.0d0
      -
      1977
      -
      1978 ! Local Variables
      -
      1979 integer(int32) :: i, j, k, n, d1, d2, flag
      -
      1980 real(real64) :: temp
      -
      1981 class(errors), pointer :: errmgr
      -
      1982 type(errors), target :: deferr
      -
      1983 character(len = 128) :: errmsg
      -
      1984
      -
      1985 ! Initialization
      -
      1986 n = size(a, 1)
      -
      1987 d1 = n
      -
      1988 d2 = n
      -
      1989 if (present(err)) then
      -
      1990 errmgr => err
      -
      1991 else
      -
      1992 errmgr => deferr
      -
      1993 end if
      -
      1994
      -
      1995 ! Input Check
      -
      1996 flag = 0
      -
      1997 if (size(a, 2) /= n) then
      -
      1998 flag = 3
      -
      1999 d2 = size(a, 2)
      -
      2000 else if (size(b, 1) /= n .or. size(b, 2) /= n) then
      -
      2001 flag = 5
      -
      2002 d1 = size(b, 1)
      -
      2003 d2 = size(b, 2)
      -
      2004 end if
      -
      2005 if (flag /= 0) then
      -
      2006 ! ERROR: Incorrectly sized matrix
      -
      2007 write(errmsg, '(AI0AI0AI0AI0AI0A)') "The matrix at input ", flag, &
      -
      2008 " was not sized appropriately. A matrix of ", n, "-by-", n, &
      -
      2009 "was expected, but a matrix of ", d1, "-by-", d2, " was found."
      -
      2010 call errmgr%report_error("tri_mtx_mult_dbl", trim(errmsg), &
      -
      2011 la_array_size_error)
      -
      2012 return
      -
      2013 end if
      -
      2014
      -
      2015 ! Process
      -
      2016 if (upper) then
      -
      2017 ! Form: B = alpha * A**T * A + beta * B
      -
      2018 if (beta == zero) then
      -
      2019 do j = 1, n
      -
      2020 do i = 1, j
      -
      2021 temp = zero
      -
      2022 do k = 1, j
      -
      2023 temp = temp + a(k,i) * a(k,j)
      -
      2024 end do
      -
      2025 temp = alpha * temp
      -
      2026 b(i,j) = temp
      -
      2027 if (i /= j) b(j,i) = temp
      -
      2028 end do
      -
      2029 end do
      -
      2030 else
      -
      2031 do j = 1, n
      -
      2032 do i = 1, j
      -
      2033 temp = zero
      -
      2034 do k = 1, j
      -
      2035 temp = temp + a(k,i) * a(k,j)
      -
      2036 end do
      -
      2037 temp = alpha * temp
      -
      2038 b(i,j) = temp + beta * b(i,j)
      -
      2039 if (i /= j) b(j,i) = temp + beta * b(j,i)
      -
      2040 end do
      -
      2041 end do
      -
      2042 end if
      -
      2043 else
      -
      2044 ! Form: B = alpha * A * A**T + beta * B
      -
      2045 if (beta == zero) then
      -
      2046 do j = 1, n
      -
      2047 do i = j, n
      -
      2048 temp = zero
      -
      2049 do k = 1, j
      -
      2050 temp = temp + a(i,k) * a(j,k)
      -
      2051 end do
      -
      2052 temp = alpha * temp
      -
      2053 b(i,j) = temp
      -
      2054 if (i /= j) b(j,i) = temp
      -
      2055 end do
      -
      2056 end do
      -
      2057 else
      -
      2058 do j = 1, n
      -
      2059 do i = j, n
      -
      2060 temp = zero
      -
      2061 do k = 1, j
      -
      2062 temp = temp + a(i,k) * a(j,k)
      -
      2063 end do
      -
      2064 temp = alpha * temp
      -
      2065 b(i,j) = temp + beta * b(i,j)
      -
      2066 if (i /= j) b(j,i) = temp + beta * b(j,i)
      -
      2067 end do
      -
      2068 end do
      -
      2069 end if
      -
      2070 end if
      -
      2071 end subroutine
      -
      2072
      -
      2073! ------------------------------------------------------------------------------
      -
      2074 module subroutine tri_mtx_mult_cmplx(upper, alpha, a, beta, b, err)
      -
      2075 ! Arguments
      -
      2076 logical, intent(in) :: upper
      -
      2077 complex(real64), intent(in) :: alpha, beta
      -
      2078 complex(real64), intent(in), dimension(:,:) :: a
      -
      2079 complex(real64), intent(inout), dimension(:,:) :: b
      -
      2080 class(errors), intent(inout), optional, target :: err
      -
      2081
      -
      2082 ! Parameters
      -
      2083 complex(real64), parameter :: zero = (0.0d0, 0.0d0)
      -
      2084
      -
      2085 ! Local Variables
      -
      2086 integer(int32) :: i, j, k, n, d1, d2, flag
      -
      2087 complex(real64) :: temp
      -
      2088 class(errors), pointer :: errmgr
      -
      2089 type(errors), target :: deferr
      -
      2090 character(len = 128) :: errmsg
      -
      2091
      -
      2092 ! Initialization
      -
      2093 n = size(a, 1)
      -
      2094 d1 = n
      -
      2095 d2 = n
      -
      2096 if (present(err)) then
      -
      2097 errmgr => err
      -
      2098 else
      -
      2099 errmgr => deferr
      -
      2100 end if
      -
      2101
      -
      2102 ! Input Check
      -
      2103 flag = 0
      -
      2104 if (size(a, 2) /= n) then
      -
      2105 flag = 3
      -
      2106 d2 = size(a, 2)
      -
      2107 else if (size(b, 1) /= n .or. size(b, 2) /= n) then
      -
      2108 flag = 5
      -
      2109 d1 = size(b, 1)
      -
      2110 d2 = size(b, 2)
      -
      2111 end if
      -
      2112 if (flag /= 0) then
      -
      2113 ! ERROR: Incorrectly sized matrix
      -
      2114 write(errmsg, '(AI0AI0AI0AI0AI0A)') "The matrix at input ", flag, &
      -
      2115 " was not sized appropriately. A matrix of ", n, "-by-", n, &
      -
      2116 "was expected, but a matrix of ", d1, "-by-", d2, " was found."
      -
      2117 call errmgr%report_error("tri_mtx_mult_cmplx", trim(errmsg), &
      -
      2118 la_array_size_error)
      -
      2119 return
      -
      2120 end if
      -
      2121
      -
      2122 ! Process
      -
      2123 if (upper) then
      -
      2124 ! Form: B = alpha * A**T * A + beta * B
      -
      2125 if (beta == zero) then
      -
      2126 do j = 1, n
      -
      2127 do i = 1, j
      -
      2128 temp = zero
      -
      2129 do k = 1, j
      -
      2130 temp = temp + a(k,i) * a(k,j)
      -
      2131 end do
      -
      2132 temp = alpha * temp
      -
      2133 b(i,j) = temp
      -
      2134 if (i /= j) b(j,i) = temp
      -
      2135 end do
      -
      2136 end do
      -
      2137 else
      -
      2138 do j = 1, n
      -
      2139 do i = 1, j
      -
      2140 temp = zero
      -
      2141 do k = 1, j
      -
      2142 temp = temp + a(k,i) * a(k,j)
      -
      2143 end do
      -
      2144 temp = alpha * temp
      -
      2145 b(i,j) = temp + beta * b(i,j)
      -
      2146 if (i /= j) b(j,i) = temp + beta * b(j,i)
      -
      2147 end do
      -
      2148 end do
      -
      2149 end if
      -
      2150 else
      -
      2151 ! Form: B = alpha * A * A**T + beta * B
      -
      2152 if (beta == zero) then
      -
      2153 do j = 1, n
      -
      2154 do i = j, n
      -
      2155 temp = zero
      -
      2156 do k = 1, j
      -
      2157 temp = temp + a(i,k) * a(j,k)
      -
      2158 end do
      -
      2159 temp = alpha * temp
      -
      2160 b(i,j) = temp
      -
      2161 if (i /= j) b(j,i) = temp
      -
      2162 end do
      -
      2163 end do
      -
      2164 else
      -
      2165 do j = 1, n
      -
      2166 do i = j, n
      -
      2167 temp = zero
      -
      2168 do k = 1, j
      -
      2169 temp = temp + a(i,k) * a(j,k)
      -
      2170 end do
      -
      2171 temp = alpha * temp
      -
      2172 b(i,j) = temp + beta * b(i,j)
      -
      2173 if (i /= j) b(j,i) = temp + beta * b(j,i)
      -
      2174 end do
      -
      2175 end do
      -
      2176 end if
      -
      2177 end if
      -
      2178 end subroutine
      -
      2179
      -
      2180! ------------------------------------------------------------------------------
      -
      2181end submodule
      +
      1956 ! Local Variables
      +
      1957 logical :: done
      +
      1958 real(real64) :: bignum, cden, cden1, cnum, cnum1, mul, smlnum
      +
      1959
      +
      1960 ! Initialization
      +
      1961 smlnum = dlamch('s')
      +
      1962 bignum = one / smlnum
      +
      1963 if (log10(bignum) > twotho) then
      +
      1964 smlnum = sqrt(smlnum)
      +
      1965 bignum = sqrt(bignum)
      +
      1966 end if
      +
      1967
      +
      1968 ! Initialize the denominator to A, and the numerator to ONE
      +
      1969 cden = a
      +
      1970 cnum = one
      +
      1971
      +
      1972 ! Process
      +
      1973 do
      +
      1974 cden1 = cden * smlnum
      +
      1975 cnum1 = cnum / bignum
      +
      1976 if (abs(cden1) > abs(cnum) .and. cnum /= zero) then
      +
      1977 mul = smlnum
      +
      1978 done = .false.
      +
      1979 cden = cden1
      +
      1980 else if (abs(cnum1) > abs(cden)) then
      +
      1981 mul = bignum
      +
      1982 done = .false.
      +
      1983 cnum = cnum1
      +
      1984 else
      +
      1985 mul = cnum / cden
      +
      1986 done = .true.
      +
      1987 end if
      +
      1988
      +
      1989 ! Scale the vector X by MUL
      +
      1990 x = mul * x
      +
      1991
      +
      1992 ! Exit if done
      +
      1993 if (done) exit
      +
      1994 end do
      +
      1995 end subroutine
      +
      1996
      +
      1997! ******************************************************************************
      +
      1998! TRIANGULAR MATRIX MULTIPLICATION ROUTINES
      +
      1999! ------------------------------------------------------------------------------
      +
      2000 module subroutine tri_mtx_mult_dbl(upper, alpha, a, beta, b, err)
      +
      2001 ! Arguments
      +
      2002 logical, intent(in) :: upper
      +
      2003 real(real64), intent(in) :: alpha, beta
      +
      2004 real(real64), intent(in), dimension(:,:) :: a
      +
      2005 real(real64), intent(inout), dimension(:,:) :: b
      +
      2006 class(errors), intent(inout), optional, target :: err
      +
      2007
      +
      2008 ! Parameters
      +
      2009 real(real64), parameter :: zero = 0.0d0
      +
      2010
      +
      2011 ! Local Variables
      +
      2012 integer(int32) :: i, j, k, n, d1, d2, flag
      +
      2013 real(real64) :: temp
      +
      2014 class(errors), pointer :: errmgr
      +
      2015 type(errors), target :: deferr
      +
      2016 character(len = 128) :: errmsg
      +
      2017
      +
      2018 ! Initialization
      +
      2019 n = size(a, 1)
      +
      2020 d1 = n
      +
      2021 d2 = n
      +
      2022 if (present(err)) then
      +
      2023 errmgr => err
      +
      2024 else
      +
      2025 errmgr => deferr
      +
      2026 end if
      +
      2027
      +
      2028 ! Input Check
      +
      2029 flag = 0
      +
      2030 if (size(a, 2) /= n) then
      +
      2031 flag = 3
      +
      2032 d2 = size(a, 2)
      +
      2033 else if (size(b, 1) /= n .or. size(b, 2) /= n) then
      +
      2034 flag = 5
      +
      2035 d1 = size(b, 1)
      +
      2036 d2 = size(b, 2)
      +
      2037 end if
      +
      2038 if (flag /= 0) then
      +
      2039 ! ERROR: Incorrectly sized matrix
      +
      2040 write(errmsg, 100) "The matrix at input ", flag, &
      +
      2041 " was not sized appropriately. A matrix of ", n, "-by-", n, &
      +
      2042 "was expected, but a matrix of ", d1, "-by-", d2, " was found."
      +
      2043 call errmgr%report_error("tri_mtx_mult_dbl", trim(errmsg), &
      +
      2044 la_array_size_error)
      +
      2045 return
      +
      2046 end if
      +
      2047
      +
      2048 ! Process
      +
      2049 if (upper) then
      +
      2050 ! Form: B = alpha * A**T * A + beta * B
      +
      2051 if (beta == zero) then
      +
      2052 do j = 1, n
      +
      2053 do i = 1, j
      +
      2054 temp = zero
      +
      2055 do k = 1, j
      +
      2056 temp = temp + a(k,i) * a(k,j)
      +
      2057 end do
      +
      2058 temp = alpha * temp
      +
      2059 b(i,j) = temp
      +
      2060 if (i /= j) b(j,i) = temp
      +
      2061 end do
      +
      2062 end do
      +
      2063 else
      +
      2064 do j = 1, n
      +
      2065 do i = 1, j
      +
      2066 temp = zero
      +
      2067 do k = 1, j
      +
      2068 temp = temp + a(k,i) * a(k,j)
      +
      2069 end do
      +
      2070 temp = alpha * temp
      +
      2071 b(i,j) = temp + beta * b(i,j)
      +
      2072 if (i /= j) b(j,i) = temp + beta * b(j,i)
      +
      2073 end do
      +
      2074 end do
      +
      2075 end if
      +
      2076 else
      +
      2077 ! Form: B = alpha * A * A**T + beta * B
      +
      2078 if (beta == zero) then
      +
      2079 do j = 1, n
      +
      2080 do i = j, n
      +
      2081 temp = zero
      +
      2082 do k = 1, j
      +
      2083 temp = temp + a(i,k) * a(j,k)
      +
      2084 end do
      +
      2085 temp = alpha * temp
      +
      2086 b(i,j) = temp
      +
      2087 if (i /= j) b(j,i) = temp
      +
      2088 end do
      +
      2089 end do
      +
      2090 else
      +
      2091 do j = 1, n
      +
      2092 do i = j, n
      +
      2093 temp = zero
      +
      2094 do k = 1, j
      +
      2095 temp = temp + a(i,k) * a(j,k)
      +
      2096 end do
      +
      2097 temp = alpha * temp
      +
      2098 b(i,j) = temp + beta * b(i,j)
      +
      2099 if (i /= j) b(j,i) = temp + beta * b(j,i)
      +
      2100 end do
      +
      2101 end do
      +
      2102 end if
      +
      2103 end if
      +
      2104
      +
      2105 ! Formatting
      +
      2106100 format(a, i0, a, i0, a, i0, a, i0, a, i0, a)
      +
      2107 end subroutine
      +
      2108
      +
      2109! ------------------------------------------------------------------------------
      +
      2110 module subroutine tri_mtx_mult_cmplx(upper, alpha, a, beta, b, err)
      +
      2111 ! Arguments
      +
      2112 logical, intent(in) :: upper
      +
      2113 complex(real64), intent(in) :: alpha, beta
      +
      2114 complex(real64), intent(in), dimension(:,:) :: a
      +
      2115 complex(real64), intent(inout), dimension(:,:) :: b
      +
      2116 class(errors), intent(inout), optional, target :: err
      +
      2117
      +
      2118 ! Parameters
      +
      2119 complex(real64), parameter :: zero = (0.0d0, 0.0d0)
      +
      2120
      +
      2121 ! Local Variables
      +
      2122 integer(int32) :: i, j, k, n, d1, d2, flag
      +
      2123 complex(real64) :: temp
      +
      2124 class(errors), pointer :: errmgr
      +
      2125 type(errors), target :: deferr
      +
      2126 character(len = 128) :: errmsg
      +
      2127
      +
      2128 ! Initialization
      +
      2129 n = size(a, 1)
      +
      2130 d1 = n
      +
      2131 d2 = n
      +
      2132 if (present(err)) then
      +
      2133 errmgr => err
      +
      2134 else
      +
      2135 errmgr => deferr
      +
      2136 end if
      +
      2137
      +
      2138 ! Input Check
      +
      2139 flag = 0
      +
      2140 if (size(a, 2) /= n) then
      +
      2141 flag = 3
      +
      2142 d2 = size(a, 2)
      +
      2143 else if (size(b, 1) /= n .or. size(b, 2) /= n) then
      +
      2144 flag = 5
      +
      2145 d1 = size(b, 1)
      +
      2146 d2 = size(b, 2)
      +
      2147 end if
      +
      2148 if (flag /= 0) then
      +
      2149 ! ERROR: Incorrectly sized matrix
      +
      2150 write(errmsg, 100) "The matrix at input ", flag, &
      +
      2151 " was not sized appropriately. A matrix of ", n, "-by-", n, &
      +
      2152 "was expected, but a matrix of ", d1, "-by-", d2, " was found."
      +
      2153 call errmgr%report_error("tri_mtx_mult_cmplx", trim(errmsg), &
      +
      2154 la_array_size_error)
      +
      2155 return
      +
      2156 end if
      +
      2157
      +
      2158 ! Process
      +
      2159 if (upper) then
      +
      2160 ! Form: B = alpha * A**T * A + beta * B
      +
      2161 if (beta == zero) then
      +
      2162 do j = 1, n
      +
      2163 do i = 1, j
      +
      2164 temp = zero
      +
      2165 do k = 1, j
      +
      2166 temp = temp + a(k,i) * a(k,j)
      +
      2167 end do
      +
      2168 temp = alpha * temp
      +
      2169 b(i,j) = temp
      +
      2170 if (i /= j) b(j,i) = temp
      +
      2171 end do
      +
      2172 end do
      +
      2173 else
      +
      2174 do j = 1, n
      +
      2175 do i = 1, j
      +
      2176 temp = zero
      +
      2177 do k = 1, j
      +
      2178 temp = temp + a(k,i) * a(k,j)
      +
      2179 end do
      +
      2180 temp = alpha * temp
      +
      2181 b(i,j) = temp + beta * b(i,j)
      +
      2182 if (i /= j) b(j,i) = temp + beta * b(j,i)
      +
      2183 end do
      +
      2184 end do
      +
      2185 end if
      +
      2186 else
      +
      2187 ! Form: B = alpha * A * A**T + beta * B
      +
      2188 if (beta == zero) then
      +
      2189 do j = 1, n
      +
      2190 do i = j, n
      +
      2191 temp = zero
      +
      2192 do k = 1, j
      +
      2193 temp = temp + a(i,k) * a(j,k)
      +
      2194 end do
      +
      2195 temp = alpha * temp
      +
      2196 b(i,j) = temp
      +
      2197 if (i /= j) b(j,i) = temp
      +
      2198 end do
      +
      2199 end do
      +
      2200 else
      +
      2201 do j = 1, n
      +
      2202 do i = j, n
      +
      2203 temp = zero
      +
      2204 do k = 1, j
      +
      2205 temp = temp + a(i,k) * a(j,k)
      +
      2206 end do
      +
      2207 temp = alpha * temp
      +
      2208 b(i,j) = temp + beta * b(i,j)
      +
      2209 if (i /= j) b(j,i) = temp + beta * b(j,i)
      +
      2210 end do
      +
      2211 end do
      +
      2212 end if
      +
      2213 end if
      +
      2214
      +
      2215 ! Formatting
      +
      2216100 format(a, i0, a, i0, a, i0, a, i0, a, i0, a)
      +
      2217 end subroutine
      +
      2218
      +
      2219! ------------------------------------------------------------------------------
      +
      2220end submodule
      Provides a set of common linear algebra routines.
      Definition: linalg.f90:15
      diff --git a/doc/html/linalg__eigen_8f90_source.html b/doc/html/linalg__eigen_8f90_source.html index d2c62cf8..2bd848de 100644 --- a/doc/html/linalg__eigen_8f90_source.html +++ b/doc/html/linalg__eigen_8f90_source.html @@ -146,7 +146,7 @@
      48 end if
      49 if (flag /= 0) then
      50 ! ERROR: One of the input arrays is not sized correctly
      -
      51 write(errmsg, '(AI0A)') "Input number ", flag, &
      +
      51 write(errmsg, 100) "Input number ", flag, &
      52 " is not sized correctly."
      53 call errmgr%report_error("eigen_symm", trim(errmsg), &
      54 la_array_size_error)
      @@ -189,506 +189,518 @@
      91 call errmgr%report_error("eigen_symm", &
      92 "The algorithm failed to converge.", la_convergence_error)
      93 end if
      -
      94 end subroutine
      -
      95
      -
      96! ------------------------------------------------------------------------------
      -
      97 module subroutine eigen_asymm(a, vals, vecs, work, olwork, err)
      -
      98 ! Arguments
      -
      99 real(real64), intent(inout), dimension(:,:) :: a
      -
      100 complex(real64), intent(out), dimension(:) :: vals
      -
      101 complex(real64), intent(out), optional, dimension(:,:) :: vecs
      -
      102 real(real64), intent(out), pointer, optional, dimension(:) :: work
      -
      103 integer(int32), intent(out), optional :: olwork
      -
      104 class(errors), intent(inout), optional, target :: err
      -
      105
      -
      106 ! Parameters
      -
      107 real(real64), parameter :: zero = 0.0d0
      -
      108 real(real64), parameter :: two = 2.0d0
      -
      109
      -
      110 ! Local Variables
      -
      111 character :: jobvl, jobvr
      -
      112 integer(int32) :: i, j, jp1, n, n1, n2a, n2b, n3a, n3b, istat, flag, &
      -
      113 lwork, lwork1
      -
      114 real(real64) :: eps
      -
      115 real(real64), dimension(1) :: dummy, temp
      -
      116 real(real64), dimension(1,1) :: dummy_mtx
      -
      117 real(real64), pointer, dimension(:) :: wr, wi, wptr, w
      -
      118 real(real64), pointer, dimension(:,:) :: vr
      -
      119 real(real64), allocatable, target, dimension(:) :: wrk
      -
      120 class(errors), pointer :: errmgr
      -
      121 type(errors), target :: deferr
      -
      122 character(len = 128) :: errmsg
      -
      123
      -
      124 ! Initialization
      -
      125 jobvl = 'N'
      -
      126 if (present(vecs)) then
      -
      127 jobvr = 'V'
      -
      128 else
      -
      129 jobvr = 'N'
      -
      130 end if
      -
      131 n = size(a, 1)
      -
      132 eps = two * epsilon(eps)
      -
      133 if (present(err)) then
      -
      134 errmgr => err
      -
      135 else
      -
      136 errmgr => deferr
      -
      137 end if
      -
      138
      -
      139 ! Input Check
      -
      140 flag = 0
      -
      141 if (size(a, 2) /= n) then
      -
      142 flag = 1
      -
      143 else if (size(vals) /= n) then
      -
      144 flag = 2
      -
      145 else if (present(vecs)) then
      -
      146 if (size(vecs, 1) /= n .or. size(vecs, 2) /= n) then
      -
      147 flag = 3
      -
      148 end if
      -
      149 end if
      -
      150 if (flag /= 0) then
      -
      151 ! ERROR: One of the input arrays is not sized correctly
      -
      152 write(errmsg, '(AI0A)') "Input number ", flag, &
      -
      153 " is not sized correctly."
      -
      154 call errmgr%report_error("eigen_asymm", trim(errmsg), &
      -
      155 la_array_size_error)
      -
      156 return
      -
      157 end if
      -
      158
      -
      159 ! Workspace Query
      -
      160 call dgeev(jobvl, jobvr, n, a, n, dummy, dummy, dummy_mtx, n, &
      -
      161 dummy_mtx, n, temp, -1, flag)
      -
      162 lwork1 = int(temp(1), int32)
      -
      163 if (present(vecs)) then
      -
      164 lwork = lwork1 + 2 * n + n * n
      -
      165 else
      -
      166 lwork = lwork1 + 2 * n
      -
      167 end if
      -
      168 if (present(olwork)) then
      -
      169 olwork = lwork
      -
      170 return
      -
      171 end if
      -
      172
      -
      173 ! Local Memory Allocation
      -
      174 if (present(work)) then
      -
      175 if (size(work) < lwork) then
      -
      176 ! ERROR: WORK not sized correctly
      -
      177 call errmgr%report_error("eigen_asymm", &
      -
      178 "Incorrectly sized input array WORK, argument 5.", &
      -
      179 la_array_size_error)
      -
      180 return
      -
      181 end if
      -
      182 wptr => work(1:lwork)
      -
      183 else
      -
      184 allocate(wrk(lwork), stat = istat)
      -
      185 if (istat /= 0) then
      -
      186 ! ERROR: Out of memory
      -
      187 call errmgr%report_error("eigen_asymm", &
      -
      188 "Insufficient memory available.", &
      -
      189 la_out_of_memory_error)
      -
      190 return
      -
      191 end if
      -
      192 wptr => wrk
      -
      193 end if
      -
      194
      -
      195 ! Locate each array within the workspace array
      -
      196 n1 = n
      -
      197 n2a = n1 + 1
      -
      198 n2b = n2a + n - 1
      -
      199 n3a = n2b + 1
      -
      200 n3b = n3a + lwork1 - 1
      -
      201
      -
      202 ! Assign pointers
      -
      203 wr => wptr(1:n1)
      -
      204 wi => wptr(n2a:n2b)
      -
      205 w => wptr(n3a:n3b)
      -
      206
      -
      207 ! Process
      -
      208 if (present(vecs)) then
      -
      209 ! Assign a pointer to the eigenvector matrix
      -
      210 vr(1:n,1:n) => wptr(n3b+1:lwork)
      -
      211
      -
      212 ! Compute the eigenvectors and eigenvalues
      -
      213 call dgeev(jobvl, jobvr, n, a, n, wr, wi, dummy_mtx, n, vr, n, &
      -
      214 w, lwork1, flag)
      -
      215
      -
      216 ! Check for convergence
      -
      217 if (flag > 0) then
      -
      218 call errmgr%report_error("eigen_asymm", &
      -
      219 "The algorithm failed to converge.", la_convergence_error)
      -
      220 return
      -
      221 end if
      -
      222
      -
      223 ! Store the eigenvalues and eigenvectors
      -
      224 j = 1
      -
      225 do while (j <= n)
      -
      226 if (abs(wi(j)) < eps) then
      -
      227 ! We've got a real-valued eigenvalue
      -
      228 vals(j) = cmplx(wr(j), zero, real64)
      -
      229 do i = 1, n
      -
      230 vecs(i,j) = cmplx(vr(i,j), zero, real64)
      -
      231 end do
      -
      232 else
      -
      233 ! We've got a complex cojugate pair of eigenvalues
      -
      234 jp1 = j + 1
      -
      235 vals(j) = cmplx(wr(j), wi(j), real64)
      -
      236 vals(jp1) = conjg(vals(j))
      -
      237 do i = 1, n
      -
      238 vecs(i,j) = cmplx(vr(i,j), vr(i,jp1), real64)
      -
      239 vecs(i,jp1) = conjg(vecs(i,j))
      -
      240 end do
      -
      241
      -
      242 ! Increment j and continue the loop
      -
      243 j = j + 2
      -
      244 cycle
      -
      245 end if
      -
      246
      -
      247 ! Increment j
      -
      248 j = j + 1
      -
      249 end do
      -
      250 else
      -
      251 ! Compute just the eigenvalues
      -
      252 call dgeev(jobvl, jobvr, n, a, n, wr, wi, dummy_mtx, n, &
      -
      253 dummy_mtx, n, w, lwork1, flag)
      -
      254
      -
      255 ! Check for convergence
      -
      256 if (flag > 0) then
      -
      257 call errmgr%report_error("eigen_asymm", &
      -
      258 "The algorithm failed to converge.", la_convergence_error)
      -
      259 return
      -
      260 end if
      -
      261
      -
      262 ! Store the eigenvalues
      -
      263 do i = 1, n
      -
      264 vals(i) = cmplx(wr(i), wi(i), real64)
      -
      265 end do
      -
      266 end if
      -
      267 end subroutine
      -
      268
      -
      269! ------------------------------------------------------------------------------
      -
      270 module subroutine eigen_gen(a, b, alpha, beta, vecs, work, olwork, err)
      -
      271 ! Arguments
      -
      272 real(real64), intent(inout), dimension(:,:) :: a, b
      -
      273 complex(real64), intent(out), dimension(:) :: alpha
      -
      274 real(real64), intent(out), optional, dimension(:) :: beta
      -
      275 complex(real64), intent(out), optional, dimension(:,:) :: vecs
      -
      276 real(real64), intent(out), optional, pointer, dimension(:) :: work
      -
      277 integer(int32), intent(out), optional :: olwork
      -
      278 class(errors), intent(inout), optional, target :: err
      -
      279
      -
      280 ! Parameters
      -
      281 real(real64), parameter :: zero = 0.0d0
      -
      282 real(real64), parameter :: two = 2.0d0
      -
      283
      -
      284 ! Local Variables
      -
      285 character :: jobvl, jobvr
      -
      286 integer(int32) :: i, j, jp1, n, n1, n2a, n2b, n3a, n3b, n4a, n4b, &
      -
      287 istat, flag, lwork, lwork1
      -
      288 real(real64), dimension(1) :: temp
      -
      289 real(real64), dimension(1,1) :: dummy
      -
      290 real(real64), pointer, dimension(:) :: wptr, w, alphar, alphai, bptr
      -
      291 real(real64), pointer, dimension(:,:) :: vr
      -
      292 real(real64), allocatable, target, dimension(:) :: wrk
      -
      293 real(real64) :: eps
      -
      294 class(errors), pointer :: errmgr
      -
      295 type(errors), target :: deferr
      -
      296 character(len = 128) :: errmsg
      -
      297
      -
      298 ! Initialization
      -
      299 jobvl = 'N'
      -
      300 jobvr = 'N'
      -
      301 if (present(vecs)) then
      -
      302 jobvr = 'V'
      -
      303 else
      -
      304 jobvr = 'N'
      -
      305 end if
      -
      306 n = size(a, 1)
      -
      307 eps = two * epsilon(eps)
      -
      308 if (present(err)) then
      -
      309 errmgr => err
      -
      310 else
      -
      311 errmgr => deferr
      -
      312 end if
      -
      313
      -
      314 ! Input Check
      -
      315 flag = 0
      -
      316 if (size(a, 2) /= n) then
      -
      317 flag = 1
      -
      318 else if (size(b, 1) /= n .or. size(b, 2) /= n) then
      -
      319 flag = 2
      -
      320 else if (size(alpha) /= n) then
      -
      321 flag = 3
      -
      322 else if (present(beta)) then
      -
      323 if (size(beta) /= n) flag = 4
      -
      324 else if (present(vecs)) then
      -
      325 if (size(vecs, 1) /= n .or. size(vecs, 2) /= n) flag = 5
      -
      326 end if
      -
      327 if (flag /= 0) then
      -
      328 ! ERROR: One of the input arrays is not sized correctly
      -
      329 write(errmsg, '(AI0A)') "Input number ", flag, &
      -
      330 " is not sized correctly."
      -
      331 call errmgr%report_error("eigen_gen", trim(errmsg), &
      -
      332 la_array_size_error)
      -
      333 return
      -
      334 end if
      -
      335
      -
      336 ! Workspace Query
      -
      337 call dggev(jobvl, jobvr, n, a, n, b, n, temp, temp, temp, dummy, n, &
      -
      338 dummy, n, temp, -1, flag)
      -
      339 lwork1 = int(temp(1), int32)
      -
      340 lwork = lwork1 + 2 * n
      -
      341 if (.not.present(beta)) then
      -
      342 lwork = lwork + n
      -
      343 end if
      -
      344 if (present(vecs)) then
      -
      345 lwork = lwork + n * n
      -
      346 end if
      -
      347 if (present(olwork)) then
      -
      348 olwork = lwork
      -
      349 return
      -
      350 end if
      -
      351
      -
      352 ! Local Memory Allocation
      -
      353 if (present(work)) then
      -
      354 if (size(work) < lwork) then
      -
      355 ! ERROR: WORK not sized correctly
      -
      356 call errmgr%report_error("eigen_gen", &
      -
      357 "Incorrectly sized input array WORK, argument 5.", &
      -
      358 la_array_size_error)
      -
      359 return
      -
      360 end if
      -
      361 wptr => work(1:lwork)
      -
      362 else
      -
      363 allocate(wrk(lwork), stat = istat)
      -
      364 if (istat /= 0) then
      -
      365 ! ERROR: Out of memory
      -
      366 call errmgr%report_error("eigen_gen", &
      -
      367 "Insufficient memory available.", &
      -
      368 la_out_of_memory_error)
      -
      369 return
      -
      370 end if
      -
      371 wptr => wrk
      -
      372 end if
      -
      373
      -
      374 ! Locate each array within the workspace array & assign pointers
      -
      375 n1 = n
      -
      376 n2a = n1 + 1
      -
      377 n2b = n2a + n - 1
      -
      378 n3a = n2b + 1
      -
      379 n3b = n3a + lwork1 - 1
      -
      380 n4b = n3b
      -
      381 alphar => wptr(1:n1)
      -
      382 alphai => wptr(n2a:n2b)
      -
      383 w => wptr(n3a:n3b)
      -
      384 if (.not.present(beta)) then
      -
      385 n4a = n3b + 1
      -
      386 n4b = n4a + n - 1
      -
      387 bptr => wptr(n4a:n4b)
      -
      388 end if
      -
      389
      -
      390 ! Process
      -
      391 if (present(vecs)) then
      -
      392 ! Assign a pointer to the eigenvector matrix
      -
      393 vr(1:n,1:n) => wptr(n4b+1:lwork)
      -
      394
      -
      395 ! Compute the eigenvalues and eigenvectors
      -
      396 if (present(beta)) then
      -
      397 call dggev(jobvl, jobvr, n, a, n, b, n, alphar, alphai, &
      -
      398 beta, dummy, n, vr, n, w, lwork1, flag)
      -
      399 else
      -
      400 call dggev(jobvl, jobvr, n, a, n, b, n, alphar, alphai, &
      -
      401 bptr, dummy, n, vr, n, w, lwork1, flag)
      -
      402 end if
      -
      403
      -
      404 ! Check for convergence
      -
      405 if (flag > 0) then
      -
      406 call errmgr%report_error("eigen_gen", &
      -
      407 "The algorithm failed to converge.", la_convergence_error)
      -
      408 return
      -
      409 end if
      -
      410
      -
      411 ! Store the eigenvalues and eigenvectors
      -
      412 j = 1
      -
      413 do while (j <= n)
      -
      414 if (abs(alphai(j)) < eps) then
      -
      415 ! Real-Valued
      -
      416 alpha(j) = cmplx(alphar(j), zero, real64)
      -
      417 do i = 1, n
      -
      418 vecs(i,j) = cmplx(vr(i,j), zero, real64)
      -
      419 end do
      -
      420 else
      -
      421 ! Complex-Valued
      -
      422 jp1 = j + 1
      -
      423 alpha(j) = cmplx(alphar(j), alphai(j), real64)
      -
      424 alpha(jp1) = cmplx(alphar(jp1), alphai(jp1), real64)
      -
      425 do i = 1, n
      -
      426 vecs(i,j) = cmplx(vr(i,j), vr(i,jp1), real64)
      -
      427 vecs(i,jp1) = conjg(vecs(i,j))
      -
      428 end do
      -
      429
      -
      430 ! Increment j and continue
      -
      431 j = j + 2
      -
      432 cycle
      -
      433 end if
      -
      434
      -
      435 ! Increment j
      -
      436 j = j + 1
      -
      437 end do
      -
      438 if (.not.present(beta)) alpha = alpha / bptr
      -
      439 else
      -
      440 ! Compute just the eigenvalues
      -
      441 if (present(beta)) then
      -
      442 call dggev(jobvl, jobvr, n, a, n, b, n, alphar, alphai, &
      -
      443 beta, dummy, n, dummy, n, w, lwork1, flag)
      -
      444 else
      -
      445 call dggev(jobvl, jobvr, n, a, n, b, n, alphar, alphai, &
      -
      446 bptr, dummy, n, dummy, n, w, lwork1, flag)
      -
      447 end if
      -
      448
      -
      449 ! Check for convergence
      -
      450 if (flag > 0) then
      -
      451 call errmgr%report_error("eigen_gen", &
      -
      452 "The algorithm failed to converge.", la_convergence_error)
      -
      453 return
      -
      454 end if
      -
      455
      -
      456 ! Store the eigenvalues
      -
      457 do i = 1, n
      -
      458 alpha(i) = cmplx(alphar(i), alphai(i), real64)
      -
      459 end do
      -
      460 if (.not.present(beta)) alpha = alpha / bptr
      -
      461 end if
      -
      462 end subroutine
      -
      463
      -
      464! ------------------------------------------------------------------------------
      -
      465 module subroutine eigen_cmplx(a, vals, vecs, work, olwork, rwork, err)
      -
      466 ! Arguments
      -
      467 complex(real64), intent(inout), dimension(:,:) :: a
      -
      468 complex(real64), intent(out), dimension(:) :: vals
      -
      469 complex(real64), intent(out), optional, dimension(:,:) :: vecs
      -
      470 complex(real64), intent(out), target, optional, dimension(:) :: work
      -
      471 real(real64), intent(out), target, optional, dimension(:) :: rwork
      -
      472 integer(int32), intent(out), optional :: olwork
      -
      473 class(errors), intent(inout), optional, target :: err
      -
      474
      -
      475 ! Local Variables
      -
      476 character :: jobvl, jobvr
      -
      477 character(len = 128) :: errmsg
      -
      478 integer(int32) :: n, flag, lwork, lrwork
      -
      479 real(real64) :: rdummy(1)
      -
      480 complex(real64) :: temp(1), dummy(1), dummy_mtx(1,1)
      -
      481 complex(real64), allocatable, target, dimension(:) :: wrk
      -
      482 complex(real64), pointer, dimension(:) :: wptr
      -
      483 real(real64), allocatable, target, dimension(:) :: rwrk
      -
      484 real(real64), pointer, dimension(:) :: rwptr
      -
      485 class(errors), pointer :: errmgr
      -
      486 type(errors), target :: deferr
      -
      487
      -
      488 ! Initialization
      -
      489 if (present(err)) then
      -
      490 errmgr => err
      -
      491 else
      -
      492 errmgr => deferr
      -
      493 end if
      -
      494 jobvl = 'N'
      -
      495 if (present(vecs)) then
      -
      496 jobvr = 'V'
      -
      497 else
      -
      498 jobvr = 'N'
      -
      499 end if
      -
      500 n = size(a, 1)
      -
      501 lrwork = 2 * n
      -
      502
      -
      503 ! Input Check
      -
      504 flag = 0
      -
      505 if (size(a, 2) /= n) then
      -
      506 flag = 1
      -
      507 else if (size(vals) /= n) then
      -
      508 flag = 2
      -
      509 else if (present(vecs)) then
      -
      510 if (size(vecs, 1) /= n .or. size(vecs, 2) /= n) then
      -
      511 flag = 3
      -
      512 end if
      -
      513 end if
      -
      514 if (flag /= 0) then
      -
      515 ! ERROR: One of the input arrays is not sized correctly
      -
      516 write(errmsg, '(AI0A)') "Input number ", flag, &
      -
      517 " is not sized correctly."
      -
      518 call errmgr%report_error("eigen_cmplx", trim(errmsg), &
      -
      519 la_array_size_error)
      -
      520 return
      -
      521 end if
      -
      522
      -
      523 ! Workspace Query
      -
      524 call zgeev(jobvl, jobvr, n, a, n, dummy, dummy_mtx, n, dummy_mtx, n, temp, &
      -
      525 -1, rdummy, flag)
      -
      526 lwork = int(temp(1), int32)
      -
      527 if (present(olwork)) then
      -
      528 olwork = lwork
      +
      94
      +
      95 ! Formatting
      +
      96100 format(a, i0, a)
      +
      97 end subroutine
      +
      98
      +
      99! ------------------------------------------------------------------------------
      +
      100 module subroutine eigen_asymm(a, vals, vecs, work, olwork, err)
      +
      101 ! Arguments
      +
      102 real(real64), intent(inout), dimension(:,:) :: a
      +
      103 complex(real64), intent(out), dimension(:) :: vals
      +
      104 complex(real64), intent(out), optional, dimension(:,:) :: vecs
      +
      105 real(real64), intent(out), pointer, optional, dimension(:) :: work
      +
      106 integer(int32), intent(out), optional :: olwork
      +
      107 class(errors), intent(inout), optional, target :: err
      +
      108
      +
      109 ! Parameters
      +
      110 real(real64), parameter :: zero = 0.0d0
      +
      111 real(real64), parameter :: two = 2.0d0
      +
      112
      +
      113 ! Local Variables
      +
      114 character :: jobvl, jobvr
      +
      115 integer(int32) :: i, j, jp1, n, n1, n2a, n2b, n3a, n3b, istat, flag, &
      +
      116 lwork, lwork1
      +
      117 real(real64) :: eps
      +
      118 real(real64), dimension(1) :: dummy, temp
      +
      119 real(real64), dimension(1,1) :: dummy_mtx
      +
      120 real(real64), pointer, dimension(:) :: wr, wi, wptr, w
      +
      121 real(real64), pointer, dimension(:,:) :: vr
      +
      122 real(real64), allocatable, target, dimension(:) :: wrk
      +
      123 class(errors), pointer :: errmgr
      +
      124 type(errors), target :: deferr
      +
      125 character(len = 128) :: errmsg
      +
      126
      +
      127 ! Initialization
      +
      128 jobvl = 'N'
      +
      129 if (present(vecs)) then
      +
      130 jobvr = 'V'
      +
      131 else
      +
      132 jobvr = 'N'
      +
      133 end if
      +
      134 n = size(a, 1)
      +
      135 eps = two * epsilon(eps)
      +
      136 if (present(err)) then
      +
      137 errmgr => err
      +
      138 else
      +
      139 errmgr => deferr
      +
      140 end if
      +
      141
      +
      142 ! Input Check
      +
      143 flag = 0
      +
      144 if (size(a, 2) /= n) then
      +
      145 flag = 1
      +
      146 else if (size(vals) /= n) then
      +
      147 flag = 2
      +
      148 else if (present(vecs)) then
      +
      149 if (size(vecs, 1) /= n .or. size(vecs, 2) /= n) then
      +
      150 flag = 3
      +
      151 end if
      +
      152 end if
      +
      153 if (flag /= 0) then
      +
      154 ! ERROR: One of the input arrays is not sized correctly
      +
      155 write(errmsg, 100) "Input number ", flag, &
      +
      156 " is not sized correctly."
      +
      157 call errmgr%report_error("eigen_asymm", trim(errmsg), &
      +
      158 la_array_size_error)
      +
      159 return
      +
      160 end if
      +
      161
      +
      162 ! Workspace Query
      +
      163 call dgeev(jobvl, jobvr, n, a, n, dummy, dummy, dummy_mtx, n, &
      +
      164 dummy_mtx, n, temp, -1, flag)
      +
      165 lwork1 = int(temp(1), int32)
      +
      166 if (present(vecs)) then
      +
      167 lwork = lwork1 + 2 * n + n * n
      +
      168 else
      +
      169 lwork = lwork1 + 2 * n
      +
      170 end if
      +
      171 if (present(olwork)) then
      +
      172 olwork = lwork
      +
      173 return
      +
      174 end if
      +
      175
      +
      176 ! Local Memory Allocation
      +
      177 if (present(work)) then
      +
      178 if (size(work) < lwork) then
      +
      179 ! ERROR: WORK not sized correctly
      +
      180 call errmgr%report_error("eigen_asymm", &
      +
      181 "Incorrectly sized input array WORK, argument 5.", &
      +
      182 la_array_size_error)
      +
      183 return
      +
      184 end if
      +
      185 wptr => work(1:lwork)
      +
      186 else
      +
      187 allocate(wrk(lwork), stat = istat)
      +
      188 if (istat /= 0) then
      +
      189 ! ERROR: Out of memory
      +
      190 call errmgr%report_error("eigen_asymm", &
      +
      191 "Insufficient memory available.", &
      +
      192 la_out_of_memory_error)
      +
      193 return
      +
      194 end if
      +
      195 wptr => wrk
      +
      196 end if
      +
      197
      +
      198 ! Locate each array within the workspace array
      +
      199 n1 = n
      +
      200 n2a = n1 + 1
      +
      201 n2b = n2a + n - 1
      +
      202 n3a = n2b + 1
      +
      203 n3b = n3a + lwork1 - 1
      +
      204
      +
      205 ! Assign pointers
      +
      206 wr => wptr(1:n1)
      +
      207 wi => wptr(n2a:n2b)
      +
      208 w => wptr(n3a:n3b)
      +
      209
      +
      210 ! Process
      +
      211 if (present(vecs)) then
      +
      212 ! Assign a pointer to the eigenvector matrix
      +
      213 vr(1:n,1:n) => wptr(n3b+1:lwork)
      +
      214
      +
      215 ! Compute the eigenvectors and eigenvalues
      +
      216 call dgeev(jobvl, jobvr, n, a, n, wr, wi, dummy_mtx, n, vr, n, &
      +
      217 w, lwork1, flag)
      +
      218
      +
      219 ! Check for convergence
      +
      220 if (flag > 0) then
      +
      221 call errmgr%report_error("eigen_asymm", &
      +
      222 "The algorithm failed to converge.", la_convergence_error)
      +
      223 return
      +
      224 end if
      +
      225
      +
      226 ! Store the eigenvalues and eigenvectors
      +
      227 j = 1
      +
      228 do while (j <= n)
      +
      229 if (abs(wi(j)) < eps) then
      +
      230 ! We've got a real-valued eigenvalue
      +
      231 vals(j) = cmplx(wr(j), zero, real64)
      +
      232 do i = 1, n
      +
      233 vecs(i,j) = cmplx(vr(i,j), zero, real64)
      +
      234 end do
      +
      235 else
      +
      236 ! We've got a complex cojugate pair of eigenvalues
      +
      237 jp1 = j + 1
      +
      238 vals(j) = cmplx(wr(j), wi(j), real64)
      +
      239 vals(jp1) = conjg(vals(j))
      +
      240 do i = 1, n
      +
      241 vecs(i,j) = cmplx(vr(i,j), vr(i,jp1), real64)
      +
      242 vecs(i,jp1) = conjg(vecs(i,j))
      +
      243 end do
      +
      244
      +
      245 ! Increment j and continue the loop
      +
      246 j = j + 2
      +
      247 cycle
      +
      248 end if
      +
      249
      +
      250 ! Increment j
      +
      251 j = j + 1
      +
      252 end do
      +
      253 else
      +
      254 ! Compute just the eigenvalues
      +
      255 call dgeev(jobvl, jobvr, n, a, n, wr, wi, dummy_mtx, n, &
      +
      256 dummy_mtx, n, w, lwork1, flag)
      +
      257
      +
      258 ! Check for convergence
      +
      259 if (flag > 0) then
      +
      260 call errmgr%report_error("eigen_asymm", &
      +
      261 "The algorithm failed to converge.", la_convergence_error)
      +
      262 return
      +
      263 end if
      +
      264
      +
      265 ! Store the eigenvalues
      +
      266 do i = 1, n
      +
      267 vals(i) = cmplx(wr(i), wi(i), real64)
      +
      268 end do
      +
      269 end if
      +
      270
      +
      271 ! Formatting
      +
      272100 format(a, i0, a)
      +
      273 end subroutine
      +
      274
      +
      275! ------------------------------------------------------------------------------
      +
      276 module subroutine eigen_gen(a, b, alpha, beta, vecs, work, olwork, err)
      +
      277 ! Arguments
      +
      278 real(real64), intent(inout), dimension(:,:) :: a, b
      +
      279 complex(real64), intent(out), dimension(:) :: alpha
      +
      280 real(real64), intent(out), optional, dimension(:) :: beta
      +
      281 complex(real64), intent(out), optional, dimension(:,:) :: vecs
      +
      282 real(real64), intent(out), optional, pointer, dimension(:) :: work
      +
      283 integer(int32), intent(out), optional :: olwork
      +
      284 class(errors), intent(inout), optional, target :: err
      +
      285
      +
      286 ! Parameters
      +
      287 real(real64), parameter :: zero = 0.0d0
      +
      288 real(real64), parameter :: two = 2.0d0
      +
      289
      +
      290 ! Local Variables
      +
      291 character :: jobvl, jobvr
      +
      292 integer(int32) :: i, j, jp1, n, n1, n2a, n2b, n3a, n3b, n4a, n4b, &
      +
      293 istat, flag, lwork, lwork1
      +
      294 real(real64), dimension(1) :: temp
      +
      295 real(real64), dimension(1,1) :: dummy
      +
      296 real(real64), pointer, dimension(:) :: wptr, w, alphar, alphai, bptr
      +
      297 real(real64), pointer, dimension(:,:) :: vr
      +
      298 real(real64), allocatable, target, dimension(:) :: wrk
      +
      299 real(real64) :: eps
      +
      300 class(errors), pointer :: errmgr
      +
      301 type(errors), target :: deferr
      +
      302 character(len = 128) :: errmsg
      +
      303
      +
      304 ! Initialization
      +
      305 jobvl = 'N'
      +
      306 jobvr = 'N'
      +
      307 if (present(vecs)) then
      +
      308 jobvr = 'V'
      +
      309 else
      +
      310 jobvr = 'N'
      +
      311 end if
      +
      312 n = size(a, 1)
      +
      313 eps = two * epsilon(eps)
      +
      314 if (present(err)) then
      +
      315 errmgr => err
      +
      316 else
      +
      317 errmgr => deferr
      +
      318 end if
      +
      319
      +
      320 ! Input Check
      +
      321 flag = 0
      +
      322 if (size(a, 2) /= n) then
      +
      323 flag = 1
      +
      324 else if (size(b, 1) /= n .or. size(b, 2) /= n) then
      +
      325 flag = 2
      +
      326 else if (size(alpha) /= n) then
      +
      327 flag = 3
      +
      328 else if (present(beta)) then
      +
      329 if (size(beta) /= n) flag = 4
      +
      330 else if (present(vecs)) then
      +
      331 if (size(vecs, 1) /= n .or. size(vecs, 2) /= n) flag = 5
      +
      332 end if
      +
      333 if (flag /= 0) then
      +
      334 ! ERROR: One of the input arrays is not sized correctly
      +
      335 write(errmsg, 100) "Input number ", flag, &
      +
      336 " is not sized correctly."
      +
      337 call errmgr%report_error("eigen_gen", trim(errmsg), &
      +
      338 la_array_size_error)
      +
      339 return
      +
      340 end if
      +
      341
      +
      342 ! Workspace Query
      +
      343 call dggev(jobvl, jobvr, n, a, n, b, n, temp, temp, temp, dummy, n, &
      +
      344 dummy, n, temp, -1, flag)
      +
      345 lwork1 = int(temp(1), int32)
      +
      346 lwork = lwork1 + 2 * n
      +
      347 if (.not.present(beta)) then
      +
      348 lwork = lwork + n
      +
      349 end if
      +
      350 if (present(vecs)) then
      +
      351 lwork = lwork + n * n
      +
      352 end if
      +
      353 if (present(olwork)) then
      +
      354 olwork = lwork
      +
      355 return
      +
      356 end if
      +
      357
      +
      358 ! Local Memory Allocation
      +
      359 if (present(work)) then
      +
      360 if (size(work) < lwork) then
      +
      361 ! ERROR: WORK not sized correctly
      +
      362 call errmgr%report_error("eigen_gen", &
      +
      363 "Incorrectly sized input array WORK, argument 5.", &
      +
      364 la_array_size_error)
      +
      365 return
      +
      366 end if
      +
      367 wptr => work(1:lwork)
      +
      368 else
      +
      369 allocate(wrk(lwork), stat = istat)
      +
      370 if (istat /= 0) then
      +
      371 ! ERROR: Out of memory
      +
      372 call errmgr%report_error("eigen_gen", &
      +
      373 "Insufficient memory available.", &
      +
      374 la_out_of_memory_error)
      +
      375 return
      +
      376 end if
      +
      377 wptr => wrk
      +
      378 end if
      +
      379
      +
      380 ! Locate each array within the workspace array & assign pointers
      +
      381 n1 = n
      +
      382 n2a = n1 + 1
      +
      383 n2b = n2a + n - 1
      +
      384 n3a = n2b + 1
      +
      385 n3b = n3a + lwork1 - 1
      +
      386 n4b = n3b
      +
      387 alphar => wptr(1:n1)
      +
      388 alphai => wptr(n2a:n2b)
      +
      389 w => wptr(n3a:n3b)
      +
      390 if (.not.present(beta)) then
      +
      391 n4a = n3b + 1
      +
      392 n4b = n4a + n - 1
      +
      393 bptr => wptr(n4a:n4b)
      +
      394 end if
      +
      395
      +
      396 ! Process
      +
      397 if (present(vecs)) then
      +
      398 ! Assign a pointer to the eigenvector matrix
      +
      399 vr(1:n,1:n) => wptr(n4b+1:lwork)
      +
      400
      +
      401 ! Compute the eigenvalues and eigenvectors
      +
      402 if (present(beta)) then
      +
      403 call dggev(jobvl, jobvr, n, a, n, b, n, alphar, alphai, &
      +
      404 beta, dummy, n, vr, n, w, lwork1, flag)
      +
      405 else
      +
      406 call dggev(jobvl, jobvr, n, a, n, b, n, alphar, alphai, &
      +
      407 bptr, dummy, n, vr, n, w, lwork1, flag)
      +
      408 end if
      +
      409
      +
      410 ! Check for convergence
      +
      411 if (flag > 0) then
      +
      412 call errmgr%report_error("eigen_gen", &
      +
      413 "The algorithm failed to converge.", la_convergence_error)
      +
      414 return
      +
      415 end if
      +
      416
      +
      417 ! Store the eigenvalues and eigenvectors
      +
      418 j = 1
      +
      419 do while (j <= n)
      +
      420 if (abs(alphai(j)) < eps) then
      +
      421 ! Real-Valued
      +
      422 alpha(j) = cmplx(alphar(j), zero, real64)
      +
      423 do i = 1, n
      +
      424 vecs(i,j) = cmplx(vr(i,j), zero, real64)
      +
      425 end do
      +
      426 else
      +
      427 ! Complex-Valued
      +
      428 jp1 = j + 1
      +
      429 alpha(j) = cmplx(alphar(j), alphai(j), real64)
      +
      430 alpha(jp1) = cmplx(alphar(jp1), alphai(jp1), real64)
      +
      431 do i = 1, n
      +
      432 vecs(i,j) = cmplx(vr(i,j), vr(i,jp1), real64)
      +
      433 vecs(i,jp1) = conjg(vecs(i,j))
      +
      434 end do
      +
      435
      +
      436 ! Increment j and continue
      +
      437 j = j + 2
      +
      438 cycle
      +
      439 end if
      +
      440
      +
      441 ! Increment j
      +
      442 j = j + 1
      +
      443 end do
      +
      444 if (.not.present(beta)) alpha = alpha / bptr
      +
      445 else
      +
      446 ! Compute just the eigenvalues
      +
      447 if (present(beta)) then
      +
      448 call dggev(jobvl, jobvr, n, a, n, b, n, alphar, alphai, &
      +
      449 beta, dummy, n, dummy, n, w, lwork1, flag)
      +
      450 else
      +
      451 call dggev(jobvl, jobvr, n, a, n, b, n, alphar, alphai, &
      +
      452 bptr, dummy, n, dummy, n, w, lwork1, flag)
      +
      453 end if
      +
      454
      +
      455 ! Check for convergence
      +
      456 if (flag > 0) then
      +
      457 call errmgr%report_error("eigen_gen", &
      +
      458 "The algorithm failed to converge.", la_convergence_error)
      +
      459 return
      +
      460 end if
      +
      461
      +
      462 ! Store the eigenvalues
      +
      463 do i = 1, n
      +
      464 alpha(i) = cmplx(alphar(i), alphai(i), real64)
      +
      465 end do
      +
      466 if (.not.present(beta)) alpha = alpha / bptr
      +
      467 end if
      +
      468
      +
      469 ! Formatting
      +
      470100 format(a, i0, a)
      +
      471 end subroutine
      +
      472
      +
      473! ------------------------------------------------------------------------------
      +
      474 module subroutine eigen_cmplx(a, vals, vecs, work, olwork, rwork, err)
      +
      475 ! Arguments
      +
      476 complex(real64), intent(inout), dimension(:,:) :: a
      +
      477 complex(real64), intent(out), dimension(:) :: vals
      +
      478 complex(real64), intent(out), optional, dimension(:,:) :: vecs
      +
      479 complex(real64), intent(out), target, optional, dimension(:) :: work
      +
      480 real(real64), intent(out), target, optional, dimension(:) :: rwork
      +
      481 integer(int32), intent(out), optional :: olwork
      +
      482 class(errors), intent(inout), optional, target :: err
      +
      483
      +
      484 ! Local Variables
      +
      485 character :: jobvl, jobvr
      +
      486 character(len = 128) :: errmsg
      +
      487 integer(int32) :: n, flag, lwork, lrwork
      +
      488 real(real64) :: rdummy(1)
      +
      489 complex(real64) :: temp(1), dummy(1), dummy_mtx(1,1)
      +
      490 complex(real64), allocatable, target, dimension(:) :: wrk
      +
      491 complex(real64), pointer, dimension(:) :: wptr
      +
      492 real(real64), allocatable, target, dimension(:) :: rwrk
      +
      493 real(real64), pointer, dimension(:) :: rwptr
      +
      494 class(errors), pointer :: errmgr
      +
      495 type(errors), target :: deferr
      +
      496
      +
      497 ! Initialization
      +
      498 if (present(err)) then
      +
      499 errmgr => err
      +
      500 else
      +
      501 errmgr => deferr
      +
      502 end if
      +
      503 jobvl = 'N'
      +
      504 if (present(vecs)) then
      +
      505 jobvr = 'V'
      +
      506 else
      +
      507 jobvr = 'N'
      +
      508 end if
      +
      509 n = size(a, 1)
      +
      510 lrwork = 2 * n
      +
      511
      +
      512 ! Input Check
      +
      513 flag = 0
      +
      514 if (size(a, 2) /= n) then
      +
      515 flag = 1
      +
      516 else if (size(vals) /= n) then
      +
      517 flag = 2
      +
      518 else if (present(vecs)) then
      +
      519 if (size(vecs, 1) /= n .or. size(vecs, 2) /= n) then
      +
      520 flag = 3
      +
      521 end if
      +
      522 end if
      +
      523 if (flag /= 0) then
      +
      524 ! ERROR: One of the input arrays is not sized correctly
      +
      525 write(errmsg, 100) "Input number ", flag, &
      +
      526 " is not sized correctly."
      +
      527 call errmgr%report_error("eigen_cmplx", trim(errmsg), &
      +
      528 la_array_size_error)
      529 return
      530 end if
      531
      -
      532 ! Local Memory Allocation
      -
      533 if (present(work)) then
      -
      534 if (size(work) < lwork) then
      -
      535 ! ERROR: WORK not sized correctly
      -
      536 call errmgr%report_error("eigen_cmplx", &
      -
      537 "Incorrectly sized input array WORK.", &
      -
      538 la_array_size_error)
      -
      539 return
      -
      540 end if
      -
      541 wptr => work
      -
      542 else
      -
      543 allocate(wrk(lwork), stat = flag)
      -
      544 if (flag /= 0) then
      -
      545 ! ERROR: Out of memory
      -
      546 call errmgr%report_error("eigen_cmplx", &
      -
      547 "Insufficient memory available.", &
      -
      548 la_out_of_memory_error)
      -
      549 return
      -
      550 end if
      -
      551 wptr => wrk
      -
      552 end if
      -
      553
      -
      554 if (present(rwork)) then
      -
      555 if (size(work) < lrwork) then
      -
      556 ! ERROR: RWORK not sized correctly
      -
      557 call errmgr%report_error("eigen_cmplx", &
      -
      558 "Incorrectly sized input array RWORK.", &
      -
      559 la_array_size_error)
      -
      560 return
      -
      561 end if
      -
      562 rwptr => rwork
      -
      563 else
      -
      564 allocate(rwrk(lrwork), stat = flag)
      -
      565 if (flag /= 0) then
      -
      566 ! ERROR: Out of memory
      -
      567 call errmgr%report_error("eigen_cmplx", &
      -
      568 "Insufficient memory available.", &
      -
      569 la_out_of_memory_error)
      -
      570 return
      -
      571 end if
      -
      572 rwptr => rwrk
      -
      573 end if
      -
      574
      -
      575 ! Process
      -
      576 if (present(vecs)) then
      -
      577 call zgeev(jobvl, jobvr, n, a, n, vals, dummy_mtx, n, vecs, n, &
      -
      578 wptr, lwork, rwptr, flag)
      -
      579 else
      -
      580 call zgeev(jobvl, jobvr, n, a, n, vals, dummy_mtx, n, dummy_mtx, n, &
      -
      581 wptr, lwork, rwptr, flag)
      +
      532 ! Workspace Query
      +
      533 call zgeev(jobvl, jobvr, n, a, n, dummy, dummy_mtx, n, dummy_mtx, n, temp, &
      +
      534 -1, rdummy, flag)
      +
      535 lwork = int(temp(1), int32)
      +
      536 if (present(olwork)) then
      +
      537 olwork = lwork
      +
      538 return
      +
      539 end if
      +
      540
      +
      541 ! Local Memory Allocation
      +
      542 if (present(work)) then
      +
      543 if (size(work) < lwork) then
      +
      544 ! ERROR: WORK not sized correctly
      +
      545 call errmgr%report_error("eigen_cmplx", &
      +
      546 "Incorrectly sized input array WORK.", &
      +
      547 la_array_size_error)
      +
      548 return
      +
      549 end if
      +
      550 wptr => work
      +
      551 else
      +
      552 allocate(wrk(lwork), stat = flag)
      +
      553 if (flag /= 0) then
      +
      554 ! ERROR: Out of memory
      +
      555 call errmgr%report_error("eigen_cmplx", &
      +
      556 "Insufficient memory available.", &
      +
      557 la_out_of_memory_error)
      +
      558 return
      +
      559 end if
      +
      560 wptr => wrk
      +
      561 end if
      +
      562
      +
      563 if (present(rwork)) then
      +
      564 if (size(work) < lrwork) then
      +
      565 ! ERROR: RWORK not sized correctly
      +
      566 call errmgr%report_error("eigen_cmplx", &
      +
      567 "Incorrectly sized input array RWORK.", &
      +
      568 la_array_size_error)
      +
      569 return
      +
      570 end if
      +
      571 rwptr => rwork
      +
      572 else
      +
      573 allocate(rwrk(lrwork), stat = flag)
      +
      574 if (flag /= 0) then
      +
      575 ! ERROR: Out of memory
      +
      576 call errmgr%report_error("eigen_cmplx", &
      +
      577 "Insufficient memory available.", &
      +
      578 la_out_of_memory_error)
      +
      579 return
      +
      580 end if
      +
      581 rwptr => rwrk
      582 end if
      583
      -
      584 if (flag > 0) then
      -
      585 call errmgr%report_error("eigen_cmplx", &
      -
      586 "The algorithm failed to converge.", &
      -
      587 la_convergence_error)
      -
      588 return
      -
      589 end if
      -
      590 end subroutine
      -
      591
      -
      592! ------------------------------------------------------------------------------
      -
      593end submodule
      +
      584 ! Process
      +
      585 if (present(vecs)) then
      +
      586 call zgeev(jobvl, jobvr, n, a, n, vals, dummy_mtx, n, vecs, n, &
      +
      587 wptr, lwork, rwptr, flag)
      +
      588 else
      +
      589 call zgeev(jobvl, jobvr, n, a, n, vals, dummy_mtx, n, dummy_mtx, n, &
      +
      590 wptr, lwork, rwptr, flag)
      +
      591 end if
      +
      592
      +
      593 if (flag > 0) then
      +
      594 call errmgr%report_error("eigen_cmplx", &
      +
      595 "The algorithm failed to converge.", &
      +
      596 la_convergence_error)
      +
      597 return
      +
      598 end if
      +
      599
      +
      600 ! Formatting
      +
      601100 format(a, i0, a)
      +
      602 end subroutine
      +
      603
      +
      604! ------------------------------------------------------------------------------
      +
      605end submodule
      Provides a set of common linear algebra routines.
      Definition: linalg.f90:15
      diff --git a/doc/html/linalg__factor_8f90_source.html b/doc/html/linalg__factor_8f90_source.html index ef095415..410463ea 100644 --- a/doc/html/linalg__factor_8f90_source.html +++ b/doc/html/linalg__factor_8f90_source.html @@ -2936,13 +2936,13 @@
      2838 rwptr, flag)
      2839 else if (present(u) .and. .not.present(vt)) then
      2840 call zgesvd(jobu, jobvt, m, n, a, m, s, u, m, temp, n, wptr, &
      -
      2841 rwptr, lwork, flag)
      +
      2841 lwork, rwptr, flag)
      2842 else if (.not.present(u) .and. present(vt)) then
      2843 call zgesvd(jobu, jobvt, m, n, a, m, s, temp, m, vt, n, wptr, &
      -
      2844 rwptr, lwork, flag)
      +
      2844 lwork, rwptr, flag)
      2845 else
      2846 call zgesvd(jobu, jobvt, m, n, a, m, s, temp, m, temp, n, wptr, &
      -
      2847 rwptr, lwork, flag)
      +
      2847 lwork, rwptr, flag)
      2848 end if
      2849
      2850 ! Check for convergence
      @@ -2958,7 +2958,8 @@
      2860101 format(i0, a)
      2861 end subroutine
      2862
      -
      2863end submodule
      +
      2863! ------------------------------------------------------------------------------
      +
      2864end submodule
      Provides a set of common linear algebra routines.
      Definition: linalg.f90:15
      diff --git a/doc/html/linalg__solve_8f90_source.html b/doc/html/linalg__solve_8f90_source.html index cf3ec11a..1e19e300 100644 --- a/doc/html/linalg__solve_8f90_source.html +++ b/doc/html/linalg__solve_8f90_source.html @@ -1728,7 +1728,7 @@
      1630 class(errors), intent(inout), optional, target :: err
      1631
      1632 ! Local Variables
      -
      1633 integer(int32) :: n, liwork, lwork, istat, flag
      +
      1633 integer(int32) :: n, liwork, lwork, istat, flag, itemp(1)
      1634 integer(int32), pointer, dimension(:) :: iptr
      1635 integer(int32), allocatable, target, dimension(:) :: iwrk
      1636 real(real64), pointer, dimension(:) :: wptr
      @@ -1754,7 +1754,7 @@
      1656 end if
      1657
      1658 ! Workspace Query
      -
      1659 call dgetri(n, a, n, istat, temp, -1, flag)
      +
      1659 call dgetri(n, a, n, itemp, temp, -1, flag)
      1660 lwork = int(temp(1), int32)
      1661 if (present(olwork)) then
      1662 olwork = lwork
      @@ -1829,7 +1829,7 @@
      1731 class(errors), intent(inout), optional, target :: err
      1732
      1733 ! Local Variables
      -
      1734 integer(int32) :: n, liwork, lwork, istat, flag
      +
      1734 integer(int32) :: n, liwork, lwork, istat, flag, itemp(1)
      1735 integer(int32), pointer, dimension(:) :: iptr
      1736 integer(int32), allocatable, target, dimension(:) :: iwrk
      1737 complex(real64), pointer, dimension(:) :: wptr
      @@ -1855,7 +1855,7 @@
      1757 end if
      1758
      1759 ! Workspace Query
      -
      1760 call zgetri(n, a, n, istat, temp, -1, flag)
      +
      1760 call zgetri(n, a, n, itemp, temp, -1, flag)
      1761 lwork = int(temp(1), int32)
      1762 if (present(olwork)) then
      1763 olwork = lwork
      @@ -2133,7 +2133,7 @@
      2035 end if
      2036
      2037 ! Workspace Query
      -
      2038 call zgesvd('S', 'A', m, n, a, m, a(1:mn,:), a, m, a, n, temp, -1, &
      +
      2038 call zgesvd('S', 'A', m, n, a, m, rtemp, a, m, a, n, temp, -1, &
      2039 rtemp, flag)
      2040 lwork = int(temp(1), int32)
      2041 lwork = lwork + m * mn + n * n
      diff --git a/include/linalg.h b/include/linalg.h index 7289509c..a3141f83 100644 --- a/include/linalg.h +++ b/include/linalg.h @@ -1,5 +1,6 @@ -#ifndef LINALG_H_ -#define LINALG_H_ +/** @file linalg.h */ +#ifndef LINALG_H_DEFINED +#define LINALG_H_DEFINED #include #include @@ -22,8 +23,9 @@ extern "C" { /** * Performs the rank-1 update to matrix A such that: - * A = alpha * X * Y**T + A, where A is an M-by-N matrix, alpha is a scalar, - * X is an M-element array, and N is an N-element array. + * \f$ A = \alpha X Y^T + A \f$, where \f$ A \f$ is an M-by-N matrix, + * \f$ \alpha \f$ is a scalar, \f$ X \f$ is an M-element array, and \f$ Y \f$ + * is an N-element array. * * @param m The number of rows in the matrix. * @param n The number of columns in the matrix. @@ -43,8 +45,9 @@ int la_rank1_update(int m, int n, double alpha, const double *x, /** * Performs the rank-1 update to matrix A such that: - * A = alpha * X * Y**T + A, where A is an M-by-N matrix, alpha is a scalar, - * X is an M-element array, and N is an N-element array. + * \f$ A = \alpha X Y^T + A \f$, where \f$ A \f$ is an M-by-N matrix, + * \f$ \alpha \f$ is a scalar, \f$ X \f$ is an M-element array, and \f$ Y \f$ + * is an N-element array. * * @param m The number of rows in the matrix. * @param n The number of columns in the matrix. @@ -97,7 +100,7 @@ int la_trace_cmplx(int m, int n, const double complex *a, int lda, double complex *rst); /** - * Computes the matrix operation C = alpha * op(A) * op(B) + beta * C. + * Computes the matrix operation \f$ C = \alpha op(A) op(B) + \beta C \f$. * * @param transa Set to true to compute op(A) as the transpose of A; else, * set to false to compute op(A) as A. @@ -127,7 +130,7 @@ int la_mtx_mult(bool transa, bool transb, int m, int n, int k, double alpha, double *c, int ldc); /** - * Computes the matrix operation C = alpha * op(A) * op(B) + beta * C. + * Computes the matrix operation \f$ C = \alpha op(A) op(B) + \beta C \f$. * * @param opa Set to LA_TRANSPOSE to compute op(A) as a direct transpose of A, * set to LA_HERMITIAN_TRANSPOSE to compute op(A) as the Hermitian transpose @@ -160,8 +163,8 @@ int la_mtx_mult_cmplx(int opa, int opb, int m, int n, int k, int ldc); /** - * Computes the matrix operation: C = alpha * A * op(B) + beta * C, - * or C = alpha * op(B) * A + beta * C. + * Computes the matrix operation: \f$ C = \alpha A op(B) + \beta C \f$, + * or \f$ C = \alpha op(B) A + \beta C \f$. * * @param lside Set to true to apply matrix A from the left; else, set * to false to apply matrix A from the left. @@ -197,8 +200,8 @@ int la_diag_mtx_mult(bool lside, bool transb, int m, int n, int k, double *c, int ldc); /** - * Computes the matrix operation: C = alpha * A * op(B) + beta * C, - * or C = alpha * op(B) * A + beta * C. + * Computes the matrix operation: \f$ C = \alpha A op(B) + \beta C \f$, + * or \f$ C = \alpha op(B) A + \beta * C \f$. * * @param lside Set to true to apply matrix A from the left; else, set * to false to apply matrix A from the left. @@ -235,8 +238,8 @@ int la_diag_mtx_mult_cmplx(bool lside, int opb, int m, int n, int k, int ldb, double complex beta, double complex *c, int ldc); /** - * Computes the matrix operation: C = alpha * A * op(B) + beta * C, - * or C = alpha * op(B) * A + beta * C. + * Computes the matrix operation: \f$ C = \alpha A op(B) + \beta C \f$, + * or \f$ C = \alpha op(B) A + \beta C \f$. * * @param lside Set to true to apply matrix A from the left; else, set * to false to apply matrix A from the left. @@ -348,13 +351,13 @@ int la_det_cmplx(int n, double complex *a, int lda, double complex *d); /** * Computes the triangular matrix operation: - * B = alpha * A**T * A + beta * B, or B = alpha * A * A**T + beta * B, - * where A is a triangular matrix. + * \f$ B = \alpha A^T A + \beta B \f$, or \f$ B = \alpha A A^T + \beta B \f$, + * where \f$ A \f$ is a triangular matrix. * - * @param upper Set to true if matrix A is upper triangular, and - * B = alpha * A**T * A + beta * B is to be calculated; else, set to false - * if A is lower triangular, and B = alpha * A * A**T + beta * B is to - * be computed. + * @param upper Set to true if matrix \f$ A \f$ is upper triangular, and + * \f$ B = \alpha A^T A + \beta B \f$ is to be calculated; else, set to false + * if \f$ A \f$ is lower triangular, and \f$ B = \alpha A A^T + \beta B \f$ is + * to be computed. * @param alpha A scalar multiplier. * @param n The dimension of the matrix. * @param a The @p n by @p n triangular matrix A. Notice, if @p upper is @@ -376,13 +379,13 @@ int la_tri_mtx_mult(bool upper, double alpha, int n, const double *a, int lda, /** * Computes the triangular matrix operation: - * B = alpha * A**T * A + beta * B, or B = alpha * A * A**T + beta * B, - * where A is a triangular matrix. + * \f$ B = \alpha A^T A + \beta B \f$, or \f$ B = \alpha A A^T + \beta B \f$, + * where \f$ A \f$ is a triangular matrix. * - * @param upper Set to true if matrix A is upper triangular, and - * B = alpha * A**T * A + beta * B is to be calculated; else, set to false - * if A is lower triangular, and B = alpha * A * A**T + beta * B is to - * be computed. + * @param upper Set to true if matrix \f$ A \f$ is upper triangular, and + * \f$ B = \alpha A^T A + \beta B \f$ is to be calculated; else, set to false + * if \f$ A \f$ is lower triangular, and \f$ B = \alpha A A^T + \beta B \f$ is + * to be computed. * @param alpha A scalar multiplier. * @param n The dimension of the matrix. * @param a The @p n by @p n triangular matrix A. Notice, if @p upper is @@ -655,7 +658,7 @@ int la_form_qr_cmplx(bool fullq, int m, int n, double complex *r, int ldr, * Forms the full M-by-M orthogonal matrix Q from the elementary * reflectors returned by the base QR factorization algorithm. This * routine also inflates the pivot array into an N-by-N matrix P such - * that A * P = Q * R. + * that \f$ A P = Q R \f$. * * @param fullq Set to true to always return the full Q matrix; else, * set to false, and in the event that M > N, Q may be supplied as M-by-N, @@ -690,7 +693,7 @@ int la_form_qr_pvt(bool fullq, int m, int n, double *r, int ldr, * Forms the full M-by-M orthogonal matrix Q from the elementary * reflectors returned by the base QR factorization algorithm. This * routine also inflates the pivot array into an N-by-N matrix P such - * that A * P = Q * R. + * that \f$ A P = Q R \f$. * * @param fullq Set to true to always return the full Q matrix; else, * set to false, and in the event that M > N, Q may be supplied as M-by-N, @@ -724,11 +727,11 @@ int la_form_qr_cmplx_pvt(bool fullq, int m, int n, double complex *r, int ldr, /** * Multiplies a general matrix by the orthogonal matrix Q from a QR - * factorization such that: C = op(Q) * C, or C = C * op(Q). + * factorization such that: \f$ C = op(Q) C \f$, or \f$ C = C op(Q) \f$. * - * @param lside Set to true to apply Q or Q**T from the left; else, set - * to false to apply Q or Q**T from the right. - * @param trans Set to true to apply Q**T; else, set to false. + * @param lside Set to true to apply \f$ Q \f$ or \f$ Q^T \f$ from the left; + * else, set to false to apply \f$ Q \f$ or \f$ Q^T \f$ from the right. + * @param trans Set to true to apply \f$ Q^T \f$; else, set to false. * @param m The number of rows in matrix C. * @param n The number of columns in matrix C. * @param k The number of elementary reflectors whose product defines @@ -756,11 +759,11 @@ int la_mult_qr(bool lside, bool trans, int m, int n, int k, double *a, int lda, /** * Multiplies a general matrix by the orthogonal matrix Q from a QR - * factorization such that: C = op(Q) * C, or C = C * op(Q). + * factorization such that: \f$ C = op(Q) C \f$, or \f$ C = C op(Q) \f$. * - * @param lside Set to true to apply Q or Q**H from the left; else, set - * to false to apply Q or Q**H from the right. - * @param trans Set to true to apply Q**H; else, set to false. + * @param lside Set to true to apply \f$ Q \f$ or \f$ Q^H \f$ from the left; + * else, set to false to apply \f$ Q \f$ or \f$ Q^H \f$ from the right. + * @param trans Set to true to apply \f$ Q^H \f$; else, set to false. * @param m The number of rows in matrix C. * @param n The number of columns in matrix C. * @param k The number of elementary reflectors whose product defines @@ -789,7 +792,8 @@ int la_mult_qr_cmplx(bool lside, bool trans, int m, int n, int k, /** * Computes the rank 1 update to an M-by-N QR factored matrix A - * (M >= N) where A = Q * R, and A1 = A + U * V**T such that A1 = Q1 * R1. + * (M >= N) where \f$ A = Q R \f$, and \f$ A1 = A + U V^T \f$ such that + * \f$ A1 = Q1 R1 \f$. * * @param m The number of rows in R. * @param n The number of columns in R. @@ -815,7 +819,8 @@ int la_qr_rank1_update(int m, int n, double *q, int ldq, double *r, int ldr, /** * Computes the rank 1 update to an M-by-N QR factored matrix A - * (M >= N) where A = Q * R, and A1 = A + U * V**T such that A1 = Q1 * R1. + * (M >= N) where \f$ A = Q R \f$, and \f$ A1 = A + U V^T \f$ such that + * \f$ A1 = Q1 R1 \f$. * * @param m The number of rows in R. * @param n The number of columns in R. @@ -1553,4 +1558,4 @@ int la_sort_eigen_cmplx(bool ascend, int n, double complex *vals, #ifdef __cplusplus } #endif // __cplusplus -#endif // LINALG_H_ +#endif // LINALG_H_DEFINED From e9f398d6ee7579890ea60daed75ecd928d1f00f9 Mon Sep 17 00:00:00 2001 From: jchristopherson Date: Sun, 18 Dec 2022 18:30:38 -0600 Subject: [PATCH 37/65] Update comments --- include/linalg.h | 70 ++++++++++++++++++++++++------------------------ src/linalg.f90 | 6 +++-- 2 files changed, 39 insertions(+), 37 deletions(-) diff --git a/include/linalg.h b/include/linalg.h index a3141f83..360ac016 100644 --- a/include/linalg.h +++ b/include/linalg.h @@ -45,7 +45,7 @@ int la_rank1_update(int m, int n, double alpha, const double *x, /** * Performs the rank-1 update to matrix A such that: - * \f$ A = \alpha X Y^T + A \f$, where \f$ A \f$ is an M-by-N matrix, + * \f$ A = \alpha X Y^H + A \f$, where \f$ A \f$ is an M-by-N matrix, * \f$ \alpha \f$ is a scalar, \f$ X \f$ is an M-element array, and \f$ Y \f$ * is an N-element array. * @@ -819,7 +819,7 @@ int la_qr_rank1_update(int m, int n, double *q, int ldq, double *r, int ldr, /** * Computes the rank 1 update to an M-by-N QR factored matrix A - * (M >= N) where \f$ A = Q R \f$, and \f$ A1 = A + U V^T \f$ such that + * (M >= N) where \f$ A = Q R \f$, and \f$ A1 = A + U V^H \f$ such that * \f$ A1 = Q1 R1 \f$. * * @param m The number of rows in R. @@ -849,8 +849,8 @@ int la_qr_rank1_update_cmplx(int m, int n, double complex *q, int ldq, * definite matrix. * * @param upper Set to true to compute the upper triangular factoriztion - * A = U**T * U; else, set to false to compute the lower triangular - * factorzation A = L * L**T. + * \f$ A = U^T U \f$; else, set to false to compute the lower triangular + * factorzation \f$ A = L L^T \f$. * @param n The dimension of matrix A. * @param a On input, the N-by-N matrix to factor. On output, the * factored matrix is returned in either the upper or lower triangular @@ -869,8 +869,8 @@ int la_cholesky_factor(bool upper, int n, double *a, int lda); * definite matrix. * * @param upper Set to true to compute the upper triangular factoriztion - * A = U**T * U; else, set to false to compute the lower triangular - * factorzation A = L * L**T. + * \f$ A = U^T U \f$; else, set to false to compute the lower triangular + * factorzation \f$ A = L L^T \f$. * @param n The dimension of matrix A. * @param a On input, the N-by-N matrix to factor. On output, the * factored matrix is returned in either the upper or lower triangular @@ -967,10 +967,10 @@ int la_cholesky_rank1_downdate_cmplx(int n, double complex *r, int ldr, double complex *u); /** - * Computes the singular value decomposition of a matrix A. The - * SVD is defined as: A = U * S * V**T, where U is an M-by-M orthogonal - * matrix, S is an M-by-N diagonal matrix, and V is an N-by-N orthogonal - * matrix. + * Computes the singular value decomposition of a matrix \f$ A \f$. The + * SVD is defined as: \f$ A = U S V^T \f$, where \f$ U \f$ is an M-by-M + * orthogonal matrix, \f$ S \f$ is an M-by-N diagonal matrix, and \f$ V \f$ is + * an N-by-N orthogonal matrix. * * @param m The number of rows in the matrix. * @param n The number of columns in the matrix. @@ -999,10 +999,10 @@ int la_svd(int m, int n, double *a, int lda, double *s, double *u, int ldu, double *vt, int ldv); /** - * Computes the singular value decomposition of a matrix A. The - * SVD is defined as: A = U * S * V**T, where U is an M-by-M orthogonal - * matrix, S is an M-by-N diagonal matrix, and V is an N-by-N orthogonal - * matrix. + * Computes the singular value decomposition of a matrix \f$ A \f$. The + * SVD is defined as: \f$ A = U S V^H \f$, where \f$ U \f$ is an M-by-M + * orthogonal matrix, \f$ S \f$ is an M-by-N diagonal matrix, and \f$ V \f$ is + * an N-by-N orthogonal matrix. * * @param m The number of rows in the matrix. * @param n The number of columns in the matrix. @@ -1014,9 +1014,9 @@ int la_svd(int m, int n, double *a, int lda, double *s, double *u, int ldu, * @param u An M-by-M matrix where the orthogonal U matrix will be * written. * @param ldu The leading dimension of matrix U. - * @param vt An N-by-N matrix where the transpose of the right + * @param vt An N-by-N matrix where the conjugate transpose of the right * singular vector matrix V. - * @param ldv The leading dimension of matrix V. + * @param ldv The leading dimension of @p vt. * * @return An error code. The following codes are possible. * - LA_NO_ERROR: No error occurred. Successful operation. @@ -1031,15 +1031,15 @@ int la_svd_cmplx(int m, int n, double complex *a, int lda, double *s, double complex *u, int ldu, double complex *vt, int ldv); /** - * Solves one of the matrix equations: op(A) * X = alpha * B, or - * X * op(A) = alpha * B, where A is a triangular matrix. + * Solves one of the matrix equations: \f$ op(A) X = \alpha B \f$, or + * \f$ X op(A) = \alpha B \f$, where \f$ A \f$ is a triangular matrix. * - * @param lside Set to true to solve op(A) * X = alpha * B; else, set to - * false to solve X * op(A) = alpha * B. + * @param lside Set to true to solve \f$ op(A) X = \alpha B \f$; else, set to + * false to solve \f$ X op(A) = \alpha B \f$. * @param upper Set to true if A is an upper triangular matrix; else, * set to false if A is a lower triangular matrix. - * @param trans Set to true if op(A) = A**T; else, set to false if - * op(A) = A. + * @param trans Set to true if \f$ op(A) = A^T \f$; else, set to false if + * \f$ op(A) = A \f$. * @param nounit Set to true if A is not a unit-diagonal matrix (ones on * every diagonal element); else, set to false if A is a unit-diagonal * matrix. @@ -1062,15 +1062,15 @@ int la_solve_tri_mtx(bool lside, bool upper, bool trans, bool nounit, int m, int n, double alpha, const double *a, int lda, double *b, int ldb); /** - * Solves one of the matrix equations: op(A) * X = alpha * B, or - * X * op(A) = alpha * B, where A is a triangular matrix. + * Solves one of the matrix equations: \f$ op(A) X = \alpha B \f$, or + * \f$ X op(A) = \alpha B \f$, where \f$ A \f$ is a triangular matrix. * - * @param lside Set to true to solve op(A) * X = alpha * B; else, set to - * false to solve X * op(A) = alpha * B. + * @param lside Set to true to solve \f$ op(A) X = \alpha B \f$; else, set to + * false to solve \f$ X op(A) = \alpha B \f$. * @param upper Set to true if A is an upper triangular matrix; else, * set to false if A is a lower triangular matrix. - * @param trans Set to true if op(A) = A**H; else, set to false if - * op(A) = A. + * @param trans Set to true if \f$ op(A) = A^H \f$; else, set to false if + * \f$ op(A) = A \f$. * @param nounit Set to true if A is not a unit-diagonal matrix (ones on * every diagonal element); else, set to false if A is a unit-diagonal * matrix. @@ -1239,8 +1239,8 @@ int la_solve_qr_cmplx_pvt(int m, int n, int k, double complex *a, int lda, * Solves a system of Cholesky factored equations. * * @param upper Set to true if the original matrix A was factored such - * that A = U**T * U; else, set to false if the factorization of A was - * A = L**T * L. + * that \f$ A = U^T U \f$; else, set to false if the factorization of A was + * \f$ A = L^T L \f$. * @param m The number of rows in matrix B. * @param n The number of columns in matrix B. * @param a The M-by-M Cholesky factored matrix. @@ -1260,8 +1260,8 @@ int la_solve_cholesky(bool upper, int m, int n, const double *a, int lda, * Solves a system of Cholesky factored equations. * * @param upper Set to true if the original matrix A was factored such - * that A = U**T * U; else, set to false if the factorization of A was - * A = L**T * L. + * that \f$ A = U^T U \f$; else, set to false if the factorization of A was + * \f$ A = L^T L \f$. * @param m The number of rows in matrix B. * @param n The number of columns in matrix B. * @param a The M-by-M Cholesky factored matrix. @@ -1278,7 +1278,7 @@ int la_solve_cholesky_cmplx(bool upper, int m, int n, const double complex *a, int lda, double complex *b, int ldb); /** - * Solves the overdetermined or underdetermined system (A*X = B) of + * Solves the overdetermined or underdetermined system (\f$ A X = B \f$) of * M equations of N unknowns using a QR or LQ factorization of the matrix A. * Notice, it is assumed that matrix A has full rank. * @@ -1306,7 +1306,7 @@ int la_solve_least_squares(int m, int n, int k, double *a, int lda, double *b, int ldb); /** - * Solves the overdetermined or underdetermined system (A*X = B) of + * Solves the overdetermined or underdetermined system (\f$ A X = B \f$) of * M equations of N unknowns using a QR or LQ factorization of the matrix A. * Notice, it is assumed that matrix A has full rank. * @@ -1455,7 +1455,7 @@ int la_eigen_asymm(bool vecs, int n, double *a, int lda, /** * Computes the eigenvalues, and optionally the right eigenvectors of * a square matrix assuming the structure of the eigenvalue problem is - * A*X = lambda*B*X. + * \f$ A X = \lambda B X \f$. * * @param vecs Set to true to compute the eigenvectors as well as the * eigenvalues; else, set to false to just compute the eigenvalues. diff --git a/src/linalg.f90 b/src/linalg.f90 index bf4b49a5..ea1c9520 100644 --- a/src/linalg.f90 +++ b/src/linalg.f90 @@ -1191,7 +1191,8 @@ module linalg ! ------------------------------------------------------------------------------ !> @brief Computes the rank 1 update to an M-by-N QR factored matrix A !! (M >= N) where \f$ A = Q R \f$, and \f$ A1 = A + U V^T \f$ such that -!! \f$ A1 = Q1 R1 \f$. +!! \f$ A1 = Q1 R1 \f$. In the event \f$ V \f$ is complex-valued, \f$ V^H \f$ +!! is computed instead of \f$ V^T \f$. !! !! @par Syntax !! @code{.f90} @@ -1810,7 +1811,8 @@ module linalg !> @brief Computes the singular value decomposition of a matrix A. The !! SVD is defined as: \f$ A = U S V^T \f$, where \f$ U \f$ is an M-by-M !! orthogonal matrix, \f$ S \f$ is an M-by-N diagonal matrix, and \f$ V \f$ is -!! an N-by-N orthogonal matrix. +!! an N-by-N orthogonal matrix. In the event that \f$ V \f$ is complex valued, +!! \f$ V^H \f$ is computed instead of \f$ V^T \f$. !! !! @par Syntax !! @code{.f90} From 010d5c818960591c47303d8528d4e310c35da784 Mon Sep 17 00:00:00 2001 From: jchristopherson Date: Sun, 18 Dec 2022 18:33:03 -0600 Subject: [PATCH 38/65] Update documentation --- doc/C/html/linalg_8h.html | 43 ++++++++++++++++++++------------------- 1 file changed, 22 insertions(+), 21 deletions(-) diff --git a/doc/C/html/linalg_8h.html b/doc/C/html/linalg_8h.html index a5f07bd1..c0933092 100644 --- a/doc/C/html/linalg_8h.html +++ b/doc/C/html/linalg_8h.html @@ -310,7 +310,7 @@

      Parameters
      - + @@ -366,7 +366,7 @@

      Parameters

      upperSet to true to compute the upper triangular factoriztion A = U**T * U; else, set to false to compute the lower triangular factorzation A = L * L**T.
      upperSet to true to compute the upper triangular factoriztion \( A = U^T U \); else, set to false to compute the lower triangular factorzation \( A = L L^T \).
      nThe dimension of matrix A.
      aOn input, the N-by-N matrix to factor. On output, the factored matrix is returned in either the upper or lower triangular portion of the matrix, dependent upon the value of upper.
      ldaThe leading dimension of matrix A.
      - + @@ -1301,7 +1301,7 @@

      -

      Computes the eigenvalues, and optionally the right eigenvectors of a square matrix assuming the structure of the eigenvalue problem is A*X = lambda*B*X.

      +

      Computes the eigenvalues, and optionally the right eigenvectors of a square matrix assuming the structure of the eigenvalue problem is \( A X = \lambda B X \).

      Parameters

      upperSet to true to compute the upper triangular factoriztion A = U**T * U; else, set to false to compute the lower triangular factorzation A = L * L**T.
      upperSet to true to compute the upper triangular factoriztion \( A = U^T U \); else, set to false to compute the lower triangular factorzation \( A = L L^T \).
      nThe dimension of matrix A.
      aOn input, the N-by-N matrix to factor. On output, the factored matrix is returned in either the upper or lower triangular portion of the matrix, dependent upon the value of upper.
      ldaThe leading dimension of matrix A.
      @@ -2471,7 +2471,7 @@

      Parameters

      vecsSet to true to compute the eigenvectors as well as the eigenvalues; else, set to false to just compute the eigenvalues.
      - + @@ -2569,7 +2569,7 @@

      Parameters

      lsideSet to true to apply \( Q \) or \( Q^T \) from the left; else, set to false to apply \( Q \) or \( Q^T \) from the right.
      transSet to true to apply Q**T; else, set to false.
      transSet to true to apply \( Q^T \); else, set to false.
      mThe number of rows in matrix C.
      nThe number of columns in matrix C.
      kThe number of elementary reflectors whose product defines the matrix Q.
      - + @@ -3137,7 +3137,7 @@

      -

      Computes the rank 1 update to an M-by-N QR factored matrix A (M >= N) where \( A = Q R \), and \( A1 = A + U V^T \) such that \( A1 = Q1 R1 \).

      +

      Computes the rank 1 update to an M-by-N QR factored matrix A (M >= N) where \( A = Q R \), and \( A1 = A + U V^H \) such that \( A1 = Q1 R1 \).

      Parameters

      lsideSet to true to apply \( Q \) or \( Q^H \) from the left; else, set to false to apply \( Q \) or \( Q^H \) from the right.
      transSet to true to apply Q**H; else, set to false.
      transSet to true to apply \( Q^H \); else, set to false.
      mThe number of rows in matrix C.
      nThe number of columns in matrix C.
      kThe number of elementary reflectors whose product defines the matrix Q.
      @@ -3355,7 +3355,7 @@

      -

      Performs the rank-1 update to matrix A such that: \( A = \alpha X Y^T + A \), where \( A \) is an M-by-N matrix, \( \alpha \) is a scalar, \( X \) is an M-element array, and \( Y \) is an N-element array.

      +

      Performs the rank-1 update to matrix A such that: \( A = \alpha X Y^H + A \), where \( A \) is an M-by-N matrix, \( \alpha \) is a scalar, \( X \) is an M-element array, and \( Y \) is an N-element array.

      Parameters

      mThe number of rows in R.
      @@ -3498,7 +3498,7 @@

      Parameters

      mThe number of rows in the matrix.
      - + @@ -3574,7 +3574,7 @@

      Parameters

      upperSet to true if the original matrix A was factored such that A = U**T * U; else, set to false if the factorization of A was A = L**T * L.
      upperSet to true if the original matrix A was factored such that \( A = U^T U \); else, set to false if the factorization of A was \( A = L^T L \).
      mThe number of rows in matrix B.
      nThe number of columns in matrix B.
      aThe M-by-M Cholesky factored matrix.
      - + @@ -3647,7 +3647,7 @@

      -

      Solves the overdetermined or underdetermined system (A*X = B) of M equations of N unknowns using a QR or LQ factorization of the matrix A. Notice, it is assumed that matrix A has full rank.

      +

      Solves the overdetermined or underdetermined system ( \( A X = B \)) of M equations of N unknowns using a QR or LQ factorization of the matrix A. Notice, it is assumed that matrix A has full rank.

      Parameters

      upperSet to true if the original matrix A was factored such that A = U**T * U; else, set to false if the factorization of A was A = L**T * L.
      upperSet to true if the original matrix A was factored such that \( A = U^T U \); else, set to false if the factorization of A was \( A = L^T L \).
      mThe number of rows in matrix B.
      nThe number of columns in matrix B.
      aThe M-by-M Cholesky factored matrix.
      @@ -3725,7 +3725,7 @@

      -

      Solves the overdetermined or underdetermined system (A*X = B) of M equations of N unknowns using a QR or LQ factorization of the matrix A. Notice, it is assumed that matrix A has full rank.

      +

      Solves the overdetermined or underdetermined system ( \( A X = B \)) of M equations of N unknowns using a QR or LQ factorization of the matrix A. Notice, it is assumed that matrix A has full rank.

      Parameters

      mThe number of equations (rows in matrix A).
      @@ -4329,12 +4329,12 @@

      -

      Solves one of the matrix equations: op(A) * X = alpha * B, or X * op(A) = alpha * B, where A is a triangular matrix.

      +

      Solves one of the matrix equations: \( op(A) X = \alpha B \), or \( X op(A) = \alpha B \), where \( A \) is a triangular matrix.

      Parameters

      mThe number of equations (rows in matrix A).
      - + - + @@ -4433,12 +4433,12 @@

      -

      Solves one of the matrix equations: op(A) * X = alpha * B, or X * op(A) = alpha * B, where A is a triangular matrix.

      +

      Solves one of the matrix equations: \( op(A) X = \alpha B \), or \( X op(A) = \alpha B \), where \( A \) is a triangular matrix.

      Parameters

      lsideSet to true to solve op(A) * X = alpha * B; else, set to false to solve X * op(A) = alpha * B.
      lsideSet to true to solve \( op(A) X = \alpha B \); else, set to false to solve \( X op(A) = \alpha B \).
      upperSet to true if A is an upper triangular matrix; else, set to false if A is a lower triangular matrix.
      transSet to true if op(A) = A**T; else, set to false if op(A) = A.
      transSet to true if \( op(A) = A^T \); else, set to false if \( op(A) = A \).
      nounitSet to true if A is not a unit-diagonal matrix (ones on every diagonal element); else, set to false if A is a unit-diagonal matrix.
      mThe number of rows in matrix B.
      nThe number of columns in matrix B.
      - + - + @@ -4651,7 +4651,7 @@

      -

      Computes the singular value decomposition of a matrix A. The SVD is defined as: A = U * S * V**T, where U is an M-by-M orthogonal matrix, S is an M-by-N diagonal matrix, and V is an N-by-N orthogonal matrix.

      +

      Computes the singular value decomposition of a matrix \( A \). The SVD is defined as: \( A = U S V^T \), where \( U \) is an M-by-M orthogonal matrix, \( S \) is an M-by-N diagonal matrix, and \( V \) is an N-by-N orthogonal matrix.

      Parameters

      lsideSet to true to solve op(A) * X = alpha * B; else, set to false to solve X * op(A) = alpha * B.
      lsideSet to true to solve \( op(A) X = \alpha B \); else, set to false to solve \( X op(A) = \alpha B \).
      upperSet to true if A is an upper triangular matrix; else, set to false if A is a lower triangular matrix.
      transSet to true if op(A) = A**H; else, set to false if op(A) = A.
      transSet to true if \( op(A) = A^H \); else, set to false if \( op(A) = A \).
      nounitSet to true if A is not a unit-diagonal matrix (ones on every diagonal element); else, set to false if A is a unit-diagonal matrix.
      mThe number of rows in matrix B.
      nThe number of columns in matrix B.
      @@ -4743,7 +4743,8 @@

      -

      Computes the singular value decomposition of a matrix A. The SVD is defined as: A = U * S * V**T, where U is an M-by-M orthogonal matrix, S is an M-by-N diagonal matrix, and V is an N-by-N orthogonal matrix.

      +

      Computes the singular value decomposition of a matrix \( A \). The SVD is defined as: \( A = U S V^H \), where \( U \) is an M-by-M orthogonal matrix, \( S \) is an M-by-N diagonal matrix, and \( V \) is an N-by-N orthogonal matrix.
      +

      Parameters

      mThe number of rows in the matrix.
      @@ -4753,8 +4754,8 @@

      s

      - - + +
      mThe number of rows in the matrix.
      A MIN(M, N)-element array containing the singular values of a sorted in descending order.
      uAn M-by-M matrix where the orthogonal U matrix will be written.
      lduThe leading dimension of matrix U.
      vtAn N-by-N matrix where the transpose of the right singular vector matrix V.
      ldvThe leading dimension of matrix V.
      vtAn N-by-N matrix where the conjugate transpose of the right singular vector matrix V.
      ldvThe leading dimension of vt.
      From d2d9f0d1f70a7384d55fefeeb3698636cde1dd24 Mon Sep 17 00:00:00 2001 From: jchristopherson Date: Sun, 18 Dec 2022 18:39:29 -0600 Subject: [PATCH 39/65] Update comments --- src/linalg.f90 | 138 +++++++++++++++++++++++++++++++++++++++++++++++-- 1 file changed, 134 insertions(+), 4 deletions(-) diff --git a/src/linalg.f90 b/src/linalg.f90 index ea1c9520..05831f06 100644 --- a/src/linalg.f90 +++ b/src/linalg.f90 @@ -1,14 +1,144 @@ ! linalg.f90 - !> @mainpage !! !! @section intro_sec Introduction !! LINALG is a linear algebra library that provides a user-friendly interface -!! to several BLAS and LAPACK routines. +!! to several BLAS and LAPACK routines. This library provides routines for +!! solving systems of linear equations, solving over or under-determined +!! systems, and solving eigenvalue problems. +!! +!! @par Example 1 - Solving Linear Equations +!! The following piece of code illustrates how to solve a system of linear +!! equations using LU factorization. +!! +!! @code{.f90} +!! program example +!! use iso_fortran_env +!! use linalg +!! implicit none +!! +!! ! Local Variables +!! real(real64) :: a(3,3), b(3) +!! integer(int32) :: i, pvt(3) +!! +!! ! Build the 3-by-3 matrix A. +!! ! | 1 2 3 | +!! ! A = | 4 5 6 | +!! ! | 7 8 0 | +!! a = reshape( & +!! [1.0d0, 4.0d0, 7.0d0, 2.0d0, 5.0d0, 8.0d0, 3.0d0, 6.0d0, 0.0d0], & +!! [3, 3]) +!! +!! ! Build the right-hand-side vector B. +!! ! | -1 | +!! ! b = | -2 | +!! ! | -3 | +!! b = [-1.0d0, -2.0d0, -3.0d0] +!! +!! ! The solution is: +!! ! | 1/3 | +!! ! x = | -2/3 | +!! ! | 0 | +!! +!! ! Compute the LU factorization +!! call lu_factor(a, pvt) +!! +!! ! Compute the solution. The results overwrite b. +!! call solve_lu(a, pvt, b) +!! +!! ! Display the results. +!! print '(A)', "LU Solution: X = " +!! print '(F8.4)', (b(i), i = 1, size(b)) +!! end program +!! @endcode +!! The program generates the following output. +!! @code{.txt} +!! LU Solution: X = +!! 0.3333 +!! -0.6667 +!! 0.0000 +!! @endcode +!! +!! @par Example 2 - Solving an Eigenvalue Problem +!! The following example illustrates how to solve an eigenvalue problem using +!! a mechanical vibrating system. +!! +!! @code{.f90} +!! ! This is an example illustrating the use of the eigenvalue and eigenvector +!! ! routines to solve a free vibration problem of 3 masses connected by springs. +!! ! +!! ! k1 k2 k3 k4 +!! ! |-\/\/\-| m1 |-\/\/\-| m2 |-\/\/\-| m3 |-\/\/\-| +!! ! +!! ! As illustrated above, the system consists of 3 masses connected by springs. +!! ! Spring k1 and spring k4 connect the end masses to ground. The equations of +!! ! motion for this system are as follows. +!! ! +!! ! | m1 0 0 | |x1"| | k1+k2 -k2 0 | |x1| |0| +!! ! | 0 m2 0 | |x2"| + | -k2 k2+k3 -k3 | |x2| = |0| +!! ! | 0 0 m3| |x3"| | 0 -k3 k3+k4| |x3| |0| +!! ! +!! ! Notice: x1" = the second time derivative of x1. +!! program example +!! use iso_fortran_env, only : int32, real64 +!! use linalg +!! implicit none +!! +!! ! Define the model parameters +!! real(real64), parameter :: pi = 3.14159265359d0 +!! real(real64), parameter :: m1 = 0.5d0 +!! real(real64), parameter :: m2 = 2.5d0 +!! real(real64), parameter :: m3 = 0.75d0 +!! real(real64), parameter :: k1 = 5.0d6 +!! real(real64), parameter :: k2 = 10.0d6 +!! real(real64), parameter :: k3 = 10.0d6 +!! real(real64), parameter :: k4 = 5.0d6 +!! +!! ! Local Variables +!! integer(int32) :: i, j +!! real(real64) :: m(3,3), k(3,3), natFreq(3) +!! complex(real64) :: vals(3), modeShapes(3,3) !! -!! @author Jason Christopherson -!! @version 1.6.1 +!! ! Define the mass matrix +!! m = reshape([m1, 0.0d0, 0.0d0, 0.0d0, m2, 0.0d0, 0.0d0, 0.0d0, m3], [3, 3]) +!! +!! ! Define the stiffness matrix +!! k = reshape([k1 + k2, -k2, 0.0d0, -k2, k2 + k3, -k3, 0.0d0, -k3, k3 + k4], & +!! [3, 3]) +!! +!! ! Compute the eigenvalues and eigenvectors. +!! call eigen(k, m, vals, vecs = modeShapes) +!! +!! ! Compute the natural frequency values, and return them with units of Hz. +!! ! Notice, all eigenvalues and eigenvectors are real for this example. +!! natFreq = sqrt(real(vals)) / (2.0d0 * pi) +!! +!! ! Display the natural frequency and mode shape values. Notice, the eigen +!! ! routine does not necessarily sort the values. +!! print '(A)', "Modal Information (Not Sorted):" +!! do i = 1, size(natFreq) +!! print '(AI0AF8.4A)', "Mode ", i, ": (", natFreq(i), " Hz)" +!! print '(F10.3)', (real(modeShapes(j,i)), j = 1, size(natFreq)) +!! end do +!! end program +!! @endcode +!! The above program produces the following output. +!! @code{.txt} +!! Modal Information: +!! Mode 1: (232.9225 Hz) +!! -0.718 +!! -1.000 +!! -0.747 +!! Mode 2: (749.6189 Hz) +!! -0.419 +!! -0.164 +!! 1.000 +!! Mode 3: (923.5669 Hz) +!! 1.000 +!! -0.184 +!! 0.179 +!! @endcode !> @brief Provides a set of common linear algebra routines. From b754f003b221f8bb81ea5a6b1f51485cc5bdc851 Mon Sep 17 00:00:00 2001 From: jchristopherson Date: Sun, 18 Dec 2022 18:52:11 -0600 Subject: [PATCH 40/65] Update documentation --- doc/C/html/index.html | 128 +- doc/C/html/linalg_8h_source.html | 398 +- doc/C/html/navtreedata.js | 1 + doc/C/html/navtreeindex0.js | 135 +- doc/C/html/search/all_0.js | 3 +- doc/C/html/search/pages_0.js | 4 + doc/C/html/search/searchdata.js | 9 +- doc/html/annotated.html | 4 +- .../dir_d44c64559bbebec7f509842c48db8b23.html | 2 +- .../dir_d44c64559bbebec7f509842c48db8b23.js | 2 +- doc/html/files.html | 2 +- doc/html/globals.html | 174 + doc/html/globals_func.html | 174 + doc/html/index.html | 124 +- .../interfacelinalg_1_1cholesky__factor.html | 10 +- ...celinalg_1_1cholesky__rank1__downdate.html | 10 +- ...facelinalg_1_1cholesky__rank1__update.html | 10 +- doc/html/interfacelinalg_1_1det.html | 2 +- .../interfacelinalg_1_1diag__mtx__mult.html | 8 +- doc/html/interfacelinalg_1_1eigen.html | 6 +- doc/html/interfacelinalg_1_1form__lu.html | 10 +- doc/html/interfacelinalg_1_1form__qr.html | 10 +- doc/html/interfacelinalg_1_1lu__factor.html | 8 +- doc/html/interfacelinalg_1_1mtx__inverse.html | 6 +- doc/html/interfacelinalg_1_1mtx__mult.html | 2 +- .../interfacelinalg_1_1mtx__pinverse.html | 6 +- doc/html/interfacelinalg_1_1mtx__rank.html | 2 +- doc/html/interfacelinalg_1_1mult__qr.html | 10 +- doc/html/interfacelinalg_1_1mult__rz.html | 2 +- doc/html/interfacelinalg_1_1qr__factor.html | 8 +- .../interfacelinalg_1_1qr__rank1__update.html | 16 +- .../interfacelinalg_1_1rank1__update.html | 2 +- ...interfacelinalg_1_1recip__mult__array.html | 2 +- doc/html/interfacelinalg_1_1rz__factor.html | 2 +- .../interfacelinalg_1_1solve__cholesky.html | 10 +- ...erfacelinalg_1_1solve__least__squares.html | 6 +- ...linalg_1_1solve__least__squares__full.html | 6 +- ...elinalg_1_1solve__least__squares__svd.html | 6 +- doc/html/interfacelinalg_1_1solve__lu.html | 8 +- doc/html/interfacelinalg_1_1solve__qr.html | 8 +- ...celinalg_1_1solve__triangular__system.html | 10 +- doc/html/interfacelinalg_1_1sort.html | 2 +- doc/html/interfacelinalg_1_1svd.html | 12 +- doc/html/interfacelinalg_1_1swap.html | 2 +- doc/html/interfacelinalg_1_1trace.html | 2 +- .../interfacelinalg_1_1tri__mtx__mult.html | 2 +- doc/html/linalg_8f90_source.html | 2381 ++++---- doc/html/linalg_8h.html | 5243 +++++++++++++++++ doc/html/linalg_8h.js | 64 + doc/html/linalg_8h__incl.dot | 12 + doc/html/linalg_8h_source.html | 468 +- doc/html/linalg__basic_8f90_source.html | 2 +- doc/html/linalg__eigen_8f90_source.html | 2 +- doc/html/linalg__factor_8f90_source.html | 2 +- doc/html/linalg__solve_8f90_source.html | 2 +- doc/html/linalg__sorting_8f90_source.html | 2 +- doc/html/menudata.js | 7 +- doc/html/namespacelinalg.html | 26 +- doc/html/namespaces.html | 4 +- doc/html/navtreedata.js | 6 +- doc/html/navtreeindex0.js | 100 +- doc/html/search/all_4.js | 86 +- doc/html/search/files_0.js | 4 + doc/html/search/functions_0.js | 62 +- doc/html/search/searchdata.js | 16 +- include/linalg.h | 147 + 66 files changed, 8165 insertions(+), 1837 deletions(-) create mode 100644 doc/C/html/search/pages_0.js create mode 100644 doc/html/globals.html create mode 100644 doc/html/globals_func.html create mode 100644 doc/html/linalg_8h.html create mode 100644 doc/html/linalg_8h.js create mode 100644 doc/html/linalg_8h__incl.dot create mode 100644 doc/html/search/files_0.js diff --git a/doc/C/html/index.html b/doc/C/html/index.html index 74de82c2..0d207418 100644 --- a/doc/C/html/index.html +++ b/doc/C/html/index.html @@ -5,7 +5,7 @@ -linalg: Main Page +linalg: linalg @@ -96,10 +96,132 @@ -
      -
      linalg Documentation
      +
      +
      linalg
      +

      +Introduction

      +

      LINALG is a linear algebra library that provides a user-friendly interface to several BLAS and LAPACK routines. This library provides routines for solving systems of linear equations, solving over or under-determined systems, and solving eigenvalue problems.

      +
      Example 2 - Solving an Eigenvalue Problem
      The following example illustrates how to solve an eigenvalue problem using a mechanical vibrating system.
      +
      // This is an example illustrating the use of the eigenvalue and eigenvector
      +
      // routines to solve a free vibration problem of 3 masses connected by springs.
      +
      //
      +
      // k1 k2 k3 k4
      +
      // |-\/\/\-| m1 |-\/\/\-| m2 |-\/\/\-| m3 |-\/\/\-|
      +
      //
      +
      // As illustrated above, the system consists of 3 masses connected by springs.
      +
      // Spring k1 and spring k4 connect the end masses to ground. The equations of
      +
      // motion for this system are as follows.
      +
      //
      +
      // | m1 0 0 | |x1"| | k1+k2 -k2 0 | |x1| |0|
      +
      // | 0 m2 0 | |x2"| + | -k2 k2+k3 -k3 | |x2| = |0|
      +
      // | 0 0 m3| |x3"| | 0 -k3 k3+k4| |x3| |0|
      +
      //
      +
      // Notice: x1" = the second time derivative of x1.
      +
      +
      #include <stdio.h>
      +
      #include <complex.h>
      +
      #include <math.h>
      +
      #include "linalg.h"
      +
      +
      #define MAX(a, b) ((a) > (b) ? (a) : (b))
      +
      #define INDEX(i, j, m) ((j) * (m) + (i))
      +
      void normalize_array(int n, double *x);
      +
      +
      int main() {
      +
      // Constants
      +
      const int ndof = 3;
      +
      const double pi = 3.14159265359;
      +
      const double m1 = 0.5;
      +
      const double m2 = 2.5;
      +
      const double m3 = 0.75;
      +
      const double k1 = 5.0e6;
      +
      const double k2 = 10.0e6;
      +
      const double k3 = 10.0e6;
      +
      const double k4 = 5.0e6;
      +
      +
      // Local Variables
      +
      int i, j, flag;
      +
      double m[9], k[9], beta[3], natFreq[3], modeShapes[9];
      +
      double complex alpha[3], vals[3], vecs[9];
      +
      +
      // Build the system matrices
      +
      m[0] = m1; m[3] = 0.0; m[6] = 0.0;
      +
      m[1] = 0.0; m[4] = m2; m[7] = 0.0;
      +
      m[2] = 0.0; m[5] = 0.0; m[8] = m3;
      +
      +
      k[0] = k1 + k2; k[3] = -k2; k[6] = 0.0;
      +
      k[1] = -k2; k[4] = k2 + k3; k[7] = -k3;
      +
      k[2] = 0.0; k[5] = -k3; k[8] = k3 + k4;
      +
      +
      // Compute the eigenvalues and eigenvectors
      +
      flag = la_eigen_gen(true, ndof, k, ndof, m, ndof, alpha, beta, vecs, ndof);
      +
      +
      // Compute the eigenvalues from their components
      +
      for (i = 0; i < ndof; ++i) vals[i] = alpha[i] / beta[i];
      +
      +
      // Sort the eigenvalues and eigenvectors
      +
      flag = la_sort_eigen_cmplx(true, ndof, vals, vecs, ndof);
      +
      +
      // Compute the natural frequencies and extract the mode shape info
      +
      for (i = 0; i < ndof; ++i) {
      +
      natFreq[i] = sqrt(creal(vals[i])) / (2.0 * pi);
      +
      +
      // Extract the real components - the imaginary component is zero
      +
      for (j = 0; j < ndof; ++j) {
      +
      modeShapes[INDEX(j,i,ndof)] = creal(vecs[INDEX(j,i,ndof)]);
      +
      }
      +
      +
      // Normalize the mode shape
      +
      normalize_array(ndof, &modeShapes[INDEX(0,i,ndof)]);
      +
      }
      +
      +
      // Print out each mode shape
      +
      printf("Modal Information:\n");
      +
      for (i = 0; i < ndof; ++i) {
      +
      printf("Mode %i: (%f Hz)\n", i + 1, natFreq[i]);
      +
      for (j = 0; j < ndof; ++j) {
      +
      printf("\t%f\n", modeShapes[INDEX(j, i, ndof)]);
      +
      }
      +
      }
      +
      +
      // End
      +
      return 0;
      +
      }
      +
      +
      void normalize_array(int n, double *x) {
      +
      // Local Variables
      +
      int i;
      +
      double val, maxval;
      +
      +
      // Find the largest magnitude value
      +
      maxval = x[0];
      +
      for (i = 1; i < n; ++i) {
      +
      val = x[i];
      +
      if (fabs(val) > fabs(maxval)) maxval = val;
      +
      }
      +
      +
      // Normalize the array
      +
      for (i = 0; i < n; ++i) x[i] /= maxval;
      +
      }
      + +
      int la_sort_eigen_cmplx(bool ascend, int n, double complex *vals, double complex *vecs, int ldv)
      +
      int la_eigen_gen(bool vecs, int n, double *a, int lda, double *b, int ldb, double complex *alpha, double *beta, double complex *v, int ldv)
      +

      The above program produces the following output.

      Modal Information:
      +
      Mode 1: (232.922543 Hz)
      +
      0.717922
      +
      1.000000
      +
      0.746623
      +
      Mode 2: (749.618856 Hz)
      +
      -0.419151
      +
      -0.163803
      +
      1.000000
      +
      Mode 3: (923.566902 Hz)
      +
      1.000000
      +
      -0.183707
      +
      0.179128
      +
      diff --git a/doc/C/html/linalg_8h_source.html b/doc/C/html/linalg_8h_source.html index 50ec7802..b6a3a77f 100644 --- a/doc/C/html/linalg_8h_source.html +++ b/doc/C/html/linalg_8h_source.html @@ -101,208 +101,208 @@
      Go to the documentation of this file.
      1
      -
      2#ifndef LINALG_H_DEFINED
      -
      3#define LINALG_H_DEFINED
      -
      4
      -
      5#include <stdbool.h>
      -
      6#include <complex.h>
      -
      7
      -
      8#define LA_NO_OPERATION 0
      -
      9#define LA_TRANSPOSE 1
      -
      10#define LA_HERMITIAN_TRANSPOSE 2
      -
      11#define LA_NO_ERROR 0
      -
      12#define LA_INVALID_INPUT_ERROR 101
      -
      13#define LA_ARRAY_SIZE_ERROR 102
      -
      14#define LA_SINGULAR_MATRIX_ERROR 103
      -
      15#define LA_MATRIX_FORMAT_ERROR 104
      -
      16#define LA_OUT_OF_MEMORY_ERROR 105
      -
      17#define LA_CONVERGENCE_ERROR 106
      -
      18#define LA_INVALID_OPERATION_ERROR 107
      -
      19
      -
      20#ifdef __cplusplus
      -
      21extern "C" {
      -
      22#endif
      -
      23
      -
      43int la_rank1_update(int m, int n, double alpha, const double *x,
      -
      44 const double *y, double *a, int lda);
      -
      45
      -
      65int la_rank1_update_cmplx(int m, int n, double complex alpha,
      -
      66 const double complex *x, const double complex *y, double complex *a,
      -
      67 int lda);
      -
      68
      -
      83int la_trace(int m, int n, const double *a, int lda, double *rst);
      -
      84
      -
      99int la_trace_cmplx(int m, int n, const double complex *a, int lda,
      -
      100 double complex *rst);
      -
      101
      -
      128int la_mtx_mult(bool transa, bool transb, int m, int n, int k, double alpha,
      -
      129 const double *a, int lda, const double *b, int ldb, double beta,
      -
      130 double *c, int ldc);
      -
      131
      -
      160int la_mtx_mult_cmplx(int opa, int opb, int m, int n, int k,
      -
      161 double complex alpha, const double complex *a, int lda,
      -
      162 const double complex *b, int ldb, double complex beta, double complex *c,
      -
      163 int ldc);
      -
      164
      -
      198int la_diag_mtx_mult(bool lside, bool transb, int m, int n, int k,
      -
      199 double alpha, const double *a, const double *b, int ldb, double beta,
      -
      200 double *c, int ldc);
      -
      201
      -
      236int la_diag_mtx_mult_cmplx(bool lside, int opb, int m, int n, int k,
      -
      237 double complex alpha, const double complex *a, const double complex *b,
      -
      238 int ldb, double complex beta, double complex *c, int ldc);
      -
      239
      -
      274int la_diag_mtx_mult_mixed(bool lside, int opb, int m, int n, int k,
      -
      275 double complex alpha, const double *a, const double complex *b,
      -
      276 int ldb, double complex beta, double complex *c, int ldc);
      -
      277
      -
      296int la_rank(int m, int n, double *a, int lda, int *rnk);
      -
      297
      -
      316int la_rank_cmplx(int m, int n, double complex *a, int lda, int *rnk);
      -
      317
      -
      333int la_det(int n, double *a, int lda, double *d);
      -
      334
      -
      350int la_det_cmplx(int n, double complex *a, int lda, double complex *d);
      -
      351
      -
      377int la_tri_mtx_mult(bool upper, double alpha, int n, const double *a, int lda,
      -
      378 double beta, double *b, int ldb);
      -
      379
      -
      405int la_tri_mtx_mult_cmplx(bool upper, double complex alpha, int n,
      -
      406 const double complex *a, int lda, double complex beta,
      -
      407 double complex *b, int ldb);
      -
      408
      -
      428int la_lu_factor(int m, int n, double *a, int lda, int *ipvt);
      -
      429
      -
      449int la_lu_factor_cmplx(int m, int n, double complex *a, int lda, int *ipvt);
      -
      450
      -
      472int la_form_lu(int n, double *a, int lda, int *ipvt, double *u, int ldu,
      -
      473 double *p, int ldp);
      -
      474
      -
      496int la_form_lu_cmplx(int n, double complex *a, int lda, int *ipvt,
      -
      497 double complex *u, int ldu, double *p, int ldp);
      -
      498
      -
      520int la_qr_factor(int m, int n, double *a, int lda, double *tau);
      -
      521
      -
      543int la_qr_factor_cmplx(int m, int n, double complex *a, int lda,
      -
      544 double complex *tau);
      -
      545
      -
      570int la_qr_factor_pvt(int m, int n, double *a, int lda, double *tau, int *jpvt);
      -
      571
      -
      596int la_qr_factor_cmplx_pvt(int m, int n, double complex *a, int lda,
      -
      597 double complex *tau, int *jpvt);
      -
      598
      -
      625int la_form_qr(bool fullq, int m, int n, double *r, int ldr, const double *tau,
      -
      626 double *q, int ldq);
      -
      627
      -
      654int la_form_qr_cmplx(bool fullq, int m, int n, double complex *r, int ldr,
      -
      655 const double complex *tau, double complex *q, int ldq);
      -
      656
      -
      689int la_form_qr_pvt(bool fullq, int m, int n, double *r, int ldr,
      -
      690 const double *tau, const int *pvt, double *q, int ldq, double *p, int ldp);
      -
      691
      -
      724int la_form_qr_cmplx_pvt(bool fullq, int m, int n, double complex *r, int ldr,
      -
      725 const double complex *tau, const int *pvt, double complex *q, int ldq,
      -
      726 double complex *p, int ldp);
      -
      727
      -
      757int la_mult_qr(bool lside, bool trans, int m, int n, int k, double *a, int lda,
      -
      758 const double *tau, double *c, int ldc);
      -
      759
      -
      789int la_mult_qr_cmplx(bool lside, bool trans, int m, int n, int k,
      -
      790 double complex *a, int lda, const double complex *tau, double complex *c,
      -
      791 int ldc);
      -
      792
      -
      817int la_qr_rank1_update(int m, int n, double *q, int ldq, double *r, int ldr,
      -
      818 double *u, double *v);
      -
      819
      -
      844int la_qr_rank1_update_cmplx(int m, int n, double complex *q, int ldq,
      -
      845 double complex *r, int ldr, double complex *u, double complex *v);
      -
      846
      -
      865int la_cholesky_factor(bool upper, int n, double *a, int lda);
      +
      141#ifndef LINALG_H_DEFINED
      +
      142#define LINALG_H_DEFINED
      +
      143
      +
      144#include <stdbool.h>
      +
      145#include <complex.h>
      +
      146
      +
      147#define LA_NO_OPERATION 0
      +
      148#define LA_TRANSPOSE 1
      +
      149#define LA_HERMITIAN_TRANSPOSE 2
      +
      150#define LA_NO_ERROR 0
      +
      151#define LA_INVALID_INPUT_ERROR 101
      +
      152#define LA_ARRAY_SIZE_ERROR 102
      +
      153#define LA_SINGULAR_MATRIX_ERROR 103
      +
      154#define LA_MATRIX_FORMAT_ERROR 104
      +
      155#define LA_OUT_OF_MEMORY_ERROR 105
      +
      156#define LA_CONVERGENCE_ERROR 106
      +
      157#define LA_INVALID_OPERATION_ERROR 107
      +
      158
      +
      159#ifdef __cplusplus
      +
      160extern "C" {
      +
      161#endif
      +
      162
      +
      182int la_rank1_update(int m, int n, double alpha, const double *x,
      +
      183 const double *y, double *a, int lda);
      +
      184
      +
      204int la_rank1_update_cmplx(int m, int n, double complex alpha,
      +
      205 const double complex *x, const double complex *y, double complex *a,
      +
      206 int lda);
      +
      207
      +
      222int la_trace(int m, int n, const double *a, int lda, double *rst);
      +
      223
      +
      238int la_trace_cmplx(int m, int n, const double complex *a, int lda,
      +
      239 double complex *rst);
      +
      240
      +
      267int la_mtx_mult(bool transa, bool transb, int m, int n, int k, double alpha,
      +
      268 const double *a, int lda, const double *b, int ldb, double beta,
      +
      269 double *c, int ldc);
      +
      270
      +
      299int la_mtx_mult_cmplx(int opa, int opb, int m, int n, int k,
      +
      300 double complex alpha, const double complex *a, int lda,
      +
      301 const double complex *b, int ldb, double complex beta, double complex *c,
      +
      302 int ldc);
      +
      303
      +
      337int la_diag_mtx_mult(bool lside, bool transb, int m, int n, int k,
      +
      338 double alpha, const double *a, const double *b, int ldb, double beta,
      +
      339 double *c, int ldc);
      +
      340
      +
      375int la_diag_mtx_mult_cmplx(bool lside, int opb, int m, int n, int k,
      +
      376 double complex alpha, const double complex *a, const double complex *b,
      +
      377 int ldb, double complex beta, double complex *c, int ldc);
      +
      378
      +
      413int la_diag_mtx_mult_mixed(bool lside, int opb, int m, int n, int k,
      +
      414 double complex alpha, const double *a, const double complex *b,
      +
      415 int ldb, double complex beta, double complex *c, int ldc);
      +
      416
      +
      435int la_rank(int m, int n, double *a, int lda, int *rnk);
      +
      436
      +
      455int la_rank_cmplx(int m, int n, double complex *a, int lda, int *rnk);
      +
      456
      +
      472int la_det(int n, double *a, int lda, double *d);
      +
      473
      +
      489int la_det_cmplx(int n, double complex *a, int lda, double complex *d);
      +
      490
      +
      516int la_tri_mtx_mult(bool upper, double alpha, int n, const double *a, int lda,
      +
      517 double beta, double *b, int ldb);
      +
      518
      +
      544int la_tri_mtx_mult_cmplx(bool upper, double complex alpha, int n,
      +
      545 const double complex *a, int lda, double complex beta,
      +
      546 double complex *b, int ldb);
      +
      547
      +
      567int la_lu_factor(int m, int n, double *a, int lda, int *ipvt);
      +
      568
      +
      588int la_lu_factor_cmplx(int m, int n, double complex *a, int lda, int *ipvt);
      +
      589
      +
      611int la_form_lu(int n, double *a, int lda, int *ipvt, double *u, int ldu,
      +
      612 double *p, int ldp);
      +
      613
      +
      635int la_form_lu_cmplx(int n, double complex *a, int lda, int *ipvt,
      +
      636 double complex *u, int ldu, double *p, int ldp);
      +
      637
      +
      659int la_qr_factor(int m, int n, double *a, int lda, double *tau);
      +
      660
      +
      682int la_qr_factor_cmplx(int m, int n, double complex *a, int lda,
      +
      683 double complex *tau);
      +
      684
      +
      709int la_qr_factor_pvt(int m, int n, double *a, int lda, double *tau, int *jpvt);
      +
      710
      +
      735int la_qr_factor_cmplx_pvt(int m, int n, double complex *a, int lda,
      +
      736 double complex *tau, int *jpvt);
      +
      737
      +
      764int la_form_qr(bool fullq, int m, int n, double *r, int ldr, const double *tau,
      +
      765 double *q, int ldq);
      +
      766
      +
      793int la_form_qr_cmplx(bool fullq, int m, int n, double complex *r, int ldr,
      +
      794 const double complex *tau, double complex *q, int ldq);
      +
      795
      +
      828int la_form_qr_pvt(bool fullq, int m, int n, double *r, int ldr,
      +
      829 const double *tau, const int *pvt, double *q, int ldq, double *p, int ldp);
      +
      830
      +
      863int la_form_qr_cmplx_pvt(bool fullq, int m, int n, double complex *r, int ldr,
      +
      864 const double complex *tau, const int *pvt, double complex *q, int ldq,
      +
      865 double complex *p, int ldp);
      866
      -
      885int la_cholesky_factor_cmplx(bool upper, int n, double complex *a, int lda);
      -
      886
      -
      904int la_cholesky_rank1_update(int n, double *r, int ldr, double *u);
      -
      905
      -
      923int la_cholesky_rank1_update_cmplx(int n, double complex *r, int ldr,
      -
      924 double complex *u);
      -
      925
      -
      945int la_cholesky_rank1_downdate(int n, double *r, int ldr, double *u);
      -
      946
      -
      966int la_cholesky_rank1_downdate_cmplx(int n, double complex *r, int ldr,
      -
      967 double complex *u);
      -
      968
      -
      998int la_svd(int m, int n, double *a, int lda, double *s, double *u, int ldu,
      -
      999 double *vt, int ldv);
      -
      1000
      -
      1030int la_svd_cmplx(int m, int n, double complex *a, int lda, double *s,
      -
      1031 double complex *u, int ldu, double complex *vt, int ldv);
      -
      1032
      -
      1061int la_solve_tri_mtx(bool lside, bool upper, bool trans, bool nounit, int m,
      -
      1062 int n, double alpha, const double *a, int lda, double *b, int ldb);
      -
      1063
      -
      1092int la_solve_tri_mtx_cmplx(bool lside, bool upper, bool trans, bool nounit,
      -
      1093 int m, int n, double complex alpha, const double complex *a, int lda,
      -
      1094 double complex *b, int ldb);
      -
      1095
      -
      1112int la_solve_lu(int m, int n, const double *a, int lda, const int *ipvt,
      -
      1113 double *b, int ldb);
      -
      1114
      -
      1131int la_solve_lu_cmplx(int m, int n, const double complex *a, int lda,
      -
      1132 const int *ipvt, double complex *b, int ldb);
      -
      1133
      -
      1157int la_solve_qr(int m, int n, int k, double *a, int lda, const double *tau,
      -
      1158 double *b, int ldb);
      -
      1159
      -
      1183int la_solve_qr_cmplx(int m, int n, int k, double complex *a, int lda,
      -
      1184 const double complex *tau, double complex *b, int ldb);
      -
      1185
      -
      1209int la_solve_qr_pvt(int m, int n, int k, double *a, int lda, const double *tau,
      -
      1210 const int *jpvt, double *b, int ldb);
      -
      1211
      -
      1235int la_solve_qr_cmplx_pvt(int m, int n, int k, double complex *a, int lda,
      -
      1236 const double complex *tau, const int *jpvt, double complex *b, int ldb);
      -
      1237
      -
      1256int la_solve_cholesky(bool upper, int m, int n, const double *a, int lda,
      -
      1257 double *b, int ldb);
      -
      1258
      -
      1277int la_solve_cholesky_cmplx(bool upper, int m, int n, const double complex *a,
      -
      1278 int lda, double complex *b, int ldb);
      -
      1279
      -
      1305int la_solve_least_squares(int m, int n, int k, double *a, int lda, double *b,
      -
      1306 int ldb);
      -
      1307
      -
      1333int la_solve_least_squares_cmplx(int m, int n, int k, double complex *a,
      -
      1334 int lda, double complex *b, int ldb);
      -
      1335
      -
      1349int la_inverse(int n, double *a, int lda);
      +
      896int la_mult_qr(bool lside, bool trans, int m, int n, int k, double *a, int lda,
      +
      897 const double *tau, double *c, int ldc);
      +
      898
      +
      928int la_mult_qr_cmplx(bool lside, bool trans, int m, int n, int k,
      +
      929 double complex *a, int lda, const double complex *tau, double complex *c,
      +
      930 int ldc);
      +
      931
      +
      956int la_qr_rank1_update(int m, int n, double *q, int ldq, double *r, int ldr,
      +
      957 double *u, double *v);
      +
      958
      +
      983int la_qr_rank1_update_cmplx(int m, int n, double complex *q, int ldq,
      +
      984 double complex *r, int ldr, double complex *u, double complex *v);
      +
      985
      +
      1004int la_cholesky_factor(bool upper, int n, double *a, int lda);
      +
      1005
      +
      1024int la_cholesky_factor_cmplx(bool upper, int n, double complex *a, int lda);
      +
      1025
      +
      1043int la_cholesky_rank1_update(int n, double *r, int ldr, double *u);
      +
      1044
      +
      1062int la_cholesky_rank1_update_cmplx(int n, double complex *r, int ldr,
      +
      1063 double complex *u);
      +
      1064
      +
      1084int la_cholesky_rank1_downdate(int n, double *r, int ldr, double *u);
      +
      1085
      +
      1105int la_cholesky_rank1_downdate_cmplx(int n, double complex *r, int ldr,
      +
      1106 double complex *u);
      +
      1107
      +
      1137int la_svd(int m, int n, double *a, int lda, double *s, double *u, int ldu,
      +
      1138 double *vt, int ldv);
      +
      1139
      +
      1169int la_svd_cmplx(int m, int n, double complex *a, int lda, double *s,
      +
      1170 double complex *u, int ldu, double complex *vt, int ldv);
      +
      1171
      +
      1200int la_solve_tri_mtx(bool lside, bool upper, bool trans, bool nounit, int m,
      +
      1201 int n, double alpha, const double *a, int lda, double *b, int ldb);
      +
      1202
      +
      1231int la_solve_tri_mtx_cmplx(bool lside, bool upper, bool trans, bool nounit,
      +
      1232 int m, int n, double complex alpha, const double complex *a, int lda,
      +
      1233 double complex *b, int ldb);
      +
      1234
      +
      1251int la_solve_lu(int m, int n, const double *a, int lda, const int *ipvt,
      +
      1252 double *b, int ldb);
      +
      1253
      +
      1270int la_solve_lu_cmplx(int m, int n, const double complex *a, int lda,
      +
      1271 const int *ipvt, double complex *b, int ldb);
      +
      1272
      +
      1296int la_solve_qr(int m, int n, int k, double *a, int lda, const double *tau,
      +
      1297 double *b, int ldb);
      +
      1298
      +
      1322int la_solve_qr_cmplx(int m, int n, int k, double complex *a, int lda,
      +
      1323 const double complex *tau, double complex *b, int ldb);
      +
      1324
      +
      1348int la_solve_qr_pvt(int m, int n, int k, double *a, int lda, const double *tau,
      +
      1349 const int *jpvt, double *b, int ldb);
      1350
      -
      1364int la_inverse_cmplx(int n, double complex *a, int lda);
      -
      1365
      -
      1383int la_pinverse(int m, int n, double *a, int lda, double *ainv, int ldai);
      -
      1384
      -
      1402int la_pinverse_cmplx(int m, int n, double complex *a, int lda,
      -
      1403 double complex *ainv, int ldai);
      -
      1404
      -
      1428int la_eigen_symm(bool vecs, int n, double *a, int lda, double *vals);
      -
      1429
      -
      1452int la_eigen_asymm(bool vecs, int n, double *a, int lda,
      -
      1453 double complex *vals, double complex *v, int ldv);
      -
      1454
      -
      1487int la_eigen_gen(bool vecs, int n, double *a, int lda, double *b, int ldb,
      -
      1488 double complex *alpha, double *beta, double complex *v, int ldv);
      +
      1374int la_solve_qr_cmplx_pvt(int m, int n, int k, double complex *a, int lda,
      +
      1375 const double complex *tau, const int *jpvt, double complex *b, int ldb);
      +
      1376
      +
      1395int la_solve_cholesky(bool upper, int m, int n, const double *a, int lda,
      +
      1396 double *b, int ldb);
      +
      1397
      +
      1416int la_solve_cholesky_cmplx(bool upper, int m, int n, const double complex *a,
      +
      1417 int lda, double complex *b, int ldb);
      +
      1418
      +
      1444int la_solve_least_squares(int m, int n, int k, double *a, int lda, double *b,
      +
      1445 int ldb);
      +
      1446
      +
      1472int la_solve_least_squares_cmplx(int m, int n, int k, double complex *a,
      +
      1473 int lda, double complex *b, int ldb);
      +
      1474
      +
      1488int la_inverse(int n, double *a, int lda);
      1489
      -
      1512int la_eigen_cmplx(bool vecs, int n, double complex *a, int lda,
      -
      1513 double complex *vals, double complex *v, int ldv);
      -
      1514
      -
      1534int la_sort_eigen(bool ascend, int n, double *vals, double *vecs, int ldv);
      -
      1535
      -
      1555int la_sort_eigen_cmplx(bool ascend, int n, double complex *vals,
      -
      1556 double complex *vecs, int ldv);
      -
      1557
      -
      1558#ifdef __cplusplus
      -
      1559}
      -
      1560#endif // __cplusplus
      -
      1561#endif // LINALG_H_DEFINED
      +
      1503int la_inverse_cmplx(int n, double complex *a, int lda);
      +
      1504
      +
      1522int la_pinverse(int m, int n, double *a, int lda, double *ainv, int ldai);
      +
      1523
      +
      1541int la_pinverse_cmplx(int m, int n, double complex *a, int lda,
      +
      1542 double complex *ainv, int ldai);
      +
      1543
      +
      1567int la_eigen_symm(bool vecs, int n, double *a, int lda, double *vals);
      +
      1568
      +
      1591int la_eigen_asymm(bool vecs, int n, double *a, int lda,
      +
      1592 double complex *vals, double complex *v, int ldv);
      +
      1593
      +
      1626int la_eigen_gen(bool vecs, int n, double *a, int lda, double *b, int ldb,
      +
      1627 double complex *alpha, double *beta, double complex *v, int ldv);
      +
      1628
      +
      1651int la_eigen_cmplx(bool vecs, int n, double complex *a, int lda,
      +
      1652 double complex *vals, double complex *v, int ldv);
      +
      1653
      +
      1673int la_sort_eigen(bool ascend, int n, double *vals, double *vecs, int ldv);
      +
      1674
      +
      1694int la_sort_eigen_cmplx(bool ascend, int n, double complex *vals,
      +
      1695 double complex *vecs, int ldv);
      +
      1696
      +
      1697#ifdef __cplusplus
      +
      1698}
      +
      1699#endif // __cplusplus
      +
      1700#endif // LINALG_H_DEFINED
      int la_cholesky_rank1_downdate_cmplx(int n, double complex *r, int ldr, double complex *u)
      int la_trace_cmplx(int m, int n, const double complex *a, int lda, double complex *rst)
      int la_tri_mtx_mult_cmplx(bool upper, double complex alpha, int n, const double complex *a, int lda, double complex beta, double complex *b, int ldb)
      diff --git a/doc/C/html/navtreedata.js b/doc/C/html/navtreedata.js index 848db1ea..f56b30fb 100644 --- a/doc/C/html/navtreedata.js +++ b/doc/C/html/navtreedata.js @@ -25,6 +25,7 @@ var NAVTREE = [ [ "linalg", "index.html", [ + [ "Introduction", "index.html#intro_sec", null ], [ "Files", "files.html", [ [ "File List", "files.html", "files_dup" ], [ "Globals", "globals.html", [ diff --git a/doc/C/html/navtreeindex0.js b/doc/C/html/navtreeindex0.js index 26cc82ad..e831859e 100644 --- a/doc/C/html/navtreeindex0.js +++ b/doc/C/html/navtreeindex0.js @@ -1,72 +1,73 @@ var NAVTREEINDEX0 = { -"dir_d44c64559bbebec7f509842c48db8b23.html":[0,0,0], -"files.html":[0,0], -"globals.html":[0,1,0], -"globals_func.html":[0,1,1], +"dir_d44c64559bbebec7f509842c48db8b23.html":[1,0,0], +"files.html":[1,0], +"globals.html":[1,1,0], +"globals_func.html":[1,1,1], "index.html":[], -"linalg_8h.html":[0,0,0,0], -"linalg_8h.html#a00c15ec713541d15eae1fd0b01897689":[0,0,0,0,3], -"linalg_8h.html#a021fbb7fdccf557ec407a86bace43d85":[0,0,0,0,58], -"linalg_8h.html#a02c464a9dd95298c91f431ae4d0773e9":[0,0,0,0,60], -"linalg_8h.html#a02eb049983dd41f2307bb52594fb210e":[0,0,0,0,43], -"linalg_8h.html#a0338870fe1142f88c96db63495fec615":[0,0,0,0,18], -"linalg_8h.html#a089690d293303e30c6eef0bb1e982191":[0,0,0,0,37], -"linalg_8h.html#a090178a5f99a4b400da80481aad77757":[0,0,0,0,54], -"linalg_8h.html#a0dc578507a0cb6ada776142476383590":[0,0,0,0,41], -"linalg_8h.html#a0ff5f2519eb1d2af94e3b4a26dfb10fe":[0,0,0,0,48], -"linalg_8h.html#a15774f6323c34d307c99b32ac4f188a7":[0,0,0,0,15], -"linalg_8h.html#a1734acc61ef569dfff9c83bcad566f67":[0,0,0,0,1], -"linalg_8h.html#a248142a5f0826cddac5daf1c74f234a6":[0,0,0,0,23], -"linalg_8h.html#a292e54c48a8e7f0203bf11f02844691f":[0,0,0,0,2], -"linalg_8h.html#a3967bc139cba341a513d1353bea62ac9":[0,0,0,0,0], -"linalg_8h.html#a3c958fe274f8d1663dd0188455a5fe15":[0,0,0,0,39], -"linalg_8h.html#a4a3f6dafe185c2985fc76aab3d0abb97":[0,0,0,0,33], -"linalg_8h.html#a4b74177a8914b109e1bf3aa56c9d9cb7":[0,0,0,0,8], -"linalg_8h.html#a4bc671dad87b42ff285a4241322a3764":[0,0,0,0,34], -"linalg_8h.html#a4d5bad18dcc8a52d9594cc21954c572d":[0,0,0,0,10], -"linalg_8h.html#a56c0cea99a066e74c8fff9682d5ca92d":[0,0,0,0,55], -"linalg_8h.html#a62f97b4319f5574aef5e52bbacff14bb":[0,0,0,0,50], -"linalg_8h.html#a63bec2daa56fdc4bbf3f45b67ea14f65":[0,0,0,0,9], -"linalg_8h.html#a719ffdff56c8fa0875409c4f4e5e95cf":[0,0,0,0,42], -"linalg_8h.html#a71ba1a09caca9d59a9d24b95c7ea749b":[0,0,0,0,30], -"linalg_8h.html#a73bea3ca338925cfa4a58bcaea726a14":[0,0,0,0,16], -"linalg_8h.html#a791d5221eb8ad4fcd106cb218590dfc9":[0,0,0,0,31], -"linalg_8h.html#a7a821b41c61670f5710214a4d9178998":[0,0,0,0,22], -"linalg_8h.html#a7f611f8f3de7d56120c78e70671c7112":[0,0,0,0,57], -"linalg_8h.html#a9491626ab4b3664771e1282b61eeaa74":[0,0,0,0,11], -"linalg_8h.html#a95d6ed56844c62d553b940091837014b":[0,0,0,0,21], -"linalg_8h.html#a95f921847131eaedd62a439490d2a801":[0,0,0,0,27], -"linalg_8h.html#a968b10545320af7bbe1030867ae88e8c":[0,0,0,0,25], -"linalg_8h.html#a9b0639faf9ac0af9bbdb348b92746d5f":[0,0,0,0,35], -"linalg_8h.html#aa067ac0d3f58e28371d413ab7419da74":[0,0,0,0,46], -"linalg_8h.html#aace787c5b11959a457b936ace4995033":[0,0,0,0,20], -"linalg_8h.html#aae725d3247301d1163c58f89edff3d4b":[0,0,0,0,45], -"linalg_8h.html#ab346fed23fd61f02d65e09c795c26d74":[0,0,0,0,38], -"linalg_8h.html#abeb7ee58d4151498be96aa91432f296f":[0,0,0,0,4], -"linalg_8h.html#abf5918abab8f97fc2ac5887e051ff493":[0,0,0,0,53], -"linalg_8h.html#ac208d5e6849972a77ef261f2e368868c":[0,0,0,0,14], -"linalg_8h.html#ac3bb7b959d8cc7400e9b13290a895b64":[0,0,0,0,44], -"linalg_8h.html#ac7b4894cd929a106e02a8e37a4d52913":[0,0,0,0,6], -"linalg_8h.html#acc25c0daa53c10ace21a61d78b2e79f3":[0,0,0,0,28], -"linalg_8h.html#ace554b62c12a5d9a2434c8171c756c47":[0,0,0,0,24], -"linalg_8h.html#ace9edf6a878ee4dd0b220b75b7db6431":[0,0,0,0,7], -"linalg_8h.html#acfbd42393c8b1931ff11bc4c7e858aef":[0,0,0,0,36], -"linalg_8h.html#ad0ee4a9c71de62911a71a342790f5070":[0,0,0,0,49], -"linalg_8h.html#ad76e25c5eb98075e83cc9df493be5b38":[0,0,0,0,19], -"linalg_8h.html#ae5a16375c14c924836c33bafa747a1cf":[0,0,0,0,12], -"linalg_8h.html#ae5ffa6e8d9c850bd41f43f7564bf6896":[0,0,0,0,32], -"linalg_8h.html#ae7d70f1ef2a2824772e1bf0f726c257e":[0,0,0,0,59], -"linalg_8h.html#aed7b29bbff1472ebe805054eb9d8c6d4":[0,0,0,0,51], -"linalg_8h.html#aefdc2e6758482d02a3aa7978f7d5efe0":[0,0,0,0,47], -"linalg_8h.html#aefefe80e13f74470d5afaf44b3a45e76":[0,0,0,0,26], -"linalg_8h.html#af19ebf41be31ee92f657131a8fbf55a3":[0,0,0,0,5], -"linalg_8h.html#af3c6f1a45aee2f275d4b109c9bb660d2":[0,0,0,0,13], -"linalg_8h.html#af7f8185c0f25ad3fb0b89cc98d77b3d6":[0,0,0,0,29], -"linalg_8h.html#af87823d73fb5a319e4262594d147e38c":[0,0,0,0,52], -"linalg_8h.html#afbffa0856d75c607a03d3dc7b5b1076e":[0,0,0,0,56], -"linalg_8h.html#afdc9b7e6ffab89915a082c00ceac7258":[0,0,0,0,40], -"linalg_8h.html#afe39765d805c1d9ae93e9aa2f20d8548":[0,0,0,0,17], -"linalg_8h_source.html":[0,0,0,0], +"index.html#intro_sec":[0], +"linalg_8h.html":[1,0,0,0], +"linalg_8h.html#a00c15ec713541d15eae1fd0b01897689":[1,0,0,0,3], +"linalg_8h.html#a021fbb7fdccf557ec407a86bace43d85":[1,0,0,0,58], +"linalg_8h.html#a02c464a9dd95298c91f431ae4d0773e9":[1,0,0,0,60], +"linalg_8h.html#a02eb049983dd41f2307bb52594fb210e":[1,0,0,0,43], +"linalg_8h.html#a0338870fe1142f88c96db63495fec615":[1,0,0,0,18], +"linalg_8h.html#a089690d293303e30c6eef0bb1e982191":[1,0,0,0,37], +"linalg_8h.html#a090178a5f99a4b400da80481aad77757":[1,0,0,0,54], +"linalg_8h.html#a0dc578507a0cb6ada776142476383590":[1,0,0,0,41], +"linalg_8h.html#a0ff5f2519eb1d2af94e3b4a26dfb10fe":[1,0,0,0,48], +"linalg_8h.html#a15774f6323c34d307c99b32ac4f188a7":[1,0,0,0,15], +"linalg_8h.html#a1734acc61ef569dfff9c83bcad566f67":[1,0,0,0,1], +"linalg_8h.html#a248142a5f0826cddac5daf1c74f234a6":[1,0,0,0,23], +"linalg_8h.html#a292e54c48a8e7f0203bf11f02844691f":[1,0,0,0,2], +"linalg_8h.html#a3967bc139cba341a513d1353bea62ac9":[1,0,0,0,0], +"linalg_8h.html#a3c958fe274f8d1663dd0188455a5fe15":[1,0,0,0,39], +"linalg_8h.html#a4a3f6dafe185c2985fc76aab3d0abb97":[1,0,0,0,33], +"linalg_8h.html#a4b74177a8914b109e1bf3aa56c9d9cb7":[1,0,0,0,8], +"linalg_8h.html#a4bc671dad87b42ff285a4241322a3764":[1,0,0,0,34], +"linalg_8h.html#a4d5bad18dcc8a52d9594cc21954c572d":[1,0,0,0,10], +"linalg_8h.html#a56c0cea99a066e74c8fff9682d5ca92d":[1,0,0,0,55], +"linalg_8h.html#a62f97b4319f5574aef5e52bbacff14bb":[1,0,0,0,50], +"linalg_8h.html#a63bec2daa56fdc4bbf3f45b67ea14f65":[1,0,0,0,9], +"linalg_8h.html#a719ffdff56c8fa0875409c4f4e5e95cf":[1,0,0,0,42], +"linalg_8h.html#a71ba1a09caca9d59a9d24b95c7ea749b":[1,0,0,0,30], +"linalg_8h.html#a73bea3ca338925cfa4a58bcaea726a14":[1,0,0,0,16], +"linalg_8h.html#a791d5221eb8ad4fcd106cb218590dfc9":[1,0,0,0,31], +"linalg_8h.html#a7a821b41c61670f5710214a4d9178998":[1,0,0,0,22], +"linalg_8h.html#a7f611f8f3de7d56120c78e70671c7112":[1,0,0,0,57], +"linalg_8h.html#a9491626ab4b3664771e1282b61eeaa74":[1,0,0,0,11], +"linalg_8h.html#a95d6ed56844c62d553b940091837014b":[1,0,0,0,21], +"linalg_8h.html#a95f921847131eaedd62a439490d2a801":[1,0,0,0,27], +"linalg_8h.html#a968b10545320af7bbe1030867ae88e8c":[1,0,0,0,25], +"linalg_8h.html#a9b0639faf9ac0af9bbdb348b92746d5f":[1,0,0,0,35], +"linalg_8h.html#aa067ac0d3f58e28371d413ab7419da74":[1,0,0,0,46], +"linalg_8h.html#aace787c5b11959a457b936ace4995033":[1,0,0,0,20], +"linalg_8h.html#aae725d3247301d1163c58f89edff3d4b":[1,0,0,0,45], +"linalg_8h.html#ab346fed23fd61f02d65e09c795c26d74":[1,0,0,0,38], +"linalg_8h.html#abeb7ee58d4151498be96aa91432f296f":[1,0,0,0,4], +"linalg_8h.html#abf5918abab8f97fc2ac5887e051ff493":[1,0,0,0,53], +"linalg_8h.html#ac208d5e6849972a77ef261f2e368868c":[1,0,0,0,14], +"linalg_8h.html#ac3bb7b959d8cc7400e9b13290a895b64":[1,0,0,0,44], +"linalg_8h.html#ac7b4894cd929a106e02a8e37a4d52913":[1,0,0,0,6], +"linalg_8h.html#acc25c0daa53c10ace21a61d78b2e79f3":[1,0,0,0,28], +"linalg_8h.html#ace554b62c12a5d9a2434c8171c756c47":[1,0,0,0,24], +"linalg_8h.html#ace9edf6a878ee4dd0b220b75b7db6431":[1,0,0,0,7], +"linalg_8h.html#acfbd42393c8b1931ff11bc4c7e858aef":[1,0,0,0,36], +"linalg_8h.html#ad0ee4a9c71de62911a71a342790f5070":[1,0,0,0,49], +"linalg_8h.html#ad76e25c5eb98075e83cc9df493be5b38":[1,0,0,0,19], +"linalg_8h.html#ae5a16375c14c924836c33bafa747a1cf":[1,0,0,0,12], +"linalg_8h.html#ae5ffa6e8d9c850bd41f43f7564bf6896":[1,0,0,0,32], +"linalg_8h.html#ae7d70f1ef2a2824772e1bf0f726c257e":[1,0,0,0,59], +"linalg_8h.html#aed7b29bbff1472ebe805054eb9d8c6d4":[1,0,0,0,51], +"linalg_8h.html#aefdc2e6758482d02a3aa7978f7d5efe0":[1,0,0,0,47], +"linalg_8h.html#aefefe80e13f74470d5afaf44b3a45e76":[1,0,0,0,26], +"linalg_8h.html#af19ebf41be31ee92f657131a8fbf55a3":[1,0,0,0,5], +"linalg_8h.html#af3c6f1a45aee2f275d4b109c9bb660d2":[1,0,0,0,13], +"linalg_8h.html#af7f8185c0f25ad3fb0b89cc98d77b3d6":[1,0,0,0,29], +"linalg_8h.html#af87823d73fb5a319e4262594d147e38c":[1,0,0,0,52], +"linalg_8h.html#afbffa0856d75c607a03d3dc7b5b1076e":[1,0,0,0,56], +"linalg_8h.html#afdc9b7e6ffab89915a082c00ceac7258":[1,0,0,0,40], +"linalg_8h.html#afe39765d805c1d9ae93e9aa2f20d8548":[1,0,0,0,17], +"linalg_8h_source.html":[1,0,0,0], "pages.html":[] }; diff --git a/doc/C/html/search/all_0.js b/doc/C/html/search/all_0.js index fa3fa6d9..54295e52 100644 --- a/doc/C/html/search/all_0.js +++ b/doc/C/html/search/all_0.js @@ -61,5 +61,6 @@ var searchData= ['la_5ftrace_5fcmplx_58',['la_trace_cmplx',['../linalg_8h.html#a021fbb7fdccf557ec407a86bace43d85',1,'linalg.h']]], ['la_5ftri_5fmtx_5fmult_59',['la_tri_mtx_mult',['../linalg_8h.html#ae7d70f1ef2a2824772e1bf0f726c257e',1,'linalg.h']]], ['la_5ftri_5fmtx_5fmult_5fcmplx_60',['la_tri_mtx_mult_cmplx',['../linalg_8h.html#a02c464a9dd95298c91f431ae4d0773e9',1,'linalg.h']]], - ['linalg_2eh_61',['linalg.h',['../linalg_8h.html',1,'']]] + ['linalg_61',['linalg',['../index.html',1,'']]], + ['linalg_2eh_62',['linalg.h',['../linalg_8h.html',1,'']]] ]; diff --git a/doc/C/html/search/pages_0.js b/doc/C/html/search/pages_0.js new file mode 100644 index 00000000..0768ea63 --- /dev/null +++ b/doc/C/html/search/pages_0.js @@ -0,0 +1,4 @@ +var searchData= +[ + ['linalg_0',['linalg',['../index.html',1,'']]] +]; diff --git a/doc/C/html/search/searchdata.js b/doc/C/html/search/searchdata.js index 22e10cbd..dd73763a 100644 --- a/doc/C/html/search/searchdata.js +++ b/doc/C/html/search/searchdata.js @@ -2,20 +2,23 @@ var indexSectionsWithContent = { 0: "l", 1: "l", - 2: "l" + 2: "l", + 3: "l" }; var indexSectionNames = { 0: "all", 1: "files", - 2: "functions" + 2: "functions", + 3: "pages" }; var indexSectionLabels = { 0: "All", 1: "Files", - 2: "Functions" + 2: "Functions", + 3: "Pages" }; diff --git a/doc/html/annotated.html b/doc/html/annotated.html index bc9df1cd..1365f35e 100644 --- a/doc/html/annotated.html +++ b/doc/html/annotated.html @@ -119,7 +119,7 @@  Cmult_qrMultiplies a general matrix by the orthogonal matrix Q from a QR factorization  Cmult_rzMultiplies a general matrix by the orthogonal matrix Z from an RZ factorization  Cqr_factorComputes the QR factorization of an M-by-N matrix - Cqr_rank1_updateComputes the rank 1 update to an M-by-N QR factored matrix A (M >= N) where \( A = Q R \), and \( A1 = A + U V^T \) such that \( A1 = Q1 R1 \) + Cqr_rank1_updateComputes the rank 1 update to an M-by-N QR factored matrix A (M >= N) where \( A = Q R \), and \( A1 = A + U V^T \) such that \( A1 = Q1 R1 \). In the event \( V \) is complex-valued, \( V^H \) is computed instead of \( V^T \)  Crank1_updatePerforms the rank-1 update to matrix A such that: \( A = \alpha X Y^T + A \), where \( A \) is an M-by-N matrix, \( \alpha \)is a scalar, \( X \) is an M-element array, and \( Y \) is an N-element array. In the event that \( Y \) is complex, \( Y^H \) is used instead of \( Y^T \)  Crecip_mult_arrayMultiplies a vector by the reciprocal of a real scalar  Crz_factorFactors an upper trapezoidal matrix by means of orthogonal transformations such that \( A = R Z = (R 0) Z \). Z is an orthogonal matrix of dimension N-by-N, and R is an M-by-M upper triangular matrix @@ -131,7 +131,7 @@  Csolve_qrSolves a system of M QR-factored equations of N unknowns  Csolve_triangular_systemSolves a triangular system of equations  CsortSorts an array - CsvdComputes the singular value decomposition of a matrix A. The SVD is defined as: \( A = U S V^T \), where \( U \) is an M-by-M orthogonal matrix, \( S \) is an M-by-N diagonal matrix, and \( V \) is an N-by-N orthogonal matrix + CsvdComputes the singular value decomposition of a matrix A. The SVD is defined as: \( A = U S V^T \), where \( U \) is an M-by-M orthogonal matrix, \( S \) is an M-by-N diagonal matrix, and \( V \) is an N-by-N orthogonal matrix. In the event that \( V \) is complex valued, \( V^H \) is computed instead of \( V^T \)  CswapSwaps the contents of two arrays  CtraceComputes the trace of a matrix (the sum of the main diagonal elements)  Ctri_mtx_multComputes the triangular matrix operation: \( B = \alpha A^T A + \beta B \), or \( B = \alpha A A^T + \beta B \), where A is a triangular matrix diff --git a/doc/html/dir_d44c64559bbebec7f509842c48db8b23.html b/doc/html/dir_d44c64559bbebec7f509842c48db8b23.html index 57ba2d5b..62de7634 100644 --- a/doc/html/dir_d44c64559bbebec7f509842c48db8b23.html +++ b/doc/html/dir_d44c64559bbebec7f509842c48db8b23.html @@ -103,7 +103,7 @@ - +

      Files

      file  linalg.h [code]
      file  linalg.h [code]
       
      diff --git a/doc/html/dir_d44c64559bbebec7f509842c48db8b23.js b/doc/html/dir_d44c64559bbebec7f509842c48db8b23.js index 31652267..7ef22b07 100644 --- a/doc/html/dir_d44c64559bbebec7f509842c48db8b23.js +++ b/doc/html/dir_d44c64559bbebec7f509842c48db8b23.js @@ -1,4 +1,4 @@ var dir_d44c64559bbebec7f509842c48db8b23 = [ - [ "linalg.h", "linalg_8h_source.html", null ] + [ "linalg.h", "linalg_8h.html", "linalg_8h" ] ]; \ No newline at end of file diff --git a/doc/html/files.html b/doc/html/files.html index 02ccfd67..277feb59 100644 --- a/doc/html/files.html +++ b/doc/html/files.html @@ -103,7 +103,7 @@
      Here is a list of all documented files with brief descriptions:
      [detail level 12]
      - + diff --git a/doc/html/globals.html b/doc/html/globals.html new file mode 100644 index 00000000..bceec022 --- /dev/null +++ b/doc/html/globals.html @@ -0,0 +1,174 @@ + + + + + + + +linalg: File Members + + + + + + + + + + + + + + + +
      +
      +
        include
       linalg.h
       linalg.h
        src
       linalg.f90
       linalg_basic.f90
      + + + + + +
      +
      linalg 1.6.1 +
      +
      A linear algebra library that provides a user-friendly interface to several BLAS and LAPACK routines.
      +
      +
      + + + + + + + +
      +
      + +
      +
      +
      + +
      + +
      +
      + + +
      +
      +
      +
      +
      +
      Loading...
      +
      Searching...
      +
      No Matches
      +
      +
      +
      +
      + +
      +
      Here is a list of all documented file members with links to the documentation:
      + +

      - l -

      +
      +
      + + + + diff --git a/doc/html/globals_func.html b/doc/html/globals_func.html new file mode 100644 index 00000000..bae03da3 --- /dev/null +++ b/doc/html/globals_func.html @@ -0,0 +1,174 @@ + + + + + + + +linalg: File Members + + + + + + + + + + + + + + + +
      +
      + + + + + + +
      +
      linalg 1.6.1 +
      +
      A linear algebra library that provides a user-friendly interface to several BLAS and LAPACK routines.
      +
      +
      + + + + + + + +
      +
      + +
      +
      +
      + +
      + +
      +
      + + +
      +
      +
      +
      +
      +
      Loading...
      +
      Searching...
      +
      No Matches
      +
      +
      +
      +
      + +
      +  + +

      - l -

      +
      +
      + + + + diff --git a/doc/html/index.html b/doc/html/index.html index 96fc1481..b0f484fb 100644 --- a/doc/html/index.html +++ b/doc/html/index.html @@ -102,10 +102,126 @@

      Introduction

      -

      LINALG is a linear algebra library that provides a user-friendly interface to several BLAS and LAPACK routines.

      -
      Author
      Jason Christopherson
      -
      Version
      1.6.1
      -
      +

      LINALG is a linear algebra library that provides a user-friendly interface to several BLAS and LAPACK routines. This library provides routines for solving systems of linear equations, solving over or under-determined systems, and solving eigenvalue problems.

      +
      Example 1 - Solving Linear Equations
      The following piece of code illustrates how to solve a system of linear equations using LU factorization.
      +
      program example
      +
      use iso_fortran_env
      +
      use linalg
      +
      implicit none
      +
      +
      ! Local Variables
      +
      real(real64) :: a(3,3), b(3)
      +
      integer(int32) :: i, pvt(3)
      +
      +
      ! Build the 3-by-3 matrix A.
      +
      ! | 1 2 3 |
      +
      ! A = | 4 5 6 |
      +
      ! | 7 8 0 |
      +
      a = reshape( &
      +
      [1.0d0, 4.0d0, 7.0d0, 2.0d0, 5.0d0, 8.0d0, 3.0d0, 6.0d0, 0.0d0], &
      +
      [3, 3])
      +
      +
      ! Build the right-hand-side vector B.
      +
      ! | -1 |
      +
      ! b = | -2 |
      +
      ! | -3 |
      +
      b = [-1.0d0, -2.0d0, -3.0d0]
      +
      +
      ! The solution is:
      +
      ! | 1/3 |
      +
      ! x = | -2/3 |
      +
      ! | 0 |
      +
      +
      ! Compute the LU factorization
      +
      call lu_factor(a, pvt)
      +
      +
      ! Compute the solution. The results overwrite b.
      +
      call solve_lu(a, pvt, b)
      +
      +
      ! Display the results.
      +
      print '(A)', "LU Solution: X = "
      +
      print '(F8.4)', (b(i), i = 1, size(b))
      +
      end program
      +
      Computes the LU factorization of an M-by-N matrix.
      Definition: linalg.f90:725
      +
      Solves a system of LU-factored equations.
      Definition: linalg.f90:2280
      +
      Provides a set of common linear algebra routines.
      Definition: linalg.f90:145
      +

      The program generates the following output.

      LU Solution: X =
      +
      0.3333
      +
      -0.6667
      +
      0.0000
      +
      Example 2 - Solving an Eigenvalue Problem
      The following example illustrates how to solve an eigenvalue problem using a mechanical vibrating system.
      +
      ! This is an example illustrating the use of the eigenvalue and eigenvector
      +
      ! routines to solve a free vibration problem of 3 masses connected by springs.
      +
      !
      +
      ! k1 k2 k3 k4
      +
      ! |-\/\/\-| m1 |-\/\/\-| m2 |-\/\/\-| m3 |-\/\/\-|
      +
      !
      +
      ! As illustrated above, the system consists of 3 masses connected by springs.
      +
      ! Spring k1 and spring k4 connect the end masses to ground. The equations of
      +
      ! motion for this system are as follows.
      +
      !
      +
      ! | m1 0 0 | |x1"| | k1+k2 -k2 0 | |x1| |0|
      +
      ! | 0 m2 0 | |x2"| + | -k2 k2+k3 -k3 | |x2| = |0|
      +
      ! | 0 0 m3| |x3"| | 0 -k3 k3+k4| |x3| |0|
      +
      !
      +
      ! Notice: x1" = the second time derivative of x1.
      +
      program example
      +
      use iso_fortran_env, only : int32, real64
      +
      use linalg
      +
      implicit none
      +
      +
      ! Define the model parameters
      +
      real(real64), parameter :: pi = 3.14159265359d0
      +
      real(real64), parameter :: m1 = 0.5d0
      +
      real(real64), parameter :: m2 = 2.5d0
      +
      real(real64), parameter :: m3 = 0.75d0
      +
      real(real64), parameter :: k1 = 5.0d6
      +
      real(real64), parameter :: k2 = 10.0d6
      +
      real(real64), parameter :: k3 = 10.0d6
      +
      real(real64), parameter :: k4 = 5.0d6
      +
      +
      ! Local Variables
      +
      integer(int32) :: i, j
      +
      real(real64) :: m(3,3), k(3,3), natFreq(3)
      +
      complex(real64) :: vals(3), modeShapes(3,3)
      +
      +
      ! Define the mass matrix
      +
      m = reshape([m1, 0.0d0, 0.0d0, 0.0d0, m2, 0.0d0, 0.0d0, 0.0d0, m3], [3, 3])
      +
      +
      ! Define the stiffness matrix
      +
      k = reshape([k1 + k2, -k2, 0.0d0, -k2, k2 + k3, -k3, 0.0d0, -k3, k3 + k4], &
      +
      [3, 3])
      +
      +
      ! Compute the eigenvalues and eigenvectors.
      +
      call eigen(k, m, vals, vecs = modeshapes)
      +
      +
      ! Compute the natural frequency values, and return them with units of Hz.
      +
      ! Notice, all eigenvalues and eigenvectors are real for this example.
      +
      natfreq = sqrt(real(vals)) / (2.0d0 * pi)
      +
      +
      ! Display the natural frequency and mode shape values. Notice, the eigen
      +
      ! routine does not necessarily sort the values.
      +
      print '(A)', "Modal Information (Not Sorted):"
      +
      do i = 1, size(natfreq)
      +
      print '(AI0AF8.4A)', "Mode ", i, ": (", natfreq(i), " Hz)"
      +
      print '(F10.3)', (real(modeshapes(j,i)), j = 1, size(natfreq))
      +
      end do
      +
      end program
      +
      Computes the eigenvalues, and optionally the eigenvectors, of a matrix.
      Definition: linalg.f90:3229
      +

      The above program produces the following output.

      Modal Information:
      +
      Mode 1: (232.9225 Hz)
      +
      -0.718
      +
      -1.000
      +
      -0.747
      +
      Mode 2: (749.6189 Hz)
      +
      -0.419
      +
      -0.164
      +
      1.000
      +
      Mode 3: (923.5669 Hz)
      +
      1.000
      +
      -0.184
      +
      0.179
      +
      diff --git a/doc/html/interfacelinalg_1_1cholesky__factor.html b/doc/html/interfacelinalg_1_1cholesky__factor.html index 5f28fefc..9db20e5d 100644 --- a/doc/html/interfacelinalg_1_1cholesky__factor.html +++ b/doc/html/interfacelinalg_1_1cholesky__factor.html @@ -173,10 +173,10 @@
      print '(A)', "Cholesky Solution (Manual Approach): X = "
      print '(F8.4)', (bu(i), i = 1, size(bu))
      end program
      -
      Computes the Cholesky factorization of a symmetric, positive definite matrix.
      Definition: linalg.f90:1432
      -
      Solves a system of Cholesky factored equations.
      Definition: linalg.f90:2389
      -
      Solves a triangular system of equations.
      Definition: linalg.f90:2060
      -
      Provides a set of common linear algebra routines.
      Definition: linalg.f90:15
      +
      Computes the Cholesky factorization of a symmetric, positive definite matrix.
      Definition: linalg.f90:1563
      +
      Solves a system of Cholesky factored equations.
      Definition: linalg.f90:2521
      +
      Solves a triangular system of equations.
      Definition: linalg.f90:2192
      +
      Provides a set of common linear algebra routines.
      Definition: linalg.f90:145
      The above program produces the following output.
      Cholesky Solution: X =
      239.5833
      -65.6667
      @@ -187,7 +187,7 @@
      10.3333
      -

      Definition at line 1432 of file linalg.f90.

      +

      Definition at line 1563 of file linalg.f90.


      The documentation for this interface was generated from the following file: diff --git a/doc/html/interfacelinalg_1_1cholesky__rank1__downdate.html b/doc/html/interfacelinalg_1_1cholesky__rank1__downdate.html index 250c1cbb..e0c21512 100644 --- a/doc/html/interfacelinalg_1_1cholesky__rank1__downdate.html +++ b/doc/html/interfacelinalg_1_1cholesky__rank1__downdate.html @@ -174,10 +174,10 @@
      print *, ad(i,:)
      end do
      end program
      -
      Computes the Cholesky factorization of a symmetric, positive definite matrix.
      Definition: linalg.f90:1432
      -
      Computes the rank 1 downdate to a Cholesky factored matrix (upper triangular).
      Definition: linalg.f90:1638
      -
      Performs the rank-1 update to matrix A such that: , where is an M-by-N matrix, is a scalar,...
      Definition: linalg.f90:194
      -
      Provides a set of common linear algebra routines.
      Definition: linalg.f90:15
      +
      Computes the Cholesky factorization of a symmetric, positive definite matrix.
      Definition: linalg.f90:1563
      +
      Computes the rank 1 downdate to a Cholesky factored matrix (upper triangular).
      Definition: linalg.f90:1769
      +
      Performs the rank-1 update to matrix A such that: , where is an M-by-N matrix, is a scalar,...
      Definition: linalg.f90:324
      +
      Provides a set of common linear algebra routines.
      Definition: linalg.f90:145
      The above program produces the following output.
      Downdating the Factored Form:
      2.0000000000000000 6.0000000000000000 -8.0000000000000000
      0.0000000000000000 1.0000000000000000 4.9999999999999973
      @@ -188,7 +188,7 @@
      0.0000000000000000 0.0000000000000000 3.0000000000000000
      -

      Definition at line 1638 of file linalg.f90.

      +

      Definition at line 1769 of file linalg.f90.


      The documentation for this interface was generated from the following file: diff --git a/doc/html/interfacelinalg_1_1cholesky__rank1__update.html b/doc/html/interfacelinalg_1_1cholesky__rank1__update.html index 91e5e629..56a3f558 100644 --- a/doc/html/interfacelinalg_1_1cholesky__rank1__update.html +++ b/doc/html/interfacelinalg_1_1cholesky__rank1__update.html @@ -168,10 +168,10 @@
      print *, au(i,:)
      end do
      end program
      -
      Computes the Cholesky factorization of a symmetric, positive definite matrix.
      Definition: linalg.f90:1432
      -
      Computes the rank 1 update to a Cholesky factored matrix (upper triangular).
      Definition: linalg.f90:1531
      -
      Performs the rank-1 update to matrix A such that: , where is an M-by-N matrix, is a scalar,...
      Definition: linalg.f90:194
      -
      Provides a set of common linear algebra routines.
      Definition: linalg.f90:15
      +
      Computes the Cholesky factorization of a symmetric, positive definite matrix.
      Definition: linalg.f90:1563
      +
      Computes the rank 1 update to a Cholesky factored matrix (upper triangular).
      Definition: linalg.f90:1662
      +
      Performs the rank-1 update to matrix A such that: , where is an M-by-N matrix, is a scalar,...
      Definition: linalg.f90:324
      +
      Provides a set of common linear algebra routines.
      Definition: linalg.f90:145
      The above program produces the following output.
      Updating the Factored Form:
      2.0615528128088303 5.4570515633174921 -7.2760687510899889
      0.0000000000000000 3.0774320845949008 -2.0452498947307731
      @@ -182,7 +182,7 @@
      0.0000000000000000 0.0000000000000000 6.6989384530323557
      -

      Definition at line 1531 of file linalg.f90.

      +

      Definition at line 1662 of file linalg.f90.


      The documentation for this interface was generated from the following file: diff --git a/doc/html/interfacelinalg_1_1det.html b/doc/html/interfacelinalg_1_1det.html index 0b464ec7..21cb4eed 100644 --- a/doc/html/interfacelinalg_1_1det.html +++ b/doc/html/interfacelinalg_1_1det.html @@ -124,7 +124,7 @@
      Returns
      The determinant of a.
      -

      Definition at line 434 of file linalg.f90.

      +

      Definition at line 564 of file linalg.f90.


      The documentation for this interface was generated from the following file: diff --git a/doc/html/interfacelinalg_1_1diag__mtx__mult.html b/doc/html/interfacelinalg_1_1diag__mtx__mult.html index 7cc9aac2..81f389cc 100644 --- a/doc/html/interfacelinalg_1_1diag__mtx__mult.html +++ b/doc/html/interfacelinalg_1_1diag__mtx__mult.html @@ -193,9 +193,9 @@
      print *, ac(i,:)
      end do
      end program
      -
      Multiplies a diagonal matrix with another matrix or array.
      Definition: linalg.f90:329
      -
      Computes the singular value decomposition of a matrix A. The SVD is defined as: , where is an M-by-M...
      Definition: linalg.f90:1926
      -
      Provides a set of common linear algebra routines.
      Definition: linalg.f90:15
      +
      Multiplies a diagonal matrix with another matrix or array.
      Definition: linalg.f90:459
      +
      Computes the singular value decomposition of a matrix A. The SVD is defined as: , where is an M-by-M...
      Definition: linalg.f90:2058
      +
      Provides a set of common linear algebra routines.
      Definition: linalg.f90:145
      The above program produces the following output.
      U =
      -0.47411577501825380 -0.81850539032073777 -0.32444284226152509
      0.82566838523833064 -0.28535874325972488 -0.48666426339228758
      @@ -212,7 +212,7 @@
      -1.0000000000000000 0.99999999999999967
      -

      Definition at line 329 of file linalg.f90.

      +

      Definition at line 459 of file linalg.f90.


      The documentation for this interface was generated from the following file: diff --git a/doc/html/interfacelinalg_1_1eigen.html b/doc/html/interfacelinalg_1_1eigen.html index de5e607f..7dd88b83 100644 --- a/doc/html/interfacelinalg_1_1eigen.html +++ b/doc/html/interfacelinalg_1_1eigen.html @@ -225,8 +225,8 @@
      print '(F10.3)', (real(modeshapes(j,i)), j = 1, size(natfreq))
      end do
      end program
      -
      Computes the eigenvalues, and optionally the eigenvectors, of a matrix.
      Definition: linalg.f90:3097
      -
      Provides a set of common linear algebra routines.
      Definition: linalg.f90:15
      +
      Computes the eigenvalues, and optionally the eigenvectors, of a matrix.
      Definition: linalg.f90:3229
      +
      Provides a set of common linear algebra routines.
      Definition: linalg.f90:145
      The above program produces the following output.
      Modal Information:
      Mode 1: (232.9225 Hz)
      -0.718
      @@ -248,7 +248,7 @@

    -

    Definition at line 3097 of file linalg.f90.

    +

    Definition at line 3229 of file linalg.f90.


    The documentation for this interface was generated from the following file: diff --git a/doc/html/interfacelinalg_1_1form__lu.html b/doc/html/interfacelinalg_1_1form__lu.html index 9cdb2245..a642fd59 100644 --- a/doc/html/interfacelinalg_1_1form__lu.html +++ b/doc/html/interfacelinalg_1_1form__lu.html @@ -197,17 +197,17 @@
    print '(A)', "LU Solution: X = "
    print '(F8.4)', (b(i), i = 1, size(b))
    end program
    -
    Extracts the L and U matrices from the condensed [L\U] storage format used by the lu_factor.
    Definition: linalg.f90:717
    -
    Computes the LU factorization of an M-by-N matrix.
    Definition: linalg.f90:595
    -
    Solves a triangular system of equations.
    Definition: linalg.f90:2060
    -
    Provides a set of common linear algebra routines.
    Definition: linalg.f90:15
    +
    Extracts the L and U matrices from the condensed [L\U] storage format used by the lu_factor.
    Definition: linalg.f90:847
    +
    Computes the LU factorization of an M-by-N matrix.
    Definition: linalg.f90:725
    +
    Solves a triangular system of equations.
    Definition: linalg.f90:2192
    +
    Provides a set of common linear algebra routines.
    Definition: linalg.f90:145
    The above program produces the following output.
    LU Solution: X =
    0.3333
    -0.6667
    0.0000
    -

    Definition at line 717 of file linalg.f90.

    +

    Definition at line 847 of file linalg.f90.


    The documentation for this interface was generated from the following file: diff --git a/doc/html/interfacelinalg_1_1form__qr.html b/doc/html/interfacelinalg_1_1form__qr.html index 8856168c..10c30a0f 100644 --- a/doc/html/interfacelinalg_1_1form__qr.html +++ b/doc/html/interfacelinalg_1_1form__qr.html @@ -202,10 +202,10 @@
    ! for by noting that Q * R = A * P, where P is an N-by-N matrix describing
    ! the column pivoting operations.
    end program
    -
    Forms the full M-by-M orthogonal matrix Q from the elementary reflectors returned by the base QR fact...
    Definition: linalg.f90:1031
    -
    Computes the QR factorization of an M-by-N matrix.
    Definition: linalg.f90:871
    -
    Solves a triangular system of equations.
    Definition: linalg.f90:2060
    -
    Provides a set of common linear algebra routines.
    Definition: linalg.f90:15
    +
    Forms the full M-by-M orthogonal matrix Q from the elementary reflectors returned by the base QR fact...
    Definition: linalg.f90:1161
    +
    Computes the QR factorization of an M-by-N matrix.
    Definition: linalg.f90:1001
    +
    Solves a triangular system of equations.
    Definition: linalg.f90:2192
    +
    Provides a set of common linear algebra routines.
    Definition: linalg.f90:145
    The above program produces the following output.
    QR Solution: X =
    0.3333
    -0.6667
    @@ -217,7 +217,7 @@ -

    Definition at line 1031 of file linalg.f90.

    +

    Definition at line 1161 of file linalg.f90.


    The documentation for this interface was generated from the following file: diff --git a/doc/html/interfacelinalg_1_1lu__factor.html b/doc/html/interfacelinalg_1_1lu__factor.html index f0fb5e3c..d5e24803 100644 --- a/doc/html/interfacelinalg_1_1lu__factor.html +++ b/doc/html/interfacelinalg_1_1lu__factor.html @@ -166,16 +166,16 @@
    print '(A)', "LU Solution: X = "
    print '(F8.4)', (b(i), i = 1, size(b))
    end program
    -
    Computes the LU factorization of an M-by-N matrix.
    Definition: linalg.f90:595
    -
    Solves a system of LU-factored equations.
    Definition: linalg.f90:2148
    -
    Provides a set of common linear algebra routines.
    Definition: linalg.f90:15
    +
    Computes the LU factorization of an M-by-N matrix.
    Definition: linalg.f90:725
    +
    Solves a system of LU-factored equations.
    Definition: linalg.f90:2280
    +
    Provides a set of common linear algebra routines.
    Definition: linalg.f90:145
    The program generates the following output.
    LU Solution: X =
    0.3333
    -0.6667
    0.0000
    -

    Definition at line 595 of file linalg.f90.

    +

    Definition at line 725 of file linalg.f90.


    The documentation for this interface was generated from the following file: diff --git a/doc/html/interfacelinalg_1_1mtx__inverse.html b/doc/html/interfacelinalg_1_1mtx__inverse.html index 25e4eb89..c197fbe8 100644 --- a/doc/html/interfacelinalg_1_1mtx__inverse.html +++ b/doc/html/interfacelinalg_1_1mtx__inverse.html @@ -167,8 +167,8 @@
    print *, c(i,:)
    end do
    end program
    -
    Computes the inverse of a square matrix.
    Definition: linalg.f90:2777
    -
    Provides a set of common linear algebra routines.
    Definition: linalg.f90:15
    +
    Computes the inverse of a square matrix.
    Definition: linalg.f90:2909
    +
    Provides a set of common linear algebra routines.
    Definition: linalg.f90:145
    The above program produces the following output.
    Inverse:
    -1.7777777777777777 0.88888888888888884 -0.11111111111111110
    1.5555555555555556 -0.77777777777777779 0.22222222222222221
    @@ -179,7 +179,7 @@
    1.7763568394002505E-015 -8.8817841970012523E-016 1.0000000000000000
    -

    Definition at line 2777 of file linalg.f90.

    +

    Definition at line 2909 of file linalg.f90.


    The documentation for this interface was generated from the following file: diff --git a/doc/html/interfacelinalg_1_1mtx__mult.html b/doc/html/interfacelinalg_1_1mtx__mult.html index 4c5d9131..00c2b81a 100644 --- a/doc/html/interfacelinalg_1_1mtx__mult.html +++ b/doc/html/interfacelinalg_1_1mtx__mult.html @@ -146,7 +146,7 @@
    Notes
    This routine utilizes the BLAS routines DGEMM, ZGEMM, DGEMV, or ZGEMV.
    -

    Definition at line 159 of file linalg.f90.

    +

    Definition at line 289 of file linalg.f90.


    The documentation for this interface was generated from the following file: diff --git a/doc/html/interfacelinalg_1_1mtx__pinverse.html b/doc/html/interfacelinalg_1_1mtx__pinverse.html index dd75c5c1..d2e839bd 100644 --- a/doc/html/interfacelinalg_1_1mtx__pinverse.html +++ b/doc/html/interfacelinalg_1_1mtx__pinverse.html @@ -171,8 +171,8 @@
    print *, c(i,:)
    end do
    end program
    -
    Computes the Moore-Penrose pseudo-inverse of a M-by-N matrix using the singular value decomposition o...
    Definition: linalg.f90:2883
    -
    Provides a set of common linear algebra routines.
    Definition: linalg.f90:15
    +
    Computes the Moore-Penrose pseudo-inverse of a M-by-N matrix using the singular value decomposition o...
    Definition: linalg.f90:3015
    +
    Provides a set of common linear algebra routines.
    Definition: linalg.f90:145
    The above program produces the following output.
    Inverse:
    1.0000000000000000 0.0000000000000000 0.0000000000000000
    0.0000000000000000 0.49999999999999978 0.49999999999999989
    @@ -181,7 +181,7 @@
    0.0000000000000000 0.99999999999999967
    -

    Definition at line 2883 of file linalg.f90.

    +

    Definition at line 3015 of file linalg.f90.


    The documentation for this interface was generated from the following file: diff --git a/doc/html/interfacelinalg_1_1mtx__rank.html b/doc/html/interfacelinalg_1_1mtx__rank.html index 4454d4b5..d089127e 100644 --- a/doc/html/interfacelinalg_1_1mtx__rank.html +++ b/doc/html/interfacelinalg_1_1mtx__rank.html @@ -131,7 +131,7 @@ -

    Definition at line 401 of file linalg.f90.

    +

    Definition at line 531 of file linalg.f90.


    The documentation for this interface was generated from the following file: diff --git a/doc/html/interfacelinalg_1_1mult__qr.html b/doc/html/interfacelinalg_1_1mult__qr.html index ba37aa88..888f0370 100644 --- a/doc/html/interfacelinalg_1_1mult__qr.html +++ b/doc/html/interfacelinalg_1_1mult__qr.html @@ -201,17 +201,17 @@
    ! for by noting that Q * R = A * P, where P is an N-by-N matrix describing
    ! the column pivoting operations.
    end program
    -
    Multiplies a general matrix by the orthogonal matrix Q from a QR factorization.
    Definition: linalg.f90:1184
    -
    Computes the QR factorization of an M-by-N matrix.
    Definition: linalg.f90:871
    -
    Solves a triangular system of equations.
    Definition: linalg.f90:2060
    -
    Provides a set of common linear algebra routines.
    Definition: linalg.f90:15
    +
    Multiplies a general matrix by the orthogonal matrix Q from a QR factorization.
    Definition: linalg.f90:1314
    +
    Computes the QR factorization of an M-by-N matrix.
    Definition: linalg.f90:1001
    +
    Solves a triangular system of equations.
    Definition: linalg.f90:2192
    +
    Provides a set of common linear algebra routines.
    Definition: linalg.f90:145
    The above program produces the following output.
    QR Solution: X =
    0.3333
    -0.6667
    0.0000
    -

    Definition at line 1184 of file linalg.f90.

    +

    Definition at line 1314 of file linalg.f90.


    The documentation for this interface was generated from the following file: diff --git a/doc/html/interfacelinalg_1_1mult__rz.html b/doc/html/interfacelinalg_1_1mult__rz.html index d78a3e8d..d5bf1e4e 100644 --- a/doc/html/interfacelinalg_1_1mult__rz.html +++ b/doc/html/interfacelinalg_1_1mult__rz.html @@ -150,7 +150,7 @@
    Notes
    This routine utilizes the LAPACK routine DORMRZ (ZUNMRZ in the complex case).
    -

    Definition at line 1802 of file linalg.f90.

    +

    Definition at line 1933 of file linalg.f90.


    The documentation for this interface was generated from the following file: diff --git a/doc/html/interfacelinalg_1_1qr__factor.html b/doc/html/interfacelinalg_1_1qr__factor.html index 17522652..778be8f6 100644 --- a/doc/html/interfacelinalg_1_1qr__factor.html +++ b/doc/html/interfacelinalg_1_1qr__factor.html @@ -189,9 +189,9 @@
    ! same manner. The only difference is to omit the PVT array (column pivot
    ! tracking array).
    end program
    -
    Computes the QR factorization of an M-by-N matrix.
    Definition: linalg.f90:871
    -
    Solves a system of M QR-factored equations of N unknowns.
    Definition: linalg.f90:2283
    -
    Provides a set of common linear algebra routines.
    Definition: linalg.f90:15
    +
    Computes the QR factorization of an M-by-N matrix.
    Definition: linalg.f90:1001
    +
    Solves a system of M QR-factored equations of N unknowns.
    Definition: linalg.f90:2415
    +
    Provides a set of common linear algebra routines.
    Definition: linalg.f90:145
    The above program produces the following output.
    QR Solution: X =
    0.3333
    -0.6667
    @@ -204,7 +204,7 @@ -

    Definition at line 871 of file linalg.f90.

    +

    Definition at line 1001 of file linalg.f90.


    The documentation for this interface was generated from the following file: diff --git a/doc/html/interfacelinalg_1_1qr__rank1__update.html b/doc/html/interfacelinalg_1_1qr__rank1__update.html index 9c9a7a0a..0e76583a 100644 --- a/doc/html/interfacelinalg_1_1qr__rank1__update.html +++ b/doc/html/interfacelinalg_1_1qr__rank1__update.html @@ -103,10 +103,10 @@
    -

    Computes the rank 1 update to an M-by-N QR factored matrix A (M >= N) where \( A = Q R \), and \( A1 = A + U V^T \) such that \( A1 = Q1 R1 \). +

    Computes the rank 1 update to an M-by-N QR factored matrix A (M >= N) where \( A = Q R \), and \( A1 = A + U V^T \) such that \( A1 = Q1 R1 \). In the event \( V \) is complex-valued, \( V^H \) is computed instead of \( V^T \). More...

    Detailed Description

    -

    Computes the rank 1 update to an M-by-N QR factored matrix A (M >= N) where \( A = Q R \), and \( A1 = A + U V^T \) such that \( A1 = Q1 R1 \).

    +

    Computes the rank 1 update to an M-by-N QR factored matrix A (M >= N) where \( A = Q R \), and \( A1 = A + U V^T \) such that \( A1 = Q1 R1 \). In the event \( V \) is complex-valued, \( V^H \) is computed instead of \( V^T \).

    Syntax
    subroutine qr_rank1_update(real(real64) q(:,:), real(real64) r(:,:), real(real64) u(:), real(real64) v(:), optional real(real64) work(:), optional class(errors) err)
    subroutine qr_rank1_update(complex(real64) q(:,:), complex(real64) r(:,:), complex(real64) u(:), complex(real64) v(:), optional complex(real64) work(:), optional real(real64) rwork(:), optional class(errors) err)
    @@ -194,11 +194,11 @@
    print *, a(i,:)
    end do
    end program
    -
    Forms the full M-by-M orthogonal matrix Q from the elementary reflectors returned by the base QR fact...
    Definition: linalg.f90:1031
    -
    Computes the QR factorization of an M-by-N matrix.
    Definition: linalg.f90:871
    -
    Computes the rank 1 update to an M-by-N QR factored matrix A (M >= N) where , and such that .
    Definition: linalg.f90:1333
    -
    Performs the rank-1 update to matrix A such that: , where is an M-by-N matrix, is a scalar,...
    Definition: linalg.f90:194
    -
    Provides a set of common linear algebra routines.
    Definition: linalg.f90:15
    +
    Forms the full M-by-M orthogonal matrix Q from the elementary reflectors returned by the base QR fact...
    Definition: linalg.f90:1161
    +
    Computes the QR factorization of an M-by-N matrix.
    Definition: linalg.f90:1001
    +
    Computes the rank 1 update to an M-by-N QR factored matrix A (M >= N) where , and such that ....
    Definition: linalg.f90:1464
    +
    Performs the rank-1 update to matrix A such that: , where is an M-by-N matrix, is a scalar,...
    Definition: linalg.f90:324
    +
    Provides a set of common linear algebra routines.
    Definition: linalg.f90:145
    The above program produces the following output.
    Updating the Factored Form:
    Q =
    -0.13031167282892092 0.98380249683206911 -0.12309149097933236
    @@ -219,7 +219,7 @@
    0.0000000000000000 0.0000000000000000 -5.2929341121113058
    -

    Definition at line 1333 of file linalg.f90.

    +

    Definition at line 1464 of file linalg.f90.


    The documentation for this interface was generated from the following file: diff --git a/doc/html/interfacelinalg_1_1rank1__update.html b/doc/html/interfacelinalg_1_1rank1__update.html index 549919ef..e1711d11 100644 --- a/doc/html/interfacelinalg_1_1rank1__update.html +++ b/doc/html/interfacelinalg_1_1rank1__update.html @@ -125,7 +125,7 @@
    Notes
    This routine is based upon the BLAS routine DGER or ZGER.
    -

    Definition at line 194 of file linalg.f90.

    +

    Definition at line 324 of file linalg.f90.


    The documentation for this interface was generated from the following file: diff --git a/doc/html/interfacelinalg_1_1recip__mult__array.html b/doc/html/interfacelinalg_1_1recip__mult__array.html index 6d553588..0337afcc 100644 --- a/doc/html/interfacelinalg_1_1recip__mult__array.html +++ b/doc/html/interfacelinalg_1_1recip__mult__array.html @@ -118,7 +118,7 @@
    Notes
    This routine is based upon the LAPACK routine DRSCL.
    -

    Definition at line 475 of file linalg.f90.

    +

    Definition at line 605 of file linalg.f90.


    The documentation for this interface was generated from the following file: diff --git a/doc/html/interfacelinalg_1_1rz__factor.html b/doc/html/interfacelinalg_1_1rz__factor.html index 6222c96c..c78461cb 100644 --- a/doc/html/interfacelinalg_1_1rz__factor.html +++ b/doc/html/interfacelinalg_1_1rz__factor.html @@ -135,7 +135,7 @@ -

    Definition at line 1711 of file linalg.f90.

    +

    Definition at line 1842 of file linalg.f90.


    The documentation for this interface was generated from the following file: diff --git a/doc/html/interfacelinalg_1_1solve__cholesky.html b/doc/html/interfacelinalg_1_1solve__cholesky.html index 7998995c..16b9fd07 100644 --- a/doc/html/interfacelinalg_1_1solve__cholesky.html +++ b/doc/html/interfacelinalg_1_1solve__cholesky.html @@ -175,10 +175,10 @@
    print '(A)', "Cholesky Solution (Manual Approach): X = "
    print '(F8.4)', (bu(i), i = 1, size(bu))
    end program
    -
    Computes the Cholesky factorization of a symmetric, positive definite matrix.
    Definition: linalg.f90:1432
    -
    Solves a system of Cholesky factored equations.
    Definition: linalg.f90:2389
    -
    Solves a triangular system of equations.
    Definition: linalg.f90:2060
    -
    Provides a set of common linear algebra routines.
    Definition: linalg.f90:15
    +
    Computes the Cholesky factorization of a symmetric, positive definite matrix.
    Definition: linalg.f90:1563
    +
    Solves a system of Cholesky factored equations.
    Definition: linalg.f90:2521
    +
    Solves a triangular system of equations.
    Definition: linalg.f90:2192
    +
    Provides a set of common linear algebra routines.
    Definition: linalg.f90:145
    The above program produces the following output.
    Cholesky Solution: X =
    239.5833
    -65.6667
    @@ -189,7 +189,7 @@
    10.3333
    -

    Definition at line 2389 of file linalg.f90.

    +

    Definition at line 2521 of file linalg.f90.


    The documentation for this interface was generated from the following file: diff --git a/doc/html/interfacelinalg_1_1solve__least__squares.html b/doc/html/interfacelinalg_1_1solve__least__squares.html index 6485f161..a596c46f 100644 --- a/doc/html/interfacelinalg_1_1solve__least__squares.html +++ b/doc/html/interfacelinalg_1_1solve__least__squares.html @@ -160,14 +160,14 @@
    print '(A)', "Least Squares Solution: X = "
    print '(F9.5)', (b(i), i = 1, size(a, 2))
    end program
    -
    Solves the overdetermined or underdetermined system of M equations of N unknowns....
    Definition: linalg.f90:2479
    -
    Provides a set of common linear algebra routines.
    Definition: linalg.f90:15
    +
    Solves the overdetermined or underdetermined system of M equations of N unknowns....
    Definition: linalg.f90:2611
    +
    Provides a set of common linear algebra routines.
    Definition: linalg.f90:145
    The above program produces the following output.
    Least Squares Solution: X =
    0.13158
    -0.57895
    -

    Definition at line 2479 of file linalg.f90.

    +

    Definition at line 2611 of file linalg.f90.


    The documentation for this interface was generated from the following file: diff --git a/doc/html/interfacelinalg_1_1solve__least__squares__full.html b/doc/html/interfacelinalg_1_1solve__least__squares__full.html index eaf4868a..fd139a4d 100644 --- a/doc/html/interfacelinalg_1_1solve__least__squares__full.html +++ b/doc/html/interfacelinalg_1_1solve__least__squares__full.html @@ -162,14 +162,14 @@
    print '(A)', "Least Squares Solution: X = "
    print '(F9.5)', (b(i), i = 1, size(a, 2))
    end program
    -
    Solves the overdetermined or underdetermined system of M equations of N unknowns,...
    Definition: linalg.f90:2580
    -
    Provides a set of common linear algebra routines.
    Definition: linalg.f90:15
    +
    Solves the overdetermined or underdetermined system of M equations of N unknowns,...
    Definition: linalg.f90:2712
    +
    Provides a set of common linear algebra routines.
    Definition: linalg.f90:145
    The above program produces the following output.
    Least Squares Solution: X =
    0.13158
    -0.57895
    -

    Definition at line 2580 of file linalg.f90.

    +

    Definition at line 2712 of file linalg.f90.


    The documentation for this interface was generated from the following file: diff --git a/doc/html/interfacelinalg_1_1solve__least__squares__svd.html b/doc/html/interfacelinalg_1_1solve__least__squares__svd.html index b725644d..a5f0d16a 100644 --- a/doc/html/interfacelinalg_1_1solve__least__squares__svd.html +++ b/doc/html/interfacelinalg_1_1solve__least__squares__svd.html @@ -164,14 +164,14 @@
    print '(A)', "Least Squares Solution: X = "
    print '(F9.5)', (b(i), i = 1, size(a, 2))
    end program
    -
    Solves the overdetermined or underdetermined system of M equations of N unknowns using a singular va...
    Definition: linalg.f90:2682
    -
    Provides a set of common linear algebra routines.
    Definition: linalg.f90:15
    +
    Solves the overdetermined or underdetermined system of M equations of N unknowns using a singular va...
    Definition: linalg.f90:2814
    +
    Provides a set of common linear algebra routines.
    Definition: linalg.f90:145
    The above program produces the following output.
    Least Squares Solution: X =
    0.13158
    -0.57895
    -

    Definition at line 2682 of file linalg.f90.

    +

    Definition at line 2814 of file linalg.f90.


    The documentation for this interface was generated from the following file: diff --git a/doc/html/interfacelinalg_1_1solve__lu.html b/doc/html/interfacelinalg_1_1solve__lu.html index 561cf898..dc299efd 100644 --- a/doc/html/interfacelinalg_1_1solve__lu.html +++ b/doc/html/interfacelinalg_1_1solve__lu.html @@ -163,9 +163,9 @@
    print '(A)', "LU Solution: X = "
    print '(F8.4)', (b(i), i = 1, size(b))
    end program
    -
    Computes the LU factorization of an M-by-N matrix.
    Definition: linalg.f90:595
    -
    Solves a system of LU-factored equations.
    Definition: linalg.f90:2148
    -
    Provides a set of common linear algebra routines.
    Definition: linalg.f90:15
    +
    Computes the LU factorization of an M-by-N matrix.
    Definition: linalg.f90:725
    +
    Solves a system of LU-factored equations.
    Definition: linalg.f90:2280
    +
    Provides a set of common linear algebra routines.
    Definition: linalg.f90:145
    The program generates the following output.
    LU Solution: X =
    0.3333
    -0.6667
    @@ -177,7 +177,7 @@ -

    Definition at line 2148 of file linalg.f90.

    +

    Definition at line 2280 of file linalg.f90.


    The documentation for this interface was generated from the following file: diff --git a/doc/html/interfacelinalg_1_1solve__qr.html b/doc/html/interfacelinalg_1_1solve__qr.html index 01dcdac9..5a65087f 100644 --- a/doc/html/interfacelinalg_1_1solve__qr.html +++ b/doc/html/interfacelinalg_1_1solve__qr.html @@ -191,9 +191,9 @@
    ! same manner. The only difference is to omit the PVT array (column pivot
    ! tracking array).
    end program
    -
    Computes the QR factorization of an M-by-N matrix.
    Definition: linalg.f90:871
    -
    Solves a system of M QR-factored equations of N unknowns.
    Definition: linalg.f90:2283
    -
    Provides a set of common linear algebra routines.
    Definition: linalg.f90:15
    +
    Computes the QR factorization of an M-by-N matrix.
    Definition: linalg.f90:1001
    +
    Solves a system of M QR-factored equations of N unknowns.
    Definition: linalg.f90:2415
    +
    Provides a set of common linear algebra routines.
    Definition: linalg.f90:145
    The above program produces the following output.
    QR Solution: X =
    0.3333
    -0.6667
    @@ -205,7 +205,7 @@ -

    Definition at line 2283 of file linalg.f90.

    +

    Definition at line 2415 of file linalg.f90.


    The documentation for this interface was generated from the following file: diff --git a/doc/html/interfacelinalg_1_1solve__triangular__system.html b/doc/html/interfacelinalg_1_1solve__triangular__system.html index e26ad015..11166375 100644 --- a/doc/html/interfacelinalg_1_1solve__triangular__system.html +++ b/doc/html/interfacelinalg_1_1solve__triangular__system.html @@ -194,17 +194,17 @@
    print '(A)', "LU Solution: X = "
    print '(F8.4)', (b(i), i = 1, size(b))
    end program
    -
    Extracts the L and U matrices from the condensed [L\U] storage format used by the lu_factor.
    Definition: linalg.f90:717
    -
    Computes the LU factorization of an M-by-N matrix.
    Definition: linalg.f90:595
    -
    Solves a triangular system of equations.
    Definition: linalg.f90:2060
    -
    Provides a set of common linear algebra routines.
    Definition: linalg.f90:15
    +
    Extracts the L and U matrices from the condensed [L\U] storage format used by the lu_factor.
    Definition: linalg.f90:847
    +
    Computes the LU factorization of an M-by-N matrix.
    Definition: linalg.f90:725
    +
    Solves a triangular system of equations.
    Definition: linalg.f90:2192
    +
    Provides a set of common linear algebra routines.
    Definition: linalg.f90:145
    The above program produces the following output.
    LU Solution: X =
    0.3333
    -0.6667
    0.0000
    -

    Definition at line 2060 of file linalg.f90.

    +

    Definition at line 2192 of file linalg.f90.


    The documentation for this interface was generated from the following file: diff --git a/doc/html/interfacelinalg_1_1sort.html b/doc/html/interfacelinalg_1_1sort.html index ebed27e9..a1086d26 100644 --- a/doc/html/interfacelinalg_1_1sort.html +++ b/doc/html/interfacelinalg_1_1sort.html @@ -152,7 +152,7 @@ -

    Definition at line 3180 of file linalg.f90.

    +

    Definition at line 3312 of file linalg.f90.


    The documentation for this interface was generated from the following file: diff --git a/doc/html/interfacelinalg_1_1svd.html b/doc/html/interfacelinalg_1_1svd.html index 48b23470..7e809635 100644 --- a/doc/html/interfacelinalg_1_1svd.html +++ b/doc/html/interfacelinalg_1_1svd.html @@ -103,10 +103,10 @@
    -

    Computes the singular value decomposition of a matrix A. The SVD is defined as: \( A = U S V^T \), where \( U \) is an M-by-M orthogonal matrix, \( S \) is an M-by-N diagonal matrix, and \( V \) is an N-by-N orthogonal matrix. +

    Computes the singular value decomposition of a matrix A. The SVD is defined as: \( A = U S V^T \), where \( U \) is an M-by-M orthogonal matrix, \( S \) is an M-by-N diagonal matrix, and \( V \) is an N-by-N orthogonal matrix. In the event that \( V \) is complex valued, \( V^H \) is computed instead of \( V^T \). More...

    Detailed Description

    -

    Computes the singular value decomposition of a matrix A. The SVD is defined as: \( A = U S V^T \), where \( U \) is an M-by-M orthogonal matrix, \( S \) is an M-by-N diagonal matrix, and \( V \) is an N-by-N orthogonal matrix.

    +

    Computes the singular value decomposition of a matrix A. The SVD is defined as: \( A = U S V^T \), where \( U \) is an M-by-M orthogonal matrix, \( S \) is an M-by-N diagonal matrix, and \( V \) is an N-by-N orthogonal matrix. In the event that \( V \) is complex valued, \( V^H \) is computed instead of \( V^T \).

    Syntax
    subroutine svd(real(real64) a(:,:), real(real64) s(:), optional real(real64) u(:,:), optional real(real64) vt(:,:), optional real(real64) work(:), optional integer(int32) olwork, optional class(errors) err)
    subroutine svd(complex(real64) a(:,:), real(real64) s(:), optional complex(real64) u(:,:), optional complex(real64) vt(:,:), optional complex(real64) work(:), optional integer(int32) olwork, optional real(real64) rwork(:), optional class(errors) err)
    @@ -175,9 +175,9 @@
    print *, ac(i,:)
    end do
    end program
    -
    Multiplies a diagonal matrix with another matrix or array.
    Definition: linalg.f90:329
    -
    Computes the singular value decomposition of a matrix A. The SVD is defined as: , where is an M-by-M...
    Definition: linalg.f90:1926
    -
    Provides a set of common linear algebra routines.
    Definition: linalg.f90:15
    +
    Multiplies a diagonal matrix with another matrix or array.
    Definition: linalg.f90:459
    +
    Computes the singular value decomposition of a matrix A. The SVD is defined as: , where is an M-by-M...
    Definition: linalg.f90:2058
    +
    Provides a set of common linear algebra routines.
    Definition: linalg.f90:145
    The above program produces the following output.
    U =
    -0.47411577501825380 -0.81850539032073777 -0.32444284226152509
    0.82566838523833064 -0.28535874325972488 -0.48666426339228758
    @@ -194,7 +194,7 @@
    -1.0000000000000000 0.99999999999999967
    -

    Definition at line 1926 of file linalg.f90.

    +

    Definition at line 2058 of file linalg.f90.


    The documentation for this interface was generated from the following file: diff --git a/doc/html/interfacelinalg_1_1swap.html b/doc/html/interfacelinalg_1_1swap.html index eea75e7e..551b5b9f 100644 --- a/doc/html/interfacelinalg_1_1swap.html +++ b/doc/html/interfacelinalg_1_1swap.html @@ -122,7 +122,7 @@ -

    Definition at line 456 of file linalg.f90.

    +

    Definition at line 586 of file linalg.f90.


    The documentation for this interface was generated from the following file: diff --git a/doc/html/interfacelinalg_1_1trace.html b/doc/html/interfacelinalg_1_1trace.html index 42a90a77..2ecefd26 100644 --- a/doc/html/interfacelinalg_1_1trace.html +++ b/doc/html/interfacelinalg_1_1trace.html @@ -118,7 +118,7 @@
    Returns
    The trace of x.
    -

    Definition at line 353 of file linalg.f90.

    +

    Definition at line 483 of file linalg.f90.


    The documentation for this interface was generated from the following file: diff --git a/doc/html/interfacelinalg_1_1tri__mtx__mult.html b/doc/html/interfacelinalg_1_1tri__mtx__mult.html index 059df584..2537ae66 100644 --- a/doc/html/interfacelinalg_1_1tri__mtx__mult.html +++ b/doc/html/interfacelinalg_1_1tri__mtx__mult.html @@ -125,7 +125,7 @@ -

    Definition at line 509 of file linalg.f90.

    +

    Definition at line 639 of file linalg.f90.


    The documentation for this interface was generated from the following file: diff --git a/doc/html/linalg_8f90_source.html b/doc/html/linalg_8f90_source.html index d126b8cf..a78b2869 100644 --- a/doc/html/linalg_8f90_source.html +++ b/doc/html/linalg_8f90_source.html @@ -102,1230 +102,1229 @@
    1! linalg.f90
    2
    -
    3
    -
    12
    -
    13
    -
    15module linalg
    -
    16 use, intrinsic :: iso_fortran_env, only : int32, real64
    -
    17 use ferror, only : errors
    -
    18 implicit none
    -
    19
    -
    20 private
    -
    21 public :: mtx_mult
    -
    22 public :: rank1_update
    -
    23 public :: diag_mtx_mult
    -
    24 public :: trace
    -
    25 public :: mtx_rank
    -
    26 public :: det
    -
    27 public :: swap
    -
    28 public :: recip_mult_array
    -
    29 public :: tri_mtx_mult
    -
    30 public :: lu_factor
    -
    31 public :: form_lu
    -
    32 public :: qr_factor
    -
    33 public :: form_qr
    -
    34 public :: mult_qr
    -
    35 public :: qr_rank1_update
    -
    36 public :: cholesky_factor
    -
    37 public :: cholesky_rank1_update
    - -
    39 public :: rz_factor
    -
    40 public :: mult_rz
    -
    41 public :: svd
    - -
    43 public :: solve_lu
    -
    44 public :: solve_qr
    -
    45 public :: solve_cholesky
    -
    46 public :: mtx_inverse
    -
    47 public :: mtx_pinverse
    -
    48 public :: solve_least_squares
    - - -
    51 public :: eigen
    -
    52 public :: sort
    -
    53 public :: la_no_operation
    -
    54 public :: la_transpose
    -
    55 public :: la_hermitian_transpose
    -
    56 public :: la_no_error
    -
    57 public :: la_invalid_input_error
    -
    58 public :: la_array_size_error
    -
    59 public :: la_singular_matrix_error
    -
    60 public :: la_matrix_format_error
    -
    61 public :: la_out_of_memory_error
    -
    62 public :: la_convergence_error
    -
    63 public :: la_invalid_operation_error
    -
    64
    -
    65! ******************************************************************************
    -
    66! CONSTANTS
    -
    67! ------------------------------------------------------------------------------
    -
    69 integer(int32), parameter :: la_no_operation = 0
    -
    71 integer(int32), parameter :: la_transpose = 1
    -
    73 integer(int32), parameter :: la_hermitian_transpose = 2
    -
    74
    -
    75! ******************************************************************************
    -
    76! ERROR FLAGS
    -
    77! ------------------------------------------------------------------------------
    -
    79 integer(int32), parameter :: la_no_error = 0
    -
    81 integer(int32), parameter :: la_invalid_input_error = 101
    -
    83 integer(int32), parameter :: la_array_size_error = 102
    -
    85 integer(int32), parameter :: la_singular_matrix_error = 103
    -
    87 integer(int32), parameter :: la_matrix_format_error = 104
    -
    89 integer(int32), parameter :: la_out_of_memory_error = 105
    -
    91 integer(int32), parameter :: la_convergence_error = 106
    -
    93 integer(int32), parameter :: la_invalid_operation_error = 107
    -
    94
    -
    95! ******************************************************************************
    -
    96! INTERFACES
    -
    97! ------------------------------------------------------------------------------
    -
    159interface mtx_mult
    -
    160 module procedure :: mtx_mult_mtx
    -
    161 module procedure :: mtx_mult_vec
    -
    162 module procedure :: cmtx_mult_mtx
    -
    163 module procedure :: cmtx_mult_vec
    -
    164end interface
    -
    165
    -
    166! ------------------------------------------------------------------------------
    - -
    195 module procedure :: rank1_update_dbl
    -
    196 module procedure :: rank1_update_cmplx
    -
    197end interface
    -
    198
    -
    199! ------------------------------------------------------------------------------
    - -
    330 module procedure :: diag_mtx_mult_mtx
    -
    331 module procedure :: diag_mtx_mult_mtx2
    -
    332 module procedure :: diag_mtx_mult_mtx3
    -
    333 module procedure :: diag_mtx_mult_mtx4
    -
    334 module procedure :: diag_mtx_mult_mtx_cmplx
    -
    335 module procedure :: diag_mtx_mult_mtx2_cmplx
    -
    336 module procedure :: diag_mtx_mult_mtx_mix
    -
    337 module procedure :: diag_mtx_mult_mtx2_mix
    -
    338end interface
    -
    339
    -
    340! ------------------------------------------------------------------------------
    -
    353interface trace
    -
    354 module procedure :: trace_dbl
    -
    355 module procedure :: trace_cmplx
    -
    356end interface
    -
    357
    -
    358! ------------------------------------------------------------------------------
    -
    401interface mtx_rank
    -
    402 module procedure :: mtx_rank_dbl
    -
    403 module procedure :: mtx_rank_cmplx
    -
    404end interface
    -
    405
    -
    406! ------------------------------------------------------------------------------
    -
    434interface det
    -
    435 module procedure :: det_dbl
    -
    436 module procedure :: det_cmplx
    -
    437end interface
    -
    438
    -
    439! ------------------------------------------------------------------------------
    -
    456interface swap
    -
    457 module procedure :: swap_dbl
    -
    458 module procedure :: swap_cmplx
    -
    459end interface
    -
    460
    -
    461! ------------------------------------------------------------------------------
    - -
    476 module procedure :: recip_mult_array_dbl
    -
    477end interface
    -
    478
    -
    479! ------------------------------------------------------------------------------
    - -
    510 module procedure :: tri_mtx_mult_dbl
    -
    511 module procedure :: tri_mtx_mult_cmplx
    -
    512end interface
    -
    513
    -
    514! ------------------------------------------------------------------------------
    -
    595interface lu_factor
    -
    596 module procedure :: lu_factor_dbl
    -
    597 module procedure :: lu_factor_cmplx
    -
    598end interface
    -
    599
    -
    717interface form_lu
    -
    718 module procedure :: form_lu_all
    -
    719 module procedure :: form_lu_all_cmplx
    -
    720 module procedure :: form_lu_only
    -
    721 module procedure :: form_lu_only_cmplx
    -
    722end interface
    -
    723
    -
    724! ------------------------------------------------------------------------------
    -
    871interface qr_factor
    -
    872 module procedure :: qr_factor_no_pivot
    -
    873 module procedure :: qr_factor_no_pivot_cmplx
    -
    874 module procedure :: qr_factor_pivot
    -
    875 module procedure :: qr_factor_pivot_cmplx
    -
    876end interface
    -
    877
    -
    878! ------------------------------------------------------------------------------
    -
    1031interface form_qr
    -
    1032 module procedure :: form_qr_no_pivot
    -
    1033 module procedure :: form_qr_no_pivot_cmplx
    -
    1034 module procedure :: form_qr_pivot
    -
    1035 module procedure :: form_qr_pivot_cmplx
    -
    1036end interface
    -
    1037
    -
    1038! ------------------------------------------------------------------------------
    -
    1184interface mult_qr
    -
    1185 module procedure :: mult_qr_mtx
    -
    1186 module procedure :: mult_qr_mtx_cmplx
    -
    1187 module procedure :: mult_qr_vec
    -
    1188 module procedure :: mult_qr_vec_cmplx
    -
    1189end interface
    -
    1190
    -
    1191! ------------------------------------------------------------------------------
    - -
    1334 module procedure :: qr_rank1_update_dbl
    -
    1335 module procedure :: qr_rank1_update_cmplx
    -
    1336end interface
    -
    1337
    -
    1338! ------------------------------------------------------------------------------
    - -
    1433 module procedure :: cholesky_factor_dbl
    -
    1434 module procedure :: cholesky_factor_cmplx
    -
    1435end interface
    -
    1436
    -
    1437! ------------------------------------------------------------------------------
    - -
    1532 module procedure :: cholesky_rank1_update_dbl
    -
    1533 module procedure :: cholesky_rank1_update_cmplx
    -
    1534end interface
    -
    1535
    -
    1536! ------------------------------------------------------------------------------
    - -
    1639 module procedure :: cholesky_rank1_downdate_dbl
    -
    1640 module procedure :: cholesky_rank1_downdate_cmplx
    -
    1641end interface
    -
    1642
    -
    1643! ------------------------------------------------------------------------------
    -
    1711interface rz_factor
    -
    1712 module procedure :: rz_factor_dbl
    -
    1713 module procedure :: rz_factor_cmplx
    -
    1714end interface
    -
    1715
    -
    1716! ------------------------------------------------------------------------------
    -
    1802interface mult_rz
    -
    1803 module procedure :: mult_rz_mtx
    -
    1804 module procedure :: mult_rz_mtx_cmplx
    -
    1805 module procedure :: mult_rz_vec
    -
    1806 module procedure :: mult_rz_vec_cmplx
    -
    1807end interface
    -
    1808
    -
    1809! ------------------------------------------------------------------------------
    -
    1926interface svd
    -
    1927 module procedure :: svd_dbl
    -
    1928 module procedure :: svd_cmplx
    -
    1929end interface
    -
    1930
    -
    1931! ------------------------------------------------------------------------------
    - -
    2061 module procedure :: solve_tri_mtx
    -
    2062 module procedure :: solve_tri_mtx_cmplx
    -
    2063 module procedure :: solve_tri_vec
    -
    2064 module procedure :: solve_tri_vec_cmplx
    -
    2065end interface
    -
    2066
    -
    2067! ------------------------------------------------------------------------------
    -
    2148interface solve_lu
    -
    2149 module procedure :: solve_lu_mtx
    -
    2150 module procedure :: solve_lu_mtx_cmplx
    -
    2151 module procedure :: solve_lu_vec
    -
    2152 module procedure :: solve_lu_vec_cmplx
    -
    2153end interface
    -
    2154
    -
    2155! ------------------------------------------------------------------------------
    -
    2283interface solve_qr
    -
    2284 module procedure :: solve_qr_no_pivot_mtx
    -
    2285 module procedure :: solve_qr_no_pivot_mtx_cmplx
    -
    2286 module procedure :: solve_qr_no_pivot_vec
    -
    2287 module procedure :: solve_qr_no_pivot_vec_cmplx
    -
    2288 module procedure :: solve_qr_pivot_mtx
    -
    2289 module procedure :: solve_qr_pivot_mtx_cmplx
    -
    2290 module procedure :: solve_qr_pivot_vec
    -
    2291 module procedure :: solve_qr_pivot_vec_cmplx
    -
    2292end interface
    -
    2293
    -
    2294! ------------------------------------------------------------------------------
    - -
    2390 module procedure :: solve_cholesky_mtx
    -
    2391 module procedure :: solve_cholesky_mtx_cmplx
    -
    2392 module procedure :: solve_cholesky_vec
    -
    2393 module procedure :: solve_cholesky_vec_cmplx
    -
    2394end interface
    -
    2395
    -
    2396! ------------------------------------------------------------------------------
    - -
    2480 module procedure :: solve_least_squares_mtx
    -
    2481 module procedure :: solve_least_squares_mtx_cmplx
    -
    2482 module procedure :: solve_least_squares_vec
    -
    2483 module procedure :: solve_least_squares_vec_cmplx
    -
    2484end interface
    -
    2485
    -
    2486! ------------------------------------------------------------------------------
    - -
    2581 module procedure :: solve_least_squares_mtx_pvt
    -
    2582 module procedure :: solve_least_squares_mtx_pvt_cmplx
    -
    2583 module procedure :: solve_least_squares_vec_pvt
    -
    2584 module procedure :: solve_least_squares_vec_pvt_cmplx
    -
    2585end interface
    -
    2586
    -
    2587! ------------------------------------------------------------------------------
    - -
    2683 module procedure :: solve_least_squares_mtx_svd
    -
    2684 module procedure :: solve_least_squares_vec_svd
    -
    2685end interface
    -
    2686
    -
    2687! ------------------------------------------------------------------------------
    - -
    2778 module procedure :: mtx_inverse_dbl
    -
    2779 module procedure :: mtx_inverse_cmplx
    -
    2780end interface
    -
    2781
    -
    2782! ------------------------------------------------------------------------------
    - -
    2884 module procedure :: mtx_pinverse_dbl
    -
    2885 module procedure :: mtx_pinverse_cmplx
    -
    2886end interface
    -
    2887
    -
    2888! ------------------------------------------------------------------------------
    -
    3097interface eigen
    -
    3098 module procedure :: eigen_symm
    -
    3099 module procedure :: eigen_asymm
    -
    3100 module procedure :: eigen_gen
    -
    3101 module procedure :: eigen_cmplx
    -
    3102end interface
    -
    3103
    -
    3104! ------------------------------------------------------------------------------
    -
    3180interface sort
    -
    3181 module procedure :: sort_dbl_array
    -
    3182 module procedure :: sort_dbl_array_ind
    -
    3183 module procedure :: sort_cmplx_array
    -
    3184 module procedure :: sort_cmplx_array_ind
    -
    3185 module procedure :: sort_eigen_cmplx
    -
    3186 module procedure :: sort_eigen_dbl
    -
    3187end interface
    -
    3188
    -
    3189! ******************************************************************************
    -
    3190! LINALG_BASIC.F90
    -
    3191! ------------------------------------------------------------------------------
    -
    3192interface
    -
    3193 module subroutine mtx_mult_mtx(transa, transb, alpha, a, b, beta, c, err)
    -
    3194 logical, intent(in) :: transa, transb
    -
    3195 real(real64), intent(in) :: alpha, beta
    -
    3196 real(real64), intent(in), dimension(:,:) :: a, b
    -
    3197 real(real64), intent(inout), dimension(:,:) :: c
    -
    3198 class(errors), intent(inout), optional, target :: err
    -
    3199 end subroutine
    -
    3200
    -
    3201 module subroutine mtx_mult_vec(trans, alpha, a, b, beta, c, err)
    -
    3202 logical, intent(in) :: trans
    -
    3203 real(real64), intent(in) :: alpha, beta
    -
    3204 real(real64), intent(in), dimension(:,:) :: a
    -
    3205 real(real64), intent(in), dimension(:) :: b
    -
    3206 real(real64), intent(inout), dimension(:) :: c
    -
    3207 class(errors), intent(inout), optional, target :: err
    -
    3208 end subroutine
    -
    3209
    -
    3210 module subroutine cmtx_mult_mtx(opa, opb, alpha, a, b, beta, c, err)
    -
    3211 integer(int32), intent(in) :: opa, opb
    -
    3212 complex(real64), intent(in) :: alpha, beta
    -
    3213 complex(real64), intent(in), dimension(:,:) :: a, b
    -
    3214 complex(real64), intent(inout), dimension(:,:) :: c
    -
    3215 class(errors), intent(inout), optional, target :: err
    -
    3216 end subroutine
    -
    3217
    -
    3218 module subroutine cmtx_mult_vec(opa, alpha, a, b, beta, c, err)
    -
    3219 integer(int32), intent(in) :: opa
    -
    3220 complex(real64), intent(in) :: alpha, beta
    -
    3221 complex(real64), intent(in), dimension(:,:) :: a
    -
    3222 complex(real64), intent(in), dimension(:) :: b
    -
    3223 complex(real64), intent(inout), dimension(:) :: c
    -
    3224 class(errors), intent(inout), optional, target :: err
    -
    3225 end subroutine
    -
    3226
    -
    3227 module subroutine rank1_update_dbl(alpha, x, y, a, err)
    -
    3228 real(real64), intent(in) :: alpha
    -
    3229 real(real64), intent(in), dimension(:) :: x, y
    -
    3230 real(real64), intent(inout), dimension(:,:) :: a
    -
    3231 class(errors), intent(inout), optional, target :: err
    -
    3232 end subroutine
    -
    3233
    -
    3234 module subroutine rank1_update_cmplx(alpha, x, y, a, err)
    -
    3235 complex(real64), intent(in) :: alpha
    -
    3236 complex(real64), intent(in), dimension(:) :: x, y
    -
    3237 complex(real64), intent(inout), dimension(:,:) :: a
    -
    3238 class(errors), intent(inout), optional, target :: err
    -
    3239 end subroutine
    -
    3240
    -
    3241 module subroutine diag_mtx_mult_mtx(lside, trans, alpha, a, b, beta, c, err)
    -
    3242 logical, intent(in) :: lside, trans
    -
    3243 real(real64) :: alpha, beta
    -
    3244 real(real64), intent(in), dimension(:) :: a
    -
    3245 real(real64), intent(in), dimension(:,:) :: b
    -
    3246 real(real64), intent(inout), dimension(:,:) :: c
    -
    3247 class(errors), intent(inout), optional, target :: err
    -
    3248 end subroutine
    -
    3249
    -
    3250 module subroutine diag_mtx_mult_mtx2(lside, alpha, a, b, err)
    -
    3251 logical, intent(in) :: lside
    -
    3252 real(real64), intent(in) :: alpha
    -
    3253 real(real64), intent(in), dimension(:) :: a
    -
    3254 real(real64), intent(inout), dimension(:,:) :: b
    -
    3255 class(errors), intent(inout), optional, target :: err
    -
    3256 end subroutine
    -
    3257
    -
    3258 module subroutine diag_mtx_mult_mtx3(lside, trans, alpha, a, b, beta, c, err)
    -
    3259 logical, intent(in) :: lside, trans
    -
    3260 real(real64) :: alpha, beta
    -
    3261 complex(real64), intent(in), dimension(:) :: a
    -
    3262 real(real64), intent(in), dimension(:,:) :: b
    -
    3263 complex(real64), intent(inout), dimension(:,:) :: c
    -
    3264 class(errors), intent(inout), optional, target :: err
    -
    3265 end subroutine
    -
    3266
    -
    3267 module subroutine diag_mtx_mult_mtx4(lside, opb, alpha, a, b, beta, c, err)
    -
    3268 logical, intent(in) :: lside
    -
    3269 integer(int32), intent(in) :: opb
    -
    3270 real(real64) :: alpha, beta
    -
    3271 complex(real64), intent(in), dimension(:) :: a
    -
    3272 complex(real64), intent(in), dimension(:,:) :: b
    -
    3273 complex(real64), intent(inout), dimension(:,:) :: c
    -
    3274 class(errors), intent(inout), optional, target :: err
    -
    3275 end subroutine
    -
    3276
    -
    3277 module subroutine diag_mtx_mult_mtx_cmplx(lside, opb, alpha, a, b, beta, c, err)
    -
    3278 logical, intent(in) :: lside
    -
    3279 integer(int32), intent(in) :: opb
    -
    3280 complex(real64) :: alpha, beta
    -
    3281 complex(real64), intent(in), dimension(:) :: a
    -
    3282 complex(real64), intent(in), dimension(:,:) :: b
    -
    3283 complex(real64), intent(inout), dimension(:,:) :: c
    -
    3284 class(errors), intent(inout), optional, target :: err
    -
    3285 end subroutine
    -
    3286
    -
    3287 module subroutine diag_mtx_mult_mtx2_cmplx(lside, alpha, a, b, err)
    -
    3288 logical, intent(in) :: lside
    -
    3289 complex(real64), intent(in) :: alpha
    -
    3290 complex(real64), intent(in), dimension(:) :: a
    -
    3291 complex(real64), intent(inout), dimension(:,:) :: b
    -
    3292 class(errors), intent(inout), optional, target :: err
    -
    3293 end subroutine
    -
    3294
    -
    3295 module subroutine diag_mtx_mult_mtx_mix(lside, opb, alpha, a, b, beta, c, err)
    -
    3296 logical, intent(in) :: lside
    -
    3297 integer(int32), intent(in) :: opb
    -
    3298 complex(real64) :: alpha, beta
    -
    3299 real(real64), intent(in), dimension(:) :: a
    -
    3300 complex(real64), intent(in), dimension(:,:) :: b
    -
    3301 complex(real64), intent(inout), dimension(:,:) :: c
    -
    3302 class(errors), intent(inout), optional, target :: err
    -
    3303 end subroutine
    -
    3304
    -
    3305 module subroutine diag_mtx_mult_mtx2_mix(lside, alpha, a, b, err)
    -
    3306 logical, intent(in) :: lside
    -
    3307 complex(real64), intent(in) :: alpha
    -
    3308 real(real64), intent(in), dimension(:) :: a
    -
    3309 complex(real64), intent(inout), dimension(:,:) :: b
    -
    3310 class(errors), intent(inout), optional, target :: err
    -
    3311 end subroutine
    -
    3312
    -
    3313 pure module function trace_dbl(x) result(y)
    -
    3314 real(real64), intent(in), dimension(:,:) :: x
    -
    3315 real(real64) :: y
    -
    3316 end function
    -
    3317
    -
    3318 pure module function trace_cmplx(x) result(y)
    -
    3319 complex(real64), intent(in), dimension(:,:) :: x
    -
    3320 complex(real64) :: y
    -
    3321 end function
    -
    3322
    -
    3323 module function mtx_rank_dbl(a, tol, work, olwork, err) result(rnk)
    -
    3324 real(real64), intent(inout), dimension(:,:) :: a
    -
    3325 real(real64), intent(in), optional :: tol
    -
    3326 real(real64), intent(out), target, optional, dimension(:) :: work
    -
    3327 integer(int32), intent(out), optional :: olwork
    -
    3328 class(errors), intent(inout), optional, target :: err
    -
    3329 integer(int32) :: rnk
    -
    3330 end function
    -
    3331
    -
    3332 module function mtx_rank_cmplx(a, tol, work, olwork, rwork, err) result(rnk)
    -
    3333 complex(real64), intent(inout), dimension(:,:) :: a
    -
    3334 real(real64), intent(in), optional :: tol
    -
    3335 complex(real64), intent(out), target, optional, dimension(:) :: work
    -
    3336 integer(int32), intent(out), optional :: olwork
    -
    3337 real(real64), intent(out), target, optional, dimension(:) :: rwork
    -
    3338 class(errors), intent(inout), optional, target :: err
    -
    3339 integer(int32) :: rnk
    -
    3340 end function
    +
    142
    +
    143
    +
    145module linalg
    +
    146 use, intrinsic :: iso_fortran_env, only : int32, real64
    +
    147 use ferror, only : errors
    +
    148 implicit none
    +
    149
    +
    150 private
    +
    151 public :: mtx_mult
    +
    152 public :: rank1_update
    +
    153 public :: diag_mtx_mult
    +
    154 public :: trace
    +
    155 public :: mtx_rank
    +
    156 public :: det
    +
    157 public :: swap
    +
    158 public :: recip_mult_array
    +
    159 public :: tri_mtx_mult
    +
    160 public :: lu_factor
    +
    161 public :: form_lu
    +
    162 public :: qr_factor
    +
    163 public :: form_qr
    +
    164 public :: mult_qr
    +
    165 public :: qr_rank1_update
    +
    166 public :: cholesky_factor
    +
    167 public :: cholesky_rank1_update
    + +
    169 public :: rz_factor
    +
    170 public :: mult_rz
    +
    171 public :: svd
    + +
    173 public :: solve_lu
    +
    174 public :: solve_qr
    +
    175 public :: solve_cholesky
    +
    176 public :: mtx_inverse
    +
    177 public :: mtx_pinverse
    +
    178 public :: solve_least_squares
    + + +
    181 public :: eigen
    +
    182 public :: sort
    +
    183 public :: la_no_operation
    +
    184 public :: la_transpose
    +
    185 public :: la_hermitian_transpose
    +
    186 public :: la_no_error
    +
    187 public :: la_invalid_input_error
    +
    188 public :: la_array_size_error
    +
    189 public :: la_singular_matrix_error
    +
    190 public :: la_matrix_format_error
    +
    191 public :: la_out_of_memory_error
    +
    192 public :: la_convergence_error
    +
    193 public :: la_invalid_operation_error
    +
    194
    +
    195! ******************************************************************************
    +
    196! CONSTANTS
    +
    197! ------------------------------------------------------------------------------
    +
    199 integer(int32), parameter :: la_no_operation = 0
    +
    201 integer(int32), parameter :: la_transpose = 1
    +
    203 integer(int32), parameter :: la_hermitian_transpose = 2
    +
    204
    +
    205! ******************************************************************************
    +
    206! ERROR FLAGS
    +
    207! ------------------------------------------------------------------------------
    +
    209 integer(int32), parameter :: la_no_error = 0
    +
    211 integer(int32), parameter :: la_invalid_input_error = 101
    +
    213 integer(int32), parameter :: la_array_size_error = 102
    +
    215 integer(int32), parameter :: la_singular_matrix_error = 103
    +
    217 integer(int32), parameter :: la_matrix_format_error = 104
    +
    219 integer(int32), parameter :: la_out_of_memory_error = 105
    +
    221 integer(int32), parameter :: la_convergence_error = 106
    +
    223 integer(int32), parameter :: la_invalid_operation_error = 107
    +
    224
    +
    225! ******************************************************************************
    +
    226! INTERFACES
    +
    227! ------------------------------------------------------------------------------
    +
    289interface mtx_mult
    +
    290 module procedure :: mtx_mult_mtx
    +
    291 module procedure :: mtx_mult_vec
    +
    292 module procedure :: cmtx_mult_mtx
    +
    293 module procedure :: cmtx_mult_vec
    +
    294end interface
    +
    295
    +
    296! ------------------------------------------------------------------------------
    + +
    325 module procedure :: rank1_update_dbl
    +
    326 module procedure :: rank1_update_cmplx
    +
    327end interface
    +
    328
    +
    329! ------------------------------------------------------------------------------
    + +
    460 module procedure :: diag_mtx_mult_mtx
    +
    461 module procedure :: diag_mtx_mult_mtx2
    +
    462 module procedure :: diag_mtx_mult_mtx3
    +
    463 module procedure :: diag_mtx_mult_mtx4
    +
    464 module procedure :: diag_mtx_mult_mtx_cmplx
    +
    465 module procedure :: diag_mtx_mult_mtx2_cmplx
    +
    466 module procedure :: diag_mtx_mult_mtx_mix
    +
    467 module procedure :: diag_mtx_mult_mtx2_mix
    +
    468end interface
    +
    469
    +
    470! ------------------------------------------------------------------------------
    +
    483interface trace
    +
    484 module procedure :: trace_dbl
    +
    485 module procedure :: trace_cmplx
    +
    486end interface
    +
    487
    +
    488! ------------------------------------------------------------------------------
    +
    531interface mtx_rank
    +
    532 module procedure :: mtx_rank_dbl
    +
    533 module procedure :: mtx_rank_cmplx
    +
    534end interface
    +
    535
    +
    536! ------------------------------------------------------------------------------
    +
    564interface det
    +
    565 module procedure :: det_dbl
    +
    566 module procedure :: det_cmplx
    +
    567end interface
    +
    568
    +
    569! ------------------------------------------------------------------------------
    +
    586interface swap
    +
    587 module procedure :: swap_dbl
    +
    588 module procedure :: swap_cmplx
    +
    589end interface
    +
    590
    +
    591! ------------------------------------------------------------------------------
    + +
    606 module procedure :: recip_mult_array_dbl
    +
    607end interface
    +
    608
    +
    609! ------------------------------------------------------------------------------
    + +
    640 module procedure :: tri_mtx_mult_dbl
    +
    641 module procedure :: tri_mtx_mult_cmplx
    +
    642end interface
    +
    643
    +
    644! ------------------------------------------------------------------------------
    +
    725interface lu_factor
    +
    726 module procedure :: lu_factor_dbl
    +
    727 module procedure :: lu_factor_cmplx
    +
    728end interface
    +
    729
    +
    847interface form_lu
    +
    848 module procedure :: form_lu_all
    +
    849 module procedure :: form_lu_all_cmplx
    +
    850 module procedure :: form_lu_only
    +
    851 module procedure :: form_lu_only_cmplx
    +
    852end interface
    +
    853
    +
    854! ------------------------------------------------------------------------------
    +
    1001interface qr_factor
    +
    1002 module procedure :: qr_factor_no_pivot
    +
    1003 module procedure :: qr_factor_no_pivot_cmplx
    +
    1004 module procedure :: qr_factor_pivot
    +
    1005 module procedure :: qr_factor_pivot_cmplx
    +
    1006end interface
    +
    1007
    +
    1008! ------------------------------------------------------------------------------
    +
    1161interface form_qr
    +
    1162 module procedure :: form_qr_no_pivot
    +
    1163 module procedure :: form_qr_no_pivot_cmplx
    +
    1164 module procedure :: form_qr_pivot
    +
    1165 module procedure :: form_qr_pivot_cmplx
    +
    1166end interface
    +
    1167
    +
    1168! ------------------------------------------------------------------------------
    +
    1314interface mult_qr
    +
    1315 module procedure :: mult_qr_mtx
    +
    1316 module procedure :: mult_qr_mtx_cmplx
    +
    1317 module procedure :: mult_qr_vec
    +
    1318 module procedure :: mult_qr_vec_cmplx
    +
    1319end interface
    +
    1320
    +
    1321! ------------------------------------------------------------------------------
    + +
    1465 module procedure :: qr_rank1_update_dbl
    +
    1466 module procedure :: qr_rank1_update_cmplx
    +
    1467end interface
    +
    1468
    +
    1469! ------------------------------------------------------------------------------
    + +
    1564 module procedure :: cholesky_factor_dbl
    +
    1565 module procedure :: cholesky_factor_cmplx
    +
    1566end interface
    +
    1567
    +
    1568! ------------------------------------------------------------------------------
    + +
    1663 module procedure :: cholesky_rank1_update_dbl
    +
    1664 module procedure :: cholesky_rank1_update_cmplx
    +
    1665end interface
    +
    1666
    +
    1667! ------------------------------------------------------------------------------
    + +
    1770 module procedure :: cholesky_rank1_downdate_dbl
    +
    1771 module procedure :: cholesky_rank1_downdate_cmplx
    +
    1772end interface
    +
    1773
    +
    1774! ------------------------------------------------------------------------------
    +
    1842interface rz_factor
    +
    1843 module procedure :: rz_factor_dbl
    +
    1844 module procedure :: rz_factor_cmplx
    +
    1845end interface
    +
    1846
    +
    1847! ------------------------------------------------------------------------------
    +
    1933interface mult_rz
    +
    1934 module procedure :: mult_rz_mtx
    +
    1935 module procedure :: mult_rz_mtx_cmplx
    +
    1936 module procedure :: mult_rz_vec
    +
    1937 module procedure :: mult_rz_vec_cmplx
    +
    1938end interface
    +
    1939
    +
    1940! ------------------------------------------------------------------------------
    +
    2058interface svd
    +
    2059 module procedure :: svd_dbl
    +
    2060 module procedure :: svd_cmplx
    +
    2061end interface
    +
    2062
    +
    2063! ------------------------------------------------------------------------------
    + +
    2193 module procedure :: solve_tri_mtx
    +
    2194 module procedure :: solve_tri_mtx_cmplx
    +
    2195 module procedure :: solve_tri_vec
    +
    2196 module procedure :: solve_tri_vec_cmplx
    +
    2197end interface
    +
    2198
    +
    2199! ------------------------------------------------------------------------------
    +
    2280interface solve_lu
    +
    2281 module procedure :: solve_lu_mtx
    +
    2282 module procedure :: solve_lu_mtx_cmplx
    +
    2283 module procedure :: solve_lu_vec
    +
    2284 module procedure :: solve_lu_vec_cmplx
    +
    2285end interface
    +
    2286
    +
    2287! ------------------------------------------------------------------------------
    +
    2415interface solve_qr
    +
    2416 module procedure :: solve_qr_no_pivot_mtx
    +
    2417 module procedure :: solve_qr_no_pivot_mtx_cmplx
    +
    2418 module procedure :: solve_qr_no_pivot_vec
    +
    2419 module procedure :: solve_qr_no_pivot_vec_cmplx
    +
    2420 module procedure :: solve_qr_pivot_mtx
    +
    2421 module procedure :: solve_qr_pivot_mtx_cmplx
    +
    2422 module procedure :: solve_qr_pivot_vec
    +
    2423 module procedure :: solve_qr_pivot_vec_cmplx
    +
    2424end interface
    +
    2425
    +
    2426! ------------------------------------------------------------------------------
    + +
    2522 module procedure :: solve_cholesky_mtx
    +
    2523 module procedure :: solve_cholesky_mtx_cmplx
    +
    2524 module procedure :: solve_cholesky_vec
    +
    2525 module procedure :: solve_cholesky_vec_cmplx
    +
    2526end interface
    +
    2527
    +
    2528! ------------------------------------------------------------------------------
    + +
    2612 module procedure :: solve_least_squares_mtx
    +
    2613 module procedure :: solve_least_squares_mtx_cmplx
    +
    2614 module procedure :: solve_least_squares_vec
    +
    2615 module procedure :: solve_least_squares_vec_cmplx
    +
    2616end interface
    +
    2617
    +
    2618! ------------------------------------------------------------------------------
    + +
    2713 module procedure :: solve_least_squares_mtx_pvt
    +
    2714 module procedure :: solve_least_squares_mtx_pvt_cmplx
    +
    2715 module procedure :: solve_least_squares_vec_pvt
    +
    2716 module procedure :: solve_least_squares_vec_pvt_cmplx
    +
    2717end interface
    +
    2718
    +
    2719! ------------------------------------------------------------------------------
    + +
    2815 module procedure :: solve_least_squares_mtx_svd
    +
    2816 module procedure :: solve_least_squares_vec_svd
    +
    2817end interface
    +
    2818
    +
    2819! ------------------------------------------------------------------------------
    + +
    2910 module procedure :: mtx_inverse_dbl
    +
    2911 module procedure :: mtx_inverse_cmplx
    +
    2912end interface
    +
    2913
    +
    2914! ------------------------------------------------------------------------------
    + +
    3016 module procedure :: mtx_pinverse_dbl
    +
    3017 module procedure :: mtx_pinverse_cmplx
    +
    3018end interface
    +
    3019
    +
    3020! ------------------------------------------------------------------------------
    +
    3229interface eigen
    +
    3230 module procedure :: eigen_symm
    +
    3231 module procedure :: eigen_asymm
    +
    3232 module procedure :: eigen_gen
    +
    3233 module procedure :: eigen_cmplx
    +
    3234end interface
    +
    3235
    +
    3236! ------------------------------------------------------------------------------
    +
    3312interface sort
    +
    3313 module procedure :: sort_dbl_array
    +
    3314 module procedure :: sort_dbl_array_ind
    +
    3315 module procedure :: sort_cmplx_array
    +
    3316 module procedure :: sort_cmplx_array_ind
    +
    3317 module procedure :: sort_eigen_cmplx
    +
    3318 module procedure :: sort_eigen_dbl
    +
    3319end interface
    +
    3320
    +
    3321! ******************************************************************************
    +
    3322! LINALG_BASIC.F90
    +
    3323! ------------------------------------------------------------------------------
    +
    3324interface
    +
    3325 module subroutine mtx_mult_mtx(transa, transb, alpha, a, b, beta, c, err)
    +
    3326 logical, intent(in) :: transa, transb
    +
    3327 real(real64), intent(in) :: alpha, beta
    +
    3328 real(real64), intent(in), dimension(:,:) :: a, b
    +
    3329 real(real64), intent(inout), dimension(:,:) :: c
    +
    3330 class(errors), intent(inout), optional, target :: err
    +
    3331 end subroutine
    +
    3332
    +
    3333 module subroutine mtx_mult_vec(trans, alpha, a, b, beta, c, err)
    +
    3334 logical, intent(in) :: trans
    +
    3335 real(real64), intent(in) :: alpha, beta
    +
    3336 real(real64), intent(in), dimension(:,:) :: a
    +
    3337 real(real64), intent(in), dimension(:) :: b
    +
    3338 real(real64), intent(inout), dimension(:) :: c
    +
    3339 class(errors), intent(inout), optional, target :: err
    +
    3340 end subroutine
    3341
    -
    3342 module function det_dbl(a, iwork, err) result(x)
    -
    3343 real(real64), intent(inout), dimension(:,:) :: a
    -
    3344 integer(int32), intent(out), target, optional, dimension(:) :: iwork
    -
    3345 class(errors), intent(inout), optional, target :: err
    -
    3346 real(real64) :: x
    -
    3347 end function
    -
    3348
    -
    3349 module function det_cmplx(a, iwork, err) result(x)
    -
    3350 complex(real64), intent(inout), dimension(:,:) :: a
    -
    3351 integer(int32), intent(out), target, optional, dimension(:) :: iwork
    -
    3352 class(errors), intent(inout), optional, target :: err
    -
    3353 complex(real64) :: x
    -
    3354 end function
    -
    3355
    -
    3356 module subroutine swap_dbl(x, y, err)
    -
    3357 real(real64), intent(inout), dimension(:) :: x, y
    -
    3358 class(errors), intent(inout), optional, target :: err
    -
    3359 end subroutine
    -
    3360
    -
    3361 module subroutine swap_cmplx(x, y, err)
    -
    3362 complex(real64), intent(inout), dimension(:) :: x, y
    +
    3342 module subroutine cmtx_mult_mtx(opa, opb, alpha, a, b, beta, c, err)
    +
    3343 integer(int32), intent(in) :: opa, opb
    +
    3344 complex(real64), intent(in) :: alpha, beta
    +
    3345 complex(real64), intent(in), dimension(:,:) :: a, b
    +
    3346 complex(real64), intent(inout), dimension(:,:) :: c
    +
    3347 class(errors), intent(inout), optional, target :: err
    +
    3348 end subroutine
    +
    3349
    +
    3350 module subroutine cmtx_mult_vec(opa, alpha, a, b, beta, c, err)
    +
    3351 integer(int32), intent(in) :: opa
    +
    3352 complex(real64), intent(in) :: alpha, beta
    +
    3353 complex(real64), intent(in), dimension(:,:) :: a
    +
    3354 complex(real64), intent(in), dimension(:) :: b
    +
    3355 complex(real64), intent(inout), dimension(:) :: c
    +
    3356 class(errors), intent(inout), optional, target :: err
    +
    3357 end subroutine
    +
    3358
    +
    3359 module subroutine rank1_update_dbl(alpha, x, y, a, err)
    +
    3360 real(real64), intent(in) :: alpha
    +
    3361 real(real64), intent(in), dimension(:) :: x, y
    +
    3362 real(real64), intent(inout), dimension(:,:) :: a
    3363 class(errors), intent(inout), optional, target :: err
    3364 end subroutine
    3365
    -
    3366 module subroutine recip_mult_array_dbl(a, x)
    -
    3367 real(real64), intent(in) :: a
    -
    3368 real(real64), intent(inout), dimension(:) :: x
    -
    3369 end subroutine
    -
    3370
    -
    3371 module subroutine tri_mtx_mult_dbl(upper, alpha, a, beta, b, err)
    -
    3372 logical, intent(in) :: upper
    -
    3373 real(real64), intent(in) :: alpha, beta
    -
    3374 real(real64), intent(in), dimension(:,:) :: a
    -
    3375 real(real64), intent(inout), dimension(:,:) :: b
    -
    3376 class(errors), intent(inout), optional, target :: err
    -
    3377 end subroutine
    -
    3378
    -
    3379 module subroutine tri_mtx_mult_cmplx(upper, alpha, a, beta, b, err)
    -
    3380 logical, intent(in) :: upper
    -
    3381 complex(real64), intent(in) :: alpha, beta
    -
    3382 complex(real64), intent(in), dimension(:,:) :: a
    -
    3383 complex(real64), intent(inout), dimension(:,:) :: b
    -
    3384 class(errors), intent(inout), optional, target :: err
    -
    3385 end subroutine
    -
    3386
    -
    3387end interface
    -
    3388
    -
    3389! ******************************************************************************
    -
    3390! LINALG_FACTOR.F90
    -
    3391! ------------------------------------------------------------------------------
    -
    3392interface
    -
    3393 module subroutine lu_factor_dbl(a, ipvt, err)
    -
    3394 real(real64), intent(inout), dimension(:,:) :: a
    -
    3395 integer(int32), intent(out), dimension(:) :: ipvt
    +
    3366 module subroutine rank1_update_cmplx(alpha, x, y, a, err)
    +
    3367 complex(real64), intent(in) :: alpha
    +
    3368 complex(real64), intent(in), dimension(:) :: x, y
    +
    3369 complex(real64), intent(inout), dimension(:,:) :: a
    +
    3370 class(errors), intent(inout), optional, target :: err
    +
    3371 end subroutine
    +
    3372
    +
    3373 module subroutine diag_mtx_mult_mtx(lside, trans, alpha, a, b, beta, c, err)
    +
    3374 logical, intent(in) :: lside, trans
    +
    3375 real(real64) :: alpha, beta
    +
    3376 real(real64), intent(in), dimension(:) :: a
    +
    3377 real(real64), intent(in), dimension(:,:) :: b
    +
    3378 real(real64), intent(inout), dimension(:,:) :: c
    +
    3379 class(errors), intent(inout), optional, target :: err
    +
    3380 end subroutine
    +
    3381
    +
    3382 module subroutine diag_mtx_mult_mtx2(lside, alpha, a, b, err)
    +
    3383 logical, intent(in) :: lside
    +
    3384 real(real64), intent(in) :: alpha
    +
    3385 real(real64), intent(in), dimension(:) :: a
    +
    3386 real(real64), intent(inout), dimension(:,:) :: b
    +
    3387 class(errors), intent(inout), optional, target :: err
    +
    3388 end subroutine
    +
    3389
    +
    3390 module subroutine diag_mtx_mult_mtx3(lside, trans, alpha, a, b, beta, c, err)
    +
    3391 logical, intent(in) :: lside, trans
    +
    3392 real(real64) :: alpha, beta
    +
    3393 complex(real64), intent(in), dimension(:) :: a
    +
    3394 real(real64), intent(in), dimension(:,:) :: b
    +
    3395 complex(real64), intent(inout), dimension(:,:) :: c
    3396 class(errors), intent(inout), optional, target :: err
    3397 end subroutine
    3398
    -
    3399 module subroutine lu_factor_cmplx(a, ipvt, err)
    -
    3400 complex(real64), intent(inout), dimension(:,:) :: a
    -
    3401 integer(int32), intent(out), dimension(:) :: ipvt
    -
    3402 class(errors), intent(inout), optional, target :: err
    -
    3403 end subroutine
    -
    3404
    -
    3405 module subroutine form_lu_all(lu, ipvt, u, p, err)
    -
    3406 real(real64), intent(inout), dimension(:,:) :: lu
    -
    3407 integer(int32), intent(in), dimension(:) :: ipvt
    -
    3408 real(real64), intent(out), dimension(:,:) :: u, p
    -
    3409 class(errors), intent(inout), optional, target :: err
    -
    3410 end subroutine
    -
    3411
    -
    3412 module subroutine form_lu_all_cmplx(lu, ipvt, u, p, err)
    -
    3413 complex(real64), intent(inout), dimension(:,:) :: lu
    -
    3414 integer(int32), intent(in), dimension(:) :: ipvt
    -
    3415 complex(real64), intent(out), dimension(:,:) :: u
    -
    3416 real(real64), intent(out), dimension(:,:) :: p
    -
    3417 class(errors), intent(inout), optional, target :: err
    -
    3418 end subroutine
    -
    3419
    -
    3420 module subroutine form_lu_only(lu, u, err)
    -
    3421 real(real64), intent(inout), dimension(:,:) :: lu
    -
    3422 real(real64), intent(out), dimension(:,:) :: u
    -
    3423 class(errors), intent(inout), optional, target :: err
    -
    3424 end subroutine
    -
    3425
    -
    3426 module subroutine form_lu_only_cmplx(lu, u, err)
    -
    3427 complex(real64), intent(inout), dimension(:,:) :: lu
    -
    3428 complex(real64), intent(out), dimension(:,:) :: u
    -
    3429 class(errors), intent(inout), optional, target :: err
    -
    3430 end subroutine
    -
    3431
    -
    3432 module subroutine qr_factor_no_pivot(a, tau, work, olwork, err)
    -
    3433 real(real64), intent(inout), dimension(:,:) :: a
    -
    3434 real(real64), intent(out), dimension(:) :: tau
    -
    3435 real(real64), intent(out), target, dimension(:), optional :: work
    -
    3436 integer(int32), intent(out), optional :: olwork
    -
    3437 class(errors), intent(inout), optional, target :: err
    -
    3438 end subroutine
    -
    3439
    -
    3440 module subroutine qr_factor_no_pivot_cmplx(a, tau, work, olwork, err)
    -
    3441 complex(real64), intent(inout), dimension(:,:) :: a
    -
    3442 complex(real64), intent(out), dimension(:) :: tau
    -
    3443 complex(real64), intent(out), target, dimension(:), optional :: work
    -
    3444 integer(int32), intent(out), optional :: olwork
    -
    3445 class(errors), intent(inout), optional, target :: err
    -
    3446 end subroutine
    -
    3447
    -
    3448 module subroutine qr_factor_pivot(a, tau, jpvt, work, olwork, err)
    -
    3449 real(real64), intent(inout), dimension(:,:) :: a
    -
    3450 real(real64), intent(out), dimension(:) :: tau
    -
    3451 integer(int32), intent(inout), dimension(:) :: jpvt
    -
    3452 real(real64), intent(out), target, dimension(:), optional :: work
    -
    3453 integer(int32), intent(out), optional :: olwork
    -
    3454 class(errors), intent(inout), optional, target :: err
    -
    3455 end subroutine
    -
    3456
    -
    3457 module subroutine qr_factor_pivot_cmplx(a, tau, jpvt, work, olwork, rwork, &
    -
    3458 err)
    -
    3459 complex(real64), intent(inout), dimension(:,:) :: a
    -
    3460 complex(real64), intent(out), dimension(:) :: tau
    -
    3461 integer(int32), intent(inout), dimension(:) :: jpvt
    -
    3462 complex(real64), intent(out), target, dimension(:), optional :: work
    -
    3463 integer(int32), intent(out), optional :: olwork
    -
    3464 real(real64), intent(out), target, dimension(:), optional :: rwork
    -
    3465 class(errors), intent(inout), optional, target :: err
    -
    3466 end subroutine
    -
    3467
    -
    3468 module subroutine form_qr_no_pivot(r, tau, q, work, olwork, err)
    -
    3469 real(real64), intent(inout), dimension(:,:) :: r
    -
    3470 real(real64), intent(in), dimension(:) :: tau
    -
    3471 real(real64), intent(out), dimension(:,:) :: q
    -
    3472 real(real64), intent(out), target, dimension(:), optional :: work
    -
    3473 integer(int32), intent(out), optional :: olwork
    -
    3474 class(errors), intent(inout), optional, target :: err
    -
    3475 end subroutine
    -
    3476
    -
    3477 module subroutine form_qr_no_pivot_cmplx(r, tau, q, work, olwork, err)
    -
    3478 complex(real64), intent(inout), dimension(:,:) :: r
    -
    3479 complex(real64), intent(in), dimension(:) :: tau
    -
    3480 complex(real64), intent(out), dimension(:,:) :: q
    -
    3481 complex(real64), intent(out), target, dimension(:), optional :: work
    -
    3482 integer(int32), intent(out), optional :: olwork
    -
    3483 class(errors), intent(inout), optional, target :: err
    -
    3484 end subroutine
    -
    3485
    -
    3486 module subroutine form_qr_pivot(r, tau, pvt, q, p, work, olwork, err)
    -
    3487 real(real64), intent(inout), dimension(:,:) :: r
    -
    3488 real(real64), intent(in), dimension(:) :: tau
    -
    3489 integer(int32), intent(in), dimension(:) :: pvt
    -
    3490 real(real64), intent(out), dimension(:,:) :: q, p
    -
    3491 real(real64), intent(out), target, dimension(:), optional :: work
    -
    3492 integer(int32), intent(out), optional :: olwork
    -
    3493 class(errors), intent(inout), optional, target :: err
    -
    3494 end subroutine
    -
    3495
    -
    3496 module subroutine form_qr_pivot_cmplx(r, tau, pvt, q, p, work, olwork, err)
    -
    3497 complex(real64), intent(inout), dimension(:,:) :: r
    -
    3498 complex(real64), intent(in), dimension(:) :: tau
    -
    3499 integer(int32), intent(in), dimension(:) :: pvt
    -
    3500 complex(real64), intent(out), dimension(:,:) :: q, p
    -
    3501 complex(real64), intent(out), target, dimension(:), optional :: work
    -
    3502 integer(int32), intent(out), optional :: olwork
    -
    3503 class(errors), intent(inout), optional, target :: err
    -
    3504 end subroutine
    -
    3505
    -
    3506 module subroutine mult_qr_mtx(lside, trans, a, tau, c, work, olwork, err)
    -
    3507 logical, intent(in) :: lside, trans
    -
    3508 real(real64), intent(in), dimension(:) :: tau
    -
    3509 real(real64), intent(inout), dimension(:,:) :: a, c
    -
    3510 real(real64), intent(out), target, dimension(:), optional :: work
    -
    3511 integer(int32), intent(out), optional :: olwork
    -
    3512 class(errors), intent(inout), optional, target :: err
    -
    3513 end subroutine
    -
    3514
    -
    3515 module subroutine mult_qr_mtx_cmplx(lside, trans, a, tau, c, work, olwork, err)
    -
    3516 logical, intent(in) :: lside, trans
    -
    3517 complex(real64), intent(in), dimension(:) :: tau
    -
    3518 complex(real64), intent(inout), dimension(:,:) :: a, c
    -
    3519 complex(real64), intent(out), target, dimension(:), optional :: work
    -
    3520 integer(int32), intent(out), optional :: olwork
    -
    3521 class(errors), intent(inout), optional, target :: err
    -
    3522 end subroutine
    -
    3523
    -
    3524 module subroutine mult_qr_vec(trans, a, tau, c, work, olwork, err)
    -
    3525 logical, intent(in) :: trans
    +
    3399 module subroutine diag_mtx_mult_mtx4(lside, opb, alpha, a, b, beta, c, err)
    +
    3400 logical, intent(in) :: lside
    +
    3401 integer(int32), intent(in) :: opb
    +
    3402 real(real64) :: alpha, beta
    +
    3403 complex(real64), intent(in), dimension(:) :: a
    +
    3404 complex(real64), intent(in), dimension(:,:) :: b
    +
    3405 complex(real64), intent(inout), dimension(:,:) :: c
    +
    3406 class(errors), intent(inout), optional, target :: err
    +
    3407 end subroutine
    +
    3408
    +
    3409 module subroutine diag_mtx_mult_mtx_cmplx(lside, opb, alpha, a, b, beta, c, err)
    +
    3410 logical, intent(in) :: lside
    +
    3411 integer(int32), intent(in) :: opb
    +
    3412 complex(real64) :: alpha, beta
    +
    3413 complex(real64), intent(in), dimension(:) :: a
    +
    3414 complex(real64), intent(in), dimension(:,:) :: b
    +
    3415 complex(real64), intent(inout), dimension(:,:) :: c
    +
    3416 class(errors), intent(inout), optional, target :: err
    +
    3417 end subroutine
    +
    3418
    +
    3419 module subroutine diag_mtx_mult_mtx2_cmplx(lside, alpha, a, b, err)
    +
    3420 logical, intent(in) :: lside
    +
    3421 complex(real64), intent(in) :: alpha
    +
    3422 complex(real64), intent(in), dimension(:) :: a
    +
    3423 complex(real64), intent(inout), dimension(:,:) :: b
    +
    3424 class(errors), intent(inout), optional, target :: err
    +
    3425 end subroutine
    +
    3426
    +
    3427 module subroutine diag_mtx_mult_mtx_mix(lside, opb, alpha, a, b, beta, c, err)
    +
    3428 logical, intent(in) :: lside
    +
    3429 integer(int32), intent(in) :: opb
    +
    3430 complex(real64) :: alpha, beta
    +
    3431 real(real64), intent(in), dimension(:) :: a
    +
    3432 complex(real64), intent(in), dimension(:,:) :: b
    +
    3433 complex(real64), intent(inout), dimension(:,:) :: c
    +
    3434 class(errors), intent(inout), optional, target :: err
    +
    3435 end subroutine
    +
    3436
    +
    3437 module subroutine diag_mtx_mult_mtx2_mix(lside, alpha, a, b, err)
    +
    3438 logical, intent(in) :: lside
    +
    3439 complex(real64), intent(in) :: alpha
    +
    3440 real(real64), intent(in), dimension(:) :: a
    +
    3441 complex(real64), intent(inout), dimension(:,:) :: b
    +
    3442 class(errors), intent(inout), optional, target :: err
    +
    3443 end subroutine
    +
    3444
    +
    3445 pure module function trace_dbl(x) result(y)
    +
    3446 real(real64), intent(in), dimension(:,:) :: x
    +
    3447 real(real64) :: y
    +
    3448 end function
    +
    3449
    +
    3450 pure module function trace_cmplx(x) result(y)
    +
    3451 complex(real64), intent(in), dimension(:,:) :: x
    +
    3452 complex(real64) :: y
    +
    3453 end function
    +
    3454
    +
    3455 module function mtx_rank_dbl(a, tol, work, olwork, err) result(rnk)
    +
    3456 real(real64), intent(inout), dimension(:,:) :: a
    +
    3457 real(real64), intent(in), optional :: tol
    +
    3458 real(real64), intent(out), target, optional, dimension(:) :: work
    +
    3459 integer(int32), intent(out), optional :: olwork
    +
    3460 class(errors), intent(inout), optional, target :: err
    +
    3461 integer(int32) :: rnk
    +
    3462 end function
    +
    3463
    +
    3464 module function mtx_rank_cmplx(a, tol, work, olwork, rwork, err) result(rnk)
    +
    3465 complex(real64), intent(inout), dimension(:,:) :: a
    +
    3466 real(real64), intent(in), optional :: tol
    +
    3467 complex(real64), intent(out), target, optional, dimension(:) :: work
    +
    3468 integer(int32), intent(out), optional :: olwork
    +
    3469 real(real64), intent(out), target, optional, dimension(:) :: rwork
    +
    3470 class(errors), intent(inout), optional, target :: err
    +
    3471 integer(int32) :: rnk
    +
    3472 end function
    +
    3473
    +
    3474 module function det_dbl(a, iwork, err) result(x)
    +
    3475 real(real64), intent(inout), dimension(:,:) :: a
    +
    3476 integer(int32), intent(out), target, optional, dimension(:) :: iwork
    +
    3477 class(errors), intent(inout), optional, target :: err
    +
    3478 real(real64) :: x
    +
    3479 end function
    +
    3480
    +
    3481 module function det_cmplx(a, iwork, err) result(x)
    +
    3482 complex(real64), intent(inout), dimension(:,:) :: a
    +
    3483 integer(int32), intent(out), target, optional, dimension(:) :: iwork
    +
    3484 class(errors), intent(inout), optional, target :: err
    +
    3485 complex(real64) :: x
    +
    3486 end function
    +
    3487
    +
    3488 module subroutine swap_dbl(x, y, err)
    +
    3489 real(real64), intent(inout), dimension(:) :: x, y
    +
    3490 class(errors), intent(inout), optional, target :: err
    +
    3491 end subroutine
    +
    3492
    +
    3493 module subroutine swap_cmplx(x, y, err)
    +
    3494 complex(real64), intent(inout), dimension(:) :: x, y
    +
    3495 class(errors), intent(inout), optional, target :: err
    +
    3496 end subroutine
    +
    3497
    +
    3498 module subroutine recip_mult_array_dbl(a, x)
    +
    3499 real(real64), intent(in) :: a
    +
    3500 real(real64), intent(inout), dimension(:) :: x
    +
    3501 end subroutine
    +
    3502
    +
    3503 module subroutine tri_mtx_mult_dbl(upper, alpha, a, beta, b, err)
    +
    3504 logical, intent(in) :: upper
    +
    3505 real(real64), intent(in) :: alpha, beta
    +
    3506 real(real64), intent(in), dimension(:,:) :: a
    +
    3507 real(real64), intent(inout), dimension(:,:) :: b
    +
    3508 class(errors), intent(inout), optional, target :: err
    +
    3509 end subroutine
    +
    3510
    +
    3511 module subroutine tri_mtx_mult_cmplx(upper, alpha, a, beta, b, err)
    +
    3512 logical, intent(in) :: upper
    +
    3513 complex(real64), intent(in) :: alpha, beta
    +
    3514 complex(real64), intent(in), dimension(:,:) :: a
    +
    3515 complex(real64), intent(inout), dimension(:,:) :: b
    +
    3516 class(errors), intent(inout), optional, target :: err
    +
    3517 end subroutine
    +
    3518
    +
    3519end interface
    +
    3520
    +
    3521! ******************************************************************************
    +
    3522! LINALG_FACTOR.F90
    +
    3523! ------------------------------------------------------------------------------
    +
    3524interface
    +
    3525 module subroutine lu_factor_dbl(a, ipvt, err)
    3526 real(real64), intent(inout), dimension(:,:) :: a
    -
    3527 real(real64), intent(in), dimension(:) :: tau
    -
    3528 real(real64), intent(inout), dimension(:) :: c
    -
    3529 real(real64), intent(out), target, dimension(:), optional :: work
    -
    3530 integer(int32), intent(out), optional :: olwork
    -
    3531 class(errors), intent(inout), optional, target :: err
    -
    3532 end subroutine
    -
    3533
    -
    3534 module subroutine mult_qr_vec_cmplx(trans, a, tau, c, work, olwork, err)
    -
    3535 logical, intent(in) :: trans
    -
    3536 complex(real64), intent(inout), dimension(:,:) :: a
    -
    3537 complex(real64), intent(in), dimension(:) :: tau
    -
    3538 complex(real64), intent(inout), dimension(:) :: c
    -
    3539 complex(real64), intent(out), target, dimension(:), optional :: work
    -
    3540 integer(int32), intent(out), optional :: olwork
    +
    3527 integer(int32), intent(out), dimension(:) :: ipvt
    +
    3528 class(errors), intent(inout), optional, target :: err
    +
    3529 end subroutine
    +
    3530
    +
    3531 module subroutine lu_factor_cmplx(a, ipvt, err)
    +
    3532 complex(real64), intent(inout), dimension(:,:) :: a
    +
    3533 integer(int32), intent(out), dimension(:) :: ipvt
    +
    3534 class(errors), intent(inout), optional, target :: err
    +
    3535 end subroutine
    +
    3536
    +
    3537 module subroutine form_lu_all(lu, ipvt, u, p, err)
    +
    3538 real(real64), intent(inout), dimension(:,:) :: lu
    +
    3539 integer(int32), intent(in), dimension(:) :: ipvt
    +
    3540 real(real64), intent(out), dimension(:,:) :: u, p
    3541 class(errors), intent(inout), optional, target :: err
    3542 end subroutine
    3543
    -
    3544 module subroutine qr_rank1_update_dbl(q, r, u, v, work, err)
    -
    3545 real(real64), intent(inout), dimension(:,:) :: q, r
    -
    3546 real(real64), intent(inout), dimension(:) :: u, v
    -
    3547 real(real64), intent(out), target, optional, dimension(:) :: work
    -
    3548 class(errors), intent(inout), optional, target :: err
    -
    3549 end subroutine
    -
    3550
    -
    3551 module subroutine qr_rank1_update_cmplx(q, r, u, v, work, rwork, err)
    -
    3552 complex(real64), intent(inout), dimension(:,:) :: q, r
    -
    3553 complex(real64), intent(inout), dimension(:) :: u, v
    -
    3554 complex(real64), intent(out), target, optional, dimension(:) :: work
    -
    3555 real(real64), intent(out), target, optional, dimension(:) :: rwork
    -
    3556 class(errors), intent(inout), optional, target :: err
    -
    3557 end subroutine
    -
    3558
    -
    3559 module subroutine cholesky_factor_dbl(a, upper, err)
    -
    3560 real(real64), intent(inout), dimension(:,:) :: a
    -
    3561 logical, intent(in), optional :: upper
    -
    3562 class(errors), intent(inout), optional, target :: err
    -
    3563 end subroutine
    -
    3564
    -
    3565 module subroutine cholesky_factor_cmplx(a, upper, err)
    -
    3566 complex(real64), intent(inout), dimension(:,:) :: a
    -
    3567 logical, intent(in), optional :: upper
    -
    3568 class(errors), intent(inout), optional, target :: err
    -
    3569 end subroutine
    -
    3570
    -
    3571 module subroutine cholesky_rank1_update_dbl(r, u, work, err)
    -
    3572 real(real64), intent(inout), dimension(:,:) :: r
    -
    3573 real(real64), intent(inout), dimension(:) :: u
    -
    3574 real(real64), intent(out), target, optional, dimension(:) :: work
    -
    3575 class(errors), intent(inout), optional, target :: err
    -
    3576 end subroutine
    -
    3577
    -
    3578 module subroutine cholesky_rank1_update_cmplx(r, u, work, err)
    -
    3579 complex(real64), intent(inout), dimension(:,:) :: r
    -
    3580 complex(real64), intent(inout), dimension(:) :: u
    -
    3581 real(real64), intent(out), target, optional, dimension(:) :: work
    -
    3582 class(errors), intent(inout), optional, target :: err
    -
    3583 end subroutine
    -
    3584
    -
    3585 module subroutine cholesky_rank1_downdate_dbl(r, u, work, err)
    -
    3586 real(real64), intent(inout), dimension(:,:) :: r
    -
    3587 real(real64), intent(inout), dimension(:) :: u
    -
    3588 real(real64), intent(out), target, optional, dimension(:) :: work
    -
    3589 class(errors), intent(inout), optional, target :: err
    -
    3590 end subroutine
    -
    3591
    -
    3592 module subroutine cholesky_rank1_downdate_cmplx(r, u, work, err)
    -
    3593 complex(real64), intent(inout), dimension(:,:) :: r
    -
    3594 complex(real64), intent(inout), dimension(:) :: u
    -
    3595 real(real64), intent(out), target, optional, dimension(:) :: work
    -
    3596 class(errors), intent(inout), optional, target :: err
    -
    3597 end subroutine
    -
    3598
    -
    3599 module subroutine rz_factor_dbl(a, tau, work, olwork, err)
    -
    3600 real(real64), intent(inout), dimension(:,:) :: a
    -
    3601 real(real64), intent(out), dimension(:) :: tau
    -
    3602 real(real64), intent(out), target, optional, dimension(:) :: work
    -
    3603 integer(int32), intent(out), optional :: olwork
    -
    3604 class(errors), intent(inout), optional, target :: err
    -
    3605 end subroutine
    -
    3606
    -
    3607 module subroutine rz_factor_cmplx(a, tau, work, olwork, err)
    -
    3608 complex(real64), intent(inout), dimension(:,:) :: a
    -
    3609 complex(real64), intent(out), dimension(:) :: tau
    -
    3610 complex(real64), intent(out), target, optional, dimension(:) :: work
    -
    3611 integer(int32), intent(out), optional :: olwork
    -
    3612 class(errors), intent(inout), optional, target :: err
    -
    3613 end subroutine
    -
    3614
    -
    3615 module subroutine mult_rz_mtx(lside, trans, l, a, tau, c, work, olwork, err)
    -
    3616 logical, intent(in) :: lside, trans
    -
    3617 integer(int32), intent(in) :: l
    -
    3618 real(real64), intent(inout), dimension(:,:) :: a, c
    -
    3619 real(real64), intent(in), dimension(:) :: tau
    -
    3620 real(real64), intent(out), target, optional, dimension(:) :: work
    -
    3621 integer(int32), intent(out), optional :: olwork
    -
    3622 class(errors), intent(inout), optional, target :: err
    -
    3623 end subroutine
    -
    3624
    -
    3625 module subroutine mult_rz_mtx_cmplx(lside, trans, l, a, tau, c, work, olwork, err)
    -
    3626 logical, intent(in) :: lside, trans
    -
    3627 integer(int32), intent(in) :: l
    -
    3628 complex(real64), intent(inout), dimension(:,:) :: a, c
    -
    3629 complex(real64), intent(in), dimension(:) :: tau
    -
    3630 complex(real64), intent(out), target, optional, dimension(:) :: work
    -
    3631 integer(int32), intent(out), optional :: olwork
    -
    3632 class(errors), intent(inout), optional, target :: err
    -
    3633 end subroutine
    -
    3634
    -
    3635 module subroutine mult_rz_vec(trans, l, a, tau, c, work, olwork, err)
    -
    3636 logical, intent(in) :: trans
    -
    3637 integer(int32), intent(in) :: l
    -
    3638 real(real64), intent(inout), dimension(:,:) :: a
    -
    3639 real(real64), intent(in), dimension(:) :: tau
    -
    3640 real(real64), intent(inout), dimension(:) :: c
    -
    3641 real(real64), intent(out), target, optional, dimension(:) :: work
    -
    3642 integer(int32), intent(out), optional :: olwork
    -
    3643 class(errors), intent(inout), optional, target :: err
    -
    3644 end subroutine
    -
    3645
    -
    3646 module subroutine mult_rz_vec_cmplx(trans, l, a, tau, c, work, olwork, err)
    -
    3647 logical, intent(in) :: trans
    -
    3648 integer(int32), intent(in) :: l
    -
    3649 complex(real64), intent(inout), dimension(:,:) :: a
    -
    3650 complex(real64), intent(in), dimension(:) :: tau
    -
    3651 complex(real64), intent(inout), dimension(:) :: c
    -
    3652 complex(real64), intent(out), target, optional, dimension(:) :: work
    -
    3653 integer(int32), intent(out), optional :: olwork
    -
    3654 class(errors), intent(inout), optional, target :: err
    -
    3655 end subroutine
    -
    3656
    -
    3657 module subroutine svd_dbl(a, s, u, vt, work, olwork, err)
    +
    3544 module subroutine form_lu_all_cmplx(lu, ipvt, u, p, err)
    +
    3545 complex(real64), intent(inout), dimension(:,:) :: lu
    +
    3546 integer(int32), intent(in), dimension(:) :: ipvt
    +
    3547 complex(real64), intent(out), dimension(:,:) :: u
    +
    3548 real(real64), intent(out), dimension(:,:) :: p
    +
    3549 class(errors), intent(inout), optional, target :: err
    +
    3550 end subroutine
    +
    3551
    +
    3552 module subroutine form_lu_only(lu, u, err)
    +
    3553 real(real64), intent(inout), dimension(:,:) :: lu
    +
    3554 real(real64), intent(out), dimension(:,:) :: u
    +
    3555 class(errors), intent(inout), optional, target :: err
    +
    3556 end subroutine
    +
    3557
    +
    3558 module subroutine form_lu_only_cmplx(lu, u, err)
    +
    3559 complex(real64), intent(inout), dimension(:,:) :: lu
    +
    3560 complex(real64), intent(out), dimension(:,:) :: u
    +
    3561 class(errors), intent(inout), optional, target :: err
    +
    3562 end subroutine
    +
    3563
    +
    3564 module subroutine qr_factor_no_pivot(a, tau, work, olwork, err)
    +
    3565 real(real64), intent(inout), dimension(:,:) :: a
    +
    3566 real(real64), intent(out), dimension(:) :: tau
    +
    3567 real(real64), intent(out), target, dimension(:), optional :: work
    +
    3568 integer(int32), intent(out), optional :: olwork
    +
    3569 class(errors), intent(inout), optional, target :: err
    +
    3570 end subroutine
    +
    3571
    +
    3572 module subroutine qr_factor_no_pivot_cmplx(a, tau, work, olwork, err)
    +
    3573 complex(real64), intent(inout), dimension(:,:) :: a
    +
    3574 complex(real64), intent(out), dimension(:) :: tau
    +
    3575 complex(real64), intent(out), target, dimension(:), optional :: work
    +
    3576 integer(int32), intent(out), optional :: olwork
    +
    3577 class(errors), intent(inout), optional, target :: err
    +
    3578 end subroutine
    +
    3579
    +
    3580 module subroutine qr_factor_pivot(a, tau, jpvt, work, olwork, err)
    +
    3581 real(real64), intent(inout), dimension(:,:) :: a
    +
    3582 real(real64), intent(out), dimension(:) :: tau
    +
    3583 integer(int32), intent(inout), dimension(:) :: jpvt
    +
    3584 real(real64), intent(out), target, dimension(:), optional :: work
    +
    3585 integer(int32), intent(out), optional :: olwork
    +
    3586 class(errors), intent(inout), optional, target :: err
    +
    3587 end subroutine
    +
    3588
    +
    3589 module subroutine qr_factor_pivot_cmplx(a, tau, jpvt, work, olwork, rwork, &
    +
    3590 err)
    +
    3591 complex(real64), intent(inout), dimension(:,:) :: a
    +
    3592 complex(real64), intent(out), dimension(:) :: tau
    +
    3593 integer(int32), intent(inout), dimension(:) :: jpvt
    +
    3594 complex(real64), intent(out), target, dimension(:), optional :: work
    +
    3595 integer(int32), intent(out), optional :: olwork
    +
    3596 real(real64), intent(out), target, dimension(:), optional :: rwork
    +
    3597 class(errors), intent(inout), optional, target :: err
    +
    3598 end subroutine
    +
    3599
    +
    3600 module subroutine form_qr_no_pivot(r, tau, q, work, olwork, err)
    +
    3601 real(real64), intent(inout), dimension(:,:) :: r
    +
    3602 real(real64), intent(in), dimension(:) :: tau
    +
    3603 real(real64), intent(out), dimension(:,:) :: q
    +
    3604 real(real64), intent(out), target, dimension(:), optional :: work
    +
    3605 integer(int32), intent(out), optional :: olwork
    +
    3606 class(errors), intent(inout), optional, target :: err
    +
    3607 end subroutine
    +
    3608
    +
    3609 module subroutine form_qr_no_pivot_cmplx(r, tau, q, work, olwork, err)
    +
    3610 complex(real64), intent(inout), dimension(:,:) :: r
    +
    3611 complex(real64), intent(in), dimension(:) :: tau
    +
    3612 complex(real64), intent(out), dimension(:,:) :: q
    +
    3613 complex(real64), intent(out), target, dimension(:), optional :: work
    +
    3614 integer(int32), intent(out), optional :: olwork
    +
    3615 class(errors), intent(inout), optional, target :: err
    +
    3616 end subroutine
    +
    3617
    +
    3618 module subroutine form_qr_pivot(r, tau, pvt, q, p, work, olwork, err)
    +
    3619 real(real64), intent(inout), dimension(:,:) :: r
    +
    3620 real(real64), intent(in), dimension(:) :: tau
    +
    3621 integer(int32), intent(in), dimension(:) :: pvt
    +
    3622 real(real64), intent(out), dimension(:,:) :: q, p
    +
    3623 real(real64), intent(out), target, dimension(:), optional :: work
    +
    3624 integer(int32), intent(out), optional :: olwork
    +
    3625 class(errors), intent(inout), optional, target :: err
    +
    3626 end subroutine
    +
    3627
    +
    3628 module subroutine form_qr_pivot_cmplx(r, tau, pvt, q, p, work, olwork, err)
    +
    3629 complex(real64), intent(inout), dimension(:,:) :: r
    +
    3630 complex(real64), intent(in), dimension(:) :: tau
    +
    3631 integer(int32), intent(in), dimension(:) :: pvt
    +
    3632 complex(real64), intent(out), dimension(:,:) :: q, p
    +
    3633 complex(real64), intent(out), target, dimension(:), optional :: work
    +
    3634 integer(int32), intent(out), optional :: olwork
    +
    3635 class(errors), intent(inout), optional, target :: err
    +
    3636 end subroutine
    +
    3637
    +
    3638 module subroutine mult_qr_mtx(lside, trans, a, tau, c, work, olwork, err)
    +
    3639 logical, intent(in) :: lside, trans
    +
    3640 real(real64), intent(in), dimension(:) :: tau
    +
    3641 real(real64), intent(inout), dimension(:,:) :: a, c
    +
    3642 real(real64), intent(out), target, dimension(:), optional :: work
    +
    3643 integer(int32), intent(out), optional :: olwork
    +
    3644 class(errors), intent(inout), optional, target :: err
    +
    3645 end subroutine
    +
    3646
    +
    3647 module subroutine mult_qr_mtx_cmplx(lside, trans, a, tau, c, work, olwork, err)
    +
    3648 logical, intent(in) :: lside, trans
    +
    3649 complex(real64), intent(in), dimension(:) :: tau
    +
    3650 complex(real64), intent(inout), dimension(:,:) :: a, c
    +
    3651 complex(real64), intent(out), target, dimension(:), optional :: work
    +
    3652 integer(int32), intent(out), optional :: olwork
    +
    3653 class(errors), intent(inout), optional, target :: err
    +
    3654 end subroutine
    +
    3655
    +
    3656 module subroutine mult_qr_vec(trans, a, tau, c, work, olwork, err)
    +
    3657 logical, intent(in) :: trans
    3658 real(real64), intent(inout), dimension(:,:) :: a
    -
    3659 real(real64), intent(out), dimension(:) :: s
    -
    3660 real(real64), intent(out), optional, dimension(:,:) :: u, vt
    -
    3661 real(real64), intent(out), target, optional, dimension(:) :: work
    +
    3659 real(real64), intent(in), dimension(:) :: tau
    +
    3660 real(real64), intent(inout), dimension(:) :: c
    +
    3661 real(real64), intent(out), target, dimension(:), optional :: work
    3662 integer(int32), intent(out), optional :: olwork
    3663 class(errors), intent(inout), optional, target :: err
    3664 end subroutine
    3665
    -
    3666 module subroutine svd_cmplx(a, s, u, vt, work, olwork, rwork, err)
    -
    3667 complex(real64), intent(inout), dimension(:,:) :: a
    -
    3668 real(real64), intent(out), dimension(:) :: s
    -
    3669 complex(real64), intent(out), optional, dimension(:,:) :: u, vt
    -
    3670 complex(real64), intent(out), target, optional, dimension(:) :: work
    -
    3671 integer(int32), intent(out), optional :: olwork
    -
    3672 real(real64), intent(out), target, optional, dimension(:) :: rwork
    +
    3666 module subroutine mult_qr_vec_cmplx(trans, a, tau, c, work, olwork, err)
    +
    3667 logical, intent(in) :: trans
    +
    3668 complex(real64), intent(inout), dimension(:,:) :: a
    +
    3669 complex(real64), intent(in), dimension(:) :: tau
    +
    3670 complex(real64), intent(inout), dimension(:) :: c
    +
    3671 complex(real64), intent(out), target, dimension(:), optional :: work
    +
    3672 integer(int32), intent(out), optional :: olwork
    3673 class(errors), intent(inout), optional, target :: err
    3674 end subroutine
    -
    3675end interface
    -
    3676
    -
    3677! ******************************************************************************
    -
    3678! LINALG_SOLVE.F90
    -
    3679! ------------------------------------------------------------------------------
    -
    3680interface
    -
    3681 module subroutine solve_tri_mtx(lside, upper, trans, nounit, alpha, a, b, err)
    -
    3682 logical, intent(in) :: lside, upper, trans, nounit
    -
    3683 real(real64), intent(in) :: alpha
    -
    3684 real(real64), intent(in), dimension(:,:) :: a
    -
    3685 real(real64), intent(inout), dimension(:,:) :: b
    -
    3686 class(errors), intent(inout), optional, target :: err
    -
    3687 end subroutine
    -
    3688
    -
    3689 module subroutine solve_tri_mtx_cmplx(lside, upper, trans, nounit, alpha, a, b, err)
    -
    3690 logical, intent(in) :: lside, upper, trans, nounit
    -
    3691 complex(real64), intent(in) :: alpha
    -
    3692 complex(real64), intent(in), dimension(:,:) :: a
    -
    3693 complex(real64), intent(inout), dimension(:,:) :: b
    +
    3675
    +
    3676 module subroutine qr_rank1_update_dbl(q, r, u, v, work, err)
    +
    3677 real(real64), intent(inout), dimension(:,:) :: q, r
    +
    3678 real(real64), intent(inout), dimension(:) :: u, v
    +
    3679 real(real64), intent(out), target, optional, dimension(:) :: work
    +
    3680 class(errors), intent(inout), optional, target :: err
    +
    3681 end subroutine
    +
    3682
    +
    3683 module subroutine qr_rank1_update_cmplx(q, r, u, v, work, rwork, err)
    +
    3684 complex(real64), intent(inout), dimension(:,:) :: q, r
    +
    3685 complex(real64), intent(inout), dimension(:) :: u, v
    +
    3686 complex(real64), intent(out), target, optional, dimension(:) :: work
    +
    3687 real(real64), intent(out), target, optional, dimension(:) :: rwork
    +
    3688 class(errors), intent(inout), optional, target :: err
    +
    3689 end subroutine
    +
    3690
    +
    3691 module subroutine cholesky_factor_dbl(a, upper, err)
    +
    3692 real(real64), intent(inout), dimension(:,:) :: a
    +
    3693 logical, intent(in), optional :: upper
    3694 class(errors), intent(inout), optional, target :: err
    3695 end subroutine
    -
    3696
    -
    3697 module subroutine solve_tri_vec(upper, trans, nounit, a, x, err)
    -
    3698 logical, intent(in) :: upper, trans, nounit
    -
    3699 real(real64), intent(in), dimension(:,:) :: a
    -
    3700 real(real64), intent(inout), dimension(:) :: x
    -
    3701 class(errors), intent(inout), optional, target :: err
    -
    3702 end subroutine
    -
    3703
    -
    3704 module subroutine solve_tri_vec_cmplx(upper, trans, nounit, a, x, err)
    -
    3705 logical, intent(in) :: upper, trans, nounit
    -
    3706 complex(real64), intent(in), dimension(:,:) :: a
    -
    3707 complex(real64), intent(inout), dimension(:) :: x
    -
    3708 class(errors), intent(inout), optional, target :: err
    -
    3709 end subroutine
    -
    3710
    -
    3711 module subroutine solve_lu_mtx(a, ipvt, b, err)
    -
    3712 real(real64), intent(in), dimension(:,:) :: a
    -
    3713 integer(int32), intent(in), dimension(:) :: ipvt
    -
    3714 real(real64), intent(inout), dimension(:,:) :: b
    -
    3715 class(errors), intent(inout), optional, target :: err
    -
    3716 end subroutine
    -
    3717
    -
    3718 module subroutine solve_lu_mtx_cmplx(a, ipvt, b, err)
    -
    3719 complex(real64), intent(in), dimension(:,:) :: a
    -
    3720 integer(int32), intent(in), dimension(:) :: ipvt
    -
    3721 complex(real64), intent(inout), dimension(:,:) :: b
    -
    3722 class(errors), intent(inout), optional, target :: err
    -
    3723 end subroutine
    -
    3724
    -
    3725 module subroutine solve_lu_vec(a, ipvt, b, err)
    -
    3726 real(real64), intent(in), dimension(:,:) :: a
    -
    3727 integer(int32), intent(in), dimension(:) :: ipvt
    -
    3728 real(real64), intent(inout), dimension(:) :: b
    -
    3729 class(errors), intent(inout), optional, target :: err
    -
    3730 end subroutine
    -
    3731
    -
    3732 module subroutine solve_lu_vec_cmplx(a, ipvt, b, err)
    -
    3733 complex(real64), intent(in), dimension(:,:) :: a
    -
    3734 integer(int32), intent(in), dimension(:) :: ipvt
    -
    3735 complex(real64), intent(inout), dimension(:) :: b
    +
    3696
    +
    3697 module subroutine cholesky_factor_cmplx(a, upper, err)
    +
    3698 complex(real64), intent(inout), dimension(:,:) :: a
    +
    3699 logical, intent(in), optional :: upper
    +
    3700 class(errors), intent(inout), optional, target :: err
    +
    3701 end subroutine
    +
    3702
    +
    3703 module subroutine cholesky_rank1_update_dbl(r, u, work, err)
    +
    3704 real(real64), intent(inout), dimension(:,:) :: r
    +
    3705 real(real64), intent(inout), dimension(:) :: u
    +
    3706 real(real64), intent(out), target, optional, dimension(:) :: work
    +
    3707 class(errors), intent(inout), optional, target :: err
    +
    3708 end subroutine
    +
    3709
    +
    3710 module subroutine cholesky_rank1_update_cmplx(r, u, work, err)
    +
    3711 complex(real64), intent(inout), dimension(:,:) :: r
    +
    3712 complex(real64), intent(inout), dimension(:) :: u
    +
    3713 real(real64), intent(out), target, optional, dimension(:) :: work
    +
    3714 class(errors), intent(inout), optional, target :: err
    +
    3715 end subroutine
    +
    3716
    +
    3717 module subroutine cholesky_rank1_downdate_dbl(r, u, work, err)
    +
    3718 real(real64), intent(inout), dimension(:,:) :: r
    +
    3719 real(real64), intent(inout), dimension(:) :: u
    +
    3720 real(real64), intent(out), target, optional, dimension(:) :: work
    +
    3721 class(errors), intent(inout), optional, target :: err
    +
    3722 end subroutine
    +
    3723
    +
    3724 module subroutine cholesky_rank1_downdate_cmplx(r, u, work, err)
    +
    3725 complex(real64), intent(inout), dimension(:,:) :: r
    +
    3726 complex(real64), intent(inout), dimension(:) :: u
    +
    3727 real(real64), intent(out), target, optional, dimension(:) :: work
    +
    3728 class(errors), intent(inout), optional, target :: err
    +
    3729 end subroutine
    +
    3730
    +
    3731 module subroutine rz_factor_dbl(a, tau, work, olwork, err)
    +
    3732 real(real64), intent(inout), dimension(:,:) :: a
    +
    3733 real(real64), intent(out), dimension(:) :: tau
    +
    3734 real(real64), intent(out), target, optional, dimension(:) :: work
    +
    3735 integer(int32), intent(out), optional :: olwork
    3736 class(errors), intent(inout), optional, target :: err
    3737 end subroutine
    3738
    -
    3739 module subroutine solve_qr_no_pivot_mtx(a, tau, b, work, olwork, err)
    -
    3740 real(real64), intent(inout), dimension(:,:) :: a, b
    -
    3741 real(real64), intent(in), dimension(:) :: tau
    -
    3742 real(real64), intent(out), target, optional, dimension(:) :: work
    +
    3739 module subroutine rz_factor_cmplx(a, tau, work, olwork, err)
    +
    3740 complex(real64), intent(inout), dimension(:,:) :: a
    +
    3741 complex(real64), intent(out), dimension(:) :: tau
    +
    3742 complex(real64), intent(out), target, optional, dimension(:) :: work
    3743 integer(int32), intent(out), optional :: olwork
    3744 class(errors), intent(inout), optional, target :: err
    3745 end subroutine
    3746
    -
    3747 module subroutine solve_qr_no_pivot_mtx_cmplx(a, tau, b, work, olwork, err)
    -
    3748 complex(real64), intent(inout), dimension(:,:) :: a, b
    -
    3749 complex(real64), intent(in), dimension(:) :: tau
    -
    3750 complex(real64), intent(out), target, optional, dimension(:) :: work
    -
    3751 integer(int32), intent(out), optional :: olwork
    -
    3752 class(errors), intent(inout), optional, target :: err
    -
    3753 end subroutine
    -
    3754
    -
    3755 module subroutine solve_qr_no_pivot_vec(a, tau, b, work, olwork, err)
    -
    3756 real(real64), intent(inout), dimension(:,:) :: a
    -
    3757 real(real64), intent(in), dimension(:) :: tau
    -
    3758 real(real64), intent(inout), dimension(:) :: b
    -
    3759 real(real64), intent(out), target, optional, dimension(:) :: work
    -
    3760 integer(int32), intent(out), optional :: olwork
    -
    3761 class(errors), intent(inout), optional, target :: err
    -
    3762 end subroutine
    -
    3763
    -
    3764 module subroutine solve_qr_no_pivot_vec_cmplx(a, tau, b, work, olwork, err)
    -
    3765 complex(real64), intent(inout), dimension(:,:) :: a
    -
    3766 complex(real64), intent(in), dimension(:) :: tau
    -
    3767 complex(real64), intent(inout), dimension(:) :: b
    -
    3768 complex(real64), intent(out), target, optional, dimension(:) :: work
    -
    3769 integer(int32), intent(out), optional :: olwork
    -
    3770 class(errors), intent(inout), optional, target :: err
    -
    3771 end subroutine
    -
    3772
    -
    3773 module subroutine solve_qr_pivot_mtx(a, tau, jpvt, b, work, olwork, err)
    -
    3774 real(real64), intent(inout), dimension(:,:) :: a
    -
    3775 real(real64), intent(in), dimension(:) :: tau
    -
    3776 integer(int32), intent(in), dimension(:) :: jpvt
    -
    3777 real(real64), intent(inout), dimension(:,:) :: b
    -
    3778 real(real64), intent(out), target, optional, dimension(:) :: work
    -
    3779 integer(int32), intent(out), optional :: olwork
    -
    3780 class(errors), intent(inout), optional, target :: err
    -
    3781 end subroutine
    -
    3782
    -
    3783 module subroutine solve_qr_pivot_mtx_cmplx(a, tau, jpvt, b, work, olwork, err)
    -
    3784 complex(real64), intent(inout), dimension(:,:) :: a
    -
    3785 complex(real64), intent(in), dimension(:) :: tau
    -
    3786 integer(int32), intent(in), dimension(:) :: jpvt
    -
    3787 complex(real64), intent(inout), dimension(:,:) :: b
    -
    3788 complex(real64), intent(out), target, optional, dimension(:) :: work
    -
    3789 integer(int32), intent(out), optional :: olwork
    -
    3790 class(errors), intent(inout), optional, target :: err
    -
    3791 end subroutine
    -
    3792
    -
    3793 module subroutine solve_qr_pivot_vec(a, tau, jpvt, b, work, olwork, err)
    -
    3794 real(real64), intent(inout), dimension(:,:) :: a
    -
    3795 real(real64), intent(in), dimension(:) :: tau
    -
    3796 integer(int32), intent(in), dimension(:) :: jpvt
    -
    3797 real(real64), intent(inout), dimension(:) :: b
    -
    3798 real(real64), intent(out), target, optional, dimension(:) :: work
    -
    3799 integer(int32), intent(out), optional :: olwork
    -
    3800 class(errors), intent(inout), optional, target :: err
    -
    3801 end subroutine
    -
    3802
    -
    3803 module subroutine solve_qr_pivot_vec_cmplx(a, tau, jpvt, b, work, olwork, err)
    -
    3804 complex(real64), intent(inout), dimension(:,:) :: a
    -
    3805 complex(real64), intent(in), dimension(:) :: tau
    -
    3806 integer(int32), intent(in), dimension(:) :: jpvt
    -
    3807 complex(real64), intent(inout), dimension(:) :: b
    -
    3808 complex(real64), intent(out), target, optional, dimension(:) :: work
    -
    3809 integer(int32), intent(out), optional :: olwork
    -
    3810 class(errors), intent(inout), optional, target :: err
    -
    3811 end subroutine
    -
    3812
    -
    3813 module subroutine solve_cholesky_mtx(upper, a, b, err)
    -
    3814 logical, intent(in) :: upper
    -
    3815 real(real64), intent(in), dimension(:,:) :: a
    -
    3816 real(real64), intent(inout), dimension(:,:) :: b
    -
    3817 class(errors), intent(inout), optional, target :: err
    -
    3818 end subroutine
    -
    3819
    -
    3820 module subroutine solve_cholesky_mtx_cmplx(upper, a, b, err)
    -
    3821 logical, intent(in) :: upper
    -
    3822 complex(real64), intent(in), dimension(:,:) :: a
    -
    3823 complex(real64), intent(inout), dimension(:,:) :: b
    -
    3824 class(errors), intent(inout), optional, target :: err
    -
    3825 end subroutine
    -
    3826
    -
    3827 module subroutine solve_cholesky_vec(upper, a, b, err)
    -
    3828 logical, intent(in) :: upper
    -
    3829 real(real64), intent(in), dimension(:,:) :: a
    -
    3830 real(real64), intent(inout), dimension(:) :: b
    -
    3831 class(errors), intent(inout), optional, target :: err
    -
    3832 end subroutine
    -
    3833
    -
    3834 module subroutine solve_cholesky_vec_cmplx(upper, a, b, err)
    -
    3835 logical, intent(in) :: upper
    -
    3836 complex(real64), intent(in), dimension(:,:) :: a
    -
    3837 complex(real64), intent(inout), dimension(:) :: b
    -
    3838 class(errors), intent(inout), optional, target :: err
    -
    3839 end subroutine
    -
    3840
    -
    3841 module subroutine solve_least_squares_mtx(a, b, work, olwork, err)
    -
    3842 real(real64), intent(inout), dimension(:,:) :: a, b
    -
    3843 real(real64), intent(out), target, optional, dimension(:) :: work
    -
    3844 integer(int32), intent(out), optional :: olwork
    -
    3845 class(errors), intent(inout), optional, target :: err
    -
    3846 end subroutine
    -
    3847
    -
    3848 module subroutine solve_least_squares_mtx_cmplx(a, b, work, olwork, err)
    -
    3849 complex(real64), intent(inout), dimension(:,:) :: a, b
    -
    3850 complex(real64), intent(out), target, optional, dimension(:) :: work
    -
    3851 integer(int32), intent(out), optional :: olwork
    -
    3852 class(errors), intent(inout), optional, target :: err
    -
    3853 end subroutine
    -
    3854
    -
    3855 module subroutine solve_least_squares_vec(a, b, work, olwork, err)
    -
    3856 real(real64), intent(inout), dimension(:,:) :: a
    -
    3857 real(real64), intent(inout), dimension(:) :: b
    -
    3858 real(real64), intent(out), target, optional, dimension(:) :: work
    -
    3859 integer(int32), intent(out), optional :: olwork
    -
    3860 class(errors), intent(inout), optional, target :: err
    -
    3861 end subroutine
    -
    3862
    -
    3863 module subroutine solve_least_squares_vec_cmplx(a, b, work, olwork, err)
    -
    3864 complex(real64), intent(inout), dimension(:,:) :: a
    -
    3865 complex(real64), intent(inout), dimension(:) :: b
    -
    3866 complex(real64), intent(out), target, optional, dimension(:) :: work
    -
    3867 integer(int32), intent(out), optional :: olwork
    +
    3747 module subroutine mult_rz_mtx(lside, trans, l, a, tau, c, work, olwork, err)
    +
    3748 logical, intent(in) :: lside, trans
    +
    3749 integer(int32), intent(in) :: l
    +
    3750 real(real64), intent(inout), dimension(:,:) :: a, c
    +
    3751 real(real64), intent(in), dimension(:) :: tau
    +
    3752 real(real64), intent(out), target, optional, dimension(:) :: work
    +
    3753 integer(int32), intent(out), optional :: olwork
    +
    3754 class(errors), intent(inout), optional, target :: err
    +
    3755 end subroutine
    +
    3756
    +
    3757 module subroutine mult_rz_mtx_cmplx(lside, trans, l, a, tau, c, work, olwork, err)
    +
    3758 logical, intent(in) :: lside, trans
    +
    3759 integer(int32), intent(in) :: l
    +
    3760 complex(real64), intent(inout), dimension(:,:) :: a, c
    +
    3761 complex(real64), intent(in), dimension(:) :: tau
    +
    3762 complex(real64), intent(out), target, optional, dimension(:) :: work
    +
    3763 integer(int32), intent(out), optional :: olwork
    +
    3764 class(errors), intent(inout), optional, target :: err
    +
    3765 end subroutine
    +
    3766
    +
    3767 module subroutine mult_rz_vec(trans, l, a, tau, c, work, olwork, err)
    +
    3768 logical, intent(in) :: trans
    +
    3769 integer(int32), intent(in) :: l
    +
    3770 real(real64), intent(inout), dimension(:,:) :: a
    +
    3771 real(real64), intent(in), dimension(:) :: tau
    +
    3772 real(real64), intent(inout), dimension(:) :: c
    +
    3773 real(real64), intent(out), target, optional, dimension(:) :: work
    +
    3774 integer(int32), intent(out), optional :: olwork
    +
    3775 class(errors), intent(inout), optional, target :: err
    +
    3776 end subroutine
    +
    3777
    +
    3778 module subroutine mult_rz_vec_cmplx(trans, l, a, tau, c, work, olwork, err)
    +
    3779 logical, intent(in) :: trans
    +
    3780 integer(int32), intent(in) :: l
    +
    3781 complex(real64), intent(inout), dimension(:,:) :: a
    +
    3782 complex(real64), intent(in), dimension(:) :: tau
    +
    3783 complex(real64), intent(inout), dimension(:) :: c
    +
    3784 complex(real64), intent(out), target, optional, dimension(:) :: work
    +
    3785 integer(int32), intent(out), optional :: olwork
    +
    3786 class(errors), intent(inout), optional, target :: err
    +
    3787 end subroutine
    +
    3788
    +
    3789 module subroutine svd_dbl(a, s, u, vt, work, olwork, err)
    +
    3790 real(real64), intent(inout), dimension(:,:) :: a
    +
    3791 real(real64), intent(out), dimension(:) :: s
    +
    3792 real(real64), intent(out), optional, dimension(:,:) :: u, vt
    +
    3793 real(real64), intent(out), target, optional, dimension(:) :: work
    +
    3794 integer(int32), intent(out), optional :: olwork
    +
    3795 class(errors), intent(inout), optional, target :: err
    +
    3796 end subroutine
    +
    3797
    +
    3798 module subroutine svd_cmplx(a, s, u, vt, work, olwork, rwork, err)
    +
    3799 complex(real64), intent(inout), dimension(:,:) :: a
    +
    3800 real(real64), intent(out), dimension(:) :: s
    +
    3801 complex(real64), intent(out), optional, dimension(:,:) :: u, vt
    +
    3802 complex(real64), intent(out), target, optional, dimension(:) :: work
    +
    3803 integer(int32), intent(out), optional :: olwork
    +
    3804 real(real64), intent(out), target, optional, dimension(:) :: rwork
    +
    3805 class(errors), intent(inout), optional, target :: err
    +
    3806 end subroutine
    +
    3807end interface
    +
    3808
    +
    3809! ******************************************************************************
    +
    3810! LINALG_SOLVE.F90
    +
    3811! ------------------------------------------------------------------------------
    +
    3812interface
    +
    3813 module subroutine solve_tri_mtx(lside, upper, trans, nounit, alpha, a, b, err)
    +
    3814 logical, intent(in) :: lside, upper, trans, nounit
    +
    3815 real(real64), intent(in) :: alpha
    +
    3816 real(real64), intent(in), dimension(:,:) :: a
    +
    3817 real(real64), intent(inout), dimension(:,:) :: b
    +
    3818 class(errors), intent(inout), optional, target :: err
    +
    3819 end subroutine
    +
    3820
    +
    3821 module subroutine solve_tri_mtx_cmplx(lside, upper, trans, nounit, alpha, a, b, err)
    +
    3822 logical, intent(in) :: lside, upper, trans, nounit
    +
    3823 complex(real64), intent(in) :: alpha
    +
    3824 complex(real64), intent(in), dimension(:,:) :: a
    +
    3825 complex(real64), intent(inout), dimension(:,:) :: b
    +
    3826 class(errors), intent(inout), optional, target :: err
    +
    3827 end subroutine
    +
    3828
    +
    3829 module subroutine solve_tri_vec(upper, trans, nounit, a, x, err)
    +
    3830 logical, intent(in) :: upper, trans, nounit
    +
    3831 real(real64), intent(in), dimension(:,:) :: a
    +
    3832 real(real64), intent(inout), dimension(:) :: x
    +
    3833 class(errors), intent(inout), optional, target :: err
    +
    3834 end subroutine
    +
    3835
    +
    3836 module subroutine solve_tri_vec_cmplx(upper, trans, nounit, a, x, err)
    +
    3837 logical, intent(in) :: upper, trans, nounit
    +
    3838 complex(real64), intent(in), dimension(:,:) :: a
    +
    3839 complex(real64), intent(inout), dimension(:) :: x
    +
    3840 class(errors), intent(inout), optional, target :: err
    +
    3841 end subroutine
    +
    3842
    +
    3843 module subroutine solve_lu_mtx(a, ipvt, b, err)
    +
    3844 real(real64), intent(in), dimension(:,:) :: a
    +
    3845 integer(int32), intent(in), dimension(:) :: ipvt
    +
    3846 real(real64), intent(inout), dimension(:,:) :: b
    +
    3847 class(errors), intent(inout), optional, target :: err
    +
    3848 end subroutine
    +
    3849
    +
    3850 module subroutine solve_lu_mtx_cmplx(a, ipvt, b, err)
    +
    3851 complex(real64), intent(in), dimension(:,:) :: a
    +
    3852 integer(int32), intent(in), dimension(:) :: ipvt
    +
    3853 complex(real64), intent(inout), dimension(:,:) :: b
    +
    3854 class(errors), intent(inout), optional, target :: err
    +
    3855 end subroutine
    +
    3856
    +
    3857 module subroutine solve_lu_vec(a, ipvt, b, err)
    +
    3858 real(real64), intent(in), dimension(:,:) :: a
    +
    3859 integer(int32), intent(in), dimension(:) :: ipvt
    +
    3860 real(real64), intent(inout), dimension(:) :: b
    +
    3861 class(errors), intent(inout), optional, target :: err
    +
    3862 end subroutine
    +
    3863
    +
    3864 module subroutine solve_lu_vec_cmplx(a, ipvt, b, err)
    +
    3865 complex(real64), intent(in), dimension(:,:) :: a
    +
    3866 integer(int32), intent(in), dimension(:) :: ipvt
    +
    3867 complex(real64), intent(inout), dimension(:) :: b
    3868 class(errors), intent(inout), optional, target :: err
    3869 end subroutine
    3870
    -
    3871 module subroutine solve_least_squares_mtx_pvt(a, b, ipvt, arnk, work, olwork, err)
    +
    3871 module subroutine solve_qr_no_pivot_mtx(a, tau, b, work, olwork, err)
    3872 real(real64), intent(inout), dimension(:,:) :: a, b
    -
    3873 integer(int32), intent(inout), target, optional, dimension(:) :: ipvt
    -
    3874 integer(int32), intent(out), optional :: arnk
    -
    3875 real(real64), intent(out), target, optional, dimension(:) :: work
    -
    3876 integer(int32), intent(out), optional :: olwork
    -
    3877 class(errors), intent(inout), optional, target :: err
    -
    3878 end subroutine
    -
    3879
    -
    3880 module subroutine solve_least_squares_mtx_pvt_cmplx(a, b, ipvt, arnk, &
    -
    3881 work, olwork, rwork, err)
    -
    3882 complex(real64), intent(inout), dimension(:,:) :: a, b
    -
    3883 integer(int32), intent(inout), target, optional, dimension(:) :: ipvt
    -
    3884 integer(int32), intent(out), optional :: arnk
    -
    3885 complex(real64), intent(out), target, optional, dimension(:) :: work
    -
    3886 integer(int32), intent(out), optional :: olwork
    -
    3887 real(real64), intent(out), target, optional, dimension(:) :: rwork
    -
    3888 class(errors), intent(inout), optional, target :: err
    -
    3889 end subroutine
    -
    3890
    -
    3891 module subroutine solve_least_squares_vec_pvt(a, b, ipvt, arnk, work, olwork, err)
    -
    3892 real(real64), intent(inout), dimension(:,:) :: a
    -
    3893 real(real64), intent(inout), dimension(:) :: b
    -
    3894 integer(int32), intent(inout), target, optional, dimension(:) :: ipvt
    -
    3895 integer(int32), intent(out), optional :: arnk
    -
    3896 real(real64), intent(out), target, optional, dimension(:) :: work
    -
    3897 integer(int32), intent(out), optional :: olwork
    -
    3898 class(errors), intent(inout), optional, target :: err
    -
    3899 end subroutine
    -
    3900
    -
    3901 module subroutine solve_least_squares_vec_pvt_cmplx(a, b, ipvt, arnk, &
    -
    3902 work, olwork, rwork, err)
    -
    3903 complex(real64), intent(inout), dimension(:,:) :: a
    -
    3904 complex(real64), intent(inout), dimension(:) :: b
    -
    3905 integer(int32), intent(inout), target, optional, dimension(:) :: ipvt
    -
    3906 integer(int32), intent(out), optional :: arnk
    -
    3907 complex(real64), intent(out), target, optional, dimension(:) :: work
    -
    3908 integer(int32), intent(out), optional :: olwork
    -
    3909 real(real64), intent(out), target, optional, dimension(:) :: rwork
    -
    3910 class(errors), intent(inout), optional, target :: err
    -
    3911 end subroutine
    -
    3912
    -
    3913 module subroutine solve_least_squares_mtx_svd(a, b, s, arnk, work, olwork, err)
    -
    3914 real(real64), intent(inout), dimension(:,:) :: a, b
    -
    3915 integer(int32), intent(out), optional :: arnk
    -
    3916 real(real64), intent(out), target, optional, dimension(:) :: work, s
    -
    3917 integer(int32), intent(out), optional :: olwork
    -
    3918 class(errors), intent(inout), optional, target :: err
    -
    3919 end subroutine
    -
    3920
    -
    3921 module subroutine solve_least_squares_mtx_svd_cmplx(a, b, s, arnk, work, &
    -
    3922 olwork, rwork, err)
    -
    3923 complex(real64), intent(inout), dimension(:,:) :: a, b
    -
    3924 integer(int32), intent(out), optional :: arnk
    -
    3925 complex(real64), intent(out), target, optional, dimension(:) :: work
    -
    3926 real(real64), intent(out), target, optional, dimension(:) :: rwork, s
    -
    3927 integer(int32), intent(out), optional :: olwork
    -
    3928 class(errors), intent(inout), optional, target :: err
    -
    3929 end subroutine
    -
    3930
    -
    3931 module subroutine solve_least_squares_vec_svd(a, b, s, arnk, work, olwork, err)
    -
    3932 real(real64), intent(inout), dimension(:,:) :: a
    -
    3933 real(real64), intent(inout), dimension(:) :: b
    -
    3934 integer(int32), intent(out), optional :: arnk
    -
    3935 real(real64), intent(out), target, optional, dimension(:) :: work, s
    -
    3936 integer(int32), intent(out), optional :: olwork
    -
    3937 class(errors), intent(inout), optional, target :: err
    -
    3938 end subroutine
    -
    3939
    -
    3940 module subroutine solve_least_squares_vec_svd_cmplx(a, b, s, arnk, work, &
    -
    3941 olwork, rwork, err)
    -
    3942 complex(real64), intent(inout), dimension(:,:) :: a
    -
    3943 complex(real64), intent(inout), dimension(:) :: b
    -
    3944 integer(int32), intent(out), optional :: arnk
    -
    3945 complex(real64), intent(out), target, optional, dimension(:) :: work
    -
    3946 real(real64), intent(out), target, optional, dimension(:) :: rwork, s
    -
    3947 integer(int32), intent(out), optional :: olwork
    -
    3948 class(errors), intent(inout), optional, target :: err
    -
    3949 end subroutine
    -
    3950
    -
    3951 module subroutine mtx_inverse_dbl(a, iwork, work, olwork, err)
    -
    3952 real(real64), intent(inout), dimension(:,:) :: a
    -
    3953 integer(int32), intent(out), target, optional, dimension(:) :: iwork
    -
    3954 real(real64), intent(out), target, optional, dimension(:) :: work
    -
    3955 integer(int32), intent(out), optional :: olwork
    +
    3873 real(real64), intent(in), dimension(:) :: tau
    +
    3874 real(real64), intent(out), target, optional, dimension(:) :: work
    +
    3875 integer(int32), intent(out), optional :: olwork
    +
    3876 class(errors), intent(inout), optional, target :: err
    +
    3877 end subroutine
    +
    3878
    +
    3879 module subroutine solve_qr_no_pivot_mtx_cmplx(a, tau, b, work, olwork, err)
    +
    3880 complex(real64), intent(inout), dimension(:,:) :: a, b
    +
    3881 complex(real64), intent(in), dimension(:) :: tau
    +
    3882 complex(real64), intent(out), target, optional, dimension(:) :: work
    +
    3883 integer(int32), intent(out), optional :: olwork
    +
    3884 class(errors), intent(inout), optional, target :: err
    +
    3885 end subroutine
    +
    3886
    +
    3887 module subroutine solve_qr_no_pivot_vec(a, tau, b, work, olwork, err)
    +
    3888 real(real64), intent(inout), dimension(:,:) :: a
    +
    3889 real(real64), intent(in), dimension(:) :: tau
    +
    3890 real(real64), intent(inout), dimension(:) :: b
    +
    3891 real(real64), intent(out), target, optional, dimension(:) :: work
    +
    3892 integer(int32), intent(out), optional :: olwork
    +
    3893 class(errors), intent(inout), optional, target :: err
    +
    3894 end subroutine
    +
    3895
    +
    3896 module subroutine solve_qr_no_pivot_vec_cmplx(a, tau, b, work, olwork, err)
    +
    3897 complex(real64), intent(inout), dimension(:,:) :: a
    +
    3898 complex(real64), intent(in), dimension(:) :: tau
    +
    3899 complex(real64), intent(inout), dimension(:) :: b
    +
    3900 complex(real64), intent(out), target, optional, dimension(:) :: work
    +
    3901 integer(int32), intent(out), optional :: olwork
    +
    3902 class(errors), intent(inout), optional, target :: err
    +
    3903 end subroutine
    +
    3904
    +
    3905 module subroutine solve_qr_pivot_mtx(a, tau, jpvt, b, work, olwork, err)
    +
    3906 real(real64), intent(inout), dimension(:,:) :: a
    +
    3907 real(real64), intent(in), dimension(:) :: tau
    +
    3908 integer(int32), intent(in), dimension(:) :: jpvt
    +
    3909 real(real64), intent(inout), dimension(:,:) :: b
    +
    3910 real(real64), intent(out), target, optional, dimension(:) :: work
    +
    3911 integer(int32), intent(out), optional :: olwork
    +
    3912 class(errors), intent(inout), optional, target :: err
    +
    3913 end subroutine
    +
    3914
    +
    3915 module subroutine solve_qr_pivot_mtx_cmplx(a, tau, jpvt, b, work, olwork, err)
    +
    3916 complex(real64), intent(inout), dimension(:,:) :: a
    +
    3917 complex(real64), intent(in), dimension(:) :: tau
    +
    3918 integer(int32), intent(in), dimension(:) :: jpvt
    +
    3919 complex(real64), intent(inout), dimension(:,:) :: b
    +
    3920 complex(real64), intent(out), target, optional, dimension(:) :: work
    +
    3921 integer(int32), intent(out), optional :: olwork
    +
    3922 class(errors), intent(inout), optional, target :: err
    +
    3923 end subroutine
    +
    3924
    +
    3925 module subroutine solve_qr_pivot_vec(a, tau, jpvt, b, work, olwork, err)
    +
    3926 real(real64), intent(inout), dimension(:,:) :: a
    +
    3927 real(real64), intent(in), dimension(:) :: tau
    +
    3928 integer(int32), intent(in), dimension(:) :: jpvt
    +
    3929 real(real64), intent(inout), dimension(:) :: b
    +
    3930 real(real64), intent(out), target, optional, dimension(:) :: work
    +
    3931 integer(int32), intent(out), optional :: olwork
    +
    3932 class(errors), intent(inout), optional, target :: err
    +
    3933 end subroutine
    +
    3934
    +
    3935 module subroutine solve_qr_pivot_vec_cmplx(a, tau, jpvt, b, work, olwork, err)
    +
    3936 complex(real64), intent(inout), dimension(:,:) :: a
    +
    3937 complex(real64), intent(in), dimension(:) :: tau
    +
    3938 integer(int32), intent(in), dimension(:) :: jpvt
    +
    3939 complex(real64), intent(inout), dimension(:) :: b
    +
    3940 complex(real64), intent(out), target, optional, dimension(:) :: work
    +
    3941 integer(int32), intent(out), optional :: olwork
    +
    3942 class(errors), intent(inout), optional, target :: err
    +
    3943 end subroutine
    +
    3944
    +
    3945 module subroutine solve_cholesky_mtx(upper, a, b, err)
    +
    3946 logical, intent(in) :: upper
    +
    3947 real(real64), intent(in), dimension(:,:) :: a
    +
    3948 real(real64), intent(inout), dimension(:,:) :: b
    +
    3949 class(errors), intent(inout), optional, target :: err
    +
    3950 end subroutine
    +
    3951
    +
    3952 module subroutine solve_cholesky_mtx_cmplx(upper, a, b, err)
    +
    3953 logical, intent(in) :: upper
    +
    3954 complex(real64), intent(in), dimension(:,:) :: a
    +
    3955 complex(real64), intent(inout), dimension(:,:) :: b
    3956 class(errors), intent(inout), optional, target :: err
    3957 end subroutine
    -
    3958
    -
    3959 module subroutine mtx_inverse_cmplx(a, iwork, work, olwork, err)
    -
    3960 complex(real64), intent(inout), dimension(:,:) :: a
    -
    3961 integer(int32), intent(out), target, optional, dimension(:) :: iwork
    -
    3962 complex(real64), intent(out), target, optional, dimension(:) :: work
    -
    3963 integer(int32), intent(out), optional :: olwork
    -
    3964 class(errors), intent(inout), optional, target :: err
    -
    3965 end subroutine
    -
    3966
    -
    3967 module subroutine mtx_pinverse_dbl(a, ainv, tol, work, olwork, err)
    -
    3968 real(real64), intent(inout), dimension(:,:) :: a
    -
    3969 real(real64), intent(out), dimension(:,:) :: ainv
    -
    3970 real(real64), intent(in), optional :: tol
    -
    3971 real(real64), intent(out), target, dimension(:), optional :: work
    -
    3972 integer(int32), intent(out), optional :: olwork
    -
    3973 class(errors), intent(inout), optional, target :: err
    -
    3974 end subroutine
    -
    3975
    -
    3976 module subroutine mtx_pinverse_cmplx(a, ainv, tol, work, olwork, rwork, err)
    -
    3977 complex(real64), intent(inout), dimension(:,:) :: a
    -
    3978 complex(real64), intent(out), dimension(:,:) :: ainv
    -
    3979 real(real64), intent(in), optional :: tol
    -
    3980 complex(real64), intent(out), target, dimension(:), optional :: work
    -
    3981 integer(int32), intent(out), optional :: olwork
    -
    3982 real(real64), intent(out), target, dimension(:), optional :: rwork
    -
    3983 class(errors), intent(inout), optional, target :: err
    -
    3984 end subroutine
    -
    3985
    -
    3986end interface
    -
    3987
    -
    3988! ******************************************************************************
    -
    3989! LINALG_EIGEN.F90
    -
    3990! ------------------------------------------------------------------------------
    -
    3991interface
    -
    3992 module subroutine eigen_symm(vecs, a, vals, work, olwork, err)
    -
    3993 logical, intent(in) :: vecs
    -
    3994 real(real64), intent(inout), dimension(:,:) :: a
    -
    3995 real(real64), intent(out), dimension(:) :: vals
    -
    3996 real(real64), intent(out), pointer, optional, dimension(:) :: work
    -
    3997 integer(int32), intent(out), optional :: olwork
    -
    3998 class(errors), intent(inout), optional, target :: err
    -
    3999 end subroutine
    -
    4000
    -
    4001 module subroutine eigen_asymm(a, vals, vecs, work, olwork, err)
    -
    4002 real(real64), intent(inout), dimension(:,:) :: a
    -
    4003 complex(real64), intent(out), dimension(:) :: vals
    -
    4004 complex(real64), intent(out), optional, dimension(:,:) :: vecs
    -
    4005 real(real64), intent(out), pointer, optional, dimension(:) :: work
    -
    4006 integer(int32), intent(out), optional :: olwork
    -
    4007 class(errors), intent(inout), optional, target :: err
    -
    4008 end subroutine
    -
    4009
    -
    4010 module subroutine eigen_gen(a, b, alpha, beta, vecs, work, olwork, err)
    -
    4011 real(real64), intent(inout), dimension(:,:) :: a, b
    -
    4012 complex(real64), intent(out), dimension(:) :: alpha
    -
    4013 real(real64), intent(out), optional, dimension(:) :: beta
    -
    4014 complex(real64), intent(out), optional, dimension(:,:) :: vecs
    -
    4015 real(real64), intent(out), optional, pointer, dimension(:) :: work
    -
    4016 integer(int32), intent(out), optional :: olwork
    -
    4017 class(errors), intent(inout), optional, target :: err
    -
    4018 end subroutine
    -
    4019
    -
    4020 module subroutine eigen_cmplx(a, vals, vecs, work, olwork, rwork, err)
    -
    4021 complex(real64), intent(inout), dimension(:,:) :: a
    -
    4022 complex(real64), intent(out), dimension(:) :: vals
    -
    4023 complex(real64), intent(out), optional, dimension(:,:) :: vecs
    -
    4024 complex(real64), intent(out), target, optional, dimension(:) :: work
    -
    4025 real(real64), intent(out), target, optional, dimension(:) :: rwork
    -
    4026 integer(int32), intent(out), optional :: olwork
    -
    4027 class(errors), intent(inout), optional, target :: err
    -
    4028 end subroutine
    -
    4029end interface
    -
    4030
    -
    4031! ******************************************************************************
    -
    4032! LINALG_SORTING.F90
    -
    4033! ------------------------------------------------------------------------------
    -
    4034interface
    -
    4035 module subroutine sort_dbl_array(x, ascend)
    -
    4036 real(real64), intent(inout), dimension(:) :: x
    -
    4037 logical, intent(in), optional :: ascend
    -
    4038 end subroutine
    -
    4039
    -
    4040 module subroutine sort_dbl_array_ind(x, ind, ascend, err)
    -
    4041 real(real64), intent(inout), dimension(:) :: x
    -
    4042 integer(int32), intent(inout), dimension(:) :: ind
    -
    4043 logical, intent(in), optional :: ascend
    -
    4044 class(errors), intent(inout), optional, target :: err
    -
    4045 end subroutine
    -
    4046
    -
    4047 module subroutine sort_cmplx_array(x, ascend)
    -
    4048 complex(real64), intent(inout), dimension(:) :: x
    -
    4049 logical, intent(in), optional :: ascend
    -
    4050 end subroutine
    -
    4051
    -
    4052 module subroutine sort_cmplx_array_ind(x, ind, ascend, err)
    -
    4053 complex(real64), intent(inout), dimension(:) :: x
    -
    4054 integer(int32), intent(inout), dimension(:) :: ind
    -
    4055 logical, intent(in), optional :: ascend
    -
    4056 class(errors), intent(inout), optional, target :: err
    -
    4057 end subroutine
    -
    4058
    -
    4059 module subroutine sort_eigen_cmplx(vals, vecs, ascend, err)
    -
    4060 complex(real64), intent(inout), dimension(:) :: vals
    -
    4061 complex(real64), intent(inout), dimension(:,:) :: vecs
    -
    4062 logical, intent(in), optional :: ascend
    -
    4063 class(errors), intent(inout), optional, target :: err
    -
    4064 end subroutine
    -
    4065
    -
    4066 module subroutine sort_eigen_dbl(vals, vecs, ascend, err)
    -
    4067 real(real64), intent(inout), dimension(:) :: vals
    -
    4068 real(real64), intent(inout), dimension(:,:) :: vecs
    -
    4069 logical, intent(in), optional :: ascend
    -
    4070 class(errors), intent(inout), optional, target :: err
    -
    4071 end subroutine
    -
    4072
    -
    4073end interface
    -
    4074
    -
    4075end module
    -
    Computes the Cholesky factorization of a symmetric, positive definite matrix.
    Definition: linalg.f90:1432
    -
    Computes the rank 1 downdate to a Cholesky factored matrix (upper triangular).
    Definition: linalg.f90:1638
    -
    Computes the rank 1 update to a Cholesky factored matrix (upper triangular).
    Definition: linalg.f90:1531
    -
    Computes the determinant of a square matrix.
    Definition: linalg.f90:434
    -
    Multiplies a diagonal matrix with another matrix or array.
    Definition: linalg.f90:329
    -
    Computes the eigenvalues, and optionally the eigenvectors, of a matrix.
    Definition: linalg.f90:3097
    -
    Extracts the L and U matrices from the condensed [L\U] storage format used by the lu_factor.
    Definition: linalg.f90:717
    -
    Forms the full M-by-M orthogonal matrix Q from the elementary reflectors returned by the base QR fact...
    Definition: linalg.f90:1031
    -
    Computes the LU factorization of an M-by-N matrix.
    Definition: linalg.f90:595
    -
    Computes the inverse of a square matrix.
    Definition: linalg.f90:2777
    -
    Performs the matrix operation: .
    Definition: linalg.f90:159
    -
    Computes the Moore-Penrose pseudo-inverse of a M-by-N matrix using the singular value decomposition o...
    Definition: linalg.f90:2883
    -
    Computes the rank of a matrix.
    Definition: linalg.f90:401
    -
    Multiplies a general matrix by the orthogonal matrix Q from a QR factorization.
    Definition: linalg.f90:1184
    -
    Multiplies a general matrix by the orthogonal matrix Z from an RZ factorization.
    Definition: linalg.f90:1802
    -
    Computes the QR factorization of an M-by-N matrix.
    Definition: linalg.f90:871
    -
    Computes the rank 1 update to an M-by-N QR factored matrix A (M >= N) where , and such that .
    Definition: linalg.f90:1333
    -
    Performs the rank-1 update to matrix A such that: , where is an M-by-N matrix, is a scalar,...
    Definition: linalg.f90:194
    -
    Multiplies a vector by the reciprocal of a real scalar.
    Definition: linalg.f90:475
    -
    Factors an upper trapezoidal matrix by means of orthogonal transformations such that ....
    Definition: linalg.f90:1711
    -
    Solves a system of Cholesky factored equations.
    Definition: linalg.f90:2389
    -
    Solves the overdetermined or underdetermined system of M equations of N unknowns,...
    Definition: linalg.f90:2580
    -
    Solves the overdetermined or underdetermined system of M equations of N unknowns using a singular va...
    Definition: linalg.f90:2682
    -
    Solves the overdetermined or underdetermined system of M equations of N unknowns....
    Definition: linalg.f90:2479
    -
    Solves a system of LU-factored equations.
    Definition: linalg.f90:2148
    -
    Solves a system of M QR-factored equations of N unknowns.
    Definition: linalg.f90:2283
    -
    Solves a triangular system of equations.
    Definition: linalg.f90:2060
    -
    Sorts an array.
    Definition: linalg.f90:3180
    -
    Computes the singular value decomposition of a matrix A. The SVD is defined as: , where is an M-by-M...
    Definition: linalg.f90:1926
    -
    Swaps the contents of two arrays.
    Definition: linalg.f90:456
    -
    Computes the trace of a matrix (the sum of the main diagonal elements).
    Definition: linalg.f90:353
    -
    Computes the triangular matrix operation: , or , where A is a triangular matrix.
    Definition: linalg.f90:509
    -
    Provides a set of common linear algebra routines.
    Definition: linalg.f90:15
    +
    3958
    +
    3959 module subroutine solve_cholesky_vec(upper, a, b, err)
    +
    3960 logical, intent(in) :: upper
    +
    3961 real(real64), intent(in), dimension(:,:) :: a
    +
    3962 real(real64), intent(inout), dimension(:) :: b
    +
    3963 class(errors), intent(inout), optional, target :: err
    +
    3964 end subroutine
    +
    3965
    +
    3966 module subroutine solve_cholesky_vec_cmplx(upper, a, b, err)
    +
    3967 logical, intent(in) :: upper
    +
    3968 complex(real64), intent(in), dimension(:,:) :: a
    +
    3969 complex(real64), intent(inout), dimension(:) :: b
    +
    3970 class(errors), intent(inout), optional, target :: err
    +
    3971 end subroutine
    +
    3972
    +
    3973 module subroutine solve_least_squares_mtx(a, b, work, olwork, err)
    +
    3974 real(real64), intent(inout), dimension(:,:) :: a, b
    +
    3975 real(real64), intent(out), target, optional, dimension(:) :: work
    +
    3976 integer(int32), intent(out), optional :: olwork
    +
    3977 class(errors), intent(inout), optional, target :: err
    +
    3978 end subroutine
    +
    3979
    +
    3980 module subroutine solve_least_squares_mtx_cmplx(a, b, work, olwork, err)
    +
    3981 complex(real64), intent(inout), dimension(:,:) :: a, b
    +
    3982 complex(real64), intent(out), target, optional, dimension(:) :: work
    +
    3983 integer(int32), intent(out), optional :: olwork
    +
    3984 class(errors), intent(inout), optional, target :: err
    +
    3985 end subroutine
    +
    3986
    +
    3987 module subroutine solve_least_squares_vec(a, b, work, olwork, err)
    +
    3988 real(real64), intent(inout), dimension(:,:) :: a
    +
    3989 real(real64), intent(inout), dimension(:) :: b
    +
    3990 real(real64), intent(out), target, optional, dimension(:) :: work
    +
    3991 integer(int32), intent(out), optional :: olwork
    +
    3992 class(errors), intent(inout), optional, target :: err
    +
    3993 end subroutine
    +
    3994
    +
    3995 module subroutine solve_least_squares_vec_cmplx(a, b, work, olwork, err)
    +
    3996 complex(real64), intent(inout), dimension(:,:) :: a
    +
    3997 complex(real64), intent(inout), dimension(:) :: b
    +
    3998 complex(real64), intent(out), target, optional, dimension(:) :: work
    +
    3999 integer(int32), intent(out), optional :: olwork
    +
    4000 class(errors), intent(inout), optional, target :: err
    +
    4001 end subroutine
    +
    4002
    +
    4003 module subroutine solve_least_squares_mtx_pvt(a, b, ipvt, arnk, work, olwork, err)
    +
    4004 real(real64), intent(inout), dimension(:,:) :: a, b
    +
    4005 integer(int32), intent(inout), target, optional, dimension(:) :: ipvt
    +
    4006 integer(int32), intent(out), optional :: arnk
    +
    4007 real(real64), intent(out), target, optional, dimension(:) :: work
    +
    4008 integer(int32), intent(out), optional :: olwork
    +
    4009 class(errors), intent(inout), optional, target :: err
    +
    4010 end subroutine
    +
    4011
    +
    4012 module subroutine solve_least_squares_mtx_pvt_cmplx(a, b, ipvt, arnk, &
    +
    4013 work, olwork, rwork, err)
    +
    4014 complex(real64), intent(inout), dimension(:,:) :: a, b
    +
    4015 integer(int32), intent(inout), target, optional, dimension(:) :: ipvt
    +
    4016 integer(int32), intent(out), optional :: arnk
    +
    4017 complex(real64), intent(out), target, optional, dimension(:) :: work
    +
    4018 integer(int32), intent(out), optional :: olwork
    +
    4019 real(real64), intent(out), target, optional, dimension(:) :: rwork
    +
    4020 class(errors), intent(inout), optional, target :: err
    +
    4021 end subroutine
    +
    4022
    +
    4023 module subroutine solve_least_squares_vec_pvt(a, b, ipvt, arnk, work, olwork, err)
    +
    4024 real(real64), intent(inout), dimension(:,:) :: a
    +
    4025 real(real64), intent(inout), dimension(:) :: b
    +
    4026 integer(int32), intent(inout), target, optional, dimension(:) :: ipvt
    +
    4027 integer(int32), intent(out), optional :: arnk
    +
    4028 real(real64), intent(out), target, optional, dimension(:) :: work
    +
    4029 integer(int32), intent(out), optional :: olwork
    +
    4030 class(errors), intent(inout), optional, target :: err
    +
    4031 end subroutine
    +
    4032
    +
    4033 module subroutine solve_least_squares_vec_pvt_cmplx(a, b, ipvt, arnk, &
    +
    4034 work, olwork, rwork, err)
    +
    4035 complex(real64), intent(inout), dimension(:,:) :: a
    +
    4036 complex(real64), intent(inout), dimension(:) :: b
    +
    4037 integer(int32), intent(inout), target, optional, dimension(:) :: ipvt
    +
    4038 integer(int32), intent(out), optional :: arnk
    +
    4039 complex(real64), intent(out), target, optional, dimension(:) :: work
    +
    4040 integer(int32), intent(out), optional :: olwork
    +
    4041 real(real64), intent(out), target, optional, dimension(:) :: rwork
    +
    4042 class(errors), intent(inout), optional, target :: err
    +
    4043 end subroutine
    +
    4044
    +
    4045 module subroutine solve_least_squares_mtx_svd(a, b, s, arnk, work, olwork, err)
    +
    4046 real(real64), intent(inout), dimension(:,:) :: a, b
    +
    4047 integer(int32), intent(out), optional :: arnk
    +
    4048 real(real64), intent(out), target, optional, dimension(:) :: work, s
    +
    4049 integer(int32), intent(out), optional :: olwork
    +
    4050 class(errors), intent(inout), optional, target :: err
    +
    4051 end subroutine
    +
    4052
    +
    4053 module subroutine solve_least_squares_mtx_svd_cmplx(a, b, s, arnk, work, &
    +
    4054 olwork, rwork, err)
    +
    4055 complex(real64), intent(inout), dimension(:,:) :: a, b
    +
    4056 integer(int32), intent(out), optional :: arnk
    +
    4057 complex(real64), intent(out), target, optional, dimension(:) :: work
    +
    4058 real(real64), intent(out), target, optional, dimension(:) :: rwork, s
    +
    4059 integer(int32), intent(out), optional :: olwork
    +
    4060 class(errors), intent(inout), optional, target :: err
    +
    4061 end subroutine
    +
    4062
    +
    4063 module subroutine solve_least_squares_vec_svd(a, b, s, arnk, work, olwork, err)
    +
    4064 real(real64), intent(inout), dimension(:,:) :: a
    +
    4065 real(real64), intent(inout), dimension(:) :: b
    +
    4066 integer(int32), intent(out), optional :: arnk
    +
    4067 real(real64), intent(out), target, optional, dimension(:) :: work, s
    +
    4068 integer(int32), intent(out), optional :: olwork
    +
    4069 class(errors), intent(inout), optional, target :: err
    +
    4070 end subroutine
    +
    4071
    +
    4072 module subroutine solve_least_squares_vec_svd_cmplx(a, b, s, arnk, work, &
    +
    4073 olwork, rwork, err)
    +
    4074 complex(real64), intent(inout), dimension(:,:) :: a
    +
    4075 complex(real64), intent(inout), dimension(:) :: b
    +
    4076 integer(int32), intent(out), optional :: arnk
    +
    4077 complex(real64), intent(out), target, optional, dimension(:) :: work
    +
    4078 real(real64), intent(out), target, optional, dimension(:) :: rwork, s
    +
    4079 integer(int32), intent(out), optional :: olwork
    +
    4080 class(errors), intent(inout), optional, target :: err
    +
    4081 end subroutine
    +
    4082
    +
    4083 module subroutine mtx_inverse_dbl(a, iwork, work, olwork, err)
    +
    4084 real(real64), intent(inout), dimension(:,:) :: a
    +
    4085 integer(int32), intent(out), target, optional, dimension(:) :: iwork
    +
    4086 real(real64), intent(out), target, optional, dimension(:) :: work
    +
    4087 integer(int32), intent(out), optional :: olwork
    +
    4088 class(errors), intent(inout), optional, target :: err
    +
    4089 end subroutine
    +
    4090
    +
    4091 module subroutine mtx_inverse_cmplx(a, iwork, work, olwork, err)
    +
    4092 complex(real64), intent(inout), dimension(:,:) :: a
    +
    4093 integer(int32), intent(out), target, optional, dimension(:) :: iwork
    +
    4094 complex(real64), intent(out), target, optional, dimension(:) :: work
    +
    4095 integer(int32), intent(out), optional :: olwork
    +
    4096 class(errors), intent(inout), optional, target :: err
    +
    4097 end subroutine
    +
    4098
    +
    4099 module subroutine mtx_pinverse_dbl(a, ainv, tol, work, olwork, err)
    +
    4100 real(real64), intent(inout), dimension(:,:) :: a
    +
    4101 real(real64), intent(out), dimension(:,:) :: ainv
    +
    4102 real(real64), intent(in), optional :: tol
    +
    4103 real(real64), intent(out), target, dimension(:), optional :: work
    +
    4104 integer(int32), intent(out), optional :: olwork
    +
    4105 class(errors), intent(inout), optional, target :: err
    +
    4106 end subroutine
    +
    4107
    +
    4108 module subroutine mtx_pinverse_cmplx(a, ainv, tol, work, olwork, rwork, err)
    +
    4109 complex(real64), intent(inout), dimension(:,:) :: a
    +
    4110 complex(real64), intent(out), dimension(:,:) :: ainv
    +
    4111 real(real64), intent(in), optional :: tol
    +
    4112 complex(real64), intent(out), target, dimension(:), optional :: work
    +
    4113 integer(int32), intent(out), optional :: olwork
    +
    4114 real(real64), intent(out), target, dimension(:), optional :: rwork
    +
    4115 class(errors), intent(inout), optional, target :: err
    +
    4116 end subroutine
    +
    4117
    +
    4118end interface
    +
    4119
    +
    4120! ******************************************************************************
    +
    4121! LINALG_EIGEN.F90
    +
    4122! ------------------------------------------------------------------------------
    +
    4123interface
    +
    4124 module subroutine eigen_symm(vecs, a, vals, work, olwork, err)
    +
    4125 logical, intent(in) :: vecs
    +
    4126 real(real64), intent(inout), dimension(:,:) :: a
    +
    4127 real(real64), intent(out), dimension(:) :: vals
    +
    4128 real(real64), intent(out), pointer, optional, dimension(:) :: work
    +
    4129 integer(int32), intent(out), optional :: olwork
    +
    4130 class(errors), intent(inout), optional, target :: err
    +
    4131 end subroutine
    +
    4132
    +
    4133 module subroutine eigen_asymm(a, vals, vecs, work, olwork, err)
    +
    4134 real(real64), intent(inout), dimension(:,:) :: a
    +
    4135 complex(real64), intent(out), dimension(:) :: vals
    +
    4136 complex(real64), intent(out), optional, dimension(:,:) :: vecs
    +
    4137 real(real64), intent(out), pointer, optional, dimension(:) :: work
    +
    4138 integer(int32), intent(out), optional :: olwork
    +
    4139 class(errors), intent(inout), optional, target :: err
    +
    4140 end subroutine
    +
    4141
    +
    4142 module subroutine eigen_gen(a, b, alpha, beta, vecs, work, olwork, err)
    +
    4143 real(real64), intent(inout), dimension(:,:) :: a, b
    +
    4144 complex(real64), intent(out), dimension(:) :: alpha
    +
    4145 real(real64), intent(out), optional, dimension(:) :: beta
    +
    4146 complex(real64), intent(out), optional, dimension(:,:) :: vecs
    +
    4147 real(real64), intent(out), optional, pointer, dimension(:) :: work
    +
    4148 integer(int32), intent(out), optional :: olwork
    +
    4149 class(errors), intent(inout), optional, target :: err
    +
    4150 end subroutine
    +
    4151
    +
    4152 module subroutine eigen_cmplx(a, vals, vecs, work, olwork, rwork, err)
    +
    4153 complex(real64), intent(inout), dimension(:,:) :: a
    +
    4154 complex(real64), intent(out), dimension(:) :: vals
    +
    4155 complex(real64), intent(out), optional, dimension(:,:) :: vecs
    +
    4156 complex(real64), intent(out), target, optional, dimension(:) :: work
    +
    4157 real(real64), intent(out), target, optional, dimension(:) :: rwork
    +
    4158 integer(int32), intent(out), optional :: olwork
    +
    4159 class(errors), intent(inout), optional, target :: err
    +
    4160 end subroutine
    +
    4161end interface
    +
    4162
    +
    4163! ******************************************************************************
    +
    4164! LINALG_SORTING.F90
    +
    4165! ------------------------------------------------------------------------------
    +
    4166interface
    +
    4167 module subroutine sort_dbl_array(x, ascend)
    +
    4168 real(real64), intent(inout), dimension(:) :: x
    +
    4169 logical, intent(in), optional :: ascend
    +
    4170 end subroutine
    +
    4171
    +
    4172 module subroutine sort_dbl_array_ind(x, ind, ascend, err)
    +
    4173 real(real64), intent(inout), dimension(:) :: x
    +
    4174 integer(int32), intent(inout), dimension(:) :: ind
    +
    4175 logical, intent(in), optional :: ascend
    +
    4176 class(errors), intent(inout), optional, target :: err
    +
    4177 end subroutine
    +
    4178
    +
    4179 module subroutine sort_cmplx_array(x, ascend)
    +
    4180 complex(real64), intent(inout), dimension(:) :: x
    +
    4181 logical, intent(in), optional :: ascend
    +
    4182 end subroutine
    +
    4183
    +
    4184 module subroutine sort_cmplx_array_ind(x, ind, ascend, err)
    +
    4185 complex(real64), intent(inout), dimension(:) :: x
    +
    4186 integer(int32), intent(inout), dimension(:) :: ind
    +
    4187 logical, intent(in), optional :: ascend
    +
    4188 class(errors), intent(inout), optional, target :: err
    +
    4189 end subroutine
    +
    4190
    +
    4191 module subroutine sort_eigen_cmplx(vals, vecs, ascend, err)
    +
    4192 complex(real64), intent(inout), dimension(:) :: vals
    +
    4193 complex(real64), intent(inout), dimension(:,:) :: vecs
    +
    4194 logical, intent(in), optional :: ascend
    +
    4195 class(errors), intent(inout), optional, target :: err
    +
    4196 end subroutine
    +
    4197
    +
    4198 module subroutine sort_eigen_dbl(vals, vecs, ascend, err)
    +
    4199 real(real64), intent(inout), dimension(:) :: vals
    +
    4200 real(real64), intent(inout), dimension(:,:) :: vecs
    +
    4201 logical, intent(in), optional :: ascend
    +
    4202 class(errors), intent(inout), optional, target :: err
    +
    4203 end subroutine
    +
    4204
    +
    4205end interface
    +
    4206
    +
    4207end module
    +
    Computes the Cholesky factorization of a symmetric, positive definite matrix.
    Definition: linalg.f90:1563
    +
    Computes the rank 1 downdate to a Cholesky factored matrix (upper triangular).
    Definition: linalg.f90:1769
    +
    Computes the rank 1 update to a Cholesky factored matrix (upper triangular).
    Definition: linalg.f90:1662
    +
    Computes the determinant of a square matrix.
    Definition: linalg.f90:564
    +
    Multiplies a diagonal matrix with another matrix or array.
    Definition: linalg.f90:459
    +
    Computes the eigenvalues, and optionally the eigenvectors, of a matrix.
    Definition: linalg.f90:3229
    +
    Extracts the L and U matrices from the condensed [L\U] storage format used by the lu_factor.
    Definition: linalg.f90:847
    +
    Forms the full M-by-M orthogonal matrix Q from the elementary reflectors returned by the base QR fact...
    Definition: linalg.f90:1161
    +
    Computes the LU factorization of an M-by-N matrix.
    Definition: linalg.f90:725
    +
    Computes the inverse of a square matrix.
    Definition: linalg.f90:2909
    +
    Performs the matrix operation: .
    Definition: linalg.f90:289
    +
    Computes the Moore-Penrose pseudo-inverse of a M-by-N matrix using the singular value decomposition o...
    Definition: linalg.f90:3015
    +
    Computes the rank of a matrix.
    Definition: linalg.f90:531
    +
    Multiplies a general matrix by the orthogonal matrix Q from a QR factorization.
    Definition: linalg.f90:1314
    +
    Multiplies a general matrix by the orthogonal matrix Z from an RZ factorization.
    Definition: linalg.f90:1933
    +
    Computes the QR factorization of an M-by-N matrix.
    Definition: linalg.f90:1001
    +
    Computes the rank 1 update to an M-by-N QR factored matrix A (M >= N) where , and such that ....
    Definition: linalg.f90:1464
    +
    Performs the rank-1 update to matrix A such that: , where is an M-by-N matrix, is a scalar,...
    Definition: linalg.f90:324
    +
    Multiplies a vector by the reciprocal of a real scalar.
    Definition: linalg.f90:605
    +
    Factors an upper trapezoidal matrix by means of orthogonal transformations such that ....
    Definition: linalg.f90:1842
    +
    Solves a system of Cholesky factored equations.
    Definition: linalg.f90:2521
    +
    Solves the overdetermined or underdetermined system of M equations of N unknowns,...
    Definition: linalg.f90:2712
    +
    Solves the overdetermined or underdetermined system of M equations of N unknowns using a singular va...
    Definition: linalg.f90:2814
    +
    Solves the overdetermined or underdetermined system of M equations of N unknowns....
    Definition: linalg.f90:2611
    +
    Solves a system of LU-factored equations.
    Definition: linalg.f90:2280
    +
    Solves a system of M QR-factored equations of N unknowns.
    Definition: linalg.f90:2415
    +
    Solves a triangular system of equations.
    Definition: linalg.f90:2192
    +
    Sorts an array.
    Definition: linalg.f90:3312
    +
    Computes the singular value decomposition of a matrix A. The SVD is defined as: , where is an M-by-M...
    Definition: linalg.f90:2058
    +
    Swaps the contents of two arrays.
    Definition: linalg.f90:586
    +
    Computes the trace of a matrix (the sum of the main diagonal elements).
    Definition: linalg.f90:483
    +
    Computes the triangular matrix operation: , or , where A is a triangular matrix.
    Definition: linalg.f90:639
    +
    Provides a set of common linear algebra routines.
    Definition: linalg.f90:145
    diff --git a/doc/html/linalg_8h.html b/doc/html/linalg_8h.html new file mode 100644 index 00000000..0d163e24 --- /dev/null +++ b/doc/html/linalg_8h.html @@ -0,0 +1,5243 @@ + + + + + + + +linalg: D:/Code/linalg/include/linalg.h File Reference + + + + + + + + + + + + + + + +
    +
    + + + + + + +
    +
    linalg 1.6.1 +
    +
    A linear algebra library that provides a user-friendly interface to several BLAS and LAPACK routines.
    +
    +
    + + + + + + + +
    +
    + +
    +
    +
    + +
    + +
    +
    + + +
    +
    +
    +
    +
    +
    Loading...
    +
    Searching...
    +
    No Matches
    +
    +
    +
    +
    + +
    + +
    linalg.h File Reference
    +
    +
    +
    #include <stdbool.h>
    +#include <complex.h>
    +
    +Include dependency graph for linalg.h:
    +
    +
    +
    +
    +

    Go to the source code of this file.

    + + + + + + + + + + + + + + + + + + + + + + + + +

    +Macros

    #define LA_NO_OPERATION   0
     
    #define LA_TRANSPOSE   1
     
    #define LA_HERMITIAN_TRANSPOSE   2
     
    #define LA_NO_ERROR   0
     
    #define LA_INVALID_INPUT_ERROR   101
     
    #define LA_ARRAY_SIZE_ERROR   102
     
    #define LA_SINGULAR_MATRIX_ERROR   103
     
    #define LA_MATRIX_FORMAT_ERROR   104
     
    #define LA_OUT_OF_MEMORY_ERROR   105
     
    #define LA_CONVERGENCE_ERROR   106
     
    #define LA_INVALID_OPERATION_ERROR   107
     
    + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +

    +Functions

    int la_rank1_update (int m, int n, double alpha, const double *x, const double *y, double *a, int lda)
     
    int la_rank1_update_cmplx (int m, int n, double complex alpha, const double complex *x, const double complex *y, double complex *a, int lda)
     
    int la_trace (int m, int n, const double *a, int lda, double *rst)
     
    int la_trace_cmplx (int m, int n, const double complex *a, int lda, double complex *rst)
     
    int la_mtx_mult (bool transa, bool transb, int m, int n, int k, double alpha, const double *a, int lda, const double *b, int ldb, double beta, double *c, int ldc)
     
    int la_mtx_mult_cmplx (int opa, int opb, int m, int n, int k, double complex alpha, const double complex *a, int lda, const double complex *b, int ldb, double complex beta, double complex *c, int ldc)
     
    int la_diag_mtx_mult (bool lside, bool transb, int m, int n, int k, double alpha, const double *a, const double *b, int ldb, double beta, double *c, int ldc)
     
    int la_diag_mtx_mult_cmplx (bool lside, int opb, int m, int n, int k, double complex alpha, const double complex *a, const double complex *b, int ldb, double complex beta, double complex *c, int ldc)
     
    int la_diag_mtx_mult_mixed (bool lside, int opb, int m, int n, int k, double complex alpha, const double *a, const double complex *b, int ldb, double complex beta, double complex *c, int ldc)
     
    int la_rank (int m, int n, double *a, int lda, int *rnk)
     
    int la_rank_cmplx (int m, int n, double complex *a, int lda, int *rnk)
     
    int la_det (int n, double *a, int lda, double *d)
     
    int la_det_cmplx (int n, double complex *a, int lda, double complex *d)
     
    int la_tri_mtx_mult (bool upper, double alpha, int n, const double *a, int lda, double beta, double *b, int ldb)
     
    int la_tri_mtx_mult_cmplx (bool upper, double complex alpha, int n, const double complex *a, int lda, double complex beta, double complex *b, int ldb)
     
    int la_lu_factor (int m, int n, double *a, int lda, int *ipvt)
     
    int la_lu_factor_cmplx (int m, int n, double complex *a, int lda, int *ipvt)
     
    int la_form_lu (int n, double *a, int lda, int *ipvt, double *u, int ldu, double *p, int ldp)
     
    int la_form_lu_cmplx (int n, double complex *a, int lda, int *ipvt, double complex *u, int ldu, double *p, int ldp)
     
    int la_qr_factor (int m, int n, double *a, int lda, double *tau)
     
    int la_qr_factor_cmplx (int m, int n, double complex *a, int lda, double complex *tau)
     
    int la_qr_factor_pvt (int m, int n, double *a, int lda, double *tau, int *jpvt)
     
    int la_qr_factor_cmplx_pvt (int m, int n, double complex *a, int lda, double complex *tau, int *jpvt)
     
    int la_form_qr (bool fullq, int m, int n, double *r, int ldr, const double *tau, double *q, int ldq)
     
    int la_form_qr_cmplx (bool fullq, int m, int n, double complex *r, int ldr, const double complex *tau, double complex *q, int ldq)
     
    int la_form_qr_pvt (bool fullq, int m, int n, double *r, int ldr, const double *tau, const int *pvt, double *q, int ldq, double *p, int ldp)
     
    int la_form_qr_cmplx_pvt (bool fullq, int m, int n, double complex *r, int ldr, const double complex *tau, const int *pvt, double complex *q, int ldq, double complex *p, int ldp)
     
    int la_mult_qr (bool lside, bool trans, int m, int n, int k, double *a, int lda, const double *tau, double *c, int ldc)
     
    int la_mult_qr_cmplx (bool lside, bool trans, int m, int n, int k, double complex *a, int lda, const double complex *tau, double complex *c, int ldc)
     
    int la_qr_rank1_update (int m, int n, double *q, int ldq, double *r, int ldr, double *u, double *v)
     
    int la_qr_rank1_update_cmplx (int m, int n, double complex *q, int ldq, double complex *r, int ldr, double complex *u, double complex *v)
     
    int la_cholesky_factor (bool upper, int n, double *a, int lda)
     
    int la_cholesky_factor_cmplx (bool upper, int n, double complex *a, int lda)
     
    int la_cholesky_rank1_update (int n, double *r, int ldr, double *u)
     
    int la_cholesky_rank1_update_cmplx (int n, double complex *r, int ldr, double complex *u)
     
    int la_cholesky_rank1_downdate (int n, double *r, int ldr, double *u)
     
    int la_cholesky_rank1_downdate_cmplx (int n, double complex *r, int ldr, double complex *u)
     
    int la_svd (int m, int n, double *a, int lda, double *s, double *u, int ldu, double *vt, int ldv)
     
    int la_svd_cmplx (int m, int n, double complex *a, int lda, double *s, double complex *u, int ldu, double complex *vt, int ldv)
     
    int la_solve_tri_mtx (bool lside, bool upper, bool trans, bool nounit, int m, int n, double alpha, const double *a, int lda, double *b, int ldb)
     
    int la_solve_tri_mtx_cmplx (bool lside, bool upper, bool trans, bool nounit, int m, int n, double complex alpha, const double complex *a, int lda, double complex *b, int ldb)
     
    int la_solve_lu (int m, int n, const double *a, int lda, const int *ipvt, double *b, int ldb)
     
    int la_solve_lu_cmplx (int m, int n, const double complex *a, int lda, const int *ipvt, double complex *b, int ldb)
     
    int la_solve_qr (int m, int n, int k, double *a, int lda, const double *tau, double *b, int ldb)
     
    int la_solve_qr_cmplx (int m, int n, int k, double complex *a, int lda, const double complex *tau, double complex *b, int ldb)
     
    int la_solve_qr_pvt (int m, int n, int k, double *a, int lda, const double *tau, const int *jpvt, double *b, int ldb)
     
    int la_solve_qr_cmplx_pvt (int m, int n, int k, double complex *a, int lda, const double complex *tau, const int *jpvt, double complex *b, int ldb)
     
    int la_solve_cholesky (bool upper, int m, int n, const double *a, int lda, double *b, int ldb)
     
    int la_solve_cholesky_cmplx (bool upper, int m, int n, const double complex *a, int lda, double complex *b, int ldb)
     
    int la_solve_least_squares (int m, int n, int k, double *a, int lda, double *b, int ldb)
     
    int la_solve_least_squares_cmplx (int m, int n, int k, double complex *a, int lda, double complex *b, int ldb)
     
    int la_inverse (int n, double *a, int lda)
     
    int la_inverse_cmplx (int n, double complex *a, int lda)
     
    int la_pinverse (int m, int n, double *a, int lda, double *ainv, int ldai)
     
    int la_pinverse_cmplx (int m, int n, double complex *a, int lda, double complex *ainv, int ldai)
     
    int la_eigen_symm (bool vecs, int n, double *a, int lda, double *vals)
     
    int la_eigen_asymm (bool vecs, int n, double *a, int lda, double complex *vals, double complex *v, int ldv)
     
    int la_eigen_gen (bool vecs, int n, double *a, int lda, double *b, int ldb, double complex *alpha, double *beta, double complex *v, int ldv)
     
    int la_eigen_cmplx (bool vecs, int n, double complex *a, int lda, double complex *vals, double complex *v, int ldv)
     
    int la_sort_eigen (bool ascend, int n, double *vals, double *vecs, int ldv)
     
    int la_sort_eigen_cmplx (bool ascend, int n, double complex *vals, double complex *vecs, int ldv)
     
    +

    Macro Definition Documentation

    + +

    ◆ LA_ARRAY_SIZE_ERROR

    + +
    +
    + + + + +
    #define LA_ARRAY_SIZE_ERROR   102
    +
    + +

    Definition at line 13 of file linalg.h.

    + +
    +
    + +

    ◆ LA_CONVERGENCE_ERROR

    + +
    +
    + + + + +
    #define LA_CONVERGENCE_ERROR   106
    +
    + +

    Definition at line 17 of file linalg.h.

    + +
    +
    + +

    ◆ LA_HERMITIAN_TRANSPOSE

    + +
    +
    + + + + +
    #define LA_HERMITIAN_TRANSPOSE   2
    +
    + +

    Definition at line 10 of file linalg.h.

    + +
    +
    + +

    ◆ LA_INVALID_INPUT_ERROR

    + +
    +
    + + + + +
    #define LA_INVALID_INPUT_ERROR   101
    +
    + +

    Definition at line 12 of file linalg.h.

    + +
    +
    + +

    ◆ LA_INVALID_OPERATION_ERROR

    + +
    +
    + + + + +
    #define LA_INVALID_OPERATION_ERROR   107
    +
    + +

    Definition at line 18 of file linalg.h.

    + +
    +
    + +

    ◆ LA_MATRIX_FORMAT_ERROR

    + +
    +
    + + + + +
    #define LA_MATRIX_FORMAT_ERROR   104
    +
    + +

    Definition at line 15 of file linalg.h.

    + +
    +
    + +

    ◆ LA_NO_ERROR

    + +
    +
    + + + + +
    #define LA_NO_ERROR   0
    +
    + +

    Definition at line 11 of file linalg.h.

    + +
    +
    + +

    ◆ LA_NO_OPERATION

    + +
    +
    + + + + +
    #define LA_NO_OPERATION   0
    +
    + +

    Definition at line 8 of file linalg.h.

    + +
    +
    + +

    ◆ LA_OUT_OF_MEMORY_ERROR

    + +
    +
    + + + + +
    #define LA_OUT_OF_MEMORY_ERROR   105
    +
    + +

    Definition at line 16 of file linalg.h.

    + +
    +
    + +

    ◆ LA_SINGULAR_MATRIX_ERROR

    + +
    +
    + + + + +
    #define LA_SINGULAR_MATRIX_ERROR   103
    +
    + +

    Definition at line 14 of file linalg.h.

    + +
    +
    + +

    ◆ LA_TRANSPOSE

    + +
    +
    + + + + +
    #define LA_TRANSPOSE   1
    +
    + +

    Definition at line 9 of file linalg.h.

    + +
    +
    +

    Function Documentation

    + +

    ◆ la_cholesky_factor()

    + +
    +
    + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
    int la_cholesky_factor (bool upper,
    int n,
    double * a,
    int lda 
    )
    +
    +

    Computes the Cholesky factorization of a symmetric, positive definite matrix.

    +
    Parameters
    + + + + + +
    upperSet to true to compute the upper triangular factoriztion \( A = U^T U \); else, set to false to compute the lower triangular factorzation \( A = L L^T \).
    nThe dimension of matrix A.
    aOn input, the N-by-N matrix to factor. On output, the factored matrix is returned in either the upper or lower triangular portion of the matrix, dependent upon the value of upper.
    ldaThe leading dimension of matrix A.
    +
    +
    +
    Returns
    An error code. The following codes are possible.
      +
    • LA_NO_ERROR: No error occurred. Successful operation.
    • +
    • LA_INVALID_INPUT_ERROR: Occurs if lda is not correct.
    • +
    • LA_MATRIX_FORMAT_ERROR: Occurs if a is not positive definite.
    • +
    +
    + +
    +
    + +

    ◆ la_cholesky_factor_cmplx()

    + +
    +
    + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
    int la_cholesky_factor_cmplx (bool upper,
    int n,
    double complex * a,
    int lda 
    )
    +
    +

    Computes the Cholesky factorization of a symmetric, positive definite matrix.

    +
    Parameters
    + + + + + +
    upperSet to true to compute the upper triangular factoriztion \( A = U^T U \); else, set to false to compute the lower triangular factorzation \( A = L L^T \).
    nThe dimension of matrix A.
    aOn input, the N-by-N matrix to factor. On output, the factored matrix is returned in either the upper or lower triangular portion of the matrix, dependent upon the value of upper.
    ldaThe leading dimension of matrix A.
    +
    +
    +
    Returns
    An error code. The following codes are possible.
      +
    • LA_NO_ERROR: No error occurred. Successful operation.
    • +
    • LA_INVALID_INPUT_ERROR: Occurs if lda is not correct.
    • +
    • LA_MATRIX_FORMAT_ERROR: Occurs if a is not positive definite.
    • +
    +
    + +
    +
    + +

    ◆ la_cholesky_rank1_downdate()

    + +
    +
    + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
    int la_cholesky_rank1_downdate (int n,
    double * r,
    int ldr,
    double * u 
    )
    +
    +

    Computes the rank 1 downdate to a Cholesky factored matrix (upper triangular).

    +
    Parameters
    + + + + + +
    nThe dimension of the matrix.
    rOn input, the N-by-N upper triangular matrix R. On output, the updated matrix R1.
    ldrThe leading dimension of matrix R.
    uOn input, the N-element update vector U. On output, the rotation sines used to transform R to R1.
    +
    +
    +
    Returns
    An error code. The following codes are possible.
      +
    • LA_NO_ERROR: No error occurred. Successful operation.
    • +
    • LA_INVALID_INPUT_ERROR: Occurs if ldr is not correct.
    • +
    • LA_OUT_OF_MEMORY_ERROR: Occurs if local memory must be allocated, and there is insufficient memory available.
    • +
    • LA_MATRIX_FORMAT_ERROR: Occurs if the downdated matrix is not positive definite.
    • +
    +
    + +
    +
    + +

    ◆ la_cholesky_rank1_downdate_cmplx()

    + +
    +
    + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
    int la_cholesky_rank1_downdate_cmplx (int n,
    double complex * r,
    int ldr,
    double complex * u 
    )
    +
    +

    Computes the rank 1 downdate to a Cholesky factored matrix (upper triangular).

    +
    Parameters
    + + + + + +
    nThe dimension of the matrix.
    rOn input, the N-by-N upper triangular matrix R. On output, the updated matrix R1.
    ldrThe leading dimension of matrix R.
    uOn input, the N-element update vector U. On output, the rotation sines used to transform R to R1.
    +
    +
    +
    Returns
    An error code. The following codes are possible.
      +
    • LA_NO_ERROR: No error occurred. Successful operation.
    • +
    • LA_INVALID_INPUT_ERROR: Occurs if ldr is not correct.
    • +
    • LA_OUT_OF_MEMORY_ERROR: Occurs if local memory must be allocated, and there is insufficient memory available.
    • +
    • LA_MATRIX_FORMAT_ERROR: Occurs if the downdated matrix is not positive definite.
    • +
    +
    + +
    +
    + +

    ◆ la_cholesky_rank1_update()

    + +
    +
    + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
    int la_cholesky_rank1_update (int n,
    double * r,
    int ldr,
    double * u 
    )
    +
    +

    Computes the rank 1 update to a Cholesky factored matrix (upper triangular).

    +
    Parameters
    + + + + + +
    nThe dimension of the matrix.
    rOn input, the N-by-N upper triangular matrix R. On output, the updated matrix R1.
    ldrThe leading dimension of matrix R.
    uOn input, the N-element update vector U. On output, the rotation sines used to transform R to R1.
    +
    +
    +
    Returns
    An error code. The following codes are possible.
      +
    • LA_NO_ERROR: No error occurred. Successful operation.
    • +
    • LA_INVALID_INPUT_ERROR: Occurs if ldr is not correct.
    • +
    • LA_OUT_OF_MEMORY_ERROR: Occurs if local memory must be allocated, and there is insufficient memory available.
    • +
    +
    + +
    +
    + +

    ◆ la_cholesky_rank1_update_cmplx()

    + +
    +
    + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
    int la_cholesky_rank1_update_cmplx (int n,
    double complex * r,
    int ldr,
    double complex * u 
    )
    +
    +

    Computes the rank 1 update to a Cholesky factored matrix (upper triangular).

    +
    Parameters
    + + + + + +
    nThe dimension of the matrix.
    rOn input, the N-by-N upper triangular matrix R. On output, the updated matrix R1.
    ldrThe leading dimension of matrix R.
    uOn input, the N-element update vector U. On output, the rotation sines used to transform R to R1.
    +
    +
    +
    Returns
    An error code. The following codes are possible.
      +
    • LA_NO_ERROR: No error occurred. Successful operation.
    • +
    • LA_INVALID_INPUT_ERROR: Occurs if ldr is not correct.
    • +
    • LA_OUT_OF_MEMORY_ERROR: Occurs if local memory must be allocated, and there is insufficient memory available.
    • +
    +
    + +
    +
    + +

    ◆ la_det()

    + +
    +
    + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
    int la_det (int n,
    double * a,
    int lda,
    double * d 
    )
    +
    +

    Computes the determinant of a square matrix.

    +
    Parameters
    + + + + + +
    nThe dimension of the matrix.
    aThe N-by-N matrix. The matrix is overwritten on output.
    ldaThe leading dimension of the matrix.
    dThe determinant of a.
    +
    +
    +
    Returns
    An error code. The following codes are possible.
      +
    • LA_NO_ERROR: No error occurred. Successful operation.
    • +
    • LA_ARRAY_SIZE_ERROR: Occurs if any of the input arrays are not sized appropriately.
    • +
    • LA_OUT_OF_MEMORY_ERROR: Occurs if local memory must be allocated, and there is insufficient memory available.
    • +
    +
    + +
    +
    + +

    ◆ la_det_cmplx()

    + +
    +
    + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
    int la_det_cmplx (int n,
    double complex * a,
    int lda,
    double complex * d 
    )
    +
    +

    Computes the determinant of a square matrix.

    +
    Parameters
    + + + + + +
    nThe dimension of the matrix.
    aThe N-by-N matrix. The matrix is overwritten on output.
    ldaThe leading dimension of the matrix.
    dThe determinant of a.
    +
    +
    +
    Returns
    An error code. The following codes are possible.
      +
    • LA_NO_ERROR: No error occurred. Successful operation.
    • +
    • LA_ARRAY_SIZE_ERROR: Occurs if any of the input arrays are not sized appropriately.
    • +
    • LA_OUT_OF_MEMORY_ERROR: Occurs if local memory must be allocated, and there is insufficient memory available.
    • +
    +
    + +
    +
    + +

    ◆ la_diag_mtx_mult()

    + +
    +
    + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
    int la_diag_mtx_mult (bool lside,
    bool transb,
    int m,
    int n,
    int k,
    double alpha,
    const double * a,
    const double * b,
    int ldb,
    double beta,
    double * c,
    int ldc 
    )
    +
    +

    Computes the matrix operation: \( C = \alpha A op(B) + \beta C \), or \( C = \alpha op(B) A + \beta C \).

    +
    Parameters
    + + + + + + + + + + + + + +
    lsideSet to true to apply matrix A from the left; else, set to false to apply matrix A from the left.
    transSet to true if op(B) == B**T; else, set to false if op(B) == B.
    mThe number of rows in the matrix C.
    nThe number of columns in the matrix C.
    kThe inner dimension of the matrix product A * op(B).
    alphaA scalar multiplier.
    aA P-element array containing the diagonal elements of matrix A where P = MIN(m, k) if lside is true; else, P = MIN(n, k) if lside is false.
    bThe LDB-by-TDB matrix B where (LDB = leading dimension of B, and TDB = trailing dimension of B):
      +
    • lside == true & trans == true: LDB = n, TDB = k
    • +
    • lside == true & trans == false: LDB = k, TDB = n
    • +
    • lside == false & trans == true: LDB = k, TDB = m
    • +
    • lside == false & trans == false: LDB = m, TDB = k
    • +
    +
    ldbThe leading dimension of matrix B.
    betaA scalar multiplier.
    cThe m by n matrix C.
    ldcThe leading dimension of matrix C.
    +
    +
    +
    Returns
    An error code. The following codes are possible.
      +
    • LA_NO_ERROR: No error occurred. Successful operation.
    • +
    • LA_INVALID_INPUT_ERROR: Occurs if ldb, or ldc are not correct.
    • +
    • LA_ARRAY_SIZE_ERROR: Occurs if any of the input array sizes are incorrect.
    • +
    +
    + +
    +
    + +

    ◆ la_diag_mtx_mult_cmplx()

    + +
    +
    + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
    int la_diag_mtx_mult_cmplx (bool lside,
    int opb,
    int m,
    int n,
    int k,
    double complex alpha,
    const double complex * a,
    const double complex * b,
    int ldb,
    double complex beta,
    double complex * c,
    int ldc 
    )
    +
    +

    Computes the matrix operation: \( C = \alpha A op(B) + \beta C \), or \( C = \alpha op(B) A + \beta * C \).

    +
    Parameters
    + + + + + + + + + + + + + +
    lsideSet to true to apply matrix A from the left; else, set to false to apply matrix A from the left.
    opbSet to LA_TRANSPOSE to compute op(B) as a direct transpose of B, set to LA_HERMITIAN_TRANSPOSE to compute op(B) as the Hermitian transpose of B, otherwise, set to LA_NO_OPERATION to compute op(B) as B.
    mThe number of rows in the matrix C.
    nThe number of columns in the matrix C.
    kThe inner dimension of the matrix product A * op(B).
    alphaA scalar multiplier.
    aA P-element array containing the diagonal elements of matrix A where P = MIN(m, k) if lside is true; else, P = MIN(n, k) if lside is false.
    bThe LDB-by-TDB matrix B where (LDB = leading dimension of B, and TDB = trailing dimension of B):
      +
    • lside == true & trans == true: LDB = n, TDB = k
    • +
    • lside == true & trans == false: LDB = k, TDB = n
    • +
    • lside == false & trans == true: LDB = k, TDB = m
    • +
    • lside == false & trans == false: LDB = m, TDB = k
    • +
    +
    ldbThe leading dimension of matrix B.
    betaA scalar multiplier.
    cThe m by n matrix C.
    ldcThe leading dimension of matrix C.
    +
    +
    +
    Returns
    An error code. The following codes are possible.
      +
    • LA_NO_ERROR: No error occurred. Successful operation.
    • +
    • LA_INVALID_INPUT_ERROR: Occurs if ldb, or ldc are not correct.
    • +
    • LA_ARRAY_SIZE_ERROR: Occurs if any of the input array sizes are incorrect.
    • +
    +
    + +
    +
    + +

    ◆ la_diag_mtx_mult_mixed()

    + +
    +
    + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
    int la_diag_mtx_mult_mixed (bool lside,
    int opb,
    int m,
    int n,
    int k,
    double complex alpha,
    const double * a,
    const double complex * b,
    int ldb,
    double complex beta,
    double complex * c,
    int ldc 
    )
    +
    +

    Computes the matrix operation: \( C = \alpha A op(B) + \beta C \), or \( C = \alpha op(B) A + \beta C \).

    +
    Parameters
    + + + + + + + + + + + + + +
    lsideSet to true to apply matrix A from the left; else, set to false to apply matrix A from the left.
    opbSet to LA_TRANSPOSE to compute op(B) as a direct transpose of B, set to LA_HERMITIAN_TRANSPOSE to compute op(B) as the Hermitian transpose of B, otherwise, set to LA_NO_OPERATION to compute op(B) as B.
    mThe number of rows in the matrix C.
    nThe number of columns in the matrix C.
    kThe inner dimension of the matrix product A * op(B).
    alphaA scalar multiplier.
    aA P-element array containing the diagonal elements of matrix A where P = MIN(m, k) if lside is true; else, P = MIN(n, k) if lside is false.
    bThe LDB-by-TDB matrix B where (LDB = leading dimension of B, and TDB = trailing dimension of B):
      +
    • lside == true & trans == true: LDB = n, TDB = k
    • +
    • lside == true & trans == false: LDB = k, TDB = n
    • +
    • lside == false & trans == true: LDB = k, TDB = m
    • +
    • lside == false & trans == false: LDB = m, TDB = k
    • +
    +
    ldbThe leading dimension of matrix B.
    betaA scalar multiplier.
    cThe m by n matrix C.
    ldcThe leading dimension of matrix C.
    +
    +
    +
    Returns
    An error code. The following codes are possible.
      +
    • LA_NO_ERROR: No error occurred. Successful operation.
    • +
    • LA_INVALID_INPUT_ERROR: Occurs if ldb, or ldc are not correct.
    • +
    • LA_ARRAY_SIZE_ERROR: Occurs if any of the input array sizes are incorrect.
    • +
    +
    + +
    +
    + +

    ◆ la_eigen_asymm()

    + +
    +
    + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
    int la_eigen_asymm (bool vecs,
    int n,
    double * a,
    int lda,
    double complex * vals,
    double complex * v,
    int ldv 
    )
    +
    +

    Computes the eigenvalues, and optionally the right eigenvectors of a square matrix.

    +
    Parameters
    + + + + + + + +
    vecsSet to true to compute the eigenvectors as well as the eigenvalues; else, set to false to just compute the eigenvalues.
    nThe dimension of the matrix.
    aOn input, the N-by-N matrix on which to operate. On output, the contents of this matrix are overwritten.
    ldaThe leading dimension of matrix A.
    valsAn N-element array containing the eigenvalues of the matrix. The eigenvalues are not sorted.
    vAn N-by-N matrix where the right eigenvectors will be written (one per column).
    +
    +
    +
    Returns
    An error code. The following codes are possible.
      +
    • LA_NO_ERROR: No error occurred. Successful operation.
    • +
    • LA_INVALID_INPUT_ERROR: Occurs if lda or ldv is not correct.
    • +
    • LA_OUT_OF_MEMORY_ERROR: Occurs if local memory must be allocated, and there is insufficient memory available.
    • +
    • LA_CONVERGENCE_ERROR: Occurs if the algorithm failed to converge.
    • +
    +
    + +
    +
    + +

    ◆ la_eigen_cmplx()

    + +
    +
    + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
    int la_eigen_cmplx (bool vecs,
    int n,
    double complex * a,
    int lda,
    double complex * vals,
    double complex * v,
    int ldv 
    )
    +
    +

    Computes the eigenvalues, and optionally the right eigenvectors of a square matrix.

    +
    Parameters
    + + + + + + + +
    vecsSet to true to compute the eigenvectors as well as the eigenvalues; else, set to false to just compute the eigenvalues.
    nThe dimension of the matrix.
    aOn input, the N-by-N matrix on which to operate. On output, the contents of this matrix are overwritten.
    ldaThe leading dimension of matrix A.
    valsAn N-element array containing the eigenvalues of the matrix. The eigenvalues are not sorted.
    vAn N-by-N matrix where the right eigenvectors will be written (one per column).
    +
    +
    +
    Returns
    An error code. The following codes are possible.
      +
    • LA_NO_ERROR: No error occurred. Successful operation.
    • +
    • LA_INVALID_INPUT_ERROR: Occurs if lda or ldv is not correct.
    • +
    • LA_OUT_OF_MEMORY_ERROR: Occurs if local memory must be allocated, and there is insufficient memory available.
    • +
    • LA_CONVERGENCE_ERROR: Occurs if the algorithm failed to converge.
    • +
    +
    + +
    +
    + +

    ◆ la_eigen_gen()

    + +
    +
    + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
    int la_eigen_gen (bool vecs,
    int n,
    double * a,
    int lda,
    double * b,
    int ldb,
    double complex * alpha,
    double * beta,
    double complex * v,
    int ldv 
    )
    +
    +

    Computes the eigenvalues, and optionally the right eigenvectors of a square matrix assuming the structure of the eigenvalue problem is \( A X = \lambda B X \).

    +
    Parameters
    + + + + + + + + + + +
    vecsSet to true to compute the eigenvectors as well as the eigenvalues; else, set to false to just compute the eigenvalues.
    nThe dimension of the matrix.
    aOn input, the N-by-N matrix A. On output, the contents of this matrix are overwritten.
    ldaThe leading dimension of matrix A.
    bOn input, the N-by-N matrix B. On output, the contents of this matrix are overwritten.
    ldbThe leading dimension of matrix B.
    alphaAn N-element array a factor of the eigenvalues. The eigenvalues must be computed as ALPHA / BETA. This however, is not as trivial as it seems as it is entirely possible, and likely, that ALPHA / BETA can overflow or underflow. With that said, the values in ALPHA will always be less than and usually comparable with the NORM(A).
    betaAn N-element array that contains the denominator used to determine the eigenvalues as ALPHA / BETA. If used, the values in this array will always be less than and usually comparable with the NORM(B).
    vAn N-by-N matrix where the right eigenvectors will be written (one per column).
    +
    +
    +
    Returns
    An error code. The following codes are possible.
      +
    • LA_NO_ERROR: No error occurred. Successful operation.
    • +
    • LA_INVALID_INPUT_ERROR: Occurs if lda or ldv is not correct.
    • +
    • LA_OUT_OF_MEMORY_ERROR: Occurs if local memory must be allocated, and there is insufficient memory available.
    • +
    • LA_CONVERGENCE_ERROR: Occurs if the algorithm failed to converge.
    • +
    +
    + +
    +
    + +

    ◆ la_eigen_symm()

    + +
    +
    + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
    int la_eigen_symm (bool vecs,
    int n,
    double * a,
    int lda,
    double * vals 
    )
    +
    +

    Computes the eigenvalues, and optionally the eigenvectors of a real, symmetric matrix.

    +
    Parameters
    + + + + + + +
    vecsSet to true to compute the eigenvectors as well as the eigenvalues; else, set to false to just compute the eigenvalues.
    nThe dimension of the matrix.
    aOn input, the N-by-N symmetric matrix on which to operate. On output, and if vecs is set to true, the matrix will contain the eigenvectors (one per column) corresponding to each eigenvalue in vals. If vecs is set to false, the lower triangular portion of the matrix is overwritten.
    ldaThe leading dimension of matrix A.
    valsAn N-element array that will contain the eigenvalues sorted into ascending order.
    +
    +
    +
    Returns
    An error code. The following codes are possible.
      +
    • LA_NO_ERROR: No error occurred. Successful operation.
    • +
    • LA_INVALID_INPUT_ERROR: Occurs if lda is not correct.
    • +
    • LA_OUT_OF_MEMORY_ERROR: Occurs if local memory must be allocated, and there is insufficient memory available.
    • +
    • LA_CONVERGENCE_ERROR: Occurs if the algorithm failed to converge.
    • +
    +
    + +
    +
    + +

    ◆ la_form_lu()

    + +
    +
    + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
    int la_form_lu (int n,
    double * a,
    int lda,
    int * ipvt,
    double * u,
    int ldu,
    double * p,
    int ldp 
    )
    +
    +

    Extracts the L, U, and P matrices from the LU factorization output from la_lu_factor.

    +
    Parameters
    + + + + + + + + + +
    nThe dimension of the input matrix.
    aOn input, the N-by-N matrix as output by la_lu_factor. On output, the N-by-N lower triangular matrix L.
    ldaThe leading dimension of a.
    ipvtThe N-element pivot array as output by la_lu_factor.
    uAn N-by-N matrix where the U matrix will be written.
    lduThe leading dimension of u.
    pAn N-by-N matrix where the row permutation matrix will be written.
    ldpThe leading dimension of p.
    +
    +
    +
    Returns
    An error code. The following codes are possible.
      +
    • LA_NO_ERROR: No error occurred. Successful operation.
    • +
    • LA_INVALID_INPUT_ERROR: Occurs if lda, ldu, or ldp is not correct.
    • +
    +
    + +
    +
    + +

    ◆ la_form_lu_cmplx()

    + +
    +
    + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
    int la_form_lu_cmplx (int n,
    double complex * a,
    int lda,
    int * ipvt,
    double complex * u,
    int ldu,
    double * p,
    int ldp 
    )
    +
    +

    Extracts the L, U, and P matrices from the LU factorization output from la_lu_factor_cmplx.

    +
    Parameters
    + + + + + + + + + +
    nThe dimension of the input matrix.
    aOn input, the N-by-N matrix as output by la_lu_factor_cmplx. On output, the N-by-N lower triangular matrix L.
    ldaThe leading dimension of a.
    ipvtThe N-element pivot array as output by la_lu_factor_cmplx.
    uAn N-by-N matrix where the U matrix will be written.
    lduThe leading dimension of u.
    pAn N-by-N matrix where the row permutation matrix will be written.
    ldpThe leading dimension of p.
    +
    +
    +
    Returns
    An error code. The following codes are possible.
      +
    • LA_NO_ERROR: No error occurred. Successful operation.
    • +
    • LA_INVALID_INPUT_ERROR: Occurs if lda, ldu, or ldp is not correct.
    • +
    +
    + +
    +
    + +

    ◆ la_form_qr()

    + +
    +
    + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
    int la_form_qr (bool fullq,
    int m,
    int n,
    double * r,
    int ldr,
    const double * tau,
    double * q,
    int ldq 
    )
    +
    +

    Forms the full M-by-M orthogonal matrix Q from the elementary reflectors returned by the base QR factorization algorithm.

    +
    Parameters
    + + + + + + + + + +
    fullqSet to true to always return the full Q matrix; else, set to false, and in the event that M > N, Q may be supplied as M-by-N, and therefore only return the useful submatrix Q1 (Q = [Q1, Q2]) as the factorization can be written as Q * R = [Q1, Q2] * [R1; 0].
    mThe number of rows in R.
    nThe number of columns in R.
    rOn input, the M-by-N factored matrix as returned by the QR factorization routine. On output, the upper triangular matrix R.
    ldrThe leading dimension of matrix R.
    tauA MIN(M, N)-element array containing the scalar factors of each elementary reflector defined in r.
    qAn M-by-M matrix where the full Q matrix will be written. In the event that fullq is set to false, and M > N, this matrix need only by M-by-N.
    ldqThe leading dimension of matrix Q.
    +
    +
    +
    Returns
    An error code. The following codes are possible.
      +
    • LA_NO_ERROR: No error occurred. Successful operation.
    • +
    • LA_INVALID_INPUT_ERROR: Occurs if lda is not correct.
    • +
    • LA_OUT_OF_MEMORY_ERROR: Occurs if there is insufficient memory available.
    • +
    +
    + +
    +
    + +

    ◆ la_form_qr_cmplx()

    + +
    +
    + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
    int la_form_qr_cmplx (bool fullq,
    int m,
    int n,
    double complex * r,
    int ldr,
    const double complex * tau,
    double complex * q,
    int ldq 
    )
    +
    +

    Forms the full M-by-M orthogonal matrix Q from the elementary reflectors returned by the base QR factorization algorithm.

    +
    Parameters
    + + + + + + + + + +
    fullqSet to true to always return the full Q matrix; else, set to false, and in the event that M > N, Q may be supplied as M-by-N, and therefore only return the useful submatrix Q1 (Q = [Q1, Q2]) as the factorization can be written as Q * R = [Q1, Q2] * [R1; 0].
    mThe number of rows in R.
    nThe number of columns in R.
    rOn input, the M-by-N factored matrix as returned by the QR factorization routine. On output, the upper triangular matrix R.
    ldrThe leading dimension of matrix R.
    tauA MIN(M, N)-element array containing the scalar factors of each elementary reflector defined in r.
    qAn M-by-M matrix where the full Q matrix will be written. In the event that fullq is set to false, and M > N, this matrix need only by M-by-N.
    ldqThe leading dimension of matrix Q.
    +
    +
    +
    Returns
    An error code. The following codes are possible.
      +
    • LA_NO_ERROR: No error occurred. Successful operation.
    • +
    • LA_INVALID_INPUT_ERROR: Occurs if lda is not correct.
    • +
    • LA_OUT_OF_MEMORY_ERROR: Occurs if there is insufficient memory available.
    • +
    +
    + +
    +
    + +

    ◆ la_form_qr_cmplx_pvt()

    + +
    +
    + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
    int la_form_qr_cmplx_pvt (bool fullq,
    int m,
    int n,
    double complex * r,
    int ldr,
    const double complex * tau,
    const int * pvt,
    double complex * q,
    int ldq,
    double complex * p,
    int ldp 
    )
    +
    +

    Forms the full M-by-M orthogonal matrix Q from the elementary reflectors returned by the base QR factorization algorithm. This routine also inflates the pivot array into an N-by-N matrix P such that \( A P = Q R \).

    +
    Parameters
    + + + + + + + + + + + + +
    fullqSet to true to always return the full Q matrix; else, set to false, and in the event that M > N, Q may be supplied as M-by-N, and therefore only return the useful submatrix Q1 (Q = [Q1, Q2]) as the factorization can be written as Q * R = [Q1, Q2] * [R1; 0].
    mThe number of rows in R.
    nThe number of columns in R.
    rOn input, the M-by-N factored matrix as returned by the QR factorization routine. On output, the upper triangular matrix R.
    ldrThe leading dimension of matrix R.
    tauA MIN(M, N)-element array containing the scalar factors of each elementary reflector defined in r.
    pvtAn N-element array containing the pivot information from the QR factorization.
    qAn M-by-M matrix where the full Q matrix will be written. In the event that fullq is set to false, and M > N, this matrix need only by M-by-N.
    ldqThe leading dimension of matrix Q.
    pAn N-by-N matrix where the pivot matrix P will be written.
    ldpThe leading dimension of matrix P.
    +
    +
    +
    Returns
    An error code. The following codes are possible.
      +
    • LA_NO_ERROR: No error occurred. Successful operation.
    • +
    • LA_INVALID_INPUT_ERROR: Occurs if lda is not correct.
    • +
    • LA_OUT_OF_MEMORY_ERROR: Occurs if there is insufficient memory available.
    • +
    +
    + +
    +
    + +

    ◆ la_form_qr_pvt()

    + +
    +
    + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
    int la_form_qr_pvt (bool fullq,
    int m,
    int n,
    double * r,
    int ldr,
    const double * tau,
    const int * pvt,
    double * q,
    int ldq,
    double * p,
    int ldp 
    )
    +
    +

    Forms the full M-by-M orthogonal matrix Q from the elementary reflectors returned by the base QR factorization algorithm. This routine also inflates the pivot array into an N-by-N matrix P such that \( A P = Q R \).

    +
    Parameters
    + + + + + + + + + + + + +
    fullqSet to true to always return the full Q matrix; else, set to false, and in the event that M > N, Q may be supplied as M-by-N, and therefore only return the useful submatrix Q1 (Q = [Q1, Q2]) as the factorization can be written as Q * R = [Q1, Q2] * [R1; 0].
    mThe number of rows in R.
    nThe number of columns in R.
    rOn input, the M-by-N factored matrix as returned by the QR factorization routine. On output, the upper triangular matrix R.
    ldrThe leading dimension of matrix R.
    tauA MIN(M, N)-element array containing the scalar factors of each elementary reflector defined in r.
    pvtAn N-element array containing the pivot information from the QR factorization.
    qAn M-by-M matrix where the full Q matrix will be written. In the event that fullq is set to false, and M > N, this matrix need only by M-by-N.
    ldqThe leading dimension of matrix Q.
    pAn N-by-N matrix where the pivot matrix P will be written.
    ldpThe leading dimension of matrix P.
    +
    +
    +
    Returns
    An error code. The following codes are possible.
      +
    • LA_NO_ERROR: No error occurred. Successful operation.
    • +
    • LA_INVALID_INPUT_ERROR: Occurs if lda is not correct.
    • +
    • LA_OUT_OF_MEMORY_ERROR: Occurs if there is insufficient memory available.
    • +
    +
    + +
    +
    + +

    ◆ la_inverse()

    + +
    +
    + + + + + + + + + + + + + + + + + + + + + + + + +
    int la_inverse (int n,
    double * a,
    int lda 
    )
    +
    +

    Computes the inverse of a square matrix.

    +
    Parameters
    + + + + +
    nThe dimension of matrix A.
    aOn input, the N-by-N matrix to invert. On output, the inverted matrix.
    ldaThe leading dimension of matrix A.
    +
    +
    +
    Returns
    An error code. The following codes are possible.
      +
    • LA_NO_ERROR: No error occurred. Successful operation.
    • +
    • LA_INVALID_INPUT_ERROR: Occurs if lda is not correct.
    • +
    • LA_SINGULAR_MATRIX_ERROR: Occurs if the input matrix is singular.
    • +
    +
    + +
    +
    + +

    ◆ la_inverse_cmplx()

    + +
    +
    + + + + + + + + + + + + + + + + + + + + + + + + +
    int la_inverse_cmplx (int n,
    double complex * a,
    int lda 
    )
    +
    +

    Computes the inverse of a square matrix.

    +
    Parameters
    + + + + +
    nThe dimension of matrix A.
    aOn input, the N-by-N matrix to invert. On output, the inverted matrix.
    ldaThe leading dimension of matrix A.
    +
    +
    +
    Returns
    An error code. The following codes are possible.
      +
    • LA_NO_ERROR: No error occurred. Successful operation.
    • +
    • LA_INVALID_INPUT_ERROR: Occurs if lda is not correct.
    • +
    • LA_SINGULAR_MATRIX_ERROR: Occurs if the input matrix is singular.
    • +
    +
    + +
    +
    + +

    ◆ la_lu_factor()

    + +
    +
    + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
    int la_lu_factor (int m,
    int n,
    double * a,
    int lda,
    int * ipvt 
    )
    +
    +

    Computes the LU factorization of an M-by-N matrix.

    +
    Parameters
    + + + + + + +
    mThe number of rows in the matrix.
    nThe number of columns in the matrix.
    aOn input, the M-by-N matrix on which to operate. On output, the LU factored matrix in the form [L\U] where the unit diagonal elements of L are not stored.
    ldaThe leading dimension of matrix A.
    ipvtAn MIN(M, N)-element array used to track row-pivot operations. The array stored pivot information such that row I is interchanged with row IPVT(I).
    +
    +
    +
    Returns
    An error code. The following codes are possible.
      +
    • LA_NO_ERROR: No error occurred. Successful operation.
    • +
    • LA_INVALID_INPUT_ERROR: Occurs if lda is not correct.
    • +
    • LA_SINGULAR_MATRIX_ERROR: Occurs as a warning if a is found to be singular.
    • +
    +
    + +
    +
    + +

    ◆ la_lu_factor_cmplx()

    + +
    +
    + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
    int la_lu_factor_cmplx (int m,
    int n,
    double complex * a,
    int lda,
    int * ipvt 
    )
    +
    +

    Computes the LU factorization of an M-by-N matrix.

    +
    Parameters
    + + + + + + +
    mThe number of rows in the matrix.
    nThe number of columns in the matrix.
    aOn input, the M-by-N matrix on which to operate. On output, the LU factored matrix in the form [L\U] where the unit diagonal elements of L are not stored.
    ldaThe leading dimension of matrix A.
    ipvtAn MIN(M, N)-element array used to track row-pivot operations. The array stored pivot information such that row I is interchanged with row IPVT(I).
    +
    +
    +
    Returns
    An error code. The following codes are possible.
      +
    • LA_NO_ERROR: No error occurred. Successful operation.
    • +
    • LA_INVALID_INPUT_ERROR: Occurs if lda is not correct.
    • +
    • LA_SINGULAR_MATRIX_ERROR: Occurs as a warning if a is found to be singular.
    • +
    +
    + +
    +
    + +

    ◆ la_mtx_mult()

    + +
    +
    + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
    int la_mtx_mult (bool transa,
    bool transb,
    int m,
    int n,
    int k,
    double alpha,
    const double * a,
    int lda,
    const double * b,
    int ldb,
    double beta,
    double * c,
    int ldc 
    )
    +
    +

    Computes the matrix operation \( C = \alpha op(A) op(B) + \beta C \).

    +
    Parameters
    + + + + + + + + + + + + + + +
    transaSet to true to compute op(A) as the transpose of A; else, set to false to compute op(A) as A.
    transbSet to true to compute op(B) as the transpose of B; else, set to false to compute op(B) as B.
    mThe number of rows in c.
    nThe number of columns in c.
    kThe interior dimension of the product a and b.
    alphaA scalar multiplier.
    aIf transa is true, this matrix must be k by m; else, if transa is false, this matrix must be m by k.
    ldaThe leading dimension of matrix a.
    bIf transb is true, this matrix must be n by k; else, if transb is false, this matrix must be k by n.
    ldbThe leading dimension of matrix b.
    betaA scalar multiplier.
    cThe m by n matrix C.
    ldcThe leading dimension of matrix c.
    +
    +
    +
    Returns
    An error code. The following codes are possible.
      +
    • LA_NO_ERROR: No error occurred. Successful operation.
    • +
    • LA_INVALID_INPUT_ERROR: Occurs if lda, ldb, or ldc are not correct.
    • +
    +
    + +
    +
    + +

    ◆ la_mtx_mult_cmplx()

    + +
    +
    + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
    int la_mtx_mult_cmplx (int opa,
    int opb,
    int m,
    int n,
    int k,
    double complex alpha,
    const double complex * a,
    int lda,
    const double complex * b,
    int ldb,
    double complex beta,
    double complex * c,
    int ldc 
    )
    +
    +

    Computes the matrix operation \( C = \alpha op(A) op(B) + \beta C \).

    +
    Parameters
    + + + + + + + + + + + + + + +
    opaSet to LA_TRANSPOSE to compute op(A) as a direct transpose of A, set to LA_HERMITIAN_TRANSPOSE to compute op(A) as the Hermitian transpose of A, otherwise, set to LA_NO_OPERATION to compute op(A) as A.
    opbSet to TLA_RANSPOSE to compute op(B) as a direct transpose of B, set to LA_HERMITIAN_TRANSPOSE to compute op(B) as the Hermitian transpose of B, otherwise, set to LA_NO_OPERATION to compute op(B) as B.
    mThenumber of rows in c.
    nThe number of columns in c.
    kThe interior dimension of the product a and b.
    alphaA scalar multiplier.
    aIf opa is LA_TRANSPOSE or LA_HERMITIAN_TRANSPOSE, this matrix must be k by m; else, this matrix must be m by k.
    ldaThe leading dimension of matrix a.
    bIf opb is LA_TRANSPOSE or LA_HERMITIAN_TRANSPOSE, this matrix must be n by k; else, this matrix must be k by n.
    ldbThe leading dimension of matrix b.
    betaA scalar multiplier.
    cThe m by n matrix C.
    ldcThe leading dimension of matrix c.
    +
    +
    +
    Returns
    An error code. The following codes are possible.
      +
    • LA_NO_ERROR: No error occurred. Successful operation.
    • +
    • LA_INVALID_INPUT_ERROR: Occurs if lda, ldb, or ldc are not correct.
    • +
    +
    + +
    +
    + +

    ◆ la_mult_qr()

    + +
    +
    + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
    int la_mult_qr (bool lside,
    bool trans,
    int m,
    int n,
    int k,
    double * a,
    int lda,
    const double * tau,
    double * c,
    int ldc 
    )
    +
    +

    Multiplies a general matrix by the orthogonal matrix Q from a QR factorization such that: \( C = op(Q) C \), or \( C = C op(Q) \).

    +
    Parameters
    + + + + + + + + + + + +
    lsideSet to true to apply \( Q \) or \( Q^T \) from the left; else, set to false to apply \( Q \) or \( Q^T \) from the right.
    transSet to true to apply \( Q^T \); else, set to false.
    mThe number of rows in matrix C.
    nThe number of columns in matrix C.
    kThe number of elementary reflectors whose product defines the matrix Q.
    aOn input, an LDA-by-K matrix containing the elementary reflectors output from the QR factorization. If lside is set to true, LDA = M, and M >= K >= 0; else, if lside is set to false, LDA = N, and N >= K >= 0. Notice, the contents of this matrix are restored on exit.
    ldaThe leading dimension of matrix A.
    tauA K-element array containing the scalar factors of each elementary reflector defined in a.
    cOn input, the M-by-N matrix C. On output, the product of the orthogonal matrix Q and the original matrix C.
    ldcTHe leading dimension of matrix C.
    +
    +
    +
    Returns
    An error code. The following codes are possible.
      +
    • LA_NO_ERROR: No error occurred. Successful operation.
    • +
    • LA_INVALID_INPUT_ERROR: Occurs if lda is not correct.
    • +
    • LA_OUT_OF_MEMORY_ERROR: Occurs if there is insufficient memory available.
    • +
    +
    + +
    +
    + +

    ◆ la_mult_qr_cmplx()

    + +
    +
    + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
    int la_mult_qr_cmplx (bool lside,
    bool trans,
    int m,
    int n,
    int k,
    double complex * a,
    int lda,
    const double complex * tau,
    double complex * c,
    int ldc 
    )
    +
    +

    Multiplies a general matrix by the orthogonal matrix Q from a QR factorization such that: \( C = op(Q) C \), or \( C = C op(Q) \).

    +
    Parameters
    + + + + + + + + + + + +
    lsideSet to true to apply \( Q \) or \( Q^H \) from the left; else, set to false to apply \( Q \) or \( Q^H \) from the right.
    transSet to true to apply \( Q^H \); else, set to false.
    mThe number of rows in matrix C.
    nThe number of columns in matrix C.
    kThe number of elementary reflectors whose product defines the matrix Q.
    aOn input, an LDA-by-K matrix containing the elementary reflectors output from the QR factorization. If lside is set to true, LDA = M, and M >= K >= 0; else, if lside is set to false, LDA = N, and N >= K >= 0. Notice, the contents of this matrix are restored on exit.
    ldaThe leading dimension of matrix A.
    tauA K-element array containing the scalar factors of each elementary reflector defined in a.
    cOn input, the M-by-N matrix C. On output, the product of the orthogonal matrix Q and the original matrix C.
    ldcTHe leading dimension of matrix C.
    +
    +
    +
    Returns
    An error code. The following codes are possible.
      +
    • LA_NO_ERROR: No error occurred. Successful operation.
    • +
    • LA_INVALID_INPUT_ERROR: Occurs if lda is not correct.
    • +
    • LA_OUT_OF_MEMORY_ERROR: Occurs if there is insufficient memory available.
    • +
    +
    + +
    +
    + +

    ◆ la_pinverse()

    + +
    +
    + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
    int la_pinverse (int m,
    int n,
    double * a,
    int lda,
    double * ainv,
    int ldai 
    )
    +
    +

    Computes the Moore-Penrose pseudo-inverse of an M-by-N matrix by means of singular value decomposition.

    +
    Parameters
    + + + + + + +
    mThe number of rows in the matrix. @parma n The number of columns in the matrix.
    aOn input, the M-by-N matrix to invert. The matrix is overwritten on output.
    ldaThe leading dimension of matrix A.
    ainvThe N-by-M matrix where the pseudo-inverse of a will be written.
    ldaiThe leading dimension of matrix AINV.
    +
    +
    +
    Returns
    An error code. The following codes are possible.
      +
    • LA_NO_ERROR: No error occurred. Successful operation.
    • +
    • LA_INVALID_INPUT_ERROR: Occurs if lda, or ldai is not correct.
    • +
    +
    + +
    +
    + +

    ◆ la_pinverse_cmplx()

    + +
    +
    + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
    int la_pinverse_cmplx (int m,
    int n,
    double complex * a,
    int lda,
    double complex * ainv,
    int ldai 
    )
    +
    +

    Computes the Moore-Penrose pseudo-inverse of an M-by-N matrix by means of singular value decomposition.

    +
    Parameters
    + + + + + + +
    mThe number of rows in the matrix. @parma n The number of columns in the matrix.
    aOn input, the M-by-N matrix to invert. The matrix is overwritten on output.
    ldaThe leading dimension of matrix A.
    ainvThe N-by-M matrix where the pseudo-inverse of a will be written.
    ldaiThe leading dimension of matrix AINV.
    +
    +
    +
    Returns
    An error code. The following codes are possible.
      +
    • LA_NO_ERROR: No error occurred. Successful operation.
    • +
    • LA_INVALID_INPUT_ERROR: Occurs if lda, or ldai is not correct.
    • +
    +
    + +
    +
    + +

    ◆ la_qr_factor()

    + +
    +
    + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
    int la_qr_factor (int m,
    int n,
    double * a,
    int lda,
    double * tau 
    )
    +
    +

    Computes the QR factorization of an M-by-N matrix without pivoting.

    +
    Parameters
    + + + + + + +
    mThe number of rows in the matrix.
    nThe number of columns in the matrix.
    aOn input, the M-by-N matrix to factor. On output, the elements on and above the diagonal contain the MIN(M, N)-by-N upper trapezoidal matrix R (R is upper triangular if M >= N). The elements below the diagonal, along with the array tau, represent the orthogonal matrix Q as a product of elementary reflectors.
    ldaThe leading dimension of matrix A.
    tauA MIN(M, N)-element array used to store the scalar factors of the elementary reflectors.
    +
    +
    +
    Returns
    An error code. The following codes are possible.
      +
    • LA_NO_ERROR: No error occurred. Successful operation.
    • +
    • LA_INVALID_INPUT_ERROR: Occurs if lda is not correct.
    • +
    • LA_OUT_OF_MEMORY_ERROR: Occurs if there is insufficient memory available.
    • +
    +
    + +
    +
    + +

    ◆ la_qr_factor_cmplx()

    + +
    +
    + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
    int la_qr_factor_cmplx (int m,
    int n,
    double complex * a,
    int lda,
    double complex * tau 
    )
    +
    +

    Computes the QR factorization of an M-by-N matrix without pivoting.

    +
    Parameters
    + + + + + + +
    mThe number of rows in the matrix.
    nThe number of columns in the matrix.
    aOn input, the M-by-N matrix to factor. On output, the elements on and above the diagonal contain the MIN(M, N)-by-N upper trapezoidal matrix R (R is upper triangular if M >= N). The elements below the diagonal, along with the array tau, represent the orthogonal matrix Q as a product of elementary reflectors.
    ldaThe leading dimension of matrix A.
    tauA MIN(M, N)-element array used to store the scalar factors of the elementary reflectors.
    +
    +
    +
    Returns
    An error code. The following codes are possible.
      +
    • LA_NO_ERROR: No error occurred. Successful operation.
    • +
    • LA_INVALID_INPUT_ERROR: Occurs if lda is not correct.
    • +
    • LA_OUT_OF_MEMORY_ERROR: Occurs if there is insufficient memory available.
    • +
    +
    + +
    +
    + +

    ◆ la_qr_factor_cmplx_pvt()

    + +
    +
    + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
    int la_qr_factor_cmplx_pvt (int m,
    int n,
    double complex * a,
    int lda,
    double complex * tau,
    int * jpvt 
    )
    +
    +

    Computes the QR factorization of an M-by-N matrix with column pivoting.

    +
    Parameters
    + + + + + + + +
    mThe number of rows in the matrix.
    nThe number of columns in the matrix.
    aOn input, the M-by-N matrix to factor. On output, the elements on and above the diagonal contain the MIN(M, N)-by-N upper trapezoidal matrix R (R is upper triangular if M >= N). The elements below the diagonal, along with the array tau, represent the orthogonal matrix Q as a product of elementary reflectors.
    ldaThe leading dimension of matrix A.
    tauA MIN(M, N)-element array used to store the scalar factors of the elementary reflectors.
    jpvtOn input, an N-element array that if JPVT(I) .ne. 0, the I-th column of A is permuted to the front of A * P; if JPVT(I) = 0, the I-th column of A is a free column. On output, if JPVT(I) = K, then the I-th column of A * P was the K-th column of A.
    +
    +
    +
    Returns
    An error code. The following codes are possible.
      +
    • LA_NO_ERROR: No error occurred. Successful operation.
    • +
    • LA_INVALID_INPUT_ERROR: Occurs if lda is not correct.
    • +
    • LA_OUT_OF_MEMORY_ERROR: Occurs if there is insufficient memory available.
    • +
    +
    + +
    +
    + +

    ◆ la_qr_factor_pvt()

    + +
    +
    + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
    int la_qr_factor_pvt (int m,
    int n,
    double * a,
    int lda,
    double * tau,
    int * jpvt 
    )
    +
    +

    Computes the QR factorization of an M-by-N matrix with column pivoting.

    +
    Parameters
    + + + + + + + +
    mThe number of rows in the matrix.
    nThe number of columns in the matrix.
    aOn input, the M-by-N matrix to factor. On output, the elements on and above the diagonal contain the MIN(M, N)-by-N upper trapezoidal matrix R (R is upper triangular if M >= N). The elements below the diagonal, along with the array tau, represent the orthogonal matrix Q as a product of elementary reflectors.
    ldaThe leading dimension of matrix A.
    tauA MIN(M, N)-element array used to store the scalar factors of the elementary reflectors.
    jpvtOn input, an N-element array that if JPVT(I) .ne. 0, the I-th column of A is permuted to the front of A * P; if JPVT(I) = 0, the I-th column of A is a free column. On output, if JPVT(I) = K, then the I-th column of A * P was the K-th column of A.
    +
    +
    +
    Returns
    An error code. The following codes are possible.
      +
    • LA_NO_ERROR: No error occurred. Successful operation.
    • +
    • LA_INVALID_INPUT_ERROR: Occurs if lda is not correct.
    • +
    • LA_OUT_OF_MEMORY_ERROR: Occurs if there is insufficient memory available.
    • +
    +
    + +
    +
    + +

    ◆ la_qr_rank1_update()

    + +
    +
    + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
    int la_qr_rank1_update (int m,
    int n,
    double * q,
    int ldq,
    double * r,
    int ldr,
    double * u,
    double * v 
    )
    +
    +

    Computes the rank 1 update to an M-by-N QR factored matrix A (M >= N) where \( A = Q R \), and \( A1 = A + U V^T \) such that \( A1 = Q1 R1 \).

    +
    Parameters
    + + + + + + + + + +
    mThe number of rows in R.
    nThe number of columns in R.
    qOn input, the original M-by-K orthogonal matrix Q. On output, the updated matrix Q1.
    ldqThe leading dimension of matrix Q.
    rOn input, the M-by-N matrix R. On output, the updated matrix R1.
    ldrThe leading dimension of matrix R.
    uOn input, the M-element U update vector. On output, the original content of the array is overwritten.
    vOn input, the N-element V update vector. On output, the original content of the array is overwritten.
    +
    +
    +
    Returns
    An error code. The following codes are possible.
      +
    • LA_NO_ERROR: No error occurred. Successful operation.
    • +
    • LA_INVALID_INPUT_ERROR: Occurs if ldq or ldr is not correct.
    • +
    • LA_OUT_OF_MEMORY_ERROR: Occurs if there is insufficient memory available.
    • +
    +
    + +
    +
    + +

    ◆ la_qr_rank1_update_cmplx()

    + +
    +
    + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
    int la_qr_rank1_update_cmplx (int m,
    int n,
    double complex * q,
    int ldq,
    double complex * r,
    int ldr,
    double complex * u,
    double complex * v 
    )
    +
    +

    Computes the rank 1 update to an M-by-N QR factored matrix A (M >= N) where \( A = Q R \), and \( A1 = A + U V^H \) such that \( A1 = Q1 R1 \).

    +
    Parameters
    + + + + + + + + + +
    mThe number of rows in R.
    nThe number of columns in R.
    qOn input, the original M-by-K orthogonal matrix Q. On output, the updated matrix Q1.
    ldqThe leading dimension of matrix Q.
    rOn input, the M-by-N matrix R. On output, the updated matrix R1.
    ldrThe leading dimension of matrix R.
    uOn input, the M-element U update vector. On output, the original content of the array is overwritten.
    vOn input, the N-element V update vector. On output, the original content of the array is overwritten.
    +
    +
    +
    Returns
    An error code. The following codes are possible.
      +
    • LA_NO_ERROR: No error occurred. Successful operation.
    • +
    • LA_INVALID_INPUT_ERROR: Occurs if ldq or ldr is not correct.
    • +
    • LA_OUT_OF_MEMORY_ERROR: Occurs if there is insufficient memory available.
    • +
    +
    + +
    +
    + +

    ◆ la_rank()

    + +
    +
    + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
    int la_rank (int m,
    int n,
    double * a,
    int lda,
    int * rnk 
    )
    +
    +

    Computes the rank of a matrix.

    +
    Parameters
    + + + + + + +
    mThe number of rows in the matrix.
    nThe number of columns in the matrix.
    aThe M-by-N matrix. The matrix is overwritten as part of this operation.
    ldaThe leading dimension of matrix A.
    rnkThe rank of a.
    +
    +
    +
    Returns
    An error code. The following codes are possible.
      +
    • LA_NO_ERROR: No error occurred. Successful operation.
    • +
    • LA_INVALID_INPUT_ERROR: Occurs if lda is not correct.
    • +
    • LA_OUT_OF_MEMORY_ERROR: Occurs if local memory must be allocated, and there is insufficient memory available.
    • +
    • LA_CONVERGENCE_ERROR: Occurs as a warning if the QR iteration process could not converge to a zero value.
    • +
    +
    + +
    +
    + +

    ◆ la_rank1_update()

    + +
    +
    + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
    int la_rank1_update (int m,
    int n,
    double alpha,
    const double * x,
    const double * y,
    double * a,
    int lda 
    )
    +
    +

    Performs the rank-1 update to matrix A such that: \( A = \alpha X Y^T + A \), where \( A \) is an M-by-N matrix, \( \alpha \) is a scalar, \( X \) is an M-element array, and \( Y \) is an N-element array.

    +
    Parameters
    + + + + + + + + +
    mThe number of rows in the matrix.
    nThe number of columns in the matrix.
    alphaThe scalar multiplier.
    xAn M-element array.
    yAn N-element array.
    aOn input, the M-by-N matrix to update. On output, the updated M-by-N matrix.
    ldaThe leading dimension of matrix A.
    +
    +
    +
    Returns
    An error code. The following codes are possible.
      +
    • LA_NO_ERROR: No error occurred. Successful operation.
    • +
    • LA_INVALID_INPUT_ERROR: Occurs if lda is not correct.
    • +
    +
    + +
    +
    + +

    ◆ la_rank1_update_cmplx()

    + +
    +
    + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
    int la_rank1_update_cmplx (int m,
    int n,
    double complex alpha,
    const double complex * x,
    const double complex * y,
    double complex * a,
    int lda 
    )
    +
    +

    Performs the rank-1 update to matrix A such that: \( A = \alpha X Y^H + A \), where \( A \) is an M-by-N matrix, \( \alpha \) is a scalar, \( X \) is an M-element array, and \( Y \) is an N-element array.

    +
    Parameters
    + + + + + + + + +
    mThe number of rows in the matrix.
    nThe number of columns in the matrix.
    alphaThe scalar multiplier.
    xAn M-element array.
    yAn N-element array.
    aOn input, the M-by-N matrix to update. On output, the updated M-by-N matrix.
    ldaThe leading dimension of matrix A.
    +
    +
    +
    Returns
    An error code. The following codes are possible.
      +
    • LA_NO_ERROR: No error occurred. Successful operation.
    • +
    • LA_INVALID_INPUT_ERROR: Occurs if lda is not correct.
    • +
    +
    + +
    +
    + +

    ◆ la_rank_cmplx()

    + +
    +
    + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
    int la_rank_cmplx (int m,
    int n,
    double complex * a,
    int lda,
    int * rnk 
    )
    +
    +

    Computes the rank of a matrix.

    +
    Parameters
    + + + + + + +
    mThe number of rows in the matrix.
    nThe number of columns in the matrix.
    aThe M-by-N matrix. The matrix is overwritten as part of this operation.
    ldaThe leading dimension of matrix A.
    rnkThe rank of a.
    +
    +
    +
    Returns
    An error code. The following codes are possible.
      +
    • LA_NO_ERROR: No error occurred. Successful operation.
    • +
    • LA_INVALID_INPUT_ERROR: Occurs if lda is not correct.
    • +
    • LA_OUT_OF_MEMORY_ERROR: Occurs if local memory must be allocated, and there is insufficient memory available.
    • +
    • LA_CONVERGENCE_ERROR: Occurs as a warning if the QR iteration process could not converge to a zero value.
    • +
    +
    + +
    +
    + +

    ◆ la_solve_cholesky()

    + +
    +
    + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
    int la_solve_cholesky (bool upper,
    int m,
    int n,
    const double * a,
    int lda,
    double * b,
    int ldb 
    )
    +
    +

    Solves a system of Cholesky factored equations.

    +
    Parameters
    + + + + + + + + +
    upperSet to true if the original matrix A was factored such that \( A = U^T U \); else, set to false if the factorization of A was \( A = L^T L \).
    mThe number of rows in matrix B.
    nThe number of columns in matrix B.
    aThe M-by-M Cholesky factored matrix.
    ldaThe leading dimension of matrix A.
    bOn input, the M-by-N right-hand-side matrix B. On output, the M-by-N solution matrix X.
    ldbThe leading dimension of matrix B.
    +
    +
    +
    Returns
    An error code. The following codes are possible.
      +
    • LA_NO_ERROR: No error occurred. Successful operation.
    • +
    • LA_INVALID_INPUT_ERROR: Occurs if lda, or ldb is not correct.
    • +
    +
    + +
    +
    + +

    ◆ la_solve_cholesky_cmplx()

    + +
    +
    + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
    int la_solve_cholesky_cmplx (bool upper,
    int m,
    int n,
    const double complex * a,
    int lda,
    double complex * b,
    int ldb 
    )
    +
    +

    Solves a system of Cholesky factored equations.

    +
    Parameters
    + + + + + + + + +
    upperSet to true if the original matrix A was factored such that \( A = U^T U \); else, set to false if the factorization of A was \( A = L^T L \).
    mThe number of rows in matrix B.
    nThe number of columns in matrix B.
    aThe M-by-M Cholesky factored matrix.
    ldaThe leading dimension of matrix A.
    bOn input, the M-by-N right-hand-side matrix B. On output, the M-by-N solution matrix X.
    ldbThe leading dimension of matrix B.
    +
    +
    +
    Returns
    An error code. The following codes are possible.
      +
    • LA_NO_ERROR: No error occurred. Successful operation.
    • +
    • LA_INVALID_INPUT_ERROR: Occurs if lda, or ldb is not correct.
    • +
    +
    + +
    +
    + +

    ◆ la_solve_least_squares()

    + +
    +
    + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
    int la_solve_least_squares (int m,
    int n,
    int k,
    double * a,
    int lda,
    double * b,
    int ldb 
    )
    +
    +

    Solves the overdetermined or underdetermined system ( \( A X = B \)) of M equations of N unknowns using a QR or LQ factorization of the matrix A. Notice, it is assumed that matrix A has full rank.

    +
    Parameters
    + + + + + + + + +
    mThe number of equations (rows in matrix A).
    nThe number of unknowns (columns in matrix A).
    kThe number of columns in the right-hand-side matrix.
    aOn input, the M-by-N matrix A. On output, if M >= N, the QR factorization of A in the form as output by qr_factor; else, if M < N, the LQ factorization of A.
    ldaThe leading dimension of matrix A.
    bIf M >= N, the M-by-NRHS matrix B. On output, the first N rows contain the N-by-NRHS solution matrix X. If M < N, an N-by-NRHS matrix with the first M rows containing the matrix B. On output, the N-by-NRHS solution matrix X.
    ldbThe leading dimension of matrix B.
    +
    +
    +
    Returns
    An error code. The following codes are possible.
      +
    • LA_NO_ERROR: No error occurred. Successful operation.
    • +
    • LA_INVALID_INPUT_ERROR: Occurs if lda, or ldb is not correct.
    • +
    • LA_OUT_OF_MEMORY_ERROR: Occurs if local memory must be allocated, and there is insufficient memory available.
    • +
    • LA_INVALID_OPERATION_ERROR: Occurs if a is not of full rank.
    • +
    +
    + +
    +
    + +

    ◆ la_solve_least_squares_cmplx()

    + +
    +
    + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
    int la_solve_least_squares_cmplx (int m,
    int n,
    int k,
    double complex * a,
    int lda,
    double complex * b,
    int ldb 
    )
    +
    +

    Solves the overdetermined or underdetermined system ( \( A X = B \)) of M equations of N unknowns using a QR or LQ factorization of the matrix A. Notice, it is assumed that matrix A has full rank.

    +
    Parameters
    + + + + + + + + +
    mThe number of equations (rows in matrix A).
    nThe number of unknowns (columns in matrix A).
    kThe number of columns in the right-hand-side matrix.
    aOn input, the M-by-N matrix A. On output, if M >= N, the QR factorization of A in the form as output by qr_factor; else, if M < N, the LQ factorization of A.
    ldaThe leading dimension of matrix A.
    bIf M >= N, the M-by-NRHS matrix B. On output, the first N rows contain the N-by-NRHS solution matrix X. If M < N, an N-by-NRHS matrix with the first M rows containing the matrix B. On output, the N-by-NRHS solution matrix X.
    ldbThe leading dimension of matrix B.
    +
    +
    +
    Returns
    An error code. The following codes are possible.
      +
    • LA_NO_ERROR: No error occurred. Successful operation.
    • +
    • LA_INVALID_INPUT_ERROR: Occurs if lda, or ldb is not correct.
    • +
    • LA_OUT_OF_MEMORY_ERROR: Occurs if local memory must be allocated, and there is insufficient memory available.
    • +
    • LA_INVALID_OPERATION_ERROR: Occurs if a is not of full rank.
    • +
    +
    + +
    +
    + +

    ◆ la_solve_lu()

    + +
    +
    + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
    int la_solve_lu (int m,
    int n,
    const double * a,
    int lda,
    const int * ipvt,
    double * b,
    int ldb 
    )
    +
    +

    Solves a system of LU-factored equations.

    +
    Parameters
    + + + + + + + + +
    mThe number of rows in matrix B.
    nThe number of columns in matrix B.
    aThe M-by-M LU factored matrix.
    ldaThe leading dimension of matrix A.
    ipvtThe M-element pivot array from the LU factorization.
    bOn input, the M-by-N right-hand-side. On output, the M-by-N solution.
    ldbThe leading dimension of matrix B.
    +
    +
    +
    Returns
    An error code. The following codes are possible.
      +
    • LA_NO_ERROR: No error occurred. Successful operation.
    • +
    • LA_INVALID_INPUT_ERROR: Occurs if lda, or ldb is not correct.
    • +
    +
    + +
    +
    + +

    ◆ la_solve_lu_cmplx()

    + +
    +
    + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
    int la_solve_lu_cmplx (int m,
    int n,
    const double complex * a,
    int lda,
    const int * ipvt,
    double complex * b,
    int ldb 
    )
    +
    +

    Solves a system of LU-factored equations.

    +
    Parameters
    + + + + + + + + +
    mThe number of rows in matrix B.
    nThe number of columns in matrix B.
    aThe M-by-M LU factored matrix.
    ldaThe leading dimension of matrix A.
    ipvtThe M-element pivot array from the LU factorization.
    bOn input, the M-by-N right-hand-side. On output, the M-by-N solution.
    ldbThe leading dimension of matrix B.
    +
    +
    +
    Returns
    An error code. The following codes are possible.
      +
    • LA_NO_ERROR: No error occurred. Successful operation.
    • +
    • LA_INVALID_INPUT_ERROR: Occurs if lda, or ldb is not correct.
    • +
    +
    + +
    +
    + +

    ◆ la_solve_qr()

    + +
    +
    + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
    int la_solve_qr (int m,
    int n,
    int k,
    double * a,
    int lda,
    const double * tau,
    double * b,
    int ldb 
    )
    +
    +

    Solves a system of M QR-factored equations of N unknowns where M >= N.

    +
    Parameters
    + + + + + + + + + +
    mThe number of equations (rows in matrix A).
    nThe number of unknowns (columns in matrix A).
    kThe number of columns in the right-hand-side matrix.
    aOn input, the M-by-N QR factored matrix as returned by qr_factor. On output, the contents of this matrix are restored.
    ldaThe leading dimension of matrix A.
    tauA MIN(M, N)-element array containing the scalar factors of the elementary reflectors as returned by qr_factor.
    bOn input, the M-by-K right-hand-side matrix. On output, the first N rows are overwritten by the solution matrix X.
    ldbThe leading dimension of matrix B.
    +
    +
    +
    Returns
    An error code. The following codes are possible.
      +
    • LA_NO_ERROR: No error occurred. Successful operation.
    • +
    • LA_INVALID_INPUT_ERROR: Occurs if lda, or ldb is not correct, or if m is less than n.
    • +
    • LA_OUT_OF_MEMORY_ERROR: Occurs if local memory must be allocated, and there is insufficient memory available.
    • +
    +
    + +
    +
    + +

    ◆ la_solve_qr_cmplx()

    + +
    +
    + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
    int la_solve_qr_cmplx (int m,
    int n,
    int k,
    double complex * a,
    int lda,
    const double complex * tau,
    double complex * b,
    int ldb 
    )
    +
    +

    Solves a system of M QR-factored equations of N unknowns where M >= N.

    +
    Parameters
    + + + + + + + + + +
    mThe number of equations (rows in matrix A).
    nThe number of unknowns (columns in matrix A).
    kThe number of columns in the right-hand-side matrix.
    aOn input, the M-by-N QR factored matrix as returned by qr_factor. On output, the contents of this matrix are restored.
    ldaThe leading dimension of matrix A.
    tauA MIN(M, N)-element array containing the scalar factors of the elementary reflectors as returned by qr_factor.
    bOn input, the M-by-K right-hand-side matrix. On output, the first N rows are overwritten by the solution matrix X.
    ldbThe leading dimension of matrix B.
    +
    +
    +
    Returns
    An error code. The following codes are possible.
      +
    • LA_NO_ERROR: No error occurred. Successful operation.
    • +
    • LA_INVALID_INPUT_ERROR: Occurs if lda, or ldb is not correct, or if m is less than n.
    • +
    • LA_OUT_OF_MEMORY_ERROR: Occurs if local memory must be allocated, and there is insufficient memory available.
    • +
    +
    + +
    +
    + +

    ◆ la_solve_qr_cmplx_pvt()

    + +
    +
    + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
    int la_solve_qr_cmplx_pvt (int m,
    int n,
    int k,
    double complex * a,
    int lda,
    const double complex * tau,
    const int * jpvt,
    double complex * b,
    int ldb 
    )
    +
    +

    Solves a system of M QR-factored equations of N unknowns.

    +
    Parameters
    + + + + + + + + + + +
    mThe number of equations (rows in matrix A).
    nThe number of unknowns (columns in matrix A).
    kThe number of columns in the right-hand-side matrix.
    aOn input, the M-by-N QR factored matrix as returned by qr_factor. On output, the contents of this matrix are restored.
    ldaThe leading dimension of matrix A.
    tauA MIN(M, N)-element array containing the scalar factors of the elementary reflectors as returned by qr_factor.
    jpvtThe N-element array that was used to track the column pivoting operations in the QR factorization.
    bOn input, the M-by-K right-hand-side matrix. On output, the first N rows are overwritten by the solution matrix X.
    ldbThe leading dimension of matrix B.
    +
    +
    +
    Returns
    An error code. The following codes are possible.
      +
    • LA_NO_ERROR: No error occurred. Successful operation.
    • +
    • LA_INVALID_INPUT_ERROR: Occurs if lda, or ldb is not correct.
    • +
    • LA_OUT_OF_MEMORY_ERROR: Occurs if local memory must be allocated, and there is insufficient memory available.
    • +
    +
    + +
    +
    + +

    ◆ la_solve_qr_pvt()

    + +
    +
    + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
    int la_solve_qr_pvt (int m,
    int n,
    int k,
    double * a,
    int lda,
    const double * tau,
    const int * jpvt,
    double * b,
    int ldb 
    )
    +
    +

    Solves a system of M QR-factored equations of N unknowns.

    +
    Parameters
    + + + + + + + + + + +
    mThe number of equations (rows in matrix A).
    nThe number of unknowns (columns in matrix A).
    kThe number of columns in the right-hand-side matrix.
    aOn input, the M-by-N QR factored matrix as returned by qr_factor. On output, the contents of this matrix are restored.
    ldaThe leading dimension of matrix A.
    tauA MIN(M, N)-element array containing the scalar factors of the elementary reflectors as returned by qr_factor.
    jpvtThe N-element array that was used to track the column pivoting operations in the QR factorization.
    bOn input, the M-by-K right-hand-side matrix. On output, the first N rows are overwritten by the solution matrix X.
    ldbThe leading dimension of matrix B.
    +
    +
    +
    Returns
    An error code. The following codes are possible.
      +
    • LA_NO_ERROR: No error occurred. Successful operation.
    • +
    • LA_INVALID_INPUT_ERROR: Occurs if lda, or ldb is not correct.
    • +
    • LA_OUT_OF_MEMORY_ERROR: Occurs if local memory must be allocated, and there is insufficient memory available.
    • +
    +
    + +
    +
    + +

    ◆ la_solve_tri_mtx()

    + +
    +
    + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
    int la_solve_tri_mtx (bool lside,
    bool upper,
    bool trans,
    bool nounit,
    int m,
    int n,
    double alpha,
    const double * a,
    int lda,
    double * b,
    int ldb 
    )
    +
    +

    Solves one of the matrix equations: \( op(A) X = \alpha B \), or \( X op(A) = \alpha B \), where \( A \) is a triangular matrix.

    +
    Parameters
    + + + + + + + + + + + + +
    lsideSet to true to solve \( op(A) X = \alpha B \); else, set to false to solve \( X op(A) = \alpha B \).
    upperSet to true if A is an upper triangular matrix; else, set to false if A is a lower triangular matrix.
    transSet to true if \( op(A) = A^T \); else, set to false if \( op(A) = A \).
    nounitSet to true if A is not a unit-diagonal matrix (ones on every diagonal element); else, set to false if A is a unit-diagonal matrix.
    mThe number of rows in matrix B.
    nThe number of columns in matrix B.
    alphaThe scalar multiplier to B.
    aIf lside is true, the M-by-M triangular matrix on which to operate; else, if lside is false, the N-by-N triangular matrix on which to operate.
    ldaThe leading dimension of matrix A.
    bOn input, the M-by-N right-hand-side. On output, the M-by-N solution.
    ldbThe leading dimension of matrix B.
    +
    +
    +
    Returns
    An error code. The following codes are possible.
      +
    • LA_NO_ERROR: No error occurred. Successful operation.
    • +
    • LA_INVALID_INPUT_ERROR: Occurs if lda, or ldb is not correct.
    • +
    +
    + +
    +
    + +

    ◆ la_solve_tri_mtx_cmplx()

    + +
    +
    + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
    int la_solve_tri_mtx_cmplx (bool lside,
    bool upper,
    bool trans,
    bool nounit,
    int m,
    int n,
    double complex alpha,
    const double complex * a,
    int lda,
    double complex * b,
    int ldb 
    )
    +
    +

    Solves one of the matrix equations: \( op(A) X = \alpha B \), or \( X op(A) = \alpha B \), where \( A \) is a triangular matrix.

    +
    Parameters
    + + + + + + + + + + + + +
    lsideSet to true to solve \( op(A) X = \alpha B \); else, set to false to solve \( X op(A) = \alpha B \).
    upperSet to true if A is an upper triangular matrix; else, set to false if A is a lower triangular matrix.
    transSet to true if \( op(A) = A^H \); else, set to false if \( op(A) = A \).
    nounitSet to true if A is not a unit-diagonal matrix (ones on every diagonal element); else, set to false if A is a unit-diagonal matrix.
    mThe number of rows in matrix B.
    nThe number of columns in matrix B.
    alphaThe scalar multiplier to B.
    aIf lside is true, the M-by-M triangular matrix on which to operate; else, if lside is false, the N-by-N triangular matrix on which to operate.
    ldaThe leading dimension of matrix A.
    bOn input, the M-by-N right-hand-side. On output, the M-by-N solution.
    ldbThe leading dimension of matrix B.
    +
    +
    +
    Returns
    An error code. The following codes are possible.
      +
    • LA_NO_ERROR: No error occurred. Successful operation.
    • +
    • LA_INVALID_INPUT_ERROR: Occurs if lda, or ldb is not correct.
    • +
    +
    + +
    +
    + +

    ◆ la_sort_eigen()

    + +
    +
    + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
    int la_sort_eigen (bool ascend,
    int n,
    double * vals,
    double * vecs,
    int ldv 
    )
    +
    +

    A sorting routine specifically tailored for sorting of eigenvalues and their associated eigenvectors using a quick-sort approach.

    +
    Parameters
    + + + + + + +
    ascend
    nThe number of eigenvalues.
    valsOn input, an N-element array containing the eigenvalues. On output, the sorted eigenvalues.
    vecsOn input, an N-by-N matrix containing the eigenvectors associated with vals (one vector per column). On output, the sorted eigenvector matrix.
    ldvThe leading dimension of vecs.
    +
    +
    +
    Returns
    An error code. The following codes are possible.
      +
    • LA_NO_ERROR: No error occurred. Successful operation.
    • +
    • LA_INVALID_INPUT_ERROR: Occurs if ldv is not correct.
    • +
    • LA_OUT_OF_MEMORY_ERROR: Occurs if local memory must be allocated, and there is insufficient memory available.
    • +
    +
    + +
    +
    + +

    ◆ la_sort_eigen_cmplx()

    + +
    +
    + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
    int la_sort_eigen_cmplx (bool ascend,
    int n,
    double complex * vals,
    double complex * vecs,
    int ldv 
    )
    +
    +

    A sorting routine specifically tailored for sorting of eigenvalues and their associated eigenvectors using a quick-sort approach.

    +
    Parameters
    + + + + + + +
    ascend
    nThe number of eigenvalues.
    valsOn input, an N-element array containing the eigenvalues. On output, the sorted eigenvalues.
    vecsOn input, an N-by-N matrix containing the eigenvectors associated with vals (one vector per column). On output, the sorted eigenvector matrix.
    ldvThe leading dimension of vecs.
    +
    +
    +
    Returns
    An error code. The following codes are possible.
      +
    • LA_NO_ERROR: No error occurred. Successful operation.
    • +
    • LA_INVALID_INPUT_ERROR: Occurs if ldv is not correct.
    • +
    • LA_OUT_OF_MEMORY_ERROR: Occurs if local memory must be allocated, and there is insufficient memory available.
    • +
    +
    + +
    +
    + +

    ◆ la_svd()

    + +
    +
    + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
    int la_svd (int m,
    int n,
    double * a,
    int lda,
    double * s,
    double * u,
    int ldu,
    double * vt,
    int ldv 
    )
    +
    +

    Computes the singular value decomposition of a matrix \( A \). The SVD is defined as: \( A = U S V^T \), where \( U \) is an M-by-M orthogonal matrix, \( S \) is an M-by-N diagonal matrix, and \( V \) is an N-by-N orthogonal matrix.

    +
    Parameters
    + + + + + + + + + + +
    mThe number of rows in the matrix.
    nThe number of columns in the matrix.
    aOn input, the M-by-N matrix to factor. The matrix is overwritten on output.
    ldaThe leading dimension of matrix A.
    sA MIN(M, N)-element array containing the singular values of a sorted in descending order.
    uAn M-by-M matrix where the orthogonal U matrix will be written.
    lduThe leading dimension of matrix U.
    vtAn N-by-N matrix where the transpose of the right singular vector matrix V.
    ldvThe leading dimension of matrix V.
    +
    +
    +
    Returns
    An error code. The following codes are possible.
      +
    • LA_NO_ERROR: No error occurred. Successful operation.
    • +
    • LA_INVALID_INPUT_ERROR: Occurs if lda, ldu, or ldv is not correct.
    • +
    • LA_OUT_OF_MEMORY_ERROR: Occurs if local memory must be allocated, and there is insufficient memory available.
    • +
    • LA_CONVERGENCE_ERROR: Occurs as a warning if the QR iteration process could not converge to a zero value.
    • +
    +
    + +
    +
    + +

    ◆ la_svd_cmplx()

    + +
    +
    + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
    int la_svd_cmplx (int m,
    int n,
    double complex * a,
    int lda,
    double * s,
    double complex * u,
    int ldu,
    double complex * vt,
    int ldv 
    )
    +
    +

    Computes the singular value decomposition of a matrix \( A \). The SVD is defined as: \( A = U S V^H \), where \( U \) is an M-by-M orthogonal matrix, \( S \) is an M-by-N diagonal matrix, and \( V \) is an N-by-N orthogonal matrix.
    +

    +
    Parameters
    + + + + + + + + + + +
    mThe number of rows in the matrix.
    nThe number of columns in the matrix.
    aOn input, the M-by-N matrix to factor. The matrix is overwritten on output.
    ldaThe leading dimension of matrix A.
    sA MIN(M, N)-element array containing the singular values of a sorted in descending order.
    uAn M-by-M matrix where the orthogonal U matrix will be written.
    lduThe leading dimension of matrix U.
    vtAn N-by-N matrix where the conjugate transpose of the right singular vector matrix V.
    ldvThe leading dimension of vt.
    +
    +
    +
    Returns
    An error code. The following codes are possible.
      +
    • LA_NO_ERROR: No error occurred. Successful operation.
    • +
    • LA_INVALID_INPUT_ERROR: Occurs if lda, ldu, or ldv is not correct.
    • +
    • LA_OUT_OF_MEMORY_ERROR: Occurs if local memory must be allocated, and there is insufficient memory available.
    • +
    • LA_CONVERGENCE_ERROR: Occurs as a warning if the QR iteration process could not converge to a zero value.
    • +
    +
    + +
    +
    + +

    ◆ la_trace()

    + +
    +
    + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
    int la_trace (int m,
    int n,
    const double * a,
    int lda,
    double * rst 
    )
    +
    +

    Computes the trace of a matrix (the sum of the main diagonal elements).

    +
    Parameters
    + + + + + + +
    mThe number of rows in the matrix.
    nThe number of columns in the matrix.
    aThe M-by-N matrix on which to operate.
    ldaThe leading dimension of the matrix.
    rstThe results of the operation.
    +
    +
    +
    Returns
    An error code. The following codes are possible.
      +
    • LA_NO_ERROR: No error occurred. Successful operation.
    • +
    • LA_INVALID_INPUT_ERROR: Occurs if lda is not correct.
    • +
    +
    + +
    +
    + +

    ◆ la_trace_cmplx()

    + +
    +
    + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
    int la_trace_cmplx (int m,
    int n,
    const double complex * a,
    int lda,
    double complex * rst 
    )
    +
    +

    Computes the trace of a matrix (the sum of the main diagonal elements).

    +
    Parameters
    + + + + + + +
    mThe number of rows in the matrix.
    nThe number of columns in the matrix.
    aThe M-by-N matrix on which to operate.
    ldaThe leading dimension of the matrix.
    rstThe results of the operation.
    +
    +
    +
    Returns
    An error code. The following codes are possible.
      +
    • LA_NO_ERROR: No error occurred. Successful operation.
    • +
    • LA_INVALID_INPUT_ERROR: Occurs if lda is not correct.
    • +
    +
    + +
    +
    + +

    ◆ la_tri_mtx_mult()

    + +
    +
    + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
    int la_tri_mtx_mult (bool upper,
    double alpha,
    int n,
    const double * a,
    int lda,
    double beta,
    double * b,
    int ldb 
    )
    +
    +

    Computes the triangular matrix operation: \( B = \alpha A^T A + \beta B \), or \( B = \alpha A A^T + \beta B \), where \( A \) is a triangular matrix.

    +
    Parameters
    + + + + + + + + + +
    upperSet to true if matrix \( A \) is upper triangular, and \( B = \alpha A^T A + \beta B \) is to be calculated; else, set to false if \( A \) is lower triangular, and \( B = \alpha A A^T + \beta B \) is to be computed.
    alphaA scalar multiplier.
    nThe dimension of the matrix.
    aThe n by n triangular matrix A. Notice, if upper is true, only the upper triangular portion of this matrix is referenced; else, if upper is false, only the lower triangular portion of this matrix is referenced.
    ldaThe leading dimension of matrix A.
    betaA scalar multiplier.
    bOn input, the n by n matrix B. On output, the n by n resulting matrix.
    ldbThe leading dimension of matrix B.
    +
    +
    +
    Returns
    An error code. The following codes are possible.
      +
    • LA_NO_ERROR: No error occurred. Successful operation.
    • +
    • LA_INVALID_INPUT_ERROR: Occurs if lda or ldb are not correct.
    • +
    +
    + +
    +
    + +

    ◆ la_tri_mtx_mult_cmplx()

    + +
    +
    + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
    int la_tri_mtx_mult_cmplx (bool upper,
    double complex alpha,
    int n,
    const double complex * a,
    int lda,
    double complex beta,
    double complex * b,
    int ldb 
    )
    +
    +

    Computes the triangular matrix operation: \( B = \alpha A^T A + \beta B \), or \( B = \alpha A A^T + \beta B \), where \( A \) is a triangular matrix.

    +
    Parameters
    + + + + + + + + + +
    upperSet to true if matrix \( A \) is upper triangular, and \( B = \alpha A^T A + \beta B \) is to be calculated; else, set to false if \( A \) is lower triangular, and \( B = \alpha A A^T + \beta B \) is to be computed.
    alphaA scalar multiplier.
    nThe dimension of the matrix.
    aThe n by n triangular matrix A. Notice, if upper is true, only the upper triangular portion of this matrix is referenced; else, if upper is false, only the lower triangular portion of this matrix is referenced.
    ldaThe leading dimension of matrix A.
    betaA scalar multiplier.
    bOn input, the n by n matrix B. On output, the n by n resulting matrix.
    ldbThe leading dimension of matrix B.
    +
    +
    +
    Returns
    An error code. The following codes are possible.
      +
    • LA_NO_ERROR: No error occurred. Successful operation.
    • +
    • LA_INVALID_INPUT_ERROR: Occurs if lda or ldb are not correct.
    • +
    +
    + +
    +
    +
    +
    + + + + diff --git a/doc/html/linalg_8h.js b/doc/html/linalg_8h.js new file mode 100644 index 00000000..32aee583 --- /dev/null +++ b/doc/html/linalg_8h.js @@ -0,0 +1,64 @@ +var linalg_8h = +[ + [ "la_cholesky_factor", "linalg_8h.html#a3967bc139cba341a513d1353bea62ac9", null ], + [ "la_cholesky_factor_cmplx", "linalg_8h.html#a1734acc61ef569dfff9c83bcad566f67", null ], + [ "la_cholesky_rank1_downdate", "linalg_8h.html#a292e54c48a8e7f0203bf11f02844691f", null ], + [ "la_cholesky_rank1_downdate_cmplx", "linalg_8h.html#a00c15ec713541d15eae1fd0b01897689", null ], + [ "la_cholesky_rank1_update", "linalg_8h.html#abeb7ee58d4151498be96aa91432f296f", null ], + [ "la_cholesky_rank1_update_cmplx", "linalg_8h.html#af19ebf41be31ee92f657131a8fbf55a3", null ], + [ "la_det", "linalg_8h.html#ac7b4894cd929a106e02a8e37a4d52913", null ], + [ "la_det_cmplx", "linalg_8h.html#ace9edf6a878ee4dd0b220b75b7db6431", null ], + [ "la_diag_mtx_mult", "linalg_8h.html#a4b74177a8914b109e1bf3aa56c9d9cb7", null ], + [ "la_diag_mtx_mult_cmplx", "linalg_8h.html#a63bec2daa56fdc4bbf3f45b67ea14f65", null ], + [ "la_diag_mtx_mult_mixed", "linalg_8h.html#a4d5bad18dcc8a52d9594cc21954c572d", null ], + [ "la_eigen_asymm", "linalg_8h.html#a9491626ab4b3664771e1282b61eeaa74", null ], + [ "la_eigen_cmplx", "linalg_8h.html#ae5a16375c14c924836c33bafa747a1cf", null ], + [ "la_eigen_gen", "linalg_8h.html#af3c6f1a45aee2f275d4b109c9bb660d2", null ], + [ "la_eigen_symm", "linalg_8h.html#ac208d5e6849972a77ef261f2e368868c", null ], + [ "la_form_lu", "linalg_8h.html#a15774f6323c34d307c99b32ac4f188a7", null ], + [ "la_form_lu_cmplx", "linalg_8h.html#a73bea3ca338925cfa4a58bcaea726a14", null ], + [ "la_form_qr", "linalg_8h.html#afe39765d805c1d9ae93e9aa2f20d8548", null ], + [ "la_form_qr_cmplx", "linalg_8h.html#a0338870fe1142f88c96db63495fec615", null ], + [ "la_form_qr_cmplx_pvt", "linalg_8h.html#ad76e25c5eb98075e83cc9df493be5b38", null ], + [ "la_form_qr_pvt", "linalg_8h.html#aace787c5b11959a457b936ace4995033", null ], + [ "la_inverse", "linalg_8h.html#a95d6ed56844c62d553b940091837014b", null ], + [ "la_inverse_cmplx", "linalg_8h.html#a7a821b41c61670f5710214a4d9178998", null ], + [ "la_lu_factor", "linalg_8h.html#a248142a5f0826cddac5daf1c74f234a6", null ], + [ "la_lu_factor_cmplx", "linalg_8h.html#ace554b62c12a5d9a2434c8171c756c47", null ], + [ "la_mtx_mult", "linalg_8h.html#a968b10545320af7bbe1030867ae88e8c", null ], + [ "la_mtx_mult_cmplx", "linalg_8h.html#aefefe80e13f74470d5afaf44b3a45e76", null ], + [ "la_mult_qr", "linalg_8h.html#a95f921847131eaedd62a439490d2a801", null ], + [ "la_mult_qr_cmplx", "linalg_8h.html#acc25c0daa53c10ace21a61d78b2e79f3", null ], + [ "la_pinverse", "linalg_8h.html#af7f8185c0f25ad3fb0b89cc98d77b3d6", null ], + [ "la_pinverse_cmplx", "linalg_8h.html#a71ba1a09caca9d59a9d24b95c7ea749b", null ], + [ "la_qr_factor", "linalg_8h.html#a791d5221eb8ad4fcd106cb218590dfc9", null ], + [ "la_qr_factor_cmplx", "linalg_8h.html#ae5ffa6e8d9c850bd41f43f7564bf6896", null ], + [ "la_qr_factor_cmplx_pvt", "linalg_8h.html#a4a3f6dafe185c2985fc76aab3d0abb97", null ], + [ "la_qr_factor_pvt", "linalg_8h.html#a4bc671dad87b42ff285a4241322a3764", null ], + [ "la_qr_rank1_update", "linalg_8h.html#a9b0639faf9ac0af9bbdb348b92746d5f", null ], + [ "la_qr_rank1_update_cmplx", "linalg_8h.html#acfbd42393c8b1931ff11bc4c7e858aef", null ], + [ "la_rank", "linalg_8h.html#a089690d293303e30c6eef0bb1e982191", null ], + [ "la_rank1_update", "linalg_8h.html#ab346fed23fd61f02d65e09c795c26d74", null ], + [ "la_rank1_update_cmplx", "linalg_8h.html#a3c958fe274f8d1663dd0188455a5fe15", null ], + [ "la_rank_cmplx", "linalg_8h.html#afdc9b7e6ffab89915a082c00ceac7258", null ], + [ "la_solve_cholesky", "linalg_8h.html#a0dc578507a0cb6ada776142476383590", null ], + [ "la_solve_cholesky_cmplx", "linalg_8h.html#a719ffdff56c8fa0875409c4f4e5e95cf", null ], + [ "la_solve_least_squares", "linalg_8h.html#a02eb049983dd41f2307bb52594fb210e", null ], + [ "la_solve_least_squares_cmplx", "linalg_8h.html#ac3bb7b959d8cc7400e9b13290a895b64", null ], + [ "la_solve_lu", "linalg_8h.html#aae725d3247301d1163c58f89edff3d4b", null ], + [ "la_solve_lu_cmplx", "linalg_8h.html#aa067ac0d3f58e28371d413ab7419da74", null ], + [ "la_solve_qr", "linalg_8h.html#aefdc2e6758482d02a3aa7978f7d5efe0", null ], + [ "la_solve_qr_cmplx", "linalg_8h.html#a0ff5f2519eb1d2af94e3b4a26dfb10fe", null ], + [ "la_solve_qr_cmplx_pvt", "linalg_8h.html#ad0ee4a9c71de62911a71a342790f5070", null ], + [ "la_solve_qr_pvt", "linalg_8h.html#a62f97b4319f5574aef5e52bbacff14bb", null ], + [ "la_solve_tri_mtx", "linalg_8h.html#aed7b29bbff1472ebe805054eb9d8c6d4", null ], + [ "la_solve_tri_mtx_cmplx", "linalg_8h.html#af87823d73fb5a319e4262594d147e38c", null ], + [ "la_sort_eigen", "linalg_8h.html#abf5918abab8f97fc2ac5887e051ff493", null ], + [ "la_sort_eigen_cmplx", "linalg_8h.html#a090178a5f99a4b400da80481aad77757", null ], + [ "la_svd", "linalg_8h.html#a56c0cea99a066e74c8fff9682d5ca92d", null ], + [ "la_svd_cmplx", "linalg_8h.html#afbffa0856d75c607a03d3dc7b5b1076e", null ], + [ "la_trace", "linalg_8h.html#a7f611f8f3de7d56120c78e70671c7112", null ], + [ "la_trace_cmplx", "linalg_8h.html#a021fbb7fdccf557ec407a86bace43d85", null ], + [ "la_tri_mtx_mult", "linalg_8h.html#ae7d70f1ef2a2824772e1bf0f726c257e", null ], + [ "la_tri_mtx_mult_cmplx", "linalg_8h.html#a02c464a9dd95298c91f431ae4d0773e9", null ] +]; \ No newline at end of file diff --git a/doc/html/linalg_8h__incl.dot b/doc/html/linalg_8h__incl.dot new file mode 100644 index 00000000..30583f9c --- /dev/null +++ b/doc/html/linalg_8h__incl.dot @@ -0,0 +1,12 @@ +digraph "D:/Code/linalg/include/linalg.h" +{ + // LATEX_PDF_SIZE + bgcolor="transparent"; + edge [fontname=Helvetica,fontsize=10,labelfontname=Helvetica,labelfontsize=10]; + node [fontname=Helvetica,fontsize=10,shape=box,height=0.2,width=0.4]; + Node1 [label="D:/Code/linalg/include\l/linalg.h",height=0.2,width=0.4,color="gray40", fillcolor="grey60", style="filled", fontcolor="black",tooltip=" "]; + Node1 -> Node2 [color="steelblue1",style="solid"]; + Node2 [label="stdbool.h",height=0.2,width=0.4,color="grey60", fillcolor="#E0E0E0", style="filled",tooltip=" "]; + Node1 -> Node3 [color="steelblue1",style="solid"]; + Node3 [label="complex.h",height=0.2,width=0.4,color="grey60", fillcolor="#E0E0E0", style="filled",tooltip=" "]; +} diff --git a/doc/html/linalg_8h_source.html b/doc/html/linalg_8h_source.html index ed277c34..7eba137e 100644 --- a/doc/html/linalg_8h_source.html +++ b/doc/html/linalg_8h_source.html @@ -100,214 +100,276 @@
    linalg.h
    -
    1#ifndef LINALG_H_
    -
    2#define LINALG_H_
    -
    3
    -
    4#include <stdbool.h>
    -
    5#include <complex.h>
    -
    6
    -
    7#define LA_NO_OPERATION 0
    -
    8#define LA_TRANSPOSE 1
    -
    9#define LA_HERMITIAN_TRANSPOSE 2
    -
    10#define LA_NO_ERROR 0
    -
    11#define LA_INVALID_INPUT_ERROR 101
    -
    12#define LA_ARRAY_SIZE_ERROR 102
    -
    13#define LA_SINGULAR_MATRIX_ERROR 103
    -
    14#define LA_MATRIX_FORMAT_ERROR 104
    -
    15#define LA_OUT_OF_MEMORY_ERROR 105
    -
    16#define LA_CONVERGENCE_ERROR 106
    -
    17#define LA_INVALID_OPERATION_ERROR 107
    -
    18
    -
    19#ifdef __cplusplus
    -
    20extern "C" {
    -
    21#endif
    -
    22
    -
    41int la_rank1_update(int m, int n, double alpha, const double *x,
    -
    42 const double *y, double *a, int lda);
    -
    43
    -
    62int la_rank1_update_cmplx(int m, int n, double complex alpha,
    -
    63 const double complex *x, const double complex *y, double complex *a,
    -
    64 int lda);
    -
    65
    -
    80int la_trace(int m, int n, const double *a, int lda, double *rst);
    -
    81
    -
    96int la_trace_cmplx(int m, int n, const double complex *a, int lda,
    -
    97 double complex *rst);
    -
    98
    -
    125int la_mtx_mult(bool transa, bool transb, int m, int n, int k, double alpha,
    -
    126 const double *a, int lda, const double *b, int ldb, double beta,
    -
    127 double *c, int ldc);
    -
    128
    -
    157int la_mtx_mult_cmplx(int opa, int opb, int m, int n, int k,
    -
    158 double complex alpha, const double complex *a, int lda,
    -
    159 const double complex *b, int ldb, double complex beta, double complex *c,
    -
    160 int ldc);
    -
    161
    -
    195int la_diag_mtx_mult(bool lside, bool transb, int m, int n, int k,
    -
    196 double alpha, const double *a, const double *b, int ldb, double beta,
    -
    197 double *c, int ldc);
    -
    198
    -
    233int la_diag_mtx_mult_cmplx(bool lside, int opb, int m, int n, int k,
    -
    234 double complex alpha, const double complex *a, const double complex *b,
    -
    235 int ldb, double complex beta, double complex *c, int ldc);
    -
    236
    -
    271int la_diag_mtx_mult_mixed(bool lside, int opb, int m, int n, int k,
    -
    272 double complex alpha, const double *a, const double complex *b,
    -
    273 int ldb, double complex beta, double complex *c, int ldc);
    -
    274
    -
    293int la_rank(int m, int n, double *a, int lda, int *rnk);
    -
    294
    -
    313int la_rank_cmplx(int m, int n, double complex *a, int lda, int *rnk);
    -
    314
    -
    330int la_det(int n, double *a, int lda, double *d);
    -
    331
    -
    347int la_det_cmplx(int n, double complex *a, int lda, double complex *d);
    -
    348
    -
    374int la_tri_mtx_mult(bool upper, double alpha, int n, const double *a, int lda,
    -
    375 double beta, double *b, int ldb);
    -
    376
    -
    402int la_tri_mtx_mult_cmplx(bool upper, double complex alpha, int n,
    -
    403 const double complex *a, int lda, double complex beta,
    -
    404 double complex *b, int ldb);
    -
    405
    -
    425int la_lu_factor(int m, int n, double *a, int lda, int *ipvt);
    -
    426
    -
    446int la_lu_factor_cmplx(int m, int n, double complex *a, int lda, int *ipvt);
    -
    447
    -
    469int la_form_lu(int n, double *a, int lda, int *ipvt, double *u, int ldu,
    -
    470 double *p, int ldp);
    -
    471
    -
    493int la_form_lu_cmplx(int n, double complex *a, int lda, int *ipvt,
    -
    494 double complex *u, int ldu, double *p, int ldp);
    -
    495
    -
    517int la_qr_factor(int m, int n, double *a, int lda, double *tau);
    -
    518
    -
    540int la_qr_factor_cmplx(int m, int n, double complex *a, int lda,
    -
    541 double complex *tau);
    -
    542
    -
    567int la_qr_factor_pvt(int m, int n, double *a, int lda, double *tau, int *jpvt);
    -
    568
    -
    593int la_qr_factor_cmplx_pvt(int m, int n, double complex *a, int lda,
    -
    594 double complex *tau, int *jpvt);
    -
    595
    -
    622int la_form_qr(bool fullq, int m, int n, double *r, int ldr, const double *tau,
    -
    623 double *q, int ldq);
    -
    624
    -
    651int la_form_qr_cmplx(bool fullq, int m, int n, double complex *r, int ldr,
    -
    652 const double complex *tau, double complex *q, int ldq);
    -
    653
    -
    686int la_form_qr_pvt(bool fullq, int m, int n, double *r, int ldr,
    -
    687 const double *tau, const int *pvt, double *q, int ldq, double *p, int ldp);
    -
    688
    -
    721int la_form_qr_cmplx_pvt(bool fullq, int m, int n, double complex *r, int ldr,
    -
    722 const double complex *tau, const int *pvt, double complex *q, int ldq,
    -
    723 double complex *p, int ldp);
    -
    724
    -
    754int la_mult_qr(bool lside, bool trans, int m, int n, int k, double *a, int lda,
    -
    755 const double *tau, double *c, int ldc);
    -
    756
    -
    786int la_mult_qr_cmplx(bool lside, bool trans, int m, int n, int k,
    -
    787 double complex *a, int lda, const double complex *tau, double complex *c,
    -
    788 int ldc);
    -
    789
    -
    813int la_qr_rank1_update(int m, int n, double *q, int ldq, double *r, int ldr,
    -
    814 double *u, double *v);
    -
    815
    -
    839int la_qr_rank1_update_cmplx(int m, int n, double complex *q, int ldq,
    -
    840 double complex *r, int ldr, double complex *u, double complex *v);
    -
    841
    -
    860int la_cholesky_factor(bool upper, int n, double *a, int lda);
    -
    861
    -
    880int la_cholesky_factor_cmplx(bool upper, int n, double complex *a, int lda);
    -
    881
    -
    899int la_cholesky_rank1_update(int n, double *r, int ldr, double *u);
    -
    900
    -
    918int la_cholesky_rank1_update_cmplx(int n, double complex *r, int ldr,
    -
    919 double complex *u);
    -
    920
    -
    940int la_cholesky_rank1_downdate(int n, double *r, int ldr, double *u);
    -
    941
    -
    961int la_cholesky_rank1_downdate_cmplx(int n, double complex *r, int ldr,
    -
    962 double complex *u);
    -
    963
    -
    993int la_svd(int m, int n, double *a, int lda, double *s, double *u, int ldu,
    -
    994 double *vt, int ldv);
    -
    995
    -
    1025int la_svd_cmplx(int m, int n, double complex *a, int lda, double *s,
    -
    1026 double complex *u, int ldu, double complex *vt, int ldv);
    -
    1027
    -
    1056int la_solve_tri_mtx(bool lside, bool upper, bool trans, bool nounit, int m,
    -
    1057 int n, double alpha, const double *a, int lda, double *b, int ldb);
    -
    1058
    -
    1087int la_solve_tri_mtx_cmplx(bool lside, bool upper, bool trans, bool nounit,
    -
    1088 int m, int n, double complex alpha, const double complex *a, int lda,
    -
    1089 double complex *b, int ldb);
    -
    1090
    -
    1107int la_solve_lu(int m, int n, const double *a, int lda, const int *ipvt,
    -
    1108 double *b, int ldb);
    -
    1109
    -
    1126int la_solve_lu_cmplx(int m, int n, const double complex *a, int lda,
    -
    1127 const int *ipvt, double complex *b, int ldb);
    -
    1128
    -
    1152int la_solve_qr(int m, int n, int k, double *a, int lda, const double *tau,
    -
    1153 double *b, int ldb);
    -
    1154
    -
    1178int la_solve_qr_cmplx(int m, int n, int k, double complex *a, int lda,
    -
    1179 const double complex *tau, double complex *b, int ldb);
    -
    1180
    -
    1204int la_solve_qr_pvt(int m, int n, int k, double *a, int lda, const double *tau,
    -
    1205 const int *jpvt, double *b, int ldb);
    -
    1206
    -
    1230int la_solve_qr_cmplx_pvt(int m, int n, int k, double complex *a, int lda,
    -
    1231 const double complex *tau, const int *jpvt, double complex *b, int ldb);
    -
    1232
    -
    1251int la_solve_cholesky(bool upper, int m, int n, const double *a, int lda,
    -
    1252 double *b, int ldb);
    -
    1253
    -
    1272int la_solve_cholesky_cmplx(bool upper, int m, int n, const double complex *a,
    -
    1273 int lda, double complex *b, int ldb);
    -
    1274
    -
    1300int la_solve_least_squares(int m, int n, int k, double *a, int lda, double *b,
    -
    1301 int ldb);
    -
    1302
    -
    1328int la_solve_least_squares_cmplx(int m, int n, int k, double complex *a,
    -
    1329 int lda, double complex *b, int ldb);
    -
    1330
    -
    1344int la_inverse(int n, double *a, int lda);
    -
    1345
    -
    1359int la_inverse_cmplx(int n, double complex *a, int lda);
    -
    1360
    -
    1378int la_pinverse(int m, int n, double *a, int lda, double *ainv, int ldai);
    -
    1379
    -
    1397int la_pinverse_cmplx(int m, int n, double complex *a, int lda,
    -
    1398 double complex *ainv, int ldai);
    -
    1399
    -
    1423int la_eigen_symm(bool vecs, int n, double *a, int lda, double *vals);
    -
    1424
    -
    1447int la_eigen_asymm(bool vecs, int n, double *a, int lda,
    -
    1448 double complex *vals, double complex *v, int ldv);
    -
    1449
    -
    1482int la_eigen_gen(bool vecs, int n, double *a, int lda, double *b, int ldb,
    -
    1483 double complex *alpha, double *beta, double complex *v, int ldv);
    -
    1484
    -
    1507int la_eigen_cmplx(bool vecs, int n, double complex *a, int lda,
    -
    1508 double complex *vals, double complex *v, int ldv);
    -
    1509
    -
    1529int la_sort_eigen(bool ascend, int n, double *vals, double *vecs, int ldv);
    -
    1530
    -
    1550int la_sort_eigen_cmplx(bool ascend, int n, double complex *vals,
    -
    1551 double complex *vecs, int ldv);
    -
    1552
    -
    1553#ifdef __cplusplus
    -
    1554}
    -
    1555#endif // __cplusplus
    -
    1556#endif // LINALG_H_
    +Go to the documentation of this file.
    1
    +
    2#ifndef LINALG_H_DEFINED
    +
    3#define LINALG_H_DEFINED
    +
    4
    +
    5#include <stdbool.h>
    +
    6#include <complex.h>
    +
    7
    +
    8#define LA_NO_OPERATION 0
    +
    9#define LA_TRANSPOSE 1
    +
    10#define LA_HERMITIAN_TRANSPOSE 2
    +
    11#define LA_NO_ERROR 0
    +
    12#define LA_INVALID_INPUT_ERROR 101
    +
    13#define LA_ARRAY_SIZE_ERROR 102
    +
    14#define LA_SINGULAR_MATRIX_ERROR 103
    +
    15#define LA_MATRIX_FORMAT_ERROR 104
    +
    16#define LA_OUT_OF_MEMORY_ERROR 105
    +
    17#define LA_CONVERGENCE_ERROR 106
    +
    18#define LA_INVALID_OPERATION_ERROR 107
    +
    19
    +
    20#ifdef __cplusplus
    +
    21extern "C" {
    +
    22#endif
    +
    23
    +
    43int la_rank1_update(int m, int n, double alpha, const double *x,
    +
    44 const double *y, double *a, int lda);
    +
    45
    +
    65int la_rank1_update_cmplx(int m, int n, double complex alpha,
    +
    66 const double complex *x, const double complex *y, double complex *a,
    +
    67 int lda);
    +
    68
    +
    83int la_trace(int m, int n, const double *a, int lda, double *rst);
    +
    84
    +
    99int la_trace_cmplx(int m, int n, const double complex *a, int lda,
    +
    100 double complex *rst);
    +
    101
    +
    128int la_mtx_mult(bool transa, bool transb, int m, int n, int k, double alpha,
    +
    129 const double *a, int lda, const double *b, int ldb, double beta,
    +
    130 double *c, int ldc);
    +
    131
    +
    160int la_mtx_mult_cmplx(int opa, int opb, int m, int n, int k,
    +
    161 double complex alpha, const double complex *a, int lda,
    +
    162 const double complex *b, int ldb, double complex beta, double complex *c,
    +
    163 int ldc);
    +
    164
    +
    198int la_diag_mtx_mult(bool lside, bool transb, int m, int n, int k,
    +
    199 double alpha, const double *a, const double *b, int ldb, double beta,
    +
    200 double *c, int ldc);
    +
    201
    +
    236int la_diag_mtx_mult_cmplx(bool lside, int opb, int m, int n, int k,
    +
    237 double complex alpha, const double complex *a, const double complex *b,
    +
    238 int ldb, double complex beta, double complex *c, int ldc);
    +
    239
    +
    274int la_diag_mtx_mult_mixed(bool lside, int opb, int m, int n, int k,
    +
    275 double complex alpha, const double *a, const double complex *b,
    +
    276 int ldb, double complex beta, double complex *c, int ldc);
    +
    277
    +
    296int la_rank(int m, int n, double *a, int lda, int *rnk);
    +
    297
    +
    316int la_rank_cmplx(int m, int n, double complex *a, int lda, int *rnk);
    +
    317
    +
    333int la_det(int n, double *a, int lda, double *d);
    +
    334
    +
    350int la_det_cmplx(int n, double complex *a, int lda, double complex *d);
    +
    351
    +
    377int la_tri_mtx_mult(bool upper, double alpha, int n, const double *a, int lda,
    +
    378 double beta, double *b, int ldb);
    +
    379
    +
    405int la_tri_mtx_mult_cmplx(bool upper, double complex alpha, int n,
    +
    406 const double complex *a, int lda, double complex beta,
    +
    407 double complex *b, int ldb);
    +
    408
    +
    428int la_lu_factor(int m, int n, double *a, int lda, int *ipvt);
    +
    429
    +
    449int la_lu_factor_cmplx(int m, int n, double complex *a, int lda, int *ipvt);
    +
    450
    +
    472int la_form_lu(int n, double *a, int lda, int *ipvt, double *u, int ldu,
    +
    473 double *p, int ldp);
    +
    474
    +
    496int la_form_lu_cmplx(int n, double complex *a, int lda, int *ipvt,
    +
    497 double complex *u, int ldu, double *p, int ldp);
    +
    498
    +
    520int la_qr_factor(int m, int n, double *a, int lda, double *tau);
    +
    521
    +
    543int la_qr_factor_cmplx(int m, int n, double complex *a, int lda,
    +
    544 double complex *tau);
    +
    545
    +
    570int la_qr_factor_pvt(int m, int n, double *a, int lda, double *tau, int *jpvt);
    +
    571
    +
    596int la_qr_factor_cmplx_pvt(int m, int n, double complex *a, int lda,
    +
    597 double complex *tau, int *jpvt);
    +
    598
    +
    625int la_form_qr(bool fullq, int m, int n, double *r, int ldr, const double *tau,
    +
    626 double *q, int ldq);
    +
    627
    +
    654int la_form_qr_cmplx(bool fullq, int m, int n, double complex *r, int ldr,
    +
    655 const double complex *tau, double complex *q, int ldq);
    +
    656
    +
    689int la_form_qr_pvt(bool fullq, int m, int n, double *r, int ldr,
    +
    690 const double *tau, const int *pvt, double *q, int ldq, double *p, int ldp);
    +
    691
    +
    724int la_form_qr_cmplx_pvt(bool fullq, int m, int n, double complex *r, int ldr,
    +
    725 const double complex *tau, const int *pvt, double complex *q, int ldq,
    +
    726 double complex *p, int ldp);
    +
    727
    +
    757int la_mult_qr(bool lside, bool trans, int m, int n, int k, double *a, int lda,
    +
    758 const double *tau, double *c, int ldc);
    +
    759
    +
    789int la_mult_qr_cmplx(bool lside, bool trans, int m, int n, int k,
    +
    790 double complex *a, int lda, const double complex *tau, double complex *c,
    +
    791 int ldc);
    +
    792
    +
    817int la_qr_rank1_update(int m, int n, double *q, int ldq, double *r, int ldr,
    +
    818 double *u, double *v);
    +
    819
    +
    844int la_qr_rank1_update_cmplx(int m, int n, double complex *q, int ldq,
    +
    845 double complex *r, int ldr, double complex *u, double complex *v);
    +
    846
    +
    865int la_cholesky_factor(bool upper, int n, double *a, int lda);
    +
    866
    +
    885int la_cholesky_factor_cmplx(bool upper, int n, double complex *a, int lda);
    +
    886
    +
    904int la_cholesky_rank1_update(int n, double *r, int ldr, double *u);
    +
    905
    +
    923int la_cholesky_rank1_update_cmplx(int n, double complex *r, int ldr,
    +
    924 double complex *u);
    +
    925
    +
    945int la_cholesky_rank1_downdate(int n, double *r, int ldr, double *u);
    +
    946
    +
    966int la_cholesky_rank1_downdate_cmplx(int n, double complex *r, int ldr,
    +
    967 double complex *u);
    +
    968
    +
    998int la_svd(int m, int n, double *a, int lda, double *s, double *u, int ldu,
    +
    999 double *vt, int ldv);
    +
    1000
    +
    1030int la_svd_cmplx(int m, int n, double complex *a, int lda, double *s,
    +
    1031 double complex *u, int ldu, double complex *vt, int ldv);
    +
    1032
    +
    1061int la_solve_tri_mtx(bool lside, bool upper, bool trans, bool nounit, int m,
    +
    1062 int n, double alpha, const double *a, int lda, double *b, int ldb);
    +
    1063
    +
    1092int la_solve_tri_mtx_cmplx(bool lside, bool upper, bool trans, bool nounit,
    +
    1093 int m, int n, double complex alpha, const double complex *a, int lda,
    +
    1094 double complex *b, int ldb);
    +
    1095
    +
    1112int la_solve_lu(int m, int n, const double *a, int lda, const int *ipvt,
    +
    1113 double *b, int ldb);
    +
    1114
    +
    1131int la_solve_lu_cmplx(int m, int n, const double complex *a, int lda,
    +
    1132 const int *ipvt, double complex *b, int ldb);
    +
    1133
    +
    1157int la_solve_qr(int m, int n, int k, double *a, int lda, const double *tau,
    +
    1158 double *b, int ldb);
    +
    1159
    +
    1183int la_solve_qr_cmplx(int m, int n, int k, double complex *a, int lda,
    +
    1184 const double complex *tau, double complex *b, int ldb);
    +
    1185
    +
    1209int la_solve_qr_pvt(int m, int n, int k, double *a, int lda, const double *tau,
    +
    1210 const int *jpvt, double *b, int ldb);
    +
    1211
    +
    1235int la_solve_qr_cmplx_pvt(int m, int n, int k, double complex *a, int lda,
    +
    1236 const double complex *tau, const int *jpvt, double complex *b, int ldb);
    +
    1237
    +
    1256int la_solve_cholesky(bool upper, int m, int n, const double *a, int lda,
    +
    1257 double *b, int ldb);
    +
    1258
    +
    1277int la_solve_cholesky_cmplx(bool upper, int m, int n, const double complex *a,
    +
    1278 int lda, double complex *b, int ldb);
    +
    1279
    +
    1305int la_solve_least_squares(int m, int n, int k, double *a, int lda, double *b,
    +
    1306 int ldb);
    +
    1307
    +
    1333int la_solve_least_squares_cmplx(int m, int n, int k, double complex *a,
    +
    1334 int lda, double complex *b, int ldb);
    +
    1335
    +
    1349int la_inverse(int n, double *a, int lda);
    +
    1350
    +
    1364int la_inverse_cmplx(int n, double complex *a, int lda);
    +
    1365
    +
    1383int la_pinverse(int m, int n, double *a, int lda, double *ainv, int ldai);
    +
    1384
    +
    1402int la_pinverse_cmplx(int m, int n, double complex *a, int lda,
    +
    1403 double complex *ainv, int ldai);
    +
    1404
    +
    1428int la_eigen_symm(bool vecs, int n, double *a, int lda, double *vals);
    +
    1429
    +
    1452int la_eigen_asymm(bool vecs, int n, double *a, int lda,
    +
    1453 double complex *vals, double complex *v, int ldv);
    +
    1454
    +
    1487int la_eigen_gen(bool vecs, int n, double *a, int lda, double *b, int ldb,
    +
    1488 double complex *alpha, double *beta, double complex *v, int ldv);
    +
    1489
    +
    1512int la_eigen_cmplx(bool vecs, int n, double complex *a, int lda,
    +
    1513 double complex *vals, double complex *v, int ldv);
    +
    1514
    +
    1534int la_sort_eigen(bool ascend, int n, double *vals, double *vecs, int ldv);
    +
    1535
    +
    1555int la_sort_eigen_cmplx(bool ascend, int n, double complex *vals,
    +
    1556 double complex *vecs, int ldv);
    +
    1557
    +
    1558#ifdef __cplusplus
    +
    1559}
    +
    1560#endif // __cplusplus
    +
    1561#endif // LINALG_H_DEFINED
    +
    int la_cholesky_rank1_downdate_cmplx(int n, double complex *r, int ldr, double complex *u)
    +
    int la_trace_cmplx(int m, int n, const double complex *a, int lda, double complex *rst)
    +
    int la_tri_mtx_mult_cmplx(bool upper, double complex alpha, int n, const double complex *a, int lda, double complex beta, double complex *b, int ldb)
    +
    int la_solve_least_squares(int m, int n, int k, double *a, int lda, double *b, int ldb)
    +
    int la_form_qr_cmplx(bool fullq, int m, int n, double complex *r, int ldr, const double complex *tau, double complex *q, int ldq)
    +
    int la_rank(int m, int n, double *a, int lda, int *rnk)
    +
    int la_sort_eigen_cmplx(bool ascend, int n, double complex *vals, double complex *vecs, int ldv)
    +
    int la_solve_cholesky(bool upper, int m, int n, const double *a, int lda, double *b, int ldb)
    +
    int la_solve_qr_cmplx(int m, int n, int k, double complex *a, int lda, const double complex *tau, double complex *b, int ldb)
    +
    int la_form_lu(int n, double *a, int lda, int *ipvt, double *u, int ldu, double *p, int ldp)
    +
    int la_cholesky_factor_cmplx(bool upper, int n, double complex *a, int lda)
    +
    int la_lu_factor(int m, int n, double *a, int lda, int *ipvt)
    +
    int la_cholesky_rank1_downdate(int n, double *r, int ldr, double *u)
    +
    int la_cholesky_factor(bool upper, int n, double *a, int lda)
    +
    int la_rank1_update_cmplx(int m, int n, double complex alpha, const double complex *x, const double complex *y, double complex *a, int lda)
    +
    int la_qr_factor_cmplx_pvt(int m, int n, double complex *a, int lda, double complex *tau, int *jpvt)
    +
    int la_diag_mtx_mult(bool lside, bool transb, int m, int n, int k, double alpha, const double *a, const double *b, int ldb, double beta, double *c, int ldc)
    +
    int la_qr_factor_pvt(int m, int n, double *a, int lda, double *tau, int *jpvt)
    +
    int la_diag_mtx_mult_mixed(bool lside, int opb, int m, int n, int k, double complex alpha, const double *a, const double complex *b, int ldb, double complex beta, double complex *c, int ldc)
    +
    int la_svd(int m, int n, double *a, int lda, double *s, double *u, int ldu, double *vt, int ldv)
    +
    int la_solve_qr_pvt(int m, int n, int k, double *a, int lda, const double *tau, const int *jpvt, double *b, int ldb)
    +
    int la_diag_mtx_mult_cmplx(bool lside, int opb, int m, int n, int k, double complex alpha, const double complex *a, const double complex *b, int ldb, double complex beta, double complex *c, int ldc)
    +
    int la_solve_cholesky_cmplx(bool upper, int m, int n, const double complex *a, int lda, double complex *b, int ldb)
    +
    int la_pinverse_cmplx(int m, int n, double complex *a, int lda, double complex *ainv, int ldai)
    +
    int la_form_lu_cmplx(int n, double complex *a, int lda, int *ipvt, double complex *u, int ldu, double *p, int ldp)
    +
    int la_qr_factor(int m, int n, double *a, int lda, double *tau)
    +
    int la_inverse_cmplx(int n, double complex *a, int lda)
    +
    int la_trace(int m, int n, const double *a, int lda, double *rst)
    +
    int la_eigen_asymm(bool vecs, int n, double *a, int lda, double complex *vals, double complex *v, int ldv)
    +
    int la_inverse(int n, double *a, int lda)
    +
    int la_mult_qr(bool lside, bool trans, int m, int n, int k, double *a, int lda, const double *tau, double *c, int ldc)
    +
    int la_mtx_mult(bool transa, bool transb, int m, int n, int k, double alpha, const double *a, int lda, const double *b, int ldb, double beta, double *c, int ldc)
    +
    int la_qr_rank1_update(int m, int n, double *q, int ldq, double *r, int ldr, double *u, double *v)
    +
    int la_solve_lu_cmplx(int m, int n, const double complex *a, int lda, const int *ipvt, double complex *b, int ldb)
    +
    int la_form_qr_pvt(bool fullq, int m, int n, double *r, int ldr, const double *tau, const int *pvt, double *q, int ldq, double *p, int ldp)
    +
    int la_solve_lu(int m, int n, const double *a, int lda, const int *ipvt, double *b, int ldb)
    +
    int la_rank1_update(int m, int n, double alpha, const double *x, const double *y, double *a, int lda)
    +
    int la_cholesky_rank1_update(int n, double *r, int ldr, double *u)
    +
    int la_sort_eigen(bool ascend, int n, double *vals, double *vecs, int ldv)
    +
    int la_eigen_symm(bool vecs, int n, double *a, int lda, double *vals)
    +
    int la_solve_least_squares_cmplx(int m, int n, int k, double complex *a, int lda, double complex *b, int ldb)
    +
    int la_det(int n, double *a, int lda, double *d)
    +
    int la_mult_qr_cmplx(bool lside, bool trans, int m, int n, int k, double complex *a, int lda, const double complex *tau, double complex *c, int ldc)
    +
    int la_lu_factor_cmplx(int m, int n, double complex *a, int lda, int *ipvt)
    +
    int la_det_cmplx(int n, double complex *a, int lda, double complex *d)
    +
    int la_qr_rank1_update_cmplx(int m, int n, double complex *q, int ldq, double complex *r, int ldr, double complex *u, double complex *v)
    +
    int la_solve_qr_cmplx_pvt(int m, int n, int k, double complex *a, int lda, const double complex *tau, const int *jpvt, double complex *b, int ldb)
    +
    int la_form_qr_cmplx_pvt(bool fullq, int m, int n, double complex *r, int ldr, const double complex *tau, const int *pvt, double complex *q, int ldq, double complex *p, int ldp)
    +
    int la_eigen_cmplx(bool vecs, int n, double complex *a, int lda, double complex *vals, double complex *v, int ldv)
    +
    int la_qr_factor_cmplx(int m, int n, double complex *a, int lda, double complex *tau)
    +
    int la_tri_mtx_mult(bool upper, double alpha, int n, const double *a, int lda, double beta, double *b, int ldb)
    +
    int la_solve_tri_mtx(bool lside, bool upper, bool trans, bool nounit, int m, int n, double alpha, const double *a, int lda, double *b, int ldb)
    +
    int la_solve_qr(int m, int n, int k, double *a, int lda, const double *tau, double *b, int ldb)
    +
    int la_mtx_mult_cmplx(int opa, int opb, int m, int n, int k, double complex alpha, const double complex *a, int lda, const double complex *b, int ldb, double complex beta, double complex *c, int ldc)
    +
    int la_cholesky_rank1_update_cmplx(int n, double complex *r, int ldr, double complex *u)
    +
    int la_eigen_gen(bool vecs, int n, double *a, int lda, double *b, int ldb, double complex *alpha, double *beta, double complex *v, int ldv)
    +
    int la_pinverse(int m, int n, double *a, int lda, double *ainv, int ldai)
    +
    int la_solve_tri_mtx_cmplx(bool lside, bool upper, bool trans, bool nounit, int m, int n, double complex alpha, const double complex *a, int lda, double complex *b, int ldb)
    +
    int la_svd_cmplx(int m, int n, double complex *a, int lda, double *s, double complex *u, int ldu, double complex *vt, int ldv)
    +
    int la_rank_cmplx(int m, int n, double complex *a, int lda, int *rnk)
    +
    int la_form_qr(bool fullq, int m, int n, double *r, int ldr, const double *tau, double *q, int ldq)
    diff --git a/doc/html/linalg__basic_8f90_source.html b/doc/html/linalg__basic_8f90_source.html index c502fe6c..1a09a6fc 100644 --- a/doc/html/linalg__basic_8f90_source.html +++ b/doc/html/linalg__basic_8f90_source.html @@ -2320,7 +2320,7 @@
    2218
    2219! ------------------------------------------------------------------------------
    2220end submodule
    -
    Provides a set of common linear algebra routines.
    Definition: linalg.f90:15
    +
    Provides a set of common linear algebra routines.
    Definition: linalg.f90:145
    diff --git a/doc/html/linalg__eigen_8f90_source.html b/doc/html/linalg__eigen_8f90_source.html index 2bd848de..d3035a8a 100644 --- a/doc/html/linalg__eigen_8f90_source.html +++ b/doc/html/linalg__eigen_8f90_source.html @@ -701,7 +701,7 @@
    603
    604! ------------------------------------------------------------------------------
    605end submodule
    -
    Provides a set of common linear algebra routines.
    Definition: linalg.f90:15
    +
    Provides a set of common linear algebra routines.
    Definition: linalg.f90:145
    diff --git a/doc/html/linalg__factor_8f90_source.html b/doc/html/linalg__factor_8f90_source.html index 410463ea..964d3aca 100644 --- a/doc/html/linalg__factor_8f90_source.html +++ b/doc/html/linalg__factor_8f90_source.html @@ -2960,7 +2960,7 @@
    2862
    2863! ------------------------------------------------------------------------------
    2864end submodule
    -
    Provides a set of common linear algebra routines.
    Definition: linalg.f90:15
    +
    Provides a set of common linear algebra routines.
    Definition: linalg.f90:145
    diff --git a/doc/html/linalg__solve_8f90_source.html b/doc/html/linalg__solve_8f90_source.html index 1e19e300..c7ab519e 100644 --- a/doc/html/linalg__solve_8f90_source.html +++ b/doc/html/linalg__solve_8f90_source.html @@ -3565,7 +3565,7 @@
    3467 end subroutine
    3468
    3469end submodule
    -
    Provides a set of common linear algebra routines.
    Definition: linalg.f90:15
    +
    Provides a set of common linear algebra routines.
    Definition: linalg.f90:145
    diff --git a/doc/html/linalg__sorting_8f90_source.html b/doc/html/linalg__sorting_8f90_source.html index e138ecff..7c2a6ed4 100644 --- a/doc/html/linalg__sorting_8f90_source.html +++ b/doc/html/linalg__sorting_8f90_source.html @@ -655,7 +655,7 @@
    651
    652! ------------------------------------------------------------------------------
    653end submodule
    -
    Provides a set of common linear algebra routines.
    Definition: linalg.f90:15
    +
    Provides a set of common linear algebra routines.
    Definition: linalg.f90:145
    diff --git a/doc/html/menudata.js b/doc/html/menudata.js index 845aa810..c6ae8736 100644 --- a/doc/html/menudata.js +++ b/doc/html/menudata.js @@ -33,4 +33,9 @@ var menudata={children:[ {text:"Data Types List",url:"annotated.html"}, {text:"Data Types",url:"classes.html"}]}, {text:"Files",url:"files.html",children:[ -{text:"File List",url:"files.html"}]}]} +{text:"File List",url:"files.html"}, +{text:"File Members",url:"globals.html",children:[ +{text:"All",url:"globals.html",children:[ +{text:"l",url:"globals.html#index_l"}]}, +{text:"Functions/Subroutines",url:"globals_func.html",children:[ +{text:"l",url:"globals_func.html#index_l"}]}]}]}]} diff --git a/doc/html/namespacelinalg.html b/doc/html/namespacelinalg.html index 5db538c0..ac5759ff 100644 --- a/doc/html/namespacelinalg.html +++ b/doc/html/namespacelinalg.html @@ -158,7 +158,7 @@  Computes the QR factorization of an M-by-N matrix. More...
      interface  qr_rank1_update - Computes the rank 1 update to an M-by-N QR factored matrix A (M >= N) where \( A = Q R \), and \( A1 = A + U V^T \) such that \( A1 = Q1 R1 \). More...
    + Computes the rank 1 update to an M-by-N QR factored matrix A (M >= N) where \( A = Q R \), and \( A1 = A + U V^T \) such that \( A1 = Q1 R1 \). In the event \( V \) is complex-valued, \( V^H \) is computed instead of \( V^T \). More...
      interface  rank1_update  Performs the rank-1 update to matrix A such that: \( A = \alpha X Y^T + A \), where \( A \) is an M-by-N matrix, \( \alpha \)is a scalar, \( X \) is an M-element array, and \( Y \) is an N-element array. In the event that \( Y \) is complex, \( Y^H \) is used instead of \( Y^T \). More...
    @@ -194,7 +194,7 @@  Sorts an array. More...
      interface  svd - Computes the singular value decomposition of a matrix A. The SVD is defined as: \( A = U S V^T \), where \( U \) is an M-by-M orthogonal matrix, \( S \) is an M-by-N diagonal matrix, and \( V \) is an N-by-N orthogonal matrix. More...
    + Computes the singular value decomposition of a matrix A. The SVD is defined as: \( A = U S V^T \), where \( U \) is an M-by-M orthogonal matrix, \( S \) is an M-by-N diagonal matrix, and \( V \) is an N-by-N orthogonal matrix. In the event that \( V \) is complex valued, \( V^H \) is computed instead of \( V^T \). More...
      interface  swap  Swaps the contents of two arrays. More...
    @@ -259,7 +259,7 @@

    Definition at line 83 of file linalg.f90.

    +

    Definition at line 213 of file linalg.f90.

    @@ -277,7 +277,7 @@

    Definition at line 91 of file linalg.f90.

    +

    Definition at line 221 of file linalg.f90.

    @@ -295,7 +295,7 @@

    Definition at line 73 of file linalg.f90.

    +

    Definition at line 203 of file linalg.f90.

    @@ -313,7 +313,7 @@

    Definition at line 81 of file linalg.f90.

    +

    Definition at line 211 of file linalg.f90.

    @@ -331,7 +331,7 @@

    Definition at line 93 of file linalg.f90.

    +

    Definition at line 223 of file linalg.f90.

    @@ -349,7 +349,7 @@

    Definition at line 87 of file linalg.f90.

    +

    Definition at line 217 of file linalg.f90.

    @@ -367,7 +367,7 @@

    Definition at line 79 of file linalg.f90.

    +

    Definition at line 209 of file linalg.f90.

    @@ -385,7 +385,7 @@

    Definition at line 69 of file linalg.f90.

    +

    Definition at line 199 of file linalg.f90.

    @@ -403,7 +403,7 @@

    Definition at line 89 of file linalg.f90.

    +

    Definition at line 219 of file linalg.f90.

    @@ -421,7 +421,7 @@

    Definition at line 85 of file linalg.f90.

    +

    Definition at line 215 of file linalg.f90.

    @@ -439,7 +439,7 @@

    Definition at line 71 of file linalg.f90.

    +

    Definition at line 201 of file linalg.f90.

    diff --git a/doc/html/namespaces.html b/doc/html/namespaces.html index 544b9fad..d6222f73 100644 --- a/doc/html/namespaces.html +++ b/doc/html/namespaces.html @@ -119,7 +119,7 @@  Cmult_qrMultiplies a general matrix by the orthogonal matrix Q from a QR factorization  Cmult_rzMultiplies a general matrix by the orthogonal matrix Z from an RZ factorization  Cqr_factorComputes the QR factorization of an M-by-N matrix - Cqr_rank1_updateComputes the rank 1 update to an M-by-N QR factored matrix A (M >= N) where \( A = Q R \), and \( A1 = A + U V^T \) such that \( A1 = Q1 R1 \) + Cqr_rank1_updateComputes the rank 1 update to an M-by-N QR factored matrix A (M >= N) where \( A = Q R \), and \( A1 = A + U V^T \) such that \( A1 = Q1 R1 \). In the event \( V \) is complex-valued, \( V^H \) is computed instead of \( V^T \)  Crank1_updatePerforms the rank-1 update to matrix A such that: \( A = \alpha X Y^T + A \), where \( A \) is an M-by-N matrix, \( \alpha \)is a scalar, \( X \) is an M-element array, and \( Y \) is an N-element array. In the event that \( Y \) is complex, \( Y^H \) is used instead of \( Y^T \)  Crecip_mult_arrayMultiplies a vector by the reciprocal of a real scalar  Crz_factorFactors an upper trapezoidal matrix by means of orthogonal transformations such that \( A = R Z = (R 0) Z \). Z is an orthogonal matrix of dimension N-by-N, and R is an M-by-M upper triangular matrix @@ -131,7 +131,7 @@  Csolve_qrSolves a system of M QR-factored equations of N unknowns  Csolve_triangular_systemSolves a triangular system of equations  CsortSorts an array - CsvdComputes the singular value decomposition of a matrix A. The SVD is defined as: \( A = U S V^T \), where \( U \) is an M-by-M orthogonal matrix, \( S \) is an M-by-N diagonal matrix, and \( V \) is an N-by-N orthogonal matrix + CsvdComputes the singular value decomposition of a matrix A. The SVD is defined as: \( A = U S V^T \), where \( U \) is an M-by-M orthogonal matrix, \( S \) is an M-by-N diagonal matrix, and \( V \) is an N-by-N orthogonal matrix. In the event that \( V \) is complex valued, \( V^H \) is computed instead of \( V^T \)  CswapSwaps the contents of two arrays  CtraceComputes the trace of a matrix (the sum of the main diagonal elements)  Ctri_mtx_multComputes the triangular matrix operation: \( B = \alpha A^T A + \beta B \), or \( B = \alpha A A^T + \beta B \), where A is a triangular matrix diff --git a/doc/html/navtreedata.js b/doc/html/navtreedata.js index d27fffa8..9d7161c8 100644 --- a/doc/html/navtreedata.js +++ b/doc/html/navtreedata.js @@ -38,7 +38,11 @@ var NAVTREE = [ "Data Types", "classes.html", null ] ] ], [ "Files", "files.html", [ - [ "File List", "files.html", "files_dup" ] + [ "File List", "files.html", "files_dup" ], + [ "File Members", "globals.html", [ + [ "All", "globals.html", null ], + [ "Functions/Subroutines", "globals_func.html", null ] + ] ] ] ] ] ] ]; diff --git a/doc/html/navtreeindex0.js b/doc/html/navtreeindex0.js index 7d06be01..69609c75 100644 --- a/doc/html/navtreeindex0.js +++ b/doc/html/navtreeindex0.js @@ -5,6 +5,8 @@ var NAVTREEINDEX0 = "dir_68267d1309a1af8e8297ef4c3efbcdba.html":[3,0,1], "dir_d44c64559bbebec7f509842c48db8b23.html":[3,0,0], "files.html":[3,0], +"globals.html":[3,1,0], +"globals_func.html":[3,1,1], "index.html":[], "index.html#intro_sec":[0], "interfacelinalg_1_1cholesky__factor.html":[1,0,0,0], @@ -13,46 +15,46 @@ var NAVTREEINDEX0 = "interfacelinalg_1_1cholesky__rank1__downdate.html":[2,0,0,1], "interfacelinalg_1_1cholesky__rank1__update.html":[1,0,0,2], "interfacelinalg_1_1cholesky__rank1__update.html":[2,0,0,2], -"interfacelinalg_1_1det.html":[1,0,0,3], "interfacelinalg_1_1det.html":[2,0,0,3], -"interfacelinalg_1_1diag__mtx__mult.html":[1,0,0,4], +"interfacelinalg_1_1det.html":[1,0,0,3], "interfacelinalg_1_1diag__mtx__mult.html":[2,0,0,4], +"interfacelinalg_1_1diag__mtx__mult.html":[1,0,0,4], "interfacelinalg_1_1eigen.html":[2,0,0,5], "interfacelinalg_1_1eigen.html":[1,0,0,5], -"interfacelinalg_1_1form__lu.html":[2,0,0,6], "interfacelinalg_1_1form__lu.html":[1,0,0,6], +"interfacelinalg_1_1form__lu.html":[2,0,0,6], "interfacelinalg_1_1form__qr.html":[1,0,0,7], "interfacelinalg_1_1form__qr.html":[2,0,0,7], -"interfacelinalg_1_1lu__factor.html":[2,0,0,8], "interfacelinalg_1_1lu__factor.html":[1,0,0,8], -"interfacelinalg_1_1mtx__inverse.html":[2,0,0,9], +"interfacelinalg_1_1lu__factor.html":[2,0,0,8], "interfacelinalg_1_1mtx__inverse.html":[1,0,0,9], +"interfacelinalg_1_1mtx__inverse.html":[2,0,0,9], "interfacelinalg_1_1mtx__mult.html":[1,0,0,10], "interfacelinalg_1_1mtx__mult.html":[2,0,0,10], "interfacelinalg_1_1mtx__pinverse.html":[2,0,0,11], "interfacelinalg_1_1mtx__pinverse.html":[1,0,0,11], -"interfacelinalg_1_1mtx__rank.html":[1,0,0,12], "interfacelinalg_1_1mtx__rank.html":[2,0,0,12], -"interfacelinalg_1_1mult__qr.html":[2,0,0,13], +"interfacelinalg_1_1mtx__rank.html":[1,0,0,12], "interfacelinalg_1_1mult__qr.html":[1,0,0,13], +"interfacelinalg_1_1mult__qr.html":[2,0,0,13], "interfacelinalg_1_1mult__rz.html":[2,0,0,14], "interfacelinalg_1_1mult__rz.html":[1,0,0,14], -"interfacelinalg_1_1qr__factor.html":[1,0,0,15], "interfacelinalg_1_1qr__factor.html":[2,0,0,15], -"interfacelinalg_1_1qr__rank1__update.html":[1,0,0,16], +"interfacelinalg_1_1qr__factor.html":[1,0,0,15], "interfacelinalg_1_1qr__rank1__update.html":[2,0,0,16], -"interfacelinalg_1_1rank1__update.html":[1,0,0,17], +"interfacelinalg_1_1qr__rank1__update.html":[1,0,0,16], "interfacelinalg_1_1rank1__update.html":[2,0,0,17], -"interfacelinalg_1_1recip__mult__array.html":[1,0,0,18], +"interfacelinalg_1_1rank1__update.html":[1,0,0,17], "interfacelinalg_1_1recip__mult__array.html":[2,0,0,18], -"interfacelinalg_1_1rz__factor.html":[1,0,0,19], +"interfacelinalg_1_1recip__mult__array.html":[1,0,0,18], "interfacelinalg_1_1rz__factor.html":[2,0,0,19], -"interfacelinalg_1_1solve__cholesky.html":[2,0,0,20], +"interfacelinalg_1_1rz__factor.html":[1,0,0,19], "interfacelinalg_1_1solve__cholesky.html":[1,0,0,20], -"interfacelinalg_1_1solve__least__squares.html":[2,0,0,21], +"interfacelinalg_1_1solve__cholesky.html":[2,0,0,20], "interfacelinalg_1_1solve__least__squares.html":[1,0,0,21], -"interfacelinalg_1_1solve__least__squares__full.html":[2,0,0,22], +"interfacelinalg_1_1solve__least__squares.html":[2,0,0,21], "interfacelinalg_1_1solve__least__squares__full.html":[1,0,0,22], +"interfacelinalg_1_1solve__least__squares__full.html":[2,0,0,22], "interfacelinalg_1_1solve__least__squares__svd.html":[1,0,0,23], "interfacelinalg_1_1solve__least__squares__svd.html":[2,0,0,23], "interfacelinalg_1_1solve__lu.html":[1,0,0,24], @@ -61,17 +63,79 @@ var NAVTREEINDEX0 = "interfacelinalg_1_1solve__qr.html":[2,0,0,25], "interfacelinalg_1_1solve__triangular__system.html":[1,0,0,26], "interfacelinalg_1_1solve__triangular__system.html":[2,0,0,26], -"interfacelinalg_1_1sort.html":[1,0,0,27], "interfacelinalg_1_1sort.html":[2,0,0,27], -"interfacelinalg_1_1svd.html":[1,0,0,28], +"interfacelinalg_1_1sort.html":[1,0,0,27], "interfacelinalg_1_1svd.html":[2,0,0,28], -"interfacelinalg_1_1swap.html":[2,0,0,29], +"interfacelinalg_1_1svd.html":[1,0,0,28], "interfacelinalg_1_1swap.html":[1,0,0,29], +"interfacelinalg_1_1swap.html":[2,0,0,29], "interfacelinalg_1_1trace.html":[1,0,0,30], "interfacelinalg_1_1trace.html":[2,0,0,30], "interfacelinalg_1_1tri__mtx__mult.html":[1,0,0,31], "interfacelinalg_1_1tri__mtx__mult.html":[2,0,0,31], "linalg_8f90_source.html":[3,0,1,0], +"linalg_8h.html":[3,0,0,0], +"linalg_8h.html#a00c15ec713541d15eae1fd0b01897689":[3,0,0,0,3], +"linalg_8h.html#a021fbb7fdccf557ec407a86bace43d85":[3,0,0,0,58], +"linalg_8h.html#a02c464a9dd95298c91f431ae4d0773e9":[3,0,0,0,60], +"linalg_8h.html#a02eb049983dd41f2307bb52594fb210e":[3,0,0,0,43], +"linalg_8h.html#a0338870fe1142f88c96db63495fec615":[3,0,0,0,18], +"linalg_8h.html#a089690d293303e30c6eef0bb1e982191":[3,0,0,0,37], +"linalg_8h.html#a090178a5f99a4b400da80481aad77757":[3,0,0,0,54], +"linalg_8h.html#a0dc578507a0cb6ada776142476383590":[3,0,0,0,41], +"linalg_8h.html#a0ff5f2519eb1d2af94e3b4a26dfb10fe":[3,0,0,0,48], +"linalg_8h.html#a15774f6323c34d307c99b32ac4f188a7":[3,0,0,0,15], +"linalg_8h.html#a1734acc61ef569dfff9c83bcad566f67":[3,0,0,0,1], +"linalg_8h.html#a248142a5f0826cddac5daf1c74f234a6":[3,0,0,0,23], +"linalg_8h.html#a292e54c48a8e7f0203bf11f02844691f":[3,0,0,0,2], +"linalg_8h.html#a3967bc139cba341a513d1353bea62ac9":[3,0,0,0,0], +"linalg_8h.html#a3c958fe274f8d1663dd0188455a5fe15":[3,0,0,0,39], +"linalg_8h.html#a4a3f6dafe185c2985fc76aab3d0abb97":[3,0,0,0,33], +"linalg_8h.html#a4b74177a8914b109e1bf3aa56c9d9cb7":[3,0,0,0,8], +"linalg_8h.html#a4bc671dad87b42ff285a4241322a3764":[3,0,0,0,34], +"linalg_8h.html#a4d5bad18dcc8a52d9594cc21954c572d":[3,0,0,0,10], +"linalg_8h.html#a56c0cea99a066e74c8fff9682d5ca92d":[3,0,0,0,55], +"linalg_8h.html#a62f97b4319f5574aef5e52bbacff14bb":[3,0,0,0,50], +"linalg_8h.html#a63bec2daa56fdc4bbf3f45b67ea14f65":[3,0,0,0,9], +"linalg_8h.html#a719ffdff56c8fa0875409c4f4e5e95cf":[3,0,0,0,42], +"linalg_8h.html#a71ba1a09caca9d59a9d24b95c7ea749b":[3,0,0,0,30], +"linalg_8h.html#a73bea3ca338925cfa4a58bcaea726a14":[3,0,0,0,16], +"linalg_8h.html#a791d5221eb8ad4fcd106cb218590dfc9":[3,0,0,0,31], +"linalg_8h.html#a7a821b41c61670f5710214a4d9178998":[3,0,0,0,22], +"linalg_8h.html#a7f611f8f3de7d56120c78e70671c7112":[3,0,0,0,57], +"linalg_8h.html#a9491626ab4b3664771e1282b61eeaa74":[3,0,0,0,11], +"linalg_8h.html#a95d6ed56844c62d553b940091837014b":[3,0,0,0,21], +"linalg_8h.html#a95f921847131eaedd62a439490d2a801":[3,0,0,0,27], +"linalg_8h.html#a968b10545320af7bbe1030867ae88e8c":[3,0,0,0,25], +"linalg_8h.html#a9b0639faf9ac0af9bbdb348b92746d5f":[3,0,0,0,35], +"linalg_8h.html#aa067ac0d3f58e28371d413ab7419da74":[3,0,0,0,46], +"linalg_8h.html#aace787c5b11959a457b936ace4995033":[3,0,0,0,20], +"linalg_8h.html#aae725d3247301d1163c58f89edff3d4b":[3,0,0,0,45], +"linalg_8h.html#ab346fed23fd61f02d65e09c795c26d74":[3,0,0,0,38], +"linalg_8h.html#abeb7ee58d4151498be96aa91432f296f":[3,0,0,0,4], +"linalg_8h.html#abf5918abab8f97fc2ac5887e051ff493":[3,0,0,0,53], +"linalg_8h.html#ac208d5e6849972a77ef261f2e368868c":[3,0,0,0,14], +"linalg_8h.html#ac3bb7b959d8cc7400e9b13290a895b64":[3,0,0,0,44], +"linalg_8h.html#ac7b4894cd929a106e02a8e37a4d52913":[3,0,0,0,6], +"linalg_8h.html#acc25c0daa53c10ace21a61d78b2e79f3":[3,0,0,0,28], +"linalg_8h.html#ace554b62c12a5d9a2434c8171c756c47":[3,0,0,0,24], +"linalg_8h.html#ace9edf6a878ee4dd0b220b75b7db6431":[3,0,0,0,7], +"linalg_8h.html#acfbd42393c8b1931ff11bc4c7e858aef":[3,0,0,0,36], +"linalg_8h.html#ad0ee4a9c71de62911a71a342790f5070":[3,0,0,0,49], +"linalg_8h.html#ad76e25c5eb98075e83cc9df493be5b38":[3,0,0,0,19], +"linalg_8h.html#ae5a16375c14c924836c33bafa747a1cf":[3,0,0,0,12], +"linalg_8h.html#ae5ffa6e8d9c850bd41f43f7564bf6896":[3,0,0,0,32], +"linalg_8h.html#ae7d70f1ef2a2824772e1bf0f726c257e":[3,0,0,0,59], +"linalg_8h.html#aed7b29bbff1472ebe805054eb9d8c6d4":[3,0,0,0,51], +"linalg_8h.html#aefdc2e6758482d02a3aa7978f7d5efe0":[3,0,0,0,47], +"linalg_8h.html#aefefe80e13f74470d5afaf44b3a45e76":[3,0,0,0,26], +"linalg_8h.html#af19ebf41be31ee92f657131a8fbf55a3":[3,0,0,0,5], +"linalg_8h.html#af3c6f1a45aee2f275d4b109c9bb660d2":[3,0,0,0,13], +"linalg_8h.html#af7f8185c0f25ad3fb0b89cc98d77b3d6":[3,0,0,0,29], +"linalg_8h.html#af87823d73fb5a319e4262594d147e38c":[3,0,0,0,52], +"linalg_8h.html#afbffa0856d75c607a03d3dc7b5b1076e":[3,0,0,0,56], +"linalg_8h.html#afdc9b7e6ffab89915a082c00ceac7258":[3,0,0,0,40], +"linalg_8h.html#afe39765d805c1d9ae93e9aa2f20d8548":[3,0,0,0,17], "linalg_8h_source.html":[3,0,0,0], "linalg__basic_8f90_source.html":[3,0,1,1], "linalg__eigen_8f90_source.html":[3,0,1,2], diff --git a/doc/html/search/all_4.js b/doc/html/search/all_4.js index b18ca7dc..8609fff0 100644 --- a/doc/html/search/all_4.js +++ b/doc/html/search/all_4.js @@ -1,16 +1,78 @@ var searchData= [ ['la_5farray_5fsize_5ferror_0',['la_array_size_error',['../namespacelinalg.html#a7974856c0c0c76e6f1f2098a1eb7eac9',1,'linalg']]], - ['la_5fconvergence_5ferror_1',['la_convergence_error',['../namespacelinalg.html#ac691dea40873ac2a70c8b44c933774a7',1,'linalg']]], - ['la_5fhermitian_5ftranspose_2',['la_hermitian_transpose',['../namespacelinalg.html#a0e420096028b759a87f2f4f4306d202a',1,'linalg']]], - ['la_5finvalid_5finput_5ferror_3',['la_invalid_input_error',['../namespacelinalg.html#ace738355659bce2e9591473f0d543ef7',1,'linalg']]], - ['la_5finvalid_5foperation_5ferror_4',['la_invalid_operation_error',['../namespacelinalg.html#a4f47021e96cd813b568422a2eb3821bc',1,'linalg']]], - ['la_5fmatrix_5fformat_5ferror_5',['la_matrix_format_error',['../namespacelinalg.html#ad89b9d502b7c484df53f9b10b9545776',1,'linalg']]], - ['la_5fno_5ferror_6',['la_no_error',['../namespacelinalg.html#aefdfc0979567e89aa3b8c599d3f766f4',1,'linalg']]], - ['la_5fno_5foperation_7',['la_no_operation',['../namespacelinalg.html#a665d131453840e869510e9e8d2f7f151',1,'linalg']]], - ['la_5fout_5fof_5fmemory_5ferror_8',['la_out_of_memory_error',['../namespacelinalg.html#abfb78ba61c0c2751f1c771c984469006',1,'linalg']]], - ['la_5fsingular_5fmatrix_5ferror_9',['la_singular_matrix_error',['../namespacelinalg.html#af5dc9d60151bb81436b442525871c8c9',1,'linalg']]], - ['la_5ftranspose_10',['la_transpose',['../namespacelinalg.html#a2b842a1fb17710d7ec2f117f5fdb2a59',1,'linalg']]], - ['linalg_11',['linalg',['../index.html',1,'(Global Namespace)'],['../namespacelinalg.html',1,'linalg']]], - ['lu_5ffactor_12',['lu_factor',['../interfacelinalg_1_1lu__factor.html',1,'linalg']]] + ['la_5fcholesky_5ffactor_1',['la_cholesky_factor',['../linalg_8h.html#a3967bc139cba341a513d1353bea62ac9',1,'linalg.h']]], + ['la_5fcholesky_5ffactor_5fcmplx_2',['la_cholesky_factor_cmplx',['../linalg_8h.html#a1734acc61ef569dfff9c83bcad566f67',1,'linalg.h']]], + ['la_5fcholesky_5frank1_5fdowndate_3',['la_cholesky_rank1_downdate',['../linalg_8h.html#a292e54c48a8e7f0203bf11f02844691f',1,'linalg.h']]], + ['la_5fcholesky_5frank1_5fdowndate_5fcmplx_4',['la_cholesky_rank1_downdate_cmplx',['../linalg_8h.html#a00c15ec713541d15eae1fd0b01897689',1,'linalg.h']]], + ['la_5fcholesky_5frank1_5fupdate_5',['la_cholesky_rank1_update',['../linalg_8h.html#abeb7ee58d4151498be96aa91432f296f',1,'linalg.h']]], + ['la_5fcholesky_5frank1_5fupdate_5fcmplx_6',['la_cholesky_rank1_update_cmplx',['../linalg_8h.html#af19ebf41be31ee92f657131a8fbf55a3',1,'linalg.h']]], + ['la_5fconvergence_5ferror_7',['la_convergence_error',['../namespacelinalg.html#ac691dea40873ac2a70c8b44c933774a7',1,'linalg']]], + ['la_5fdet_8',['la_det',['../linalg_8h.html#ac7b4894cd929a106e02a8e37a4d52913',1,'linalg.h']]], + ['la_5fdet_5fcmplx_9',['la_det_cmplx',['../linalg_8h.html#ace9edf6a878ee4dd0b220b75b7db6431',1,'linalg.h']]], + ['la_5fdiag_5fmtx_5fmult_10',['la_diag_mtx_mult',['../linalg_8h.html#a4b74177a8914b109e1bf3aa56c9d9cb7',1,'linalg.h']]], + ['la_5fdiag_5fmtx_5fmult_5fcmplx_11',['la_diag_mtx_mult_cmplx',['../linalg_8h.html#a63bec2daa56fdc4bbf3f45b67ea14f65',1,'linalg.h']]], + ['la_5fdiag_5fmtx_5fmult_5fmixed_12',['la_diag_mtx_mult_mixed',['../linalg_8h.html#a4d5bad18dcc8a52d9594cc21954c572d',1,'linalg.h']]], + ['la_5feigen_5fasymm_13',['la_eigen_asymm',['../linalg_8h.html#a9491626ab4b3664771e1282b61eeaa74',1,'linalg.h']]], + ['la_5feigen_5fcmplx_14',['la_eigen_cmplx',['../linalg_8h.html#ae5a16375c14c924836c33bafa747a1cf',1,'linalg.h']]], + ['la_5feigen_5fgen_15',['la_eigen_gen',['../linalg_8h.html#af3c6f1a45aee2f275d4b109c9bb660d2',1,'linalg.h']]], + ['la_5feigen_5fsymm_16',['la_eigen_symm',['../linalg_8h.html#ac208d5e6849972a77ef261f2e368868c',1,'linalg.h']]], + ['la_5fform_5flu_17',['la_form_lu',['../linalg_8h.html#a15774f6323c34d307c99b32ac4f188a7',1,'linalg.h']]], + ['la_5fform_5flu_5fcmplx_18',['la_form_lu_cmplx',['../linalg_8h.html#a73bea3ca338925cfa4a58bcaea726a14',1,'linalg.h']]], + ['la_5fform_5fqr_19',['la_form_qr',['../linalg_8h.html#afe39765d805c1d9ae93e9aa2f20d8548',1,'linalg.h']]], + ['la_5fform_5fqr_5fcmplx_20',['la_form_qr_cmplx',['../linalg_8h.html#a0338870fe1142f88c96db63495fec615',1,'linalg.h']]], + ['la_5fform_5fqr_5fcmplx_5fpvt_21',['la_form_qr_cmplx_pvt',['../linalg_8h.html#ad76e25c5eb98075e83cc9df493be5b38',1,'linalg.h']]], + ['la_5fform_5fqr_5fpvt_22',['la_form_qr_pvt',['../linalg_8h.html#aace787c5b11959a457b936ace4995033',1,'linalg.h']]], + ['la_5fhermitian_5ftranspose_23',['la_hermitian_transpose',['../namespacelinalg.html#a0e420096028b759a87f2f4f4306d202a',1,'linalg']]], + ['la_5finvalid_5finput_5ferror_24',['la_invalid_input_error',['../namespacelinalg.html#ace738355659bce2e9591473f0d543ef7',1,'linalg']]], + ['la_5finvalid_5foperation_5ferror_25',['la_invalid_operation_error',['../namespacelinalg.html#a4f47021e96cd813b568422a2eb3821bc',1,'linalg']]], + ['la_5finverse_26',['la_inverse',['../linalg_8h.html#a95d6ed56844c62d553b940091837014b',1,'linalg.h']]], + ['la_5finverse_5fcmplx_27',['la_inverse_cmplx',['../linalg_8h.html#a7a821b41c61670f5710214a4d9178998',1,'linalg.h']]], + ['la_5flu_5ffactor_28',['la_lu_factor',['../linalg_8h.html#a248142a5f0826cddac5daf1c74f234a6',1,'linalg.h']]], + ['la_5flu_5ffactor_5fcmplx_29',['la_lu_factor_cmplx',['../linalg_8h.html#ace554b62c12a5d9a2434c8171c756c47',1,'linalg.h']]], + ['la_5fmatrix_5fformat_5ferror_30',['la_matrix_format_error',['../namespacelinalg.html#ad89b9d502b7c484df53f9b10b9545776',1,'linalg']]], + ['la_5fmtx_5fmult_31',['la_mtx_mult',['../linalg_8h.html#a968b10545320af7bbe1030867ae88e8c',1,'linalg.h']]], + ['la_5fmtx_5fmult_5fcmplx_32',['la_mtx_mult_cmplx',['../linalg_8h.html#aefefe80e13f74470d5afaf44b3a45e76',1,'linalg.h']]], + ['la_5fmult_5fqr_33',['la_mult_qr',['../linalg_8h.html#a95f921847131eaedd62a439490d2a801',1,'linalg.h']]], + ['la_5fmult_5fqr_5fcmplx_34',['la_mult_qr_cmplx',['../linalg_8h.html#acc25c0daa53c10ace21a61d78b2e79f3',1,'linalg.h']]], + ['la_5fno_5ferror_35',['la_no_error',['../namespacelinalg.html#aefdfc0979567e89aa3b8c599d3f766f4',1,'linalg']]], + ['la_5fno_5foperation_36',['la_no_operation',['../namespacelinalg.html#a665d131453840e869510e9e8d2f7f151',1,'linalg']]], + ['la_5fout_5fof_5fmemory_5ferror_37',['la_out_of_memory_error',['../namespacelinalg.html#abfb78ba61c0c2751f1c771c984469006',1,'linalg']]], + ['la_5fpinverse_38',['la_pinverse',['../linalg_8h.html#af7f8185c0f25ad3fb0b89cc98d77b3d6',1,'linalg.h']]], + ['la_5fpinverse_5fcmplx_39',['la_pinverse_cmplx',['../linalg_8h.html#a71ba1a09caca9d59a9d24b95c7ea749b',1,'linalg.h']]], + ['la_5fqr_5ffactor_40',['la_qr_factor',['../linalg_8h.html#a791d5221eb8ad4fcd106cb218590dfc9',1,'linalg.h']]], + ['la_5fqr_5ffactor_5fcmplx_41',['la_qr_factor_cmplx',['../linalg_8h.html#ae5ffa6e8d9c850bd41f43f7564bf6896',1,'linalg.h']]], + ['la_5fqr_5ffactor_5fcmplx_5fpvt_42',['la_qr_factor_cmplx_pvt',['../linalg_8h.html#a4a3f6dafe185c2985fc76aab3d0abb97',1,'linalg.h']]], + ['la_5fqr_5ffactor_5fpvt_43',['la_qr_factor_pvt',['../linalg_8h.html#a4bc671dad87b42ff285a4241322a3764',1,'linalg.h']]], + ['la_5fqr_5frank1_5fupdate_44',['la_qr_rank1_update',['../linalg_8h.html#a9b0639faf9ac0af9bbdb348b92746d5f',1,'linalg.h']]], + ['la_5fqr_5frank1_5fupdate_5fcmplx_45',['la_qr_rank1_update_cmplx',['../linalg_8h.html#acfbd42393c8b1931ff11bc4c7e858aef',1,'linalg.h']]], + ['la_5frank_46',['la_rank',['../linalg_8h.html#a089690d293303e30c6eef0bb1e982191',1,'linalg.h']]], + ['la_5frank1_5fupdate_47',['la_rank1_update',['../linalg_8h.html#ab346fed23fd61f02d65e09c795c26d74',1,'linalg.h']]], + ['la_5frank1_5fupdate_5fcmplx_48',['la_rank1_update_cmplx',['../linalg_8h.html#a3c958fe274f8d1663dd0188455a5fe15',1,'linalg.h']]], + ['la_5frank_5fcmplx_49',['la_rank_cmplx',['../linalg_8h.html#afdc9b7e6ffab89915a082c00ceac7258',1,'linalg.h']]], + ['la_5fsingular_5fmatrix_5ferror_50',['la_singular_matrix_error',['../namespacelinalg.html#af5dc9d60151bb81436b442525871c8c9',1,'linalg']]], + ['la_5fsolve_5fcholesky_51',['la_solve_cholesky',['../linalg_8h.html#a0dc578507a0cb6ada776142476383590',1,'linalg.h']]], + ['la_5fsolve_5fcholesky_5fcmplx_52',['la_solve_cholesky_cmplx',['../linalg_8h.html#a719ffdff56c8fa0875409c4f4e5e95cf',1,'linalg.h']]], + ['la_5fsolve_5fleast_5fsquares_53',['la_solve_least_squares',['../linalg_8h.html#a02eb049983dd41f2307bb52594fb210e',1,'linalg.h']]], + ['la_5fsolve_5fleast_5fsquares_5fcmplx_54',['la_solve_least_squares_cmplx',['../linalg_8h.html#ac3bb7b959d8cc7400e9b13290a895b64',1,'linalg.h']]], + ['la_5fsolve_5flu_55',['la_solve_lu',['../linalg_8h.html#aae725d3247301d1163c58f89edff3d4b',1,'linalg.h']]], + ['la_5fsolve_5flu_5fcmplx_56',['la_solve_lu_cmplx',['../linalg_8h.html#aa067ac0d3f58e28371d413ab7419da74',1,'linalg.h']]], + ['la_5fsolve_5fqr_57',['la_solve_qr',['../linalg_8h.html#aefdc2e6758482d02a3aa7978f7d5efe0',1,'linalg.h']]], + ['la_5fsolve_5fqr_5fcmplx_58',['la_solve_qr_cmplx',['../linalg_8h.html#a0ff5f2519eb1d2af94e3b4a26dfb10fe',1,'linalg.h']]], + ['la_5fsolve_5fqr_5fcmplx_5fpvt_59',['la_solve_qr_cmplx_pvt',['../linalg_8h.html#ad0ee4a9c71de62911a71a342790f5070',1,'linalg.h']]], + ['la_5fsolve_5fqr_5fpvt_60',['la_solve_qr_pvt',['../linalg_8h.html#a62f97b4319f5574aef5e52bbacff14bb',1,'linalg.h']]], + ['la_5fsolve_5ftri_5fmtx_61',['la_solve_tri_mtx',['../linalg_8h.html#aed7b29bbff1472ebe805054eb9d8c6d4',1,'linalg.h']]], + ['la_5fsolve_5ftri_5fmtx_5fcmplx_62',['la_solve_tri_mtx_cmplx',['../linalg_8h.html#af87823d73fb5a319e4262594d147e38c',1,'linalg.h']]], + ['la_5fsort_5feigen_63',['la_sort_eigen',['../linalg_8h.html#abf5918abab8f97fc2ac5887e051ff493',1,'linalg.h']]], + ['la_5fsort_5feigen_5fcmplx_64',['la_sort_eigen_cmplx',['../linalg_8h.html#a090178a5f99a4b400da80481aad77757',1,'linalg.h']]], + ['la_5fsvd_65',['la_svd',['../linalg_8h.html#a56c0cea99a066e74c8fff9682d5ca92d',1,'linalg.h']]], + ['la_5fsvd_5fcmplx_66',['la_svd_cmplx',['../linalg_8h.html#afbffa0856d75c607a03d3dc7b5b1076e',1,'linalg.h']]], + ['la_5ftrace_67',['la_trace',['../linalg_8h.html#a7f611f8f3de7d56120c78e70671c7112',1,'linalg.h']]], + ['la_5ftrace_5fcmplx_68',['la_trace_cmplx',['../linalg_8h.html#a021fbb7fdccf557ec407a86bace43d85',1,'linalg.h']]], + ['la_5ftranspose_69',['la_transpose',['../namespacelinalg.html#a2b842a1fb17710d7ec2f117f5fdb2a59',1,'linalg']]], + ['la_5ftri_5fmtx_5fmult_70',['la_tri_mtx_mult',['../linalg_8h.html#ae7d70f1ef2a2824772e1bf0f726c257e',1,'linalg.h']]], + ['la_5ftri_5fmtx_5fmult_5fcmplx_71',['la_tri_mtx_mult_cmplx',['../linalg_8h.html#a02c464a9dd95298c91f431ae4d0773e9',1,'linalg.h']]], + ['linalg_72',['linalg',['../index.html',1,'(Global Namespace)'],['../namespacelinalg.html',1,'linalg']]], + ['linalg_2eh_73',['linalg.h',['../linalg_8h.html',1,'']]], + ['lu_5ffactor_74',['lu_factor',['../interfacelinalg_1_1lu__factor.html',1,'linalg']]] ]; diff --git a/doc/html/search/files_0.js b/doc/html/search/files_0.js new file mode 100644 index 00000000..0afbecf1 --- /dev/null +++ b/doc/html/search/files_0.js @@ -0,0 +1,4 @@ +var searchData= +[ + ['linalg_2eh_0',['linalg.h',['../linalg_8h.html',1,'']]] +]; diff --git a/doc/html/search/functions_0.js b/doc/html/search/functions_0.js index 7cf2a492..50c950b0 100644 --- a/doc/html/search/functions_0.js +++ b/doc/html/search/functions_0.js @@ -1,4 +1,64 @@ var searchData= [ - ['identity_0',['identity',['../namespacelinalg__immutable.html#aeb1f553973ae3e9b86cb30a1ca1f5700',1,'linalg_immutable']]] + ['la_5fcholesky_5ffactor_0',['la_cholesky_factor',['../linalg_8h.html#a3967bc139cba341a513d1353bea62ac9',1,'linalg.h']]], + ['la_5fcholesky_5ffactor_5fcmplx_1',['la_cholesky_factor_cmplx',['../linalg_8h.html#a1734acc61ef569dfff9c83bcad566f67',1,'linalg.h']]], + ['la_5fcholesky_5frank1_5fdowndate_2',['la_cholesky_rank1_downdate',['../linalg_8h.html#a292e54c48a8e7f0203bf11f02844691f',1,'linalg.h']]], + ['la_5fcholesky_5frank1_5fdowndate_5fcmplx_3',['la_cholesky_rank1_downdate_cmplx',['../linalg_8h.html#a00c15ec713541d15eae1fd0b01897689',1,'linalg.h']]], + ['la_5fcholesky_5frank1_5fupdate_4',['la_cholesky_rank1_update',['../linalg_8h.html#abeb7ee58d4151498be96aa91432f296f',1,'linalg.h']]], + ['la_5fcholesky_5frank1_5fupdate_5fcmplx_5',['la_cholesky_rank1_update_cmplx',['../linalg_8h.html#af19ebf41be31ee92f657131a8fbf55a3',1,'linalg.h']]], + ['la_5fdet_6',['la_det',['../linalg_8h.html#ac7b4894cd929a106e02a8e37a4d52913',1,'linalg.h']]], + ['la_5fdet_5fcmplx_7',['la_det_cmplx',['../linalg_8h.html#ace9edf6a878ee4dd0b220b75b7db6431',1,'linalg.h']]], + ['la_5fdiag_5fmtx_5fmult_8',['la_diag_mtx_mult',['../linalg_8h.html#a4b74177a8914b109e1bf3aa56c9d9cb7',1,'linalg.h']]], + ['la_5fdiag_5fmtx_5fmult_5fcmplx_9',['la_diag_mtx_mult_cmplx',['../linalg_8h.html#a63bec2daa56fdc4bbf3f45b67ea14f65',1,'linalg.h']]], + ['la_5fdiag_5fmtx_5fmult_5fmixed_10',['la_diag_mtx_mult_mixed',['../linalg_8h.html#a4d5bad18dcc8a52d9594cc21954c572d',1,'linalg.h']]], + ['la_5feigen_5fasymm_11',['la_eigen_asymm',['../linalg_8h.html#a9491626ab4b3664771e1282b61eeaa74',1,'linalg.h']]], + ['la_5feigen_5fcmplx_12',['la_eigen_cmplx',['../linalg_8h.html#ae5a16375c14c924836c33bafa747a1cf',1,'linalg.h']]], + ['la_5feigen_5fgen_13',['la_eigen_gen',['../linalg_8h.html#af3c6f1a45aee2f275d4b109c9bb660d2',1,'linalg.h']]], + ['la_5feigen_5fsymm_14',['la_eigen_symm',['../linalg_8h.html#ac208d5e6849972a77ef261f2e368868c',1,'linalg.h']]], + ['la_5fform_5flu_15',['la_form_lu',['../linalg_8h.html#a15774f6323c34d307c99b32ac4f188a7',1,'linalg.h']]], + ['la_5fform_5flu_5fcmplx_16',['la_form_lu_cmplx',['../linalg_8h.html#a73bea3ca338925cfa4a58bcaea726a14',1,'linalg.h']]], + ['la_5fform_5fqr_17',['la_form_qr',['../linalg_8h.html#afe39765d805c1d9ae93e9aa2f20d8548',1,'linalg.h']]], + ['la_5fform_5fqr_5fcmplx_18',['la_form_qr_cmplx',['../linalg_8h.html#a0338870fe1142f88c96db63495fec615',1,'linalg.h']]], + ['la_5fform_5fqr_5fcmplx_5fpvt_19',['la_form_qr_cmplx_pvt',['../linalg_8h.html#ad76e25c5eb98075e83cc9df493be5b38',1,'linalg.h']]], + ['la_5fform_5fqr_5fpvt_20',['la_form_qr_pvt',['../linalg_8h.html#aace787c5b11959a457b936ace4995033',1,'linalg.h']]], + ['la_5finverse_21',['la_inverse',['../linalg_8h.html#a95d6ed56844c62d553b940091837014b',1,'linalg.h']]], + ['la_5finverse_5fcmplx_22',['la_inverse_cmplx',['../linalg_8h.html#a7a821b41c61670f5710214a4d9178998',1,'linalg.h']]], + ['la_5flu_5ffactor_23',['la_lu_factor',['../linalg_8h.html#a248142a5f0826cddac5daf1c74f234a6',1,'linalg.h']]], + ['la_5flu_5ffactor_5fcmplx_24',['la_lu_factor_cmplx',['../linalg_8h.html#ace554b62c12a5d9a2434c8171c756c47',1,'linalg.h']]], + ['la_5fmtx_5fmult_25',['la_mtx_mult',['../linalg_8h.html#a968b10545320af7bbe1030867ae88e8c',1,'linalg.h']]], + ['la_5fmtx_5fmult_5fcmplx_26',['la_mtx_mult_cmplx',['../linalg_8h.html#aefefe80e13f74470d5afaf44b3a45e76',1,'linalg.h']]], + ['la_5fmult_5fqr_27',['la_mult_qr',['../linalg_8h.html#a95f921847131eaedd62a439490d2a801',1,'linalg.h']]], + ['la_5fmult_5fqr_5fcmplx_28',['la_mult_qr_cmplx',['../linalg_8h.html#acc25c0daa53c10ace21a61d78b2e79f3',1,'linalg.h']]], + ['la_5fpinverse_29',['la_pinverse',['../linalg_8h.html#af7f8185c0f25ad3fb0b89cc98d77b3d6',1,'linalg.h']]], + ['la_5fpinverse_5fcmplx_30',['la_pinverse_cmplx',['../linalg_8h.html#a71ba1a09caca9d59a9d24b95c7ea749b',1,'linalg.h']]], + ['la_5fqr_5ffactor_31',['la_qr_factor',['../linalg_8h.html#a791d5221eb8ad4fcd106cb218590dfc9',1,'linalg.h']]], + ['la_5fqr_5ffactor_5fcmplx_32',['la_qr_factor_cmplx',['../linalg_8h.html#ae5ffa6e8d9c850bd41f43f7564bf6896',1,'linalg.h']]], + ['la_5fqr_5ffactor_5fcmplx_5fpvt_33',['la_qr_factor_cmplx_pvt',['../linalg_8h.html#a4a3f6dafe185c2985fc76aab3d0abb97',1,'linalg.h']]], + ['la_5fqr_5ffactor_5fpvt_34',['la_qr_factor_pvt',['../linalg_8h.html#a4bc671dad87b42ff285a4241322a3764',1,'linalg.h']]], + ['la_5fqr_5frank1_5fupdate_35',['la_qr_rank1_update',['../linalg_8h.html#a9b0639faf9ac0af9bbdb348b92746d5f',1,'linalg.h']]], + ['la_5fqr_5frank1_5fupdate_5fcmplx_36',['la_qr_rank1_update_cmplx',['../linalg_8h.html#acfbd42393c8b1931ff11bc4c7e858aef',1,'linalg.h']]], + ['la_5frank_37',['la_rank',['../linalg_8h.html#a089690d293303e30c6eef0bb1e982191',1,'linalg.h']]], + ['la_5frank1_5fupdate_38',['la_rank1_update',['../linalg_8h.html#ab346fed23fd61f02d65e09c795c26d74',1,'linalg.h']]], + ['la_5frank1_5fupdate_5fcmplx_39',['la_rank1_update_cmplx',['../linalg_8h.html#a3c958fe274f8d1663dd0188455a5fe15',1,'linalg.h']]], + ['la_5frank_5fcmplx_40',['la_rank_cmplx',['../linalg_8h.html#afdc9b7e6ffab89915a082c00ceac7258',1,'linalg.h']]], + ['la_5fsolve_5fcholesky_41',['la_solve_cholesky',['../linalg_8h.html#a0dc578507a0cb6ada776142476383590',1,'linalg.h']]], + ['la_5fsolve_5fcholesky_5fcmplx_42',['la_solve_cholesky_cmplx',['../linalg_8h.html#a719ffdff56c8fa0875409c4f4e5e95cf',1,'linalg.h']]], + ['la_5fsolve_5fleast_5fsquares_43',['la_solve_least_squares',['../linalg_8h.html#a02eb049983dd41f2307bb52594fb210e',1,'linalg.h']]], + ['la_5fsolve_5fleast_5fsquares_5fcmplx_44',['la_solve_least_squares_cmplx',['../linalg_8h.html#ac3bb7b959d8cc7400e9b13290a895b64',1,'linalg.h']]], + ['la_5fsolve_5flu_45',['la_solve_lu',['../linalg_8h.html#aae725d3247301d1163c58f89edff3d4b',1,'linalg.h']]], + ['la_5fsolve_5flu_5fcmplx_46',['la_solve_lu_cmplx',['../linalg_8h.html#aa067ac0d3f58e28371d413ab7419da74',1,'linalg.h']]], + ['la_5fsolve_5fqr_47',['la_solve_qr',['../linalg_8h.html#aefdc2e6758482d02a3aa7978f7d5efe0',1,'linalg.h']]], + ['la_5fsolve_5fqr_5fcmplx_48',['la_solve_qr_cmplx',['../linalg_8h.html#a0ff5f2519eb1d2af94e3b4a26dfb10fe',1,'linalg.h']]], + ['la_5fsolve_5fqr_5fcmplx_5fpvt_49',['la_solve_qr_cmplx_pvt',['../linalg_8h.html#ad0ee4a9c71de62911a71a342790f5070',1,'linalg.h']]], + ['la_5fsolve_5fqr_5fpvt_50',['la_solve_qr_pvt',['../linalg_8h.html#a62f97b4319f5574aef5e52bbacff14bb',1,'linalg.h']]], + ['la_5fsolve_5ftri_5fmtx_51',['la_solve_tri_mtx',['../linalg_8h.html#aed7b29bbff1472ebe805054eb9d8c6d4',1,'linalg.h']]], + ['la_5fsolve_5ftri_5fmtx_5fcmplx_52',['la_solve_tri_mtx_cmplx',['../linalg_8h.html#af87823d73fb5a319e4262594d147e38c',1,'linalg.h']]], + ['la_5fsort_5feigen_53',['la_sort_eigen',['../linalg_8h.html#abf5918abab8f97fc2ac5887e051ff493',1,'linalg.h']]], + ['la_5fsort_5feigen_5fcmplx_54',['la_sort_eigen_cmplx',['../linalg_8h.html#a090178a5f99a4b400da80481aad77757',1,'linalg.h']]], + ['la_5fsvd_55',['la_svd',['../linalg_8h.html#a56c0cea99a066e74c8fff9682d5ca92d',1,'linalg.h']]], + ['la_5fsvd_5fcmplx_56',['la_svd_cmplx',['../linalg_8h.html#afbffa0856d75c607a03d3dc7b5b1076e',1,'linalg.h']]], + ['la_5ftrace_57',['la_trace',['../linalg_8h.html#a7f611f8f3de7d56120c78e70671c7112',1,'linalg.h']]], + ['la_5ftrace_5fcmplx_58',['la_trace_cmplx',['../linalg_8h.html#a021fbb7fdccf557ec407a86bace43d85',1,'linalg.h']]], + ['la_5ftri_5fmtx_5fmult_59',['la_tri_mtx_mult',['../linalg_8h.html#ae7d70f1ef2a2824772e1bf0f726c257e',1,'linalg.h']]], + ['la_5ftri_5fmtx_5fmult_5fcmplx_60',['la_tri_mtx_mult_cmplx',['../linalg_8h.html#a02c464a9dd95298c91f431ae4d0773e9',1,'linalg.h']]] ]; diff --git a/doc/html/search/searchdata.js b/doc/html/search/searchdata.js index fe73d8e6..a684d4e6 100644 --- a/doc/html/search/searchdata.js +++ b/doc/html/search/searchdata.js @@ -4,7 +4,9 @@ var indexSectionsWithContent = 1: "cdeflmqrst", 2: "l", 3: "l", - 4: "l" + 4: "l", + 5: "l", + 6: "l" }; var indexSectionNames = @@ -12,8 +14,10 @@ var indexSectionNames = 0: "all", 1: "classes", 2: "namespaces", - 3: "variables", - 4: "pages" + 3: "files", + 4: "functions", + 5: "variables", + 6: "pages" }; var indexSectionLabels = @@ -21,7 +25,9 @@ var indexSectionLabels = 0: "All", 1: "Classes", 2: "Namespaces", - 3: "Variables", - 4: "Pages" + 3: "Files", + 4: "Functions", + 5: "Variables", + 6: "Pages" }; diff --git a/include/linalg.h b/include/linalg.h index 360ac016..03dae3cb 100644 --- a/include/linalg.h +++ b/include/linalg.h @@ -1,4 +1,151 @@ /** @file linalg.h */ + +/** @mainpage + * + * @section intro_sec Introduction + * LINALG is a linear algebra library that provides a user-friendly interface + * to several BLAS and LAPACK routines. This library provides routines for + * solving systems of linear equations, solving over or under-determined + * systems, and solving eigenvalue problems. + * + * @par Example 1 - Solving Linear Equations + * The following piece of code illustrates how to solve a system of linear + * equations using LU factorization. + * + * @code{.c} + * + * @endcode + * The program generates the following output. + * @code{.txt} + * + * @endcode + * + * + * @par Example 2 - Solving an Eigenvalue Problem + * The following example illustrates how to solve an eigenvalue problem using + * a mechanical vibrating system. + * + * @code{.c} + * // This is an example illustrating the use of the eigenvalue and eigenvector + * // routines to solve a free vibration problem of 3 masses connected by springs. + * // + * // k1 k2 k3 k4 + * // |-\/\/\-| m1 |-\/\/\-| m2 |-\/\/\-| m3 |-\/\/\-| + * // + * // As illustrated above, the system consists of 3 masses connected by springs. + * // Spring k1 and spring k4 connect the end masses to ground. The equations of + * // motion for this system are as follows. + * // + * // | m1 0 0 | |x1"| | k1+k2 -k2 0 | |x1| |0| + * // | 0 m2 0 | |x2"| + | -k2 k2+k3 -k3 | |x2| = |0| + * // | 0 0 m3| |x3"| | 0 -k3 k3+k4| |x3| |0| + * // + * // Notice: x1" = the second time derivative of x1. + +#include +#include +#include +#include "linalg.h" + +#define MAX(a, b) ((a) > (b) ? (a) : (b)) +#define INDEX(i, j, m) ((j) * (m) + (i)) +void normalize_array(int n, double *x); + +int main() { + // Constants + const int ndof = 3; + const double pi = 3.14159265359; + const double m1 = 0.5; + const double m2 = 2.5; + const double m3 = 0.75; + const double k1 = 5.0e6; + const double k2 = 10.0e6; + const double k3 = 10.0e6; + const double k4 = 5.0e6; + + // Local Variables + int i, j, flag; + double m[9], k[9], beta[3], natFreq[3], modeShapes[9]; + double complex alpha[3], vals[3], vecs[9]; + + // Build the system matrices + m[0] = m1; m[3] = 0.0; m[6] = 0.0; + m[1] = 0.0; m[4] = m2; m[7] = 0.0; + m[2] = 0.0; m[5] = 0.0; m[8] = m3; + + k[0] = k1 + k2; k[3] = -k2; k[6] = 0.0; + k[1] = -k2; k[4] = k2 + k3; k[7] = -k3; + k[2] = 0.0; k[5] = -k3; k[8] = k3 + k4; + + // Compute the eigenvalues and eigenvectors + flag = la_eigen_gen(true, ndof, k, ndof, m, ndof, alpha, beta, vecs, ndof); + + // Compute the eigenvalues from their components + for (i = 0; i < ndof; ++i) vals[i] = alpha[i] / beta[i]; + + // Sort the eigenvalues and eigenvectors + flag = la_sort_eigen_cmplx(true, ndof, vals, vecs, ndof); + + // Compute the natural frequencies and extract the mode shape info + for (i = 0; i < ndof; ++i) { + natFreq[i] = sqrt(creal(vals[i])) / (2.0 * pi); + + // Extract the real components - the imaginary component is zero + for (j = 0; j < ndof; ++j) { + modeShapes[INDEX(j,i,ndof)] = creal(vecs[INDEX(j,i,ndof)]); + } + + // Normalize the mode shape + normalize_array(ndof, &modeShapes[INDEX(0,i,ndof)]); + } + + // Print out each mode shape + printf("Modal Information:\n"); + for (i = 0; i < ndof; ++i) { + printf("Mode %i: (%f Hz)\n", i + 1, natFreq[i]); + for (j = 0; j < ndof; ++j) { + printf("\t%f\n", modeShapes[INDEX(j, i, ndof)]); + } + } + + // End + return 0; +} + +void normalize_array(int n, double *x) { + // Local Variables + int i; + double val, maxval; + + // Find the largest magnitude value + maxval = x[0]; + for (i = 1; i < n; ++i) { + val = x[i]; + if (fabs(val) > fabs(maxval)) maxval = val; + } + + // Normalize the array + for (i = 0; i < n; ++i) x[i] /= maxval; +} + * @endcode + * The above program produces the following output. + * @code{.txt} + * Modal Information: + Mode 1: (232.922543 Hz) + 0.717922 + 1.000000 + 0.746623 + Mode 2: (749.618856 Hz) + -0.419151 + -0.163803 + 1.000000 + Mode 3: (923.566902 Hz) + 1.000000 + -0.183707 + 0.179128 + * @endcode +*/ + #ifndef LINALG_H_DEFINED #define LINALG_H_DEFINED From 53dec2c9083b20ec903927894e23bc3b3218348c Mon Sep 17 00:00:00 2001 From: jchristopherson Date: Sun, 18 Dec 2022 19:00:14 -0600 Subject: [PATCH 41/65] Add an example --- examples/CMakeLists.txt | 3 +++ examples/c_linalg_lu_example.c | 41 ++++++++++++++++++++++++++++++++++ 2 files changed, 44 insertions(+) create mode 100644 examples/c_linalg_lu_example.c diff --git a/examples/CMakeLists.txt b/examples/CMakeLists.txt index 879a0363..bfa3231b 100644 --- a/examples/CMakeLists.txt +++ b/examples/CMakeLists.txt @@ -59,3 +59,6 @@ target_link_libraries(svd_example linalg) include_directories(${PROJECT_SOURCE_DIR}/include) add_executable(c_eigen_example c_linalg_eigen_example.c) target_link_libraries(c_eigen_example linalg) + +add_executable(c_lu_example c_linalg_lu_example.c) +target_link_libraries(c_lu_example linalg) diff --git a/examples/c_linalg_lu_example.c b/examples/c_linalg_lu_example.c new file mode 100644 index 00000000..3260551c --- /dev/null +++ b/examples/c_linalg_lu_example.c @@ -0,0 +1,41 @@ +#include +#include +#include "linalg.h" + +#define INDEX(i, j, m) ((j) * (m) + (i)) + +int main() { + // Local Variables + int i, flag, pvt[3]; + + // Build the 3-by-3 matrix A - Use column-major formating! + // | 1 2 3 | + // A = | 4 5 6 | + // | 7 8 0 | + double a[] = {1.0, 4.0, 7.0, 2.0, 5.0, 8.0, 3.0, 6.0, 0.0}; + + // Build the right-hand-side vector B. + // | -1 | + // b = | -2 | + // | -3 | + double b[] = {-1.0, -2.0, -3.0}; + + // The solution is: + // | 1/3 | + // x = | -2/3 | + // | 0 | + + // Compute the LU factorization + flag = la_lu_factor(3, 3, a, 3, pvt); + if (flag != LA_NO_ERROR) return flag; + + // Solve. The results overwrite b. + flag = la_solve_lu(3, 1, a, 3, pvt, b, 3); + if (flag != LA_NO_ERROR) return flag; + + // Display the results + printf("LU Solution: X = \n"); + for (i = 0; i < 3; i++) { + printf("%8.4f\n", b[i]); + } +} \ No newline at end of file From 790f4319be45642d25a5204c98e87fdefb931b2e Mon Sep 17 00:00:00 2001 From: jchristopherson Date: Sun, 18 Dec 2022 19:01:06 -0600 Subject: [PATCH 42/65] Update example --- examples/c_linalg_lu_example.c | 3 +++ 1 file changed, 3 insertions(+) diff --git a/examples/c_linalg_lu_example.c b/examples/c_linalg_lu_example.c index 3260551c..10d4ff94 100644 --- a/examples/c_linalg_lu_example.c +++ b/examples/c_linalg_lu_example.c @@ -38,4 +38,7 @@ int main() { for (i = 0; i < 3; i++) { printf("%8.4f\n", b[i]); } + + // End + return 0; } \ No newline at end of file From e90918c605c3863fde58be10dcb0091c2fee957d Mon Sep 17 00:00:00 2001 From: jchristopherson Date: Sun, 18 Dec 2022 19:01:11 -0600 Subject: [PATCH 43/65] Update comments --- include/linalg.h | 44 ++++++++++++++++++++++++++++++++++++++++++-- 1 file changed, 42 insertions(+), 2 deletions(-) diff --git a/include/linalg.h b/include/linalg.h index 03dae3cb..c1f894c0 100644 --- a/include/linalg.h +++ b/include/linalg.h @@ -13,11 +13,51 @@ * equations using LU factorization. * * @code{.c} - * + int main() { + // Local Variables + int i, flag, pvt[3]; + + // Build the 3-by-3 matrix A - Use column-major formating! + // | 1 2 3 | + // A = | 4 5 6 | + // | 7 8 0 | + double a[] = {1.0, 4.0, 7.0, 2.0, 5.0, 8.0, 3.0, 6.0, 0.0}; + + // Build the right-hand-side vector B. + // | -1 | + // b = | -2 | + // | -3 | + double b[] = {-1.0, -2.0, -3.0}; + + // The solution is: + // | 1/3 | + // x = | -2/3 | + // | 0 | + + // Compute the LU factorization + flag = la_lu_factor(3, 3, a, 3, pvt); + if (flag != LA_NO_ERROR) return flag; + + // Solve. The results overwrite b. + flag = la_solve_lu(3, 1, a, 3, pvt, b, 3); + if (flag != LA_NO_ERROR) return flag; + + // Display the results + printf("LU Solution: X = \n"); + for (i = 0; i < 3; i++) { + printf("%8.4f\n", b[i]); + } + + // End + return 0; +} * @endcode * The program generates the following output. * @code{.txt} - * + LU Solution: X = + 0.3333 + -0.6667 + 0.0000 * @endcode * * From ab212f05b3a2c0e0aacfa87506d95b7f09fdd10d Mon Sep 17 00:00:00 2001 From: jchristopherson Date: Sun, 18 Dec 2022 19:03:00 -0600 Subject: [PATCH 44/65] Update documentation --- doc/C/html/index.html | 49 +++- doc/C/html/linalg_8h_source.html | 402 +++++++++++++++---------------- 2 files changed, 248 insertions(+), 203 deletions(-) diff --git a/doc/C/html/index.html b/doc/C/html/index.html index 0d207418..f3938df5 100644 --- a/doc/C/html/index.html +++ b/doc/C/html/index.html @@ -103,7 +103,52 @@

    Introduction

    LINALG is a linear algebra library that provides a user-friendly interface to several BLAS and LAPACK routines. This library provides routines for solving systems of linear equations, solving over or under-determined systems, and solving eigenvalue problems.

    -
    Example 2 - Solving an Eigenvalue Problem
    The following example illustrates how to solve an eigenvalue problem using a mechanical vibrating system.
    +
    Example 1 - Solving Linear Equations
    The following piece of code illustrates how to solve a system of linear equations using LU factorization.
    +
    int main() {
    +
    // Local Variables
    +
    int i, flag, pvt[3];
    +
    +
    // Build the 3-by-3 matrix A - Use column-major formating!
    +
    // | 1 2 3 |
    +
    // A = | 4 5 6 |
    +
    // | 7 8 0 |
    +
    double a[] = {1.0, 4.0, 7.0, 2.0, 5.0, 8.0, 3.0, 6.0, 0.0};
    +
    +
    // Build the right-hand-side vector B.
    +
    // | -1 |
    +
    // b = | -2 |
    +
    // | -3 |
    +
    double b[] = {-1.0, -2.0, -3.0};
    +
    +
    // The solution is:
    +
    // | 1/3 |
    +
    // x = | -2/3 |
    +
    // | 0 |
    +
    +
    // Compute the LU factorization
    +
    flag = la_lu_factor(3, 3, a, 3, pvt);
    +
    if (flag != LA_NO_ERROR) return flag;
    +
    +
    // Solve. The results overwrite b.
    +
    flag = la_solve_lu(3, 1, a, 3, pvt, b, 3);
    +
    if (flag != LA_NO_ERROR) return flag;
    +
    +
    // Display the results
    +
    printf("LU Solution: X = \n");
    +
    for (i = 0; i < 3; i++) {
    +
    printf("%8.4f\n", b[i]);
    +
    }
    +
    +
    // End
    +
    return 0;
    +
    }
    +
    int la_lu_factor(int m, int n, double *a, int lda, int *ipvt)
    +
    int la_solve_lu(int m, int n, const double *a, int lda, const int *ipvt, double *b, int ldb)
    +

    The program generates the following output.

    LU Solution: X =
    +
    0.3333
    +
    -0.6667
    +
    0.0000
    +
    Example 2 - Solving an Eigenvalue Problem
    The following example illustrates how to solve an eigenvalue problem using a mechanical vibrating system.
    // This is an example illustrating the use of the eigenvalue and eigenvector
    // routines to solve a free vibration problem of 3 masses connected by springs.
    //
    @@ -119,7 +164,7 @@
    // | 0 0 m3| |x3"| | 0 -k3 k3+k4| |x3| |0|
    //
    // Notice: x1" = the second time derivative of x1.
    -
    +
    #include <stdio.h>
    #include <complex.h>
    #include <math.h>
    diff --git a/doc/C/html/linalg_8h_source.html b/doc/C/html/linalg_8h_source.html index b6a3a77f..d4f7dc00 100644 --- a/doc/C/html/linalg_8h_source.html +++ b/doc/C/html/linalg_8h_source.html @@ -101,208 +101,208 @@
    Go to the documentation of this file.
    1
    -
    141#ifndef LINALG_H_DEFINED
    -
    142#define LINALG_H_DEFINED
    -
    143
    -
    144#include <stdbool.h>
    -
    145#include <complex.h>
    -
    146
    -
    147#define LA_NO_OPERATION 0
    -
    148#define LA_TRANSPOSE 1
    -
    149#define LA_HERMITIAN_TRANSPOSE 2
    -
    150#define LA_NO_ERROR 0
    -
    151#define LA_INVALID_INPUT_ERROR 101
    -
    152#define LA_ARRAY_SIZE_ERROR 102
    -
    153#define LA_SINGULAR_MATRIX_ERROR 103
    -
    154#define LA_MATRIX_FORMAT_ERROR 104
    -
    155#define LA_OUT_OF_MEMORY_ERROR 105
    -
    156#define LA_CONVERGENCE_ERROR 106
    -
    157#define LA_INVALID_OPERATION_ERROR 107
    -
    158
    -
    159#ifdef __cplusplus
    -
    160extern "C" {
    -
    161#endif
    -
    162
    -
    182int la_rank1_update(int m, int n, double alpha, const double *x,
    -
    183 const double *y, double *a, int lda);
    -
    184
    -
    204int la_rank1_update_cmplx(int m, int n, double complex alpha,
    -
    205 const double complex *x, const double complex *y, double complex *a,
    -
    206 int lda);
    -
    207
    -
    222int la_trace(int m, int n, const double *a, int lda, double *rst);
    -
    223
    -
    238int la_trace_cmplx(int m, int n, const double complex *a, int lda,
    -
    239 double complex *rst);
    -
    240
    -
    267int la_mtx_mult(bool transa, bool transb, int m, int n, int k, double alpha,
    -
    268 const double *a, int lda, const double *b, int ldb, double beta,
    -
    269 double *c, int ldc);
    -
    270
    -
    299int la_mtx_mult_cmplx(int opa, int opb, int m, int n, int k,
    -
    300 double complex alpha, const double complex *a, int lda,
    -
    301 const double complex *b, int ldb, double complex beta, double complex *c,
    -
    302 int ldc);
    -
    303
    -
    337int la_diag_mtx_mult(bool lside, bool transb, int m, int n, int k,
    -
    338 double alpha, const double *a, const double *b, int ldb, double beta,
    -
    339 double *c, int ldc);
    -
    340
    -
    375int la_diag_mtx_mult_cmplx(bool lside, int opb, int m, int n, int k,
    -
    376 double complex alpha, const double complex *a, const double complex *b,
    -
    377 int ldb, double complex beta, double complex *c, int ldc);
    -
    378
    -
    413int la_diag_mtx_mult_mixed(bool lside, int opb, int m, int n, int k,
    -
    414 double complex alpha, const double *a, const double complex *b,
    -
    415 int ldb, double complex beta, double complex *c, int ldc);
    -
    416
    -
    435int la_rank(int m, int n, double *a, int lda, int *rnk);
    -
    436
    -
    455int la_rank_cmplx(int m, int n, double complex *a, int lda, int *rnk);
    -
    456
    -
    472int la_det(int n, double *a, int lda, double *d);
    -
    473
    -
    489int la_det_cmplx(int n, double complex *a, int lda, double complex *d);
    -
    490
    -
    516int la_tri_mtx_mult(bool upper, double alpha, int n, const double *a, int lda,
    -
    517 double beta, double *b, int ldb);
    -
    518
    -
    544int la_tri_mtx_mult_cmplx(bool upper, double complex alpha, int n,
    -
    545 const double complex *a, int lda, double complex beta,
    -
    546 double complex *b, int ldb);
    -
    547
    -
    567int la_lu_factor(int m, int n, double *a, int lda, int *ipvt);
    -
    568
    -
    588int la_lu_factor_cmplx(int m, int n, double complex *a, int lda, int *ipvt);
    -
    589
    -
    611int la_form_lu(int n, double *a, int lda, int *ipvt, double *u, int ldu,
    -
    612 double *p, int ldp);
    -
    613
    -
    635int la_form_lu_cmplx(int n, double complex *a, int lda, int *ipvt,
    -
    636 double complex *u, int ldu, double *p, int ldp);
    +
    189#ifndef LINALG_H_DEFINED
    +
    190#define LINALG_H_DEFINED
    +
    191
    +
    192#include <stdbool.h>
    +
    193#include <complex.h>
    +
    194
    +
    195#define LA_NO_OPERATION 0
    +
    196#define LA_TRANSPOSE 1
    +
    197#define LA_HERMITIAN_TRANSPOSE 2
    +
    198#define LA_NO_ERROR 0
    +
    199#define LA_INVALID_INPUT_ERROR 101
    +
    200#define LA_ARRAY_SIZE_ERROR 102
    +
    201#define LA_SINGULAR_MATRIX_ERROR 103
    +
    202#define LA_MATRIX_FORMAT_ERROR 104
    +
    203#define LA_OUT_OF_MEMORY_ERROR 105
    +
    204#define LA_CONVERGENCE_ERROR 106
    +
    205#define LA_INVALID_OPERATION_ERROR 107
    +
    206
    +
    207#ifdef __cplusplus
    +
    208extern "C" {
    +
    209#endif
    +
    210
    +
    230int la_rank1_update(int m, int n, double alpha, const double *x,
    +
    231 const double *y, double *a, int lda);
    +
    232
    +
    252int la_rank1_update_cmplx(int m, int n, double complex alpha,
    +
    253 const double complex *x, const double complex *y, double complex *a,
    +
    254 int lda);
    +
    255
    +
    270int la_trace(int m, int n, const double *a, int lda, double *rst);
    +
    271
    +
    286int la_trace_cmplx(int m, int n, const double complex *a, int lda,
    +
    287 double complex *rst);
    +
    288
    +
    315int la_mtx_mult(bool transa, bool transb, int m, int n, int k, double alpha,
    +
    316 const double *a, int lda, const double *b, int ldb, double beta,
    +
    317 double *c, int ldc);
    +
    318
    +
    347int la_mtx_mult_cmplx(int opa, int opb, int m, int n, int k,
    +
    348 double complex alpha, const double complex *a, int lda,
    +
    349 const double complex *b, int ldb, double complex beta, double complex *c,
    +
    350 int ldc);
    +
    351
    +
    385int la_diag_mtx_mult(bool lside, bool transb, int m, int n, int k,
    +
    386 double alpha, const double *a, const double *b, int ldb, double beta,
    +
    387 double *c, int ldc);
    +
    388
    +
    423int la_diag_mtx_mult_cmplx(bool lside, int opb, int m, int n, int k,
    +
    424 double complex alpha, const double complex *a, const double complex *b,
    +
    425 int ldb, double complex beta, double complex *c, int ldc);
    +
    426
    +
    461int la_diag_mtx_mult_mixed(bool lside, int opb, int m, int n, int k,
    +
    462 double complex alpha, const double *a, const double complex *b,
    +
    463 int ldb, double complex beta, double complex *c, int ldc);
    +
    464
    +
    483int la_rank(int m, int n, double *a, int lda, int *rnk);
    +
    484
    +
    503int la_rank_cmplx(int m, int n, double complex *a, int lda, int *rnk);
    +
    504
    +
    520int la_det(int n, double *a, int lda, double *d);
    +
    521
    +
    537int la_det_cmplx(int n, double complex *a, int lda, double complex *d);
    +
    538
    +
    564int la_tri_mtx_mult(bool upper, double alpha, int n, const double *a, int lda,
    +
    565 double beta, double *b, int ldb);
    +
    566
    +
    592int la_tri_mtx_mult_cmplx(bool upper, double complex alpha, int n,
    +
    593 const double complex *a, int lda, double complex beta,
    +
    594 double complex *b, int ldb);
    +
    595
    +
    615int la_lu_factor(int m, int n, double *a, int lda, int *ipvt);
    +
    616
    +
    636int la_lu_factor_cmplx(int m, int n, double complex *a, int lda, int *ipvt);
    637
    -
    659int la_qr_factor(int m, int n, double *a, int lda, double *tau);
    -
    660
    -
    682int la_qr_factor_cmplx(int m, int n, double complex *a, int lda,
    -
    683 double complex *tau);
    -
    684
    -
    709int la_qr_factor_pvt(int m, int n, double *a, int lda, double *tau, int *jpvt);
    -
    710
    -
    735int la_qr_factor_cmplx_pvt(int m, int n, double complex *a, int lda,
    -
    736 double complex *tau, int *jpvt);
    -
    737
    -
    764int la_form_qr(bool fullq, int m, int n, double *r, int ldr, const double *tau,
    -
    765 double *q, int ldq);
    -
    766
    -
    793int la_form_qr_cmplx(bool fullq, int m, int n, double complex *r, int ldr,
    -
    794 const double complex *tau, double complex *q, int ldq);
    -
    795
    -
    828int la_form_qr_pvt(bool fullq, int m, int n, double *r, int ldr,
    -
    829 const double *tau, const int *pvt, double *q, int ldq, double *p, int ldp);
    -
    830
    -
    863int la_form_qr_cmplx_pvt(bool fullq, int m, int n, double complex *r, int ldr,
    -
    864 const double complex *tau, const int *pvt, double complex *q, int ldq,
    -
    865 double complex *p, int ldp);
    -
    866
    -
    896int la_mult_qr(bool lside, bool trans, int m, int n, int k, double *a, int lda,
    -
    897 const double *tau, double *c, int ldc);
    -
    898
    -
    928int la_mult_qr_cmplx(bool lside, bool trans, int m, int n, int k,
    -
    929 double complex *a, int lda, const double complex *tau, double complex *c,
    -
    930 int ldc);
    -
    931
    -
    956int la_qr_rank1_update(int m, int n, double *q, int ldq, double *r, int ldr,
    -
    957 double *u, double *v);
    -
    958
    -
    983int la_qr_rank1_update_cmplx(int m, int n, double complex *q, int ldq,
    -
    984 double complex *r, int ldr, double complex *u, double complex *v);
    -
    985
    -
    1004int la_cholesky_factor(bool upper, int n, double *a, int lda);
    -
    1005
    -
    1024int la_cholesky_factor_cmplx(bool upper, int n, double complex *a, int lda);
    -
    1025
    -
    1043int la_cholesky_rank1_update(int n, double *r, int ldr, double *u);
    -
    1044
    -
    1062int la_cholesky_rank1_update_cmplx(int n, double complex *r, int ldr,
    -
    1063 double complex *u);
    -
    1064
    -
    1084int la_cholesky_rank1_downdate(int n, double *r, int ldr, double *u);
    -
    1085
    -
    1105int la_cholesky_rank1_downdate_cmplx(int n, double complex *r, int ldr,
    -
    1106 double complex *u);
    -
    1107
    -
    1137int la_svd(int m, int n, double *a, int lda, double *s, double *u, int ldu,
    -
    1138 double *vt, int ldv);
    -
    1139
    -
    1169int la_svd_cmplx(int m, int n, double complex *a, int lda, double *s,
    -
    1170 double complex *u, int ldu, double complex *vt, int ldv);
    -
    1171
    -
    1200int la_solve_tri_mtx(bool lside, bool upper, bool trans, bool nounit, int m,
    -
    1201 int n, double alpha, const double *a, int lda, double *b, int ldb);
    -
    1202
    -
    1231int la_solve_tri_mtx_cmplx(bool lside, bool upper, bool trans, bool nounit,
    -
    1232 int m, int n, double complex alpha, const double complex *a, int lda,
    -
    1233 double complex *b, int ldb);
    -
    1234
    -
    1251int la_solve_lu(int m, int n, const double *a, int lda, const int *ipvt,
    -
    1252 double *b, int ldb);
    -
    1253
    -
    1270int la_solve_lu_cmplx(int m, int n, const double complex *a, int lda,
    -
    1271 const int *ipvt, double complex *b, int ldb);
    -
    1272
    -
    1296int la_solve_qr(int m, int n, int k, double *a, int lda, const double *tau,
    -
    1297 double *b, int ldb);
    -
    1298
    -
    1322int la_solve_qr_cmplx(int m, int n, int k, double complex *a, int lda,
    -
    1323 const double complex *tau, double complex *b, int ldb);
    -
    1324
    -
    1348int la_solve_qr_pvt(int m, int n, int k, double *a, int lda, const double *tau,
    -
    1349 const int *jpvt, double *b, int ldb);
    -
    1350
    -
    1374int la_solve_qr_cmplx_pvt(int m, int n, int k, double complex *a, int lda,
    -
    1375 const double complex *tau, const int *jpvt, double complex *b, int ldb);
    -
    1376
    -
    1395int la_solve_cholesky(bool upper, int m, int n, const double *a, int lda,
    -
    1396 double *b, int ldb);
    -
    1397
    -
    1416int la_solve_cholesky_cmplx(bool upper, int m, int n, const double complex *a,
    -
    1417 int lda, double complex *b, int ldb);
    -
    1418
    -
    1444int la_solve_least_squares(int m, int n, int k, double *a, int lda, double *b,
    -
    1445 int ldb);
    -
    1446
    -
    1472int la_solve_least_squares_cmplx(int m, int n, int k, double complex *a,
    -
    1473 int lda, double complex *b, int ldb);
    -
    1474
    -
    1488int la_inverse(int n, double *a, int lda);
    -
    1489
    -
    1503int la_inverse_cmplx(int n, double complex *a, int lda);
    -
    1504
    -
    1522int la_pinverse(int m, int n, double *a, int lda, double *ainv, int ldai);
    -
    1523
    -
    1541int la_pinverse_cmplx(int m, int n, double complex *a, int lda,
    -
    1542 double complex *ainv, int ldai);
    -
    1543
    -
    1567int la_eigen_symm(bool vecs, int n, double *a, int lda, double *vals);
    -
    1568
    -
    1591int la_eigen_asymm(bool vecs, int n, double *a, int lda,
    -
    1592 double complex *vals, double complex *v, int ldv);
    -
    1593
    -
    1626int la_eigen_gen(bool vecs, int n, double *a, int lda, double *b, int ldb,
    -
    1627 double complex *alpha, double *beta, double complex *v, int ldv);
    -
    1628
    -
    1651int la_eigen_cmplx(bool vecs, int n, double complex *a, int lda,
    -
    1652 double complex *vals, double complex *v, int ldv);
    -
    1653
    -
    1673int la_sort_eigen(bool ascend, int n, double *vals, double *vecs, int ldv);
    -
    1674
    -
    1694int la_sort_eigen_cmplx(bool ascend, int n, double complex *vals,
    -
    1695 double complex *vecs, int ldv);
    -
    1696
    -
    1697#ifdef __cplusplus
    -
    1698}
    -
    1699#endif // __cplusplus
    -
    1700#endif // LINALG_H_DEFINED
    +
    659int la_form_lu(int n, double *a, int lda, int *ipvt, double *u, int ldu,
    +
    660 double *p, int ldp);
    +
    661
    +
    683int la_form_lu_cmplx(int n, double complex *a, int lda, int *ipvt,
    +
    684 double complex *u, int ldu, double *p, int ldp);
    +
    685
    +
    707int la_qr_factor(int m, int n, double *a, int lda, double *tau);
    +
    708
    +
    730int la_qr_factor_cmplx(int m, int n, double complex *a, int lda,
    +
    731 double complex *tau);
    +
    732
    +
    757int la_qr_factor_pvt(int m, int n, double *a, int lda, double *tau, int *jpvt);
    +
    758
    +
    783int la_qr_factor_cmplx_pvt(int m, int n, double complex *a, int lda,
    +
    784 double complex *tau, int *jpvt);
    +
    785
    +
    812int la_form_qr(bool fullq, int m, int n, double *r, int ldr, const double *tau,
    +
    813 double *q, int ldq);
    +
    814
    +
    841int la_form_qr_cmplx(bool fullq, int m, int n, double complex *r, int ldr,
    +
    842 const double complex *tau, double complex *q, int ldq);
    +
    843
    +
    876int la_form_qr_pvt(bool fullq, int m, int n, double *r, int ldr,
    +
    877 const double *tau, const int *pvt, double *q, int ldq, double *p, int ldp);
    +
    878
    +
    911int la_form_qr_cmplx_pvt(bool fullq, int m, int n, double complex *r, int ldr,
    +
    912 const double complex *tau, const int *pvt, double complex *q, int ldq,
    +
    913 double complex *p, int ldp);
    +
    914
    +
    944int la_mult_qr(bool lside, bool trans, int m, int n, int k, double *a, int lda,
    +
    945 const double *tau, double *c, int ldc);
    +
    946
    +
    976int la_mult_qr_cmplx(bool lside, bool trans, int m, int n, int k,
    +
    977 double complex *a, int lda, const double complex *tau, double complex *c,
    +
    978 int ldc);
    +
    979
    +
    1004int la_qr_rank1_update(int m, int n, double *q, int ldq, double *r, int ldr,
    +
    1005 double *u, double *v);
    +
    1006
    +
    1031int la_qr_rank1_update_cmplx(int m, int n, double complex *q, int ldq,
    +
    1032 double complex *r, int ldr, double complex *u, double complex *v);
    +
    1033
    +
    1052int la_cholesky_factor(bool upper, int n, double *a, int lda);
    +
    1053
    +
    1072int la_cholesky_factor_cmplx(bool upper, int n, double complex *a, int lda);
    +
    1073
    +
    1091int la_cholesky_rank1_update(int n, double *r, int ldr, double *u);
    +
    1092
    +
    1110int la_cholesky_rank1_update_cmplx(int n, double complex *r, int ldr,
    +
    1111 double complex *u);
    +
    1112
    +
    1132int la_cholesky_rank1_downdate(int n, double *r, int ldr, double *u);
    +
    1133
    +
    1153int la_cholesky_rank1_downdate_cmplx(int n, double complex *r, int ldr,
    +
    1154 double complex *u);
    +
    1155
    +
    1185int la_svd(int m, int n, double *a, int lda, double *s, double *u, int ldu,
    +
    1186 double *vt, int ldv);
    +
    1187
    +
    1217int la_svd_cmplx(int m, int n, double complex *a, int lda, double *s,
    +
    1218 double complex *u, int ldu, double complex *vt, int ldv);
    +
    1219
    +
    1248int la_solve_tri_mtx(bool lside, bool upper, bool trans, bool nounit, int m,
    +
    1249 int n, double alpha, const double *a, int lda, double *b, int ldb);
    +
    1250
    +
    1279int la_solve_tri_mtx_cmplx(bool lside, bool upper, bool trans, bool nounit,
    +
    1280 int m, int n, double complex alpha, const double complex *a, int lda,
    +
    1281 double complex *b, int ldb);
    +
    1282
    +
    1299int la_solve_lu(int m, int n, const double *a, int lda, const int *ipvt,
    +
    1300 double *b, int ldb);
    +
    1301
    +
    1318int la_solve_lu_cmplx(int m, int n, const double complex *a, int lda,
    +
    1319 const int *ipvt, double complex *b, int ldb);
    +
    1320
    +
    1344int la_solve_qr(int m, int n, int k, double *a, int lda, const double *tau,
    +
    1345 double *b, int ldb);
    +
    1346
    +
    1370int la_solve_qr_cmplx(int m, int n, int k, double complex *a, int lda,
    +
    1371 const double complex *tau, double complex *b, int ldb);
    +
    1372
    +
    1396int la_solve_qr_pvt(int m, int n, int k, double *a, int lda, const double *tau,
    +
    1397 const int *jpvt, double *b, int ldb);
    +
    1398
    +
    1422int la_solve_qr_cmplx_pvt(int m, int n, int k, double complex *a, int lda,
    +
    1423 const double complex *tau, const int *jpvt, double complex *b, int ldb);
    +
    1424
    +
    1443int la_solve_cholesky(bool upper, int m, int n, const double *a, int lda,
    +
    1444 double *b, int ldb);
    +
    1445
    +
    1464int la_solve_cholesky_cmplx(bool upper, int m, int n, const double complex *a,
    +
    1465 int lda, double complex *b, int ldb);
    +
    1466
    +
    1492int la_solve_least_squares(int m, int n, int k, double *a, int lda, double *b,
    +
    1493 int ldb);
    +
    1494
    +
    1520int la_solve_least_squares_cmplx(int m, int n, int k, double complex *a,
    +
    1521 int lda, double complex *b, int ldb);
    +
    1522
    +
    1536int la_inverse(int n, double *a, int lda);
    +
    1537
    +
    1551int la_inverse_cmplx(int n, double complex *a, int lda);
    +
    1552
    +
    1570int la_pinverse(int m, int n, double *a, int lda, double *ainv, int ldai);
    +
    1571
    +
    1589int la_pinverse_cmplx(int m, int n, double complex *a, int lda,
    +
    1590 double complex *ainv, int ldai);
    +
    1591
    +
    1615int la_eigen_symm(bool vecs, int n, double *a, int lda, double *vals);
    +
    1616
    +
    1639int la_eigen_asymm(bool vecs, int n, double *a, int lda,
    +
    1640 double complex *vals, double complex *v, int ldv);
    +
    1641
    +
    1674int la_eigen_gen(bool vecs, int n, double *a, int lda, double *b, int ldb,
    +
    1675 double complex *alpha, double *beta, double complex *v, int ldv);
    +
    1676
    +
    1699int la_eigen_cmplx(bool vecs, int n, double complex *a, int lda,
    +
    1700 double complex *vals, double complex *v, int ldv);
    +
    1701
    +
    1721int la_sort_eigen(bool ascend, int n, double *vals, double *vecs, int ldv);
    +
    1722
    +
    1742int la_sort_eigen_cmplx(bool ascend, int n, double complex *vals,
    +
    1743 double complex *vecs, int ldv);
    +
    1744
    +
    1745#ifdef __cplusplus
    +
    1746}
    +
    1747#endif // __cplusplus
    +
    1748#endif // LINALG_H_DEFINED
    int la_cholesky_rank1_downdate_cmplx(int n, double complex *r, int ldr, double complex *u)
    int la_trace_cmplx(int m, int n, const double complex *a, int lda, double complex *rst)
    int la_tri_mtx_mult_cmplx(bool upper, double complex alpha, int n, const double complex *a, int lda, double complex beta, double complex *b, int ldb)
    From 2871673e440df0865881d52e6adfbc7eb2c9263b Mon Sep 17 00:00:00 2001 From: jchristopherson Date: Mon, 19 Dec 2022 11:34:58 -0600 Subject: [PATCH 45/65] Add LQ factorization code --- examples/CMakeLists.txt | 12 + examples/linalg_lq_example.f90 | 40 ++ examples/linalg_lq_full_example.f90 | 56 +++ examples/linalg_lq_mult_example.f90 | 53 +++ src/linalg.f90 | 505 +++++++++++++++++++- src/linalg_factor.f90 | 704 ++++++++++++++++++++++++++++ src/linalg_solve.f90 | 375 +++++++++++++++ 7 files changed, 1743 insertions(+), 2 deletions(-) create mode 100644 examples/linalg_lq_example.f90 create mode 100644 examples/linalg_lq_full_example.f90 create mode 100644 examples/linalg_lq_mult_example.f90 diff --git a/examples/CMakeLists.txt b/examples/CMakeLists.txt index bfa3231b..a02fcdbc 100644 --- a/examples/CMakeLists.txt +++ b/examples/CMakeLists.txt @@ -54,6 +54,18 @@ target_link_libraries(pinverse_example linalg) add_executable(svd_example linalg_svd_example.f90) target_link_libraries(svd_example linalg) +# Full LQ Example +add_executable(lq_full_example linalg_lq_full_example.f90) +target_link_libraries(lq_full_example linalg) + +# LQ Multiplication Example +add_executable(lq_mult_example linalg_lq_mult_example.f90) +target_link_libraries(lq_mult_example linalg) + +# LQ Example +add_executable(lq_example linalg_lq_example.f90) +target_link_libraries(lq_example linalg) + # -------------------- # C API Eigenvalue Example include_directories(${PROJECT_SOURCE_DIR}/include) diff --git a/examples/linalg_lq_example.f90 b/examples/linalg_lq_example.f90 new file mode 100644 index 00000000..75345c7b --- /dev/null +++ b/examples/linalg_lq_example.f90 @@ -0,0 +1,40 @@ +! linalg_lq_example.f90 + +program example + use iso_fortran_env, only : real64, int32 + use linalg + implicit none + + ! Local Variables + real(real64) :: a(3,3), tau(3), b(3) + integer(int32) :: i, pvt(3) + + ! Build the 3-by-3 matrix A. + ! | 1 2 3 | + ! A = | 4 5 6 | + ! | 7 8 0 | + a = reshape( & + [1.0d0, 4.0d0, 7.0d0, 2.0d0, 5.0d0, 8.0d0, 3.0d0, 6.0d0, 0.0d0], & + [3, 3]) + + ! Build the right-hand-side vector B. + ! | -1 | + ! b = | -2 | + ! | -3 | + b = [-1.0d0, -2.0d0, -3.0d0] + + ! The solution is: + ! | 1/3 | + ! x = | -2/3 | + ! | 0 | + + ! Compute the LQ factorization + call lq_factor(a, tau) + + ! Compute the solution. The results overwrite b. + call solve_lq(a, tau, b) + + ! Display the results + print '(A)', "LQ Solution: X = " + print '(F8.4)', (b(i), i = 1, size(b)) +end program \ No newline at end of file diff --git a/examples/linalg_lq_full_example.f90 b/examples/linalg_lq_full_example.f90 new file mode 100644 index 00000000..b6e1562d --- /dev/null +++ b/examples/linalg_lq_full_example.f90 @@ -0,0 +1,56 @@ +! linalg_lq_full_example.f90 + +program example + use iso_fortran_env, only : real64, int32 + use linalg + implicit none + + ! Variables + real(real64) :: a(3,3), b(3), q(3,3), tau(3), x(3) + integer(int32) :: i + + ! Build the 3-by-3 matrix A. + ! | 1 2 3 | + ! A = | 4 5 6 | + ! | 7 8 0 | + a = reshape( & + [1.0d0, 4.0d0, 7.0d0, 2.0d0, 5.0d0, 8.0d0, 3.0d0, 6.0d0, 0.0d0], & + [3, 3]) + + ! Build the right-hand-side vector B. + ! | -1 | + ! b = | -2 | + ! | -3 | + b = [-1.0d0, -2.0d0, -3.0d0] + + ! The solution is: + ! | 1/3 | + ! x = | -2/3 | + ! | 0 | + + ! Compute the LQ factorization + call lq_factor(a, tau) + + ! Build L and Q. A is overwritten with L + call form_lq(a, tau, q) + + ! Solve the lower triangular problem and store the solution in B. + ! + ! A comment about this solution noting we've factored A = L * Q. + ! + ! We then have to solve: L * Q * X = B for X. If we let Y = Q * X, then + ! we solve the lower triangular system L * Y = B for Y. + call solve_triangular_system(.false., .false., .true., a, b) + + ! Now we've solved the lower triangular system L * Y = B for Y. At + ! this point we solve the problem: Q * X = Y. Q is an orthogonal matrix; + ! therefore, inv(Q) = Q**T. We can solve this by multiplying both + ! sides by Q**T: + ! + ! Compute Q**T * B = X + call mtx_mult(.true., 1.0d0, q, b, 0.0d0, x) + + ! Display the results + print '(A)', "LQ Solution: X = " + print '(F8.4)', (x(i), i = 1, size(x)) +end program \ No newline at end of file diff --git a/examples/linalg_lq_mult_example.f90 b/examples/linalg_lq_mult_example.f90 new file mode 100644 index 00000000..cdcd5b7f --- /dev/null +++ b/examples/linalg_lq_mult_example.f90 @@ -0,0 +1,53 @@ +! linalg_qr_mult_example.f90 + +program example + use iso_fortran_env, only : real64, int32 + use linalg + implicit none + + ! Local Variables + real(real64) :: a(3,3), tau(3), b(3) + integer(int32) :: i, pvt(3) + + ! Build the 3-by-3 matrix A. + ! | 1 2 3 | + ! A = | 4 5 6 | + ! | 7 8 0 | + a = reshape( & + [1.0d0, 4.0d0, 7.0d0, 2.0d0, 5.0d0, 8.0d0, 3.0d0, 6.0d0, 0.0d0], & + [3, 3]) + + ! Build the right-hand-side vector B. + ! | -1 | + ! b = | -2 | + ! | -3 | + b = [-1.0d0, -2.0d0, -3.0d0] + + ! The solution is: + ! | 1/3 | + ! x = | -2/3 | + ! | 0 | + + ! Compute the LQ factorization + call lq_factor(a, tau) + + ! Solve the lower triangular problem and store the solution in B. + ! + ! A comment about this solution noting we've factored A = L * Q. + ! + ! We then have to solve: L * Q * X = B for X. If we let Y = Q * X, then + ! we solve the lower triangular system L * Y = B for Y. + call solve_triangular_system(.false., .false., .true., a, b) + + ! Now we've solved the lower triangular system L * Y = B for Y. At + ! this point we solve the problem: Q * X = Y. Q is an orthogonal matrix; + ! therefore, inv(Q) = Q**T. We can solve this by multiplying both + ! sides by Q**T: + ! + ! Compute Q**T * B = X + call mult_lq(.true., a, tau, b) + + ! Display the results + print '(A)', "LQ Solution: X = " + print '(F8.4)', (b(i), i = 1, size(b)) +end program \ No newline at end of file diff --git a/src/linalg.f90 b/src/linalg.f90 index 05831f06..8843acf7 100644 --- a/src/linalg.f90 +++ b/src/linalg.f90 @@ -180,6 +180,10 @@ module linalg public :: solve_least_squares_svd public :: eigen public :: sort + public :: lq_factor + public :: form_lq + public :: mult_lq + public :: solve_lq public :: LA_NO_OPERATION public :: LA_TRANSPOSE public :: LA_HERMITIAN_TRANSPOSE @@ -1179,7 +1183,9 @@ module linalg !! !! @param[in] lside Set to true to apply \f$ Q \f$ or \f$ Q^T \f$ from the left; !! else, set to false to apply \f$ Q \f$ or \f$ Q^T \f$ from the right. -!! @param[in] trans Set to true to apply \f$ Q^T \f$; else, set to false. +!! @param[in] trans Set to true to apply \f$ Q^T \f$; else, set to false. In +!! the event \f$ Q \f$ is complex-valued, \f$ Q^H \f$ is computed instead of +!! \f$ Q^T \f$. !! @param[in] a On input, an LDA-by-K matrix containing the elementary !! reflectors output from the QR factorization. If @p lside is set to !! true, LDA = M, and M >= K >= 0; else, if @p lside is set to false, @@ -1217,7 +1223,9 @@ module linalg !! subroutine mult_qr(logical trans, complex(real64) a(:,:), complex(real64) tau(:), complex(real64) c(:), optional complex(real64) work(:), optional integer(int32) olwork, optional class(errors) err) !! @endcode !! -!! @param[in] trans Set to true to apply \f$ Q^T \f$; else, set to false. +!! @param[in] trans Set to true to apply \f$ Q^T \f$; else, set to false. In +!! the event \f$ Q \f$ is complex-valued, \f$ Q^H \f$ is computed instead of +!! \f$ Q^T \f$. !! @param[in] a On input, an M-by-K matrix containing the elementary !! reflectors output from the QR factorization. Notice, the contents of !! this matrix are restored on exit. @@ -3318,6 +3326,390 @@ module linalg module procedure :: sort_eigen_dbl end interface +!> @brief Computes the LQ factorization of an M-by-N matrix. +!! +!! @par Syntax +!! @code{.f90} +!! subroutine lq_factor(real(real64) a(:,:), real(real64) tau(:), optional real(real64) work(:), optional integer(int32) olwork, optional class(errors) err) +!! subroutine lq_factor(complex(real64) a(:,:), complex(real64) tau(:), optional complex(real64) work(:), optional integer(int32) olwork, optional class(errors) err) +!! @endcode +!! +!! @param[in,out] a On input, the M-by-N matrix to factor. On output, the +!! elements on and below the diagonal contain the MIN(M, N)-by-N lower +!! trapezoidal matrix L (L is lower triangular if M >= N). The elements +!! above the diagonal, along with the array @p tau, represent the +!! orthogonal matrix Q as a product of elementary reflectors. +!! @param[out] tau A MIN(M, N)-element array used to store the scalar +!! factors of the elementary reflectors. +!! @param[out] work An optional input, that if provided, prevents any local +!! memory allocation. If not provided, the memory required is allocated +!! within. If provided, the length of the array must be at least +!! @p olwork. +!! @param[out] olwork An optional output used to determine workspace size. +!! If supplied, the routine determines the optimal size for @p work, and +!! returns without performing any actual calculations. +!! @param[in,out] err An optional errors-based object that if provided can be +!! used to retrieve information relating to any errors encountered during +!! execution. If not provided, a default implementation of the errors +!! class is used internally to provide error handling. Possible errors and +!! warning messages that may be encountered are as follows. +!! - LA_ARRAY_SIZE_ERROR: Occurs if @p tau or @p work are not sized +!! appropriately. +!! - LA_OUT_OF_MEMORY_ERROR: Occurs if local memory must be allocated, and +!! there is insufficient memory available. +!! +!! @par Notes +!! This routine utilizes the LAPACK routine DGELQF (ZGELQF for the complex +!! case). +!! +!! @par Usage +!! The folowing example illustrates the solution of a system of equations using +!! LQ factorization. +!! @code{.f90} +!! program example +!! use iso_fortran_env, only : real64, int32 +!! use linalg +!! implicit none +!! +!! ! Variables +!! real(real64) :: a(3,3), b(3), q(3,3), tau(3), x(3) +!! integer(int32) :: i +!! +!! ! Build the 3-by-3 matrix A. +!! ! | 1 2 3 | +!! ! A = | 4 5 6 | +!! ! | 7 8 0 | +!! a = reshape( & +!! [1.0d0, 4.0d0, 7.0d0, 2.0d0, 5.0d0, 8.0d0, 3.0d0, 6.0d0, 0.0d0], & +!! [3, 3]) +!! +!! ! Build the right-hand-side vector B. +!! ! | -1 | +!! ! b = | -2 | +!! ! | -3 | +!! b = [-1.0d0, -2.0d0, -3.0d0] +!! +!! ! The solution is: +!! ! | 1/3 | +!! ! x = | -2/3 | +!! ! | 0 | +!! +!! ! Compute the LQ factorization +!! call lq_factor(a, tau) +!! +!! ! Build L and Q. A is overwritten with L +!! call form_lq(a, tau, q) +!! +!! ! Solve the lower triangular problem and store the solution in B. +!! ! +!! ! A few notes about this solution noting we've factored A = L * Q. +!! ! +!! ! We then have to solve: L * Q * X = B for X. If we let Y = Q * X, then +!! ! we solve the lower triangular system L * Y = B for Y. +!! call solve_triangular_system(.false., .false., .true., a, b) +!! +!! ! Now we've solved the lower triangular system L * Y = B for Y. At +!! ! this point we solve the problem: Q * X = Y. Q is an orthogonal matrix; +!! ! therefore, inv(Q) = Q**T. We can solve this by multiplying both +!! ! sides by Q**T: +!! ! +!! ! Compute Q**T * B = X +!! call mtx_mult(.true., 1.0d0, q, b, 0.0d0, x) +!! +!! ! Display the results +!! print '(A)', "LQ Solution: X = " +!! print '(F8.4)', (x(i), i = 1, size(x)) +!! end program +!! @endcode +!! The above program produces the following output. +!! @code{.txt} +!! LQ Solution: X = +!! 0.3333 +!! -0.6667 +!! 0.0000 +!! @endcode +!! +!! @par See Also +!! - [LAPACK Users Manual](https://netlib.org/lapack/lug/node41.html) +interface lq_factor + module procedure :: lq_factor_no_pivot + module procedure :: lq_factor_no_pivot_cmplx +end interface + +!> @brief Forms the matrix Q with orthonormal rows from the elementary +!! reflectors returned by the LQ factorization algorithm. +!! +!! @par Syntax +!! @code{.f90} +!! subroutine form_lq(real(real64) l(:,:), real(real64) tau(:), real(real64) q(:,:), optional real(real64) work(:), optional integer(int32) olwork, optional class(errors) err) +!! subroutine form_lq(complex(real64) l(:,:), complex(real64) tau(:), complex(real64) q(:,:), optional complex(real64) work(:), optional integer(int32) olwork, optional class(errors) err) +!! @endcode +!! +!! @param[in,out] l On input, an M-by-N matrix where the elements above the +!! diagonal contain the elementary reflectors generated from the LQ +!! factorization performed by @ref lq_factor. On and below the diagonal the +!! matrix contains the matrix L. On output, the elements above the diagonal +!! are zeroed sucht hat the remaining matrix is the M-by-N lower trapezoidal +!! matrix L where only the M-by-M submatrix is the lower triangular matrix L. +!! Notice, M must be less than or equal to N for this routine. +!! @param[in] tau A MIN(M, N)-element array containing the scalar factors of +!! each elementary reflector defined in @p l. +!! @param[out] q An M-by-N matrix where the matrix Q with orhtonormal rows will +!! be written. +!! @param[out] work An optional input, that if provided, prevents any local +!! memory allocation. If not provided, the memory required is allocated +!! within. If provided, the length of the array must be at least +!! @p olwork. +!! @param[out] olwork An optional output used to determine workspace size. +!! If supplied, the routine determines the optimal size for @p work, and +!! returns without performing any actual calculations. +!! @param[in,out] err An optional errors-based object that if provided can be +!! used to retrieve information relating to any errors encountered during +!! execution. If not provided, a default implementation of the errors +!! class is used internally to provide error handling. Possible errors and +!! warning messages that may be encountered are as follows. +!! - LA_ARRAY_SIZE_ERROR: Occurs if any of the input arrays are not sized +!! appropriately. +!! - LA_OUT_OF_MEMORY_ERROR: Occurs if local memory must be allocated, and +!! there is insufficient memory available. +!! +!! @par Notes +!! This routine utilizes the LAPACK routine DORGLQ (ZUNGLQ in the complex case). +!! +!! @par Usage +!! The folowing example illustrates the solution of a system of equations using +!! LQ factorization. +!! @code{.f90} +!! program example +!! use iso_fortran_env, only : real64, int32 +!! use linalg +!! implicit none +!! +!! ! Variables +!! real(real64) :: a(3,3), b(3), q(3,3), tau(3), x(3) +!! integer(int32) :: i +!! +!! ! Build the 3-by-3 matrix A. +!! ! | 1 2 3 | +!! ! A = | 4 5 6 | +!! ! | 7 8 0 | +!! a = reshape( & +!! [1.0d0, 4.0d0, 7.0d0, 2.0d0, 5.0d0, 8.0d0, 3.0d0, 6.0d0, 0.0d0], & +!! [3, 3]) +!! +!! ! Build the right-hand-side vector B. +!! ! | -1 | +!! ! b = | -2 | +!! ! | -3 | +!! b = [-1.0d0, -2.0d0, -3.0d0] +!! +!! ! The solution is: +!! ! | 1/3 | +!! ! x = | -2/3 | +!! ! | 0 | +!! +!! ! Compute the LQ factorization +!! call lq_factor(a, tau) +!! +!! ! Build L and Q. A is overwritten with L +!! call form_lq(a, tau, q) +!! +!! ! Solve the lower triangular problem and store the solution in B. +!! ! +!! ! A few notes about this solution noting we've factored A = L * Q. +!! ! +!! ! We then have to solve: L * Q * X = B for X. If we let Y = Q * X, then +!! ! we solve the lower triangular system L * Y = B for Y. +!! call solve_triangular_system(.false., .false., .true., a, b) +!! +!! ! Now we've solved the lower triangular system L * Y = B for Y. At +!! ! this point we solve the problem: Q * X = Y. Q is an orthogonal matrix; +!! ! therefore, inv(Q) = Q**T. We can solve this by multiplying both +!! ! sides by Q**T: +!! ! +!! ! Compute Q**T * B = X +!! call mtx_mult(.true., 1.0d0, q, b, 0.0d0, x) +!! +!! ! Display the results +!! print '(A)', "LQ Solution: X = " +!! print '(F8.4)', (x(i), i = 1, size(x)) +!! end program +!! @endcode +!! The above program produces the following output. +!! @code{.txt} +!! LQ Solution: X = +!! 0.3333 +!! -0.6667 +!! 0.0000 +!! @endcode +!! +!! @par See Also +!! - [LAPACK Users Manual](https://netlib.org/lapack/lug/node41.html) +interface form_lq + module procedure :: form_lq_no_pivot + module procedure :: form_lq_no_pivot_cmplx +end interface + +!> @brief Multiplies a general matrix by the orthogonal matrix Q from a LQ +!! factorization. +!! +!! @par Syntax 1 +!! Multiplies a general matrix by the orthogonal matrix \f$ Q \f$ from a LQ +!! factorization such that: \f$ C = op(Q) C \f$, or \f$ C = C op(Q) \f$. +!! @code{.f90} +!! subroutine mult_qr(logical lside, logical trans, real(real64) a(:,:), real(real64) tau(:), real(real64) c(:,:), optional real(real64) work(:), optional integer(int32) olwork, optional class(errors) err) +!! subroutine mult_qr(logical lside, logical trans, complex(real64) a(:,:), complex(real64) tau(:), complex(real64) c(:,:), optional complex(real64) work(:), optional integer(int32) olwork, optional class(errors) err) +!! @endcode +!! +!! @param[in] lside Set to true to apply \f$ Q \f$ or \f$ Q^T \f$ from the left; +!! else, set to false to apply \f$ Q \f$ or \f$ Q^T \f$ from the right. +!! @param[in] trans Set to true to apply \f$ Q^T \f$; else, set to false. In +!! the event \f$ Q \f$ is complex-valued, \f$ Q^H \f$ is computed instead of +!! \f$ Q^T \f$. +!! @param[in] a On input, an LDA-by-K matrix containing the elementary +!! reflectors output from the QR factorization. If @p lside is set to +!! true, LDA = M, and M >= K >= 0; else, if @p lside is set to false, +!! LDA = N, and N >= K >= 0. Notice, the contents of this matrix are +!! restored on exit. +!! @param[in] tau A K-element array containing the scalar factors of each +!! elementary reflector defined in @p a. +!! @param[in,out] c On input, the M-by-N matrix C. On output, the product +!! of the orthogonal matrix Q and the original matrix C. +!! @param[out] work An optional input, that if provided, prevents any local +!! memory allocation. If not provided, the memory required is allocated +!! within. If provided, the length of the array must be at least +!! @p olwork. +!! @param[in,out] olwork An optional output used to determine workspace size. +!! If supplied, the routine determines the optimal size for @p work, and +!! returns without performing any actual calculations. +!! @param[in,out] err An optional errors-based object that if provided can be +!! used to retrieve information relating to any errors encountered during +!! execution. If not provided, a default implementation of the errors +!! class is used internally to provide error handling. Possible errors and +!! warning messages that may be encountered are as follows. +!! - LA_ARRAY_SIZE_ERROR: Occurs if any of the input arrays are not sized +!! appropriately. +!! - LA_OUT_OF_MEMORY_ERROR: Occurs if local memory must be allocated, and +!! there is insufficient memory available. +!! +!! @par Syntax 2 +!! Multiplies a vector by the orthogonal matrix \f$ Q \f$ from a QR +!! factorization such that: \f$ C = op(Q) C\f$. +!! @code{.f90} +!! subroutine mult_qr(logical trans, real(real64) a(:,:), real(real64) tau(:), real(real64) c(:), optional real(real64) work(:), optional integer(int32) olwork, optional class(errors) err) +!! subroutine mult_qr(logical trans, complex(real64) a(:,:), complex(real64) tau(:), complex(real64) c(:), optional complex(real64) work(:), optional integer(int32) olwork, optional class(errors) err) +!! @endcode +!! +!! @param[in] trans Set to true to apply \f$ Q^T \f$; else, set to false. In +!! the event \f$ Q \f$ is complex-valued, \f$ Q^H \f$ is computed instead of +!! \f$ Q^T \f$. +!! @param[in] a On input, an M-by-K matrix containing the elementary +!! reflectors output from the QR factorization. Notice, the contents of +!! this matrix are restored on exit. +!! @param[in] tau A K-element array containing the scalar factors of each +!! elementary reflector defined in @p a. +!! @param[in,out] c On input, the M-element vector C. On output, the +!! product of the orthogonal matrix Q and the original vector C. +!! @param[out] work An optional input, that if provided, prevents any local +!! memory allocation. If not provided, the memory required is allocated +!! within. If provided, the length of the array must be at least +!! @p olwork. +!! @param[out] olwork An optional output used to determine workspace size. +!! If supplied, the routine determines the optimal size for @p work, and +!! returns without performing any actual calculations. +!! @param[in,out] err An optional errors-based object that if provided can be +!! used to retrieve information relating to any errors encountered during +!! execution. If not provided, a default implementation of the errors +!! class is used internally to provide error handling. Possible errors and +!! warning messages that may be encountered are as follows. +!! - LA_ARRAY_SIZE_ERROR: Occurs if any of the input arrays are not sized +!! appropriately. +!! - LA_OUT_OF_MEMORY_ERROR: Occurs if local memory must be allocated, and +!! there is insufficient memory available. +!! +!! @par Notes +!! This routine utilizes the LAPACK routine DORMLQ (ZUNMLQ in the complex case). +!! +!! @par Usage +!! The folowing example illustrates the solution of a system of equations using +!! LQ factorization. +!! @code{.f90} +!! program example +!! use iso_fortran_env, only : real64, int32 +!! use linalg +!! implicit none +!! +!! ! Local Variables +!! real(real64) :: a(3,3), tau(3), b(3) +!! integer(int32) :: i, pvt(3) +!! +!! ! Build the 3-by-3 matrix A. +!! ! | 1 2 3 | +!! ! A = | 4 5 6 | +!! ! | 7 8 0 | +!! a = reshape( & +!! [1.0d0, 4.0d0, 7.0d0, 2.0d0, 5.0d0, 8.0d0, 3.0d0, 6.0d0, 0.0d0], & +!! [3, 3]) +!! +!! ! Build the right-hand-side vector B. +!! ! | -1 | +!! ! b = | -2 | +!! ! | -3 | +!! b = [-1.0d0, -2.0d0, -3.0d0] +!! +!! ! The solution is: +!! ! | 1/3 | +!! ! x = | -2/3 | +!! ! | 0 | +!! +!! ! Compute the LQ factorization +!! call lq_factor(a, tau) +!! +!! ! Solve the lower triangular problem and store the solution in B. +!! ! +!! ! A comment about this solution noting we've factored A = L * Q. +!! ! +!! ! We then have to solve: L * Q * X = B for X. If we let Y = Q * X, then +!! ! we solve the lower triangular system L * Y = B for Y. +!! call solve_triangular_system(.false., .false., .true., a, b) +!! +!! ! Now we've solved the lower triangular system L * Y = B for Y. At +!! ! this point we solve the problem: Q * X = Y. Q is an orthogonal matrix; +!! ! therefore, inv(Q) = Q**T. We can solve this by multiplying both +!! ! sides by Q**T: +!! ! +!! ! Compute Q**T * B = X +!! call mult_lq(.true., a, tau, b) +!! +!! ! Display the results +!! print '(A)', "LQ Solution: X = " +!! print '(F8.4)', (b(i), i = 1, size(b)) +!! end program +!! @endcode +!! The above program produces the following output. +!! @code{.txt} +!! LQ Solution: X = +!! 0.3333 +!! -0.6667 +!! 0.0000 +!! @endcode +!! +!! @par See Also +!! - [LAPACK Users Manual](https://netlib.org/lapack/lug/node41.html) +interface mult_lq + module procedure :: mult_lq_mtx + module procedure :: mult_lq_mtx_cmplx + module procedure :: mult_lq_vec + module procedure :: mult_lq_vec_cmplx +end interface + +interface solve_lq + module procedure :: solve_lq_mtx + module procedure :: solve_lq_mtx_cmplx + module procedure :: solve_lq_vec + module procedure :: solve_lq_vec_cmplx +end interface + ! ****************************************************************************** ! LINALG_BASIC.F90 ! ------------------------------------------------------------------------------ @@ -3804,6 +4196,80 @@ module subroutine svd_cmplx(a, s, u, vt, work, olwork, rwork, err) real(real64), intent(out), target, optional, dimension(:) :: rwork class(errors), intent(inout), optional, target :: err end subroutine + + module subroutine lq_factor_no_pivot(a, tau, work, olwork, err) + real(real64), intent(inout), dimension(:,:) :: a + real(real64), intent(out), dimension(:) :: tau + real(real64), intent(out), target, dimension(:), optional :: work + integer(int32), intent(out), optional :: olwork + class(errors), intent(inout), optional, target :: err + end subroutine + + module subroutine lq_factor_no_pivot_cmplx(a, tau, work, olwork, err) + complex(real64), intent(inout), dimension(:,:) :: a + complex(real64), intent(out), dimension(:) :: tau + complex(real64), intent(out), target, dimension(:), optional :: work + integer(int32), intent(out), optional :: olwork + class(errors), intent(inout), optional, target :: err + end subroutine + + module subroutine form_lq_no_pivot(l, tau, q, work, olwork, err) + real(real64), intent(inout), dimension(:,:) :: l + real(real64), intent(in), dimension(:) :: tau + real(real64), intent(out), dimension(:,:) :: q + real(real64), intent(out), target, dimension(:), optional :: work + integer(int32), intent(out), optional :: olwork + class(errors), intent(inout), optional, target :: err + end subroutine + + module subroutine form_lq_no_pivot_cmplx(l, tau, q, work, olwork, err) + complex(real64), intent(inout), dimension(:,:) :: l + complex(real64), intent(in), dimension(:) :: tau + complex(real64), intent(out), dimension(:,:) :: q + complex(real64), intent(out), target, dimension(:), optional :: work + integer(int32), intent(out), optional :: olwork + class(errors), intent(inout), optional, target :: err + end subroutine + + module subroutine mult_lq_mtx(lside, trans, a, tau, c, work, olwork, err) + logical, intent(in) :: lside, trans + real(real64), intent(in), dimension(:,:) :: a + real(real64), intent(in), dimension(:) :: tau + real(real64), intent(inout), dimension(:,:) :: c + real(real64), intent(out), target, dimension(:), optional :: work + integer(int32), intent(out), optional :: olwork + class(errors), intent(inout), optional, target :: err + end subroutine + + module subroutine mult_lq_mtx_cmplx(lside, trans, a, tau, c, work, olwork, err) + logical, intent(in) :: lside, trans + complex(real64), intent(in), dimension(:,:) :: a + complex(real64), intent(in), dimension(:) :: tau + complex(real64), intent(inout), dimension(:,:) :: c + complex(real64), intent(out), target, dimension(:), optional :: work + integer(int32), intent(out), optional :: olwork + class(errors), intent(inout), optional, target :: err + end subroutine + + module subroutine mult_lq_vec(trans, a, tau, c, work, olwork, err) + logical, intent(in) :: trans + real(real64), intent(in), dimension(:,:) :: a + real(real64), intent(in), dimension(:) :: tau + real(real64), intent(inout), dimension(:) :: c + real(real64), intent(out), target, dimension(:), optional :: work + integer(int32), intent(out), optional :: olwork + class(errors), intent(inout), optional, target :: err + end subroutine + + module subroutine mult_lq_vec_cmplx(trans, a, tau, c, work, olwork, err) + logical, intent(in) :: trans + complex(real64), intent(in), dimension(:,:) :: a + complex(real64), intent(in), dimension(:) :: tau + complex(real64), intent(inout), dimension(:) :: c + complex(real64), intent(out), target, dimension(:), optional :: work + integer(int32), intent(out), optional :: olwork + class(errors), intent(inout), optional, target :: err + end subroutine end interface ! ****************************************************************************** @@ -4115,6 +4581,41 @@ module subroutine mtx_pinverse_cmplx(a, ainv, tol, work, olwork, rwork, err) class(errors), intent(inout), optional, target :: err end subroutine + module subroutine solve_lq_mtx(a, tau, b, work, olwork, err) + real(real64), intent(in), dimension(:,:) :: a + real(real64), intent(in), dimension(:) :: tau + real(real64), intent(inout), dimension(:,:) :: b + real(real64), intent(out), target, optional, dimension(:) :: work + integer(int32), intent(out), optional :: olwork + class(errors), intent(inout), optional, target :: err + end subroutine + + module subroutine solve_lq_mtx_cmplx(a, tau, b, work, olwork, err) + complex(real64), intent(in), dimension(:,:) :: a + complex(real64), intent(in), dimension(:) :: tau + complex(real64), intent(inout), dimension(:,:) :: b + complex(real64), intent(out), target, optional, dimension(:) :: work + integer(int32), intent(out), optional :: olwork + class(errors), intent(inout), optional, target :: err + end subroutine + + module subroutine solve_lq_vec(a, tau, b, work, olwork, err) + real(real64), intent(in), dimension(:,:) :: a + real(real64), intent(in), dimension(:) :: tau + real(real64), intent(inout), dimension(:) :: b + real(real64), intent(out), target, optional, dimension(:) :: work + integer(int32), intent(out), optional :: olwork + class(errors), intent(inout), optional, target :: err + end subroutine + + module subroutine solve_lq_vec_cmplx(a, tau, b, work, olwork, err) + complex(real64), intent(in), dimension(:,:) :: a + complex(real64), intent(in), dimension(:) :: tau + complex(real64), intent(inout), dimension(:) :: b + complex(real64), intent(out), target, optional, dimension(:) :: work + integer(int32), intent(out), optional :: olwork + class(errors), intent(inout), optional, target :: err + end subroutine end interface ! ****************************************************************************** diff --git a/src/linalg_factor.f90 b/src/linalg_factor.f90 index 001ab3b6..26e34178 100644 --- a/src/linalg_factor.f90 +++ b/src/linalg_factor.f90 @@ -2860,5 +2860,709 @@ module subroutine svd_cmplx(a, s, u, vt, work, olwork, rwork, err) 101 format(I0, A) end subroutine +! ****************************************************************************** +! LQ FACTORIZATION +! ------------------------------------------------------------------------------ + module subroutine lq_factor_no_pivot(a, tau, work, olwork, err) + ! Arguments + real(real64), intent(inout), dimension(:,:) :: a + real(real64), intent(out), dimension(:) :: tau + real(real64), intent(out), target, dimension(:), optional :: work + integer(int32), intent(out), optional :: olwork + class(errors), intent(inout), optional, target :: err + + ! Local Variables + integer(int32) :: m, n, mn, istat, lwork, flag + real(real64), dimension(1) :: temp + real(real64), pointer, dimension(:) :: wptr + real(real64), allocatable, target, dimension(:) :: wrk + class(errors), pointer :: errmgr + type(errors), target :: deferr + + ! Initialization + m = size(a, 1) + n = size(a, 2) + mn = min(m, n) + if (present(err)) then + errmgr => err + else + errmgr => deferr + end if + + ! Input Check + if (size(tau) /= mn) then + ! ERROR: TAU not sized correctly + call errmgr%report_error("lq_factor_no_pivot", & + "Incorrectly sized input array TAU, argument 2.", & + LA_ARRAY_SIZE_ERROR) + return + end if + + ! Workspace Query + call DGELQF(m, n, a, m, tau, temp, -1, flag) + lwork = int(temp(1), int32) + if (present(olwork)) then + olwork = lwork + return + end if + + ! Local Memory Allocation + if (present(work)) then + if (size(work) < lwork) then + ! ERROR: WORK not sized correctly + call errmgr%report_error("lq_factor_no_pivot", & + "Incorrectly sized input array WORK, argument 3.", & + LA_ARRAY_SIZE_ERROR) + return + end if + wptr => work(1:lwork) + else + allocate(wrk(lwork), stat = istat) + if (istat /= 0) then + ! ERROR: Out of memory + call errmgr%report_error("lq_factor_no_pivot", & + "Insufficient memory available.", & + LA_OUT_OF_MEMORY_ERROR) + return + end if + wptr => wrk + end if + + ! Call DGELQF + call DGELQF(m, n, a, m, tau, wptr, lwork, flag) + end subroutine + +! ------------------------------------------------------------------------------ + module subroutine lq_factor_no_pivot_cmplx(a, tau, work, olwork, err) + ! Arguments + complex(real64), intent(inout), dimension(:,:) :: a + complex(real64), intent(out), dimension(:) :: tau + complex(real64), intent(out), target, dimension(:), optional :: work + integer(int32), intent(out), optional :: olwork + class(errors), intent(inout), optional, target :: err + + ! Local Variables + integer(int32) :: m, n, mn, istat, lwork, flag + complex(real64), dimension(1) :: temp + complex(real64), pointer, dimension(:) :: wptr + complex(real64), allocatable, target, dimension(:) :: wrk + class(errors), pointer :: errmgr + type(errors), target :: deferr + + ! Initialization + m = size(a, 1) + n = size(a, 2) + mn = min(m, n) + if (present(err)) then + errmgr => err + else + errmgr => deferr + end if + + ! Input Check + if (size(tau) /= mn) then + ! ERROR: TAU not sized correctly + call errmgr%report_error("lq_factor_no_pivot_cmplx", & + "Incorrectly sized input array TAU, argument 2.", & + LA_ARRAY_SIZE_ERROR) + return + end if + + ! Workspace Query + call ZGELQF(m, n, a, m, tau, temp, -1, flag) + lwork = int(temp(1), int32) + if (present(olwork)) then + olwork = lwork + return + end if + + ! Local Memory Allocation + if (present(work)) then + if (size(work) < lwork) then + ! ERROR: WORK not sized correctly + call errmgr%report_error("lq_factor_no_pivot_cmplx", & + "Incorrectly sized input array WORK, argument 3.", & + LA_ARRAY_SIZE_ERROR) + return + end if + wptr => work(1:lwork) + else + allocate(wrk(lwork), stat = istat) + if (istat /= 0) then + ! ERROR: Out of memory + call errmgr%report_error("lq_factor_no_pivot_cmplx", & + "Insufficient memory available.", & + LA_OUT_OF_MEMORY_ERROR) + return + end if + wptr => wrk + end if + + ! Call ZGELQF + call ZGELQF(m, n, a, m, tau, wptr, lwork, flag) + end subroutine + +! ------------------------------------------------------------------------------ + module subroutine form_lq_no_pivot(l, tau, q, work, olwork, err) + ! Arguments + real(real64), intent(inout), dimension(:,:) :: l + real(real64), intent(in), dimension(:) :: tau + real(real64), intent(out), dimension(:,:) :: q + real(real64), intent(out), target, dimension(:), optional :: work + integer(int32), intent(out), optional :: olwork + class(errors), intent(inout), optional, target :: err + + ! Parameters + real(real64), parameter :: zero = 0.0d0 + + ! Local Variables + integer(int32) :: i, m, n, mn, istat, flag, lwork + real(real64), pointer, dimension(:) :: wptr + real(real64), allocatable, target, dimension(:) :: wrk + real(real64), dimension(1) :: temp + class(errors), pointer :: errmgr + type(errors), target :: deferr + character(len = 128) :: errmsg + + ! Initialization + m = size(l, 1) + n = size(l, 2) + mn = min(m, n) + qcol = size(q, 2) + if (present(err)) then + errmgr => err + else + errmgr => deferr + end if + + ! Input Check + flag = 0 + if (m > n) then + flag = 1 + else if (size(tau) /= mn) then + flag = 2 + else if (size(q, 1) /= m .or. size(q, 2) /= n) then + flag = 3 + end if + if (flag /= 0) then + ! ERROR: One of the input arrays is not sized correctly + write(errmsg, 100) "Input number ", flag, & + " is not sized correctly." + call errmgr%report_error("form_lq_no_pivot", trim(errmsg), & + LA_ARRAY_SIZE_ERROR) + return + end if + + ! Workspace Query + call DORGLQ(m, n, mn, q, m, tau, temp, -1, flag) + lwork = int(temp(1), int32) + if (present(olwork)) then + olwork = lwork + return + end if + + ! Local Memory Allocation + if (present(work)) then + if (size(work) < lwork) then + ! ERROR: WORK not sized correctly + call errmgr%report_error("form_lq_no_pivot", & + "Incorrectly sized input array WORK, argument 4.", & + LA_ARRAY_SIZE_ERROR) + return + end if + wptr => work(1:lwork) + else + allocate(wrk(lwork), stat = istat) + if (istat /= 0) then + ! ERROR: Out of memory + call errmgr%report_error("form_lq_no_pivot", & + "Insufficient memory available.", & + LA_OUT_OF_MEMORY_ERROR) + return + end if + wptr => wrk + end if + + ! Copy the upper triangular portion of L to Q, and then zero it out in L + do j = 2, mn + q(1:j-1,j) = l(1:j-1,j) + l(1:j-1,j) = zero + end do + if (n > m) then + l(:,m+1:n) = zero + end if + + ! Build Q + call DORGLQ(m, n, mn, q, m, tau, wptr, lwork, flag) + + ! Formatting +100 format(A, I0, A) + end subroutine + +! ------------------------------------------------------------------------------ + module subroutine form_lq_no_pivot_cmplx(l, tau, q, work, olwork, err) + ! Arguments + complex(real64), intent(inout), dimension(:,:) :: l + complex(real64), intent(in), dimension(:) :: tau + complex(real64), intent(out), dimension(:,:) :: q + complex(real64), intent(out), target, dimension(:), optional :: work + integer(int32), intent(out), optional :: olwork + class(errors), intent(inout), optional, target :: err + + ! Parameters + complex(real64), parameter :: zero = (0.0d0, 0.0d0) + + ! Local Variables + integer(int32) :: i, m, n, mn, istat, flag, lwork + complex(real64), pointer, dimension(:) :: wptr + complex(real64), allocatable, target, dimension(:) :: wrk + complex(real64), dimension(1) :: temp + class(errors), pointer :: errmgr + type(errors), target :: deferr + character(len = 128) :: errmsg + + ! Initialization + m = size(l, 1) + n = size(l, 2) + mn = min(m, n) + qcol = size(q, 2) + if (present(err)) then + errmgr => err + else + errmgr => deferr + end if + + ! Input Check + flag = 0 + if (m > n) then + flag = 1 + else if (size(tau) /= mn) then + flag = 2 + else if (size(q, 1) /= m .or. size(q, 2) /= n) then + flag = 3 + end if + if (flag /= 0) then + ! ERROR: One of the input arrays is not sized correctly + write(errmsg, 100) "Input number ", flag, & + " is not sized correctly." + call errmgr%report_error("form_lq_no_pivot_cmplx", trim(errmsg), & + LA_ARRAY_SIZE_ERROR) + return + end if + + ! Workspace Query + call ZUNGLQ(m, n, mn, q, m, tau, temp, -1, flag) + lwork = int(temp(1), int32) + if (present(olwork)) then + olwork = lwork + return + end if + + ! Local Memory Allocation + if (present(work)) then + if (size(work) < lwork) then + ! ERROR: WORK not sized correctly + call errmgr%report_error("form_lq_no_pivot_cmplx", & + "Incorrectly sized input array WORK, argument 4.", & + LA_ARRAY_SIZE_ERROR) + return + end if + wptr => work(1:lwork) + else + allocate(wrk(lwork), stat = istat) + if (istat /= 0) then + ! ERROR: Out of memory + call errmgr%report_error("form_lq_no_pivot_cmplx", & + "Insufficient memory available.", & + LA_OUT_OF_MEMORY_ERROR) + return + end if + wptr => wrk + end if + + ! Copy the upper triangular portion of L to Q, and then zero it out in L + do j = 2, mn + q(1:j-1,j) = l(1:j-1,j) + l(1:j-1,j) = zero + end do + if (n > m) then + l(:,m+1:n) = zero + end if + + ! Build Q + call ZUNGLQ(m, n, mn, q, m, tau, wptr, lwork, flag) + + ! Formatting +100 format(A, I0, A) + end subroutine + +! ------------------------------------------------------------------------------ + module subroutine mult_lq_mtx(lside, trans, a, tau, c, work, olwork, err) + ! Arguments + logical, intent(in) :: lside, trans + real(real64), intent(in), dimension(:,:) :: a + real(real64), intent(in), dimension(:) :: tau + real(real64), intent(inout), dimension(:,:) :: c + real(real64), intent(out), target, dimension(:), optional :: work + integer(int32), intent(out), optional :: olwork + class(errors), intent(inout), optional, target :: err + + ! Local Variables + character :: side, t + integer(int32) :: m, n, k, nrowa, ncola, istat, flag, lwork + real(real64), pointer, dimension(:) :: wptr + real(real64), allocatable, target, dimension(:) :: wrk + real(real64), dimension(1) :: temp + class(errors), pointer :: errmgr + type(errors), target :: deferr + character(len = 128) :: errmsg + + ! Initialization + m = size(c, 1) + n = size(c, 2) + k = size(tau) + if (lside) then + side = 'L' + nrowa = m + ncola = n + else + side = 'R' + nrowa = n + ncola = m + end if + if (trans) then + t = 'T' + else + t = 'N' + end if + if (present(err)) then + errmgr => err + else + errmgr => deferr + end if + + ! Input Check + flag = 0 + if (size(a, 1) /= nrowa .or. size(a, 2) /= ncola) then + flag = 3 + end if + if (flag /= 0) then + ! ERROR: One of the input arrays is not sized correctly + write(errmsg, 100) "Input number ", flag, & + " is not sized correctly." + call errmgr%report_error("mult_lq_mtx", trim(errmsg), & + LA_ARRAY_SIZE_ERROR) + return + end if + + ! Workspace Query + call DORMLQ(side, t, m, n, k, a, nrowa, tau, c, m, temp, -1, flag) + lwork = int(temp(1), int32) + if (present(olwork)) then + olwork = lwork + return + end if + + ! Local Memory Allocation + if (present(work)) then + if (size(work) < lwork) then + ! ERROR: WORK not sized correctly + call errmgr%report_error("mult_lq_mtx", & + "Incorrectly sized input array WORK, argument 6.", & + LA_ARRAY_SIZE_ERROR) + return + end if + wptr => work(1:lwork) + else + allocate(wrk(lwork), stat = istat) + if (istat /= 0) then + ! ERROR: Out of memory + call errmgr%report_error("mult_lq_mtx", & + "Insufficient memory available.", & + LA_OUT_OF_MEMORY_ERROR) + return + end if + wptr => wrk + end if + + ! Call DORMLQ + call DORMLQ(side, t, m, n, k, a, nrowa, tau, c, m, wptr, lwork, flag) + + ! Formatting +100 format(A, I0, A) + end subroutine + +! ------------------------------------------------------------------------------ + module subroutine mult_lq_mtx_cmplx(lside, trans, a, tau, c, work, olwork, err) + ! Arguments + logical, intent(in) :: lside, trans + complex(real64), intent(in), dimension(:,:) :: a + complex(real64), intent(in), dimension(:) :: tau + complex(real64), intent(inout), dimension(:,:) :: c + complex(real64), intent(out), target, dimension(:), optional :: work + integer(int32), intent(out), optional :: olwork + class(errors), intent(inout), optional, target :: err + + ! Local Variables + character :: side, t + integer(int32) :: m, n, k, nrowa, ncola, istat, flag, lwork + complex(real64), pointer, dimension(:) :: wptr + complex(real64), allocatable, target, dimension(:) :: wrk + complex(real64), dimension(1) :: temp + class(errors), pointer :: errmgr + type(errors), target :: deferr + character(len = 128) :: errmsg + + ! Initialization + m = size(c, 1) + n = size(c, 2) + k = size(tau) + if (lside) then + side = 'L' + nrowa = m + ncola = n + else + side = 'R' + nrowa = n + ncola = m + end if + if (trans) then + t = 'T' + else + t = 'N' + end if + if (present(err)) then + errmgr => err + else + errmgr => deferr + end if + + ! Input Check + flag = 0 + if (size(a, 1) /= nrowa .or. size(a, 2) /= ncola) then + flag = 3 + end if + if (flag /= 0) then + ! ERROR: One of the input arrays is not sized correctly + write(errmsg, 100) "Input number ", flag, & + " is not sized correctly." + call errmgr%report_error("mult_lq_mtx_cmplx", trim(errmsg), & + LA_ARRAY_SIZE_ERROR) + return + end if + + ! Workspace Query + call ZUNMLQ(side, t, m, n, k, a, nrowa, tau, c, m, temp, -1, flag) + lwork = int(temp(1), int32) + if (present(olwork)) then + olwork = lwork + return + end if + + ! Local Memory Allocation + if (present(work)) then + if (size(work) < lwork) then + ! ERROR: WORK not sized correctly + call errmgr%report_error("mult_lq_mtx_cmplx", & + "Incorrectly sized input array WORK, argument 6.", & + LA_ARRAY_SIZE_ERROR) + return + end if + wptr => work(1:lwork) + else + allocate(wrk(lwork), stat = istat) + if (istat /= 0) then + ! ERROR: Out of memory + call errmgr%report_error("mult_lq_mtx_cmplx", & + "Insufficient memory available.", & + LA_OUT_OF_MEMORY_ERROR) + return + end if + wptr => wrk + end if + + ! Call ZUNMLQ + call ZUNMLQ(side, t, m, n, k, a, nrowa, tau, c, m, wptr, lwork, flag) + + ! Formatting +100 format(A, I0, A) + end subroutine + +! ------------------------------------------------------------------------------ + module subroutine mult_lq_vec(trans, a, tau, c, work, olwork, err) + ! Arguments + logical, intent(in) :: trans + real(real64), intent(in), dimension(:,:) :: a + real(real64), intent(in), dimension(:) :: tau + real(real64), intent(inout), dimension(:) :: c + real(real64), intent(out), target, dimension(:), optional :: work + integer(int32), intent(out), optional :: olwork + class(errors), intent(inout), optional, target :: err + + ! Local Variables + character :: side, t + integer(int32) :: m, n, k, istat, flag, lwork + real(real64), pointer, dimension(:) :: wptr + real(real64), allocatable, target, dimension(:) :: wrk + real(real64), dimension(1) :: temp + class(errors), pointer :: errmgr + type(errors), target :: deferr + character(len = 128) :: errmsg + + ! Initialization + m = size(c) + n = 1 + k = size(tau) + side = 'L' + if (trans) then + t = 'T' + else + t = 'N' + end if + if (present(err)) then + errmgr => err + else + errmgr => deferr + end if + + ! Input Check + flag = 0 + if (size(a, 1) /= m .or. size(a, 2) < m) then + flag = 3 + end if + if (flag /= 0) then + ! ERROR: One of the input arrays is not sized correctly + write(errmsg, 100) "Input number ", flag, & + " is not sized correctly." + call errmgr%report_error("mult_lq_vec", trim(errmsg), & + LA_ARRAY_SIZE_ERROR) + return + end if + + ! Workspace Query + call DORMLQ(side, t, m, n, k, a, m, tau, c, m, temp, -1, flag) + lwork = int(temp(1), int32) + if (present(olwork)) then + olwork = lwork + return + end if + + ! Local Memory Allocation + if (present(work)) then + if (size(work) < lwork) then + ! ERROR: WORK not sized correctly + call errmgr%report_error("mult_lq_vec", & + "Incorrectly sized input array WORK, argument 6.", & + LA_ARRAY_SIZE_ERROR) + return + end if + wptr => work(1:lwork) + else + allocate(wrk(lwork), stat = istat) + if (istat /= 0) then + ! ERROR: Out of memory + call errmgr%report_error("mult_lq_vec", & + "Insufficient memory available.", & + LA_OUT_OF_MEMORY_ERROR) + return + end if + wptr => wrk + end if + + ! Call DORMLQ + call DORMLQ(side, t, m, n, k, a, m, tau, c, m, wptr, lwork, flag) + + ! Formatting +100 format(A, I0, A) + end subroutine + +! ------------------------------------------------------------------------------ + module subroutine mult_lq_vec_cmplx(trans, a, tau, c, work, olwork, err) + ! Arguments + logical, intent(in) :: trans + complex(real64), intent(in), dimension(:,:) :: a + complex(real64), intent(in), dimension(:) :: tau + complex(real64), intent(inout), dimension(:) :: c + complex(real64), intent(out), target, dimension(:), optional :: work + integer(int32), intent(out), optional :: olwork + class(errors), intent(inout), optional, target :: err + + ! Local Variables + character :: side, t + integer(int32) :: m, n, k, istat, flag, lwork + complex(real64), pointer, dimension(:) :: wptr + complex(real64), allocatable, target, dimension(:) :: wrk + complex(real64), dimension(1) :: temp + class(errors), pointer :: errmgr + type(errors), target :: deferr + character(len = 128) :: errmsg + + ! Initialization + m = size(c) + n = 1 + k = size(tau) + side = 'L' + if (trans) then + t = 'T' + else + t = 'N' + end if + if (present(err)) then + errmgr => err + else + errmgr => deferr + end if + + ! Input Check + flag = 0 + if (size(a, 1) /= m .or. size(a, 2) < m) then + flag = 3 + end if + if (flag /= 0) then + ! ERROR: One of the input arrays is not sized correctly + write(errmsg, 100) "Input number ", flag, & + " is not sized correctly." + call errmgr%report_error("mult_lq_vec_cmplx", trim(errmsg), & + LA_ARRAY_SIZE_ERROR) + return + end if + + ! Workspace Query + call ZUNMLQ(side, t, m, n, k, a, m, tau, c, m, temp, -1, flag) + lwork = int(temp(1), int32) + if (present(olwork)) then + olwork = lwork + return + end if + + ! Local Memory Allocation + if (present(work)) then + if (size(work) < lwork) then + ! ERROR: WORK not sized correctly + call errmgr%report_error("mult_lq_vec_cmplx", & + "Incorrectly sized input array WORK, argument 6.", & + LA_ARRAY_SIZE_ERROR) + return + end if + wptr => work(1:lwork) + else + allocate(wrk(lwork), stat = istat) + if (istat /= 0) then + ! ERROR: Out of memory + call errmgr%report_error("mult_lq_vec_cmplx", & + "Insufficient memory available.", & + LA_OUT_OF_MEMORY_ERROR) + return + end if + wptr => wrk + end if + + ! Call ZUNMLQ + call ZUNMLQ(side, t, m, n, k, a, m, tau, c, m, wptr, lwork, flag) + + ! Formatting +100 format(A, I0, A) + end subroutine + ! ------------------------------------------------------------------------------ end submodule diff --git a/src/linalg_solve.f90 b/src/linalg_solve.f90 index f362a8bd..8280a342 100644 --- a/src/linalg_solve.f90 +++ b/src/linalg_solve.f90 @@ -3466,4 +3466,379 @@ module subroutine solve_least_squares_vec_svd_cmplx(a, b, s, arnk, work, & 101 format(I0, A) end subroutine +! ****************************************************************************** +! LQ SOLUTION +! ------------------------------------------------------------------------------ + module subroutine solve_lq_mtx(a, tau, b, work, olwork, err) + ! Arguments + real(real64), intent(in), dimension(:,:) :: a + real(real64), intent(in), dimension(:) :: tau + real(real64), intent(inout), dimension(:,:) :: b + real(real64), intent(out), target, optional, dimension(:) :: work + integer(int32), intent(out), optional :: olwork + class(errors), intent(inout), optional, target :: err + + ! Parameters + real(real64), parameter :: one = 1.0d0 + + ! Local Variables + integer(int32) :: m, n, nrhs, k, lwork, flag, istat + real(real64), pointer, dimension(:) :: wptr + real(real64), allocatable, target, dimension(:) :: wrk + class(errors), pointer :: errmgr + type(errors), target :: deferr + character(len = 128) :: errmsg + + ! Initialization + m = size(a, 1) + n = size(a, 2) + nrhs = size(b, 2) + k = min(m, n) + if (present(err)) then + errmgr => err + else + errmgr => deferr + end if + + ! Input Check + flag = 0 + if (m > n) then + flag = 1 + else if (size(tau) /= k) then + flag = 2 + else if (size(b, 1) /= n) then + flag = 3 + end if + + if (flag /= 0) then + ! ERROR: One of the input arrays is not sized correctly + write(errmsg, 100) "Input number ", flag, & + " is not sized correctly." + call errmgr%report_error("solve_lq_mtx", trim(errmsg), & + LA_ARRAY_SIZE_ERROR) + return + end if + + ! Workspace Query + call mult_lq(.true., .true., a, tau, b, olwork = lwork) + + if (present(olwork)) then + olwork = lwork + return + end if + + ! Local Memory Allocation + if (present(work)) then + if (size(work) < lwork) then + ! ERROR: WORK not sized correctly + call errmgr%report_error("solve_lq_mtx", & + "Incorrectly sized input array WORK, argument 4.", & + LA_ARRAY_SIZE_ERROR) + return + end if + wptr => work(1:lwork) + else + allocate(wrk(lwork), stat = istat) + if (istat /= 0) then + ! ERROR: Out of memory + call errmgr%report_error("solve_lq_mtx", & + "Insufficient memory available.", & + LA_OUT_OF_MEMORY_ERROR) + return + end if + wptr => wrk + end if + + ! Solve the lower triangular system L * Y = B for Y, where Y = Q * X. + ! The lower triangular system is M-by-M and Y is M-by-NHRS. + call solve_triangular_system(.true., .false., .false., .true., one, & + a(1:m,1:m), b(1:m,:), errmgr) + if (errmgr%has_error_occurred()) return + + ! Compute Q**T * Y = X + call mult_lq(.true., .true., a, tau, b, work = wptr, err = errmgr) + if (errmgr%has_error_occurred()) return + + ! Formatting +100 format(A, I0, A) + end subroutine + +! ------------------------------------------------------------------------------ + module subroutine solve_lq_mtx_cmplx(a, tau, b, work, olwork, err) + ! Arguments + complex(real64), intent(in), dimension(:,:) :: a + complex(real64), intent(in), dimension(:) :: tau + complex(real64), intent(inout), dimension(:,:) :: b + complex(real64), intent(out), target, optional, dimension(:) :: work + integer(int32), intent(out), optional :: olwork + class(errors), intent(inout), optional, target :: err + + ! Parameters + complex(real64), parameter :: one = (1.0d0, 0.0d0) + + ! Local Variables + integer(int32) :: m, n, nrhs, k, lwork, flag, istat + complex(real64), pointer, dimension(:) :: wptr + complex(real64), allocatable, target, dimension(:) :: wrk + class(errors), pointer :: errmgr + type(errors), target :: deferr + character(len = 128) :: errmsg + + ! Initialization + m = size(a, 1) + n = size(a, 2) + nrhs = size(b, 2) + k = min(m, n) + if (present(err)) then + errmgr => err + else + errmgr => deferr + end if + + ! Input Check + flag = 0 + if (m > n) then + flag = 1 + else if (size(tau) /= k) then + flag = 2 + else if (size(b, 1) /= n) then + flag = 3 + end if + + if (flag /= 0) then + ! ERROR: One of the input arrays is not sized correctly + write(errmsg, 100) "Input number ", flag, & + " is not sized correctly." + call errmgr%report_error("solve_lq_mtx_cmplx", trim(errmsg), & + LA_ARRAY_SIZE_ERROR) + return + end if + + ! Workspace Query + call mult_lq(.true., .true., a, tau, b, olwork = lwork) + + if (present(olwork)) then + olwork = lwork + return + end if + + ! Local Memory Allocation + if (present(work)) then + if (size(work) < lwork) then + ! ERROR: WORK not sized correctly + call errmgr%report_error("solve_lq_mtx_cmplx", & + "Incorrectly sized input array WORK, argument 4.", & + LA_ARRAY_SIZE_ERROR) + return + end if + wptr => work(1:lwork) + else + allocate(wrk(lwork), stat = istat) + if (istat /= 0) then + ! ERROR: Out of memory + call errmgr%report_error("solve_lq_mtx_cmplx", & + "Insufficient memory available.", & + LA_OUT_OF_MEMORY_ERROR) + return + end if + wptr => wrk + end if + + ! Solve the lower triangular system L * Y = B for Y, where Y = Q * X. + ! The lower triangular system is M-by-M and Y is M-by-NHRS. + call solve_triangular_system(.true., .false., .false., .true., one, & + a(1:m,1:m), b(1:m,:), errmgr) + if (errmgr%has_error_occurred()) return + + ! Compute Q**T * Y = X + call mult_lq(.true., .true., a, tau, b, work = wptr, err = errmgr) + if (errmgr%has_error_occurred()) return + + ! Formatting +100 format(A, I0, A) + end subroutine + +! ------------------------------------------------------------------------------ + module subroutine solve_lq_vec(a, tau, b, work, olwork, err) + ! Arguments + real(real64), intent(in), dimension(:,:) :: a + real(real64), intent(in), dimension(:) :: tau + real(real64), intent(inout), dimension(:) :: b + real(real64), intent(out), target, optional, dimension(:) :: work + integer(int32), intent(out), optional :: olwork + class(errors), intent(inout), optional, target :: err + + ! Local Variables + integer(int32) :: m, n, k, lwork, flag, istat + real(real64), pointer, dimension(:) :: wptr + real(real64), allocatable, target, dimension(:) :: wrk + class(errors), pointer :: errmgr + type(errors), target :: deferr + character(len = 128) :: errmsg + + ! Initialization + m = size(a, 1) + n = size(a, 2) + k = min(m, n) + if (present(err)) then + errmgr => err + else + errmgr => deferr + end if + + ! Input Check + flag = 0 + if (m > n) then + flag = 1 + else if (size(tau) /= k) then + flag = 2 + else if (size(b) /= n) then + flag = 3 + end if + + if (flag /= 0) then + ! ERROR: One of the input arrays is not sized correctly + write(errmsg, 100) "Input number ", flag, & + " is not sized correctly." + call errmgr%report_error("solve_lq_vec", trim(errmsg), & + LA_ARRAY_SIZE_ERROR) + return + end if + + ! Workspace Query + call mult_lq(.true., a, tau, b, olwork = lwork) + + if (present(olwork)) then + olwork = lwork + return + end if + + ! Local Memory Allocation + if (present(work)) then + if (size(work) < lwork) then + ! ERROR: WORK not sized correctly + call errmgr%report_error("solve_lq_vec", & + "Incorrectly sized input array WORK, argument 4.", & + LA_ARRAY_SIZE_ERROR) + return + end if + wptr => work(1:lwork) + else + allocate(wrk(lwork), stat = istat) + if (istat /= 0) then + ! ERROR: Out of memory + call errmgr%report_error("solve_lq_vec", & + "Insufficient memory available.", & + LA_OUT_OF_MEMORY_ERROR) + return + end if + wptr => wrk + end if + + ! Solve the lower triangular system L * Y = B for Y, where Y = Q * X. + ! The lower triangular system is M-by-M and Y is M-by-NHRS. + call solve_triangular_system(.false., .false., .true., a(1:m,1:m), & + b(1:m), errmgr) + if (errmgr%has_error_occurred()) return + + ! Compute Q**T * Y = X + call mult_lq(.true., a, tau, b, work = wptr, err = errmgr) + if (errmgr%has_error_occurred()) return + + ! Formatting +100 format(A, I0, A) + end subroutine + +! ------------------------------------------------------------------------------ + module subroutine solve_lq_vec_cmplx(a, tau, b, work, olwork, err) + ! Arguments + complex(real64), intent(in), dimension(:,:) :: a + complex(real64), intent(in), dimension(:) :: tau + complex(real64), intent(inout), dimension(:) :: b + complex(real64), intent(out), target, optional, dimension(:) :: work + integer(int32), intent(out), optional :: olwork + class(errors), intent(inout), optional, target :: err + + ! Local Variables + integer(int32) :: m, n, k, lwork, flag, istat + complex(real64), pointer, dimension(:) :: wptr + complex(real64), allocatable, target, dimension(:) :: wrk + class(errors), pointer :: errmgr + type(errors), target :: deferr + character(len = 128) :: errmsg + + ! Initialization + m = size(a, 1) + n = size(a, 2) + k = min(m, n) + if (present(err)) then + errmgr => err + else + errmgr => deferr + end if + + ! Input Check + flag = 0 + if (m > n) then + flag = 1 + else if (size(tau) /= k) then + flag = 2 + else if (size(b) /= n) then + flag = 3 + end if + + if (flag /= 0) then + ! ERROR: One of the input arrays is not sized correctly + write(errmsg, 100) "Input number ", flag, & + " is not sized correctly." + call errmgr%report_error("solve_lq_vec_cmplx", trim(errmsg), & + LA_ARRAY_SIZE_ERROR) + return + end if + + ! Workspace Query + call mult_lq(.true., a, tau, b, olwork = lwork) + + if (present(olwork)) then + olwork = lwork + return + end if + + ! Local Memory Allocation + if (present(work)) then + if (size(work) < lwork) then + ! ERROR: WORK not sized correctly + call errmgr%report_error("solve_lq_vec_cmplx", & + "Incorrectly sized input array WORK, argument 4.", & + LA_ARRAY_SIZE_ERROR) + return + end if + wptr => work(1:lwork) + else + allocate(wrk(lwork), stat = istat) + if (istat /= 0) then + ! ERROR: Out of memory + call errmgr%report_error("solve_lq_vec_cmplx", & + "Insufficient memory available.", & + LA_OUT_OF_MEMORY_ERROR) + return + end if + wptr => wrk + end if + + ! Solve the lower triangular system L * Y = B for Y, where Y = Q * X. + ! The lower triangular system is M-by-M and Y is M-by-NHRS. + call solve_triangular_system(.false., .false., .true., a(1:m,1:m), & + b(1:m), errmgr) + if (errmgr%has_error_occurred()) return + + ! Compute Q**T * Y = X + call mult_lq(.true., a, tau, b, work = wptr, err = errmgr) + if (errmgr%has_error_occurred()) return + + ! Formatting +100 format(A, I0, A) + end subroutine + +! ------------------------------------------------------------------------------ end submodule From 76ba99f08147c8e1615083d645eb30489e466511 Mon Sep 17 00:00:00 2001 From: jchristopherson Date: Mon, 19 Dec 2022 11:57:58 -0600 Subject: [PATCH 46/65] Update comments --- src/linalg.f90 | 88 ++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 88 insertions(+) diff --git a/src/linalg.f90 b/src/linalg.f90 index 8843acf7..d03bdc7f 100644 --- a/src/linalg.f90 +++ b/src/linalg.f90 @@ -3703,6 +3703,94 @@ module linalg module procedure :: mult_lq_vec_cmplx end interface +!> @brief Solves a system of M LQ-factored equations of N unknowns. N must be +!! greater than or equal to M. +!! +!! @par Syntax +!! @code{.f90} +!! subroutine solve_lq(real(real64) a(:,:), real(real64) tau(:), real(real64) b(:,:), optional real(real64) work(:), optional integer(int32) olwork, optional class(errors) err) +!! subroutine solve_lq(complex(real64) a(:,:), complex(real64) tau(:), complex(real64) b(:,:), optional complex(real64) work(:), optional integer(int32) olwork, optional class(errors) err) +!! subroutine solve_lq(real(real64) a(:,:), real(real64) tau(:), real(real64) b(:), optional real(real64) work(:), optional integer(int32) olwork, optional class(errors) err) +!! subroutine solve_lq(complex(real64) a(:,:), complex(real64) tau(:), complex(real64) b(:), optional complex(real64) work(:), optional integer(int32) olwork, optional class(errors) err) +!! @endcode +!! +!! @param[in] a On input, the M-by-N LQ factored matrix as returned by +!! @ref lq_factor. On output, the contents of this matrix are restored. +!! Notice, N must be greater than or equal to M. +!! @param[in] tau A MIN(M, N)-element array containing the scalar factors of +!! the elementary reflectors as returned by @ref lq_factor. +!! @param[in] b On input, an N-by-NRHS matrix where the first M rows contain +!! the right-hand-side matrix. On output, the N-by-NRHS solution matrix X. +!! @param[out] work An optional input, that if provided, prevents any local +!! memory allocation. If not provided, the memory required is allocated +!! within. If provided, the length of the array must be at least +!! @p olwork. +!! @param[out] olwork An optional output used to determine workspace size. +!! If supplied, the routine determines the optimal size for @p work, and +!! returns without performing any actual calculations. +!! @param[in,out] err An optional errors-based object that if provided can be +!! used to retrieve information relating to any errors encountered during +!! execution. If not provided, a default implementation of the errors +!! class is used internally to provide error handling. Possible errors and +!! warning messages that may be encountered are as follows. +!! - LA_ARRAY_SIZE_ERROR: Occurs if any of the input arrays are not sized +!! appropriately. +!! - LA_OUT_OF_MEMORY_ERROR: Occurs if local memory must be allocated, and +!! there is insufficient memory available. +!! +!! @par Usage +!! The following example illustrates the solution of a system of equations +!! using LQ factorization. +!! @code{.f90} +!! program example +!! use iso_fortran_env, only : real64, int32 +!! use linalg +!! implicit none +!! +!! ! Local Variables +!! real(real64) :: a(3,3), tau(3), b(3) +!! integer(int32) :: i, pvt(3) +!! +!! ! Build the 3-by-3 matrix A. +!! ! | 1 2 3 | +!! ! A = | 4 5 6 | +!! ! | 7 8 0 | +!! a = reshape( & +!! [1.0d0, 4.0d0, 7.0d0, 2.0d0, 5.0d0, 8.0d0, 3.0d0, 6.0d0, 0.0d0], & +!! [3, 3]) +!! +!! ! Build the right-hand-side vector B. +!! ! | -1 | +!! ! b = | -2 | +!! ! | -3 | +!! b = [-1.0d0, -2.0d0, -3.0d0] +!! +!! ! The solution is: +!! ! | 1/3 | +!! ! x = | -2/3 | +!! ! | 0 | +!! +!! ! Compute the LQ factorization +!! call lq_factor(a, tau) +!! +!! ! Compute the solution. The results overwrite b. +!! call solve_lq(a, tau, b) +!! +!! ! Display the results +!! print '(A)', "LQ Solution: X = " +!! print '(F8.4)', (b(i), i = 1, size(b)) +!! end program +!! @endcode +!! The above program produces the following output. +!! @code{.txt} +!! QR Solution: X = +!! 0.3333 +!! -0.6667 +!! 0.0000 +!! @endcode +!! +!! @par See Also +!! - [LAPACK Users Manual](https://netlib.org/lapack/lug/node41.html) interface solve_lq module procedure :: solve_lq_mtx module procedure :: solve_lq_mtx_cmplx From 467f1e7e67dfe059f2e75377a68d14127db1de8a Mon Sep 17 00:00:00 2001 From: jchristopherson Date: Mon, 19 Dec 2022 15:10:24 -0600 Subject: [PATCH 47/65] Update C API --- include/linalg.h | 238 +++++++++++++++++++++++++++++++++++++--- src/linalg_c_api.f90 | 252 +++++++++++++++++++++++++++++++++++++++++++ 2 files changed, 476 insertions(+), 14 deletions(-) diff --git a/include/linalg.h b/include/linalg.h index c1f894c0..701484e3 100644 --- a/include/linalg.h +++ b/include/linalg.h @@ -805,7 +805,7 @@ int la_qr_factor_cmplx_pvt(int m, int n, double complex *a, int lda, * * @return An error code. The following codes are possible. * - LA_NO_ERROR: No error occurred. Successful operation. - * - LA_INVALID_INPUT_ERROR: Occurs if @p lda is not correct. + * - LA_INVALID_INPUT_ERROR: Occurs if @p ldr or @p ldq are not correct. * - LA_OUT_OF_MEMORY_ERROR: Occurs if there is insufficient memory * available. */ @@ -834,7 +834,7 @@ int la_form_qr(bool fullq, int m, int n, double *r, int ldr, const double *tau, * * @return An error code. The following codes are possible. * - LA_NO_ERROR: No error occurred. Successful operation. - * - LA_INVALID_INPUT_ERROR: Occurs if @p lda is not correct. + * - LA_INVALID_INPUT_ERROR: Occurs if @p ldr or @p ldq are not correct. * - LA_OUT_OF_MEMORY_ERROR: Occurs if there is insufficient memory * available. */ @@ -933,11 +933,11 @@ int la_form_qr_cmplx_pvt(bool fullq, int m, int n, double complex *r, int ldr, * elementary reflector defined in @p a. * @param c On input, the M-by-N matrix C. On output, the product * of the orthogonal matrix Q and the original matrix C. - * @param ldc THe leading dimension of matrix C. + * @param ldc The leading dimension of matrix C. * * @return An error code. The following codes are possible. * - LA_NO_ERROR: No error occurred. Successful operation. - * - LA_INVALID_INPUT_ERROR: Occurs if @p lda is not correct. + * - LA_INVALID_INPUT_ERROR: Occurs if @p lda or @p ldc are not correct. * - LA_OUT_OF_MEMORY_ERROR: Occurs if there is insufficient memory * available. */ @@ -965,11 +965,11 @@ int la_mult_qr(bool lside, bool trans, int m, int n, int k, double *a, int lda, * elementary reflector defined in @p a. * @param c On input, the M-by-N matrix C. On output, the product * of the orthogonal matrix Q and the original matrix C. - * @param ldc THe leading dimension of matrix C. + * @param ldc The leading dimension of matrix C. * * @return An error code. The following codes are possible. * - LA_NO_ERROR: No error occurred. Successful operation. - * - LA_INVALID_INPUT_ERROR: Occurs if @p lda is not correct. + * - LA_INVALID_INPUT_ERROR: Occurs if @p lda or @p ldc are not correct. * - LA_OUT_OF_MEMORY_ERROR: Occurs if there is insufficient memory * available. */ @@ -1326,10 +1326,10 @@ int la_solve_lu_cmplx(int m, int n, const double complex *a, int lda, * @param n The number of unknowns (columns in matrix A). * @param k The number of columns in the right-hand-side matrix. * @param a On input, the M-by-N QR factored matrix as returned by - * qr_factor. On output, the contents of this matrix are restored. + * @ref qr_factor. On output, the contents of this matrix are restored. * @param lda The leading dimension of matrix A. * @param tau A MIN(M, N)-element array containing the scalar factors of - * the elementary reflectors as returned by qr_factor. + * the elementary reflectors as returned by @ref qr_factor. * @param b On input, the M-by-K right-hand-side matrix. On output, * the first N rows are overwritten by the solution matrix X. * @param ldb The leading dimension of matrix B. @@ -1352,10 +1352,10 @@ int la_solve_qr(int m, int n, int k, double *a, int lda, const double *tau, * @param n The number of unknowns (columns in matrix A). * @param k The number of columns in the right-hand-side matrix. * @param a On input, the M-by-N QR factored matrix as returned by - * qr_factor. On output, the contents of this matrix are restored. + * @ref qr_factor. On output, the contents of this matrix are restored. * @param lda The leading dimension of matrix A. * @param tau A MIN(M, N)-element array containing the scalar factors of - * the elementary reflectors as returned by qr_factor. + * the elementary reflectors as returned by @ref qr_factor. * @param b On input, the M-by-K right-hand-side matrix. On output, * the first N rows are overwritten by the solution matrix X. * @param ldb The leading dimension of matrix B. @@ -1377,10 +1377,10 @@ int la_solve_qr_cmplx(int m, int n, int k, double complex *a, int lda, * @param n The number of unknowns (columns in matrix A). * @param k The number of columns in the right-hand-side matrix. * @param a On input, the M-by-N QR factored matrix as returned by - * qr_factor. On output, the contents of this matrix are restored. + * @ref qr_factor. On output, the contents of this matrix are restored. * @param lda The leading dimension of matrix A. * @param tau A MIN(M, N)-element array containing the scalar factors of - * the elementary reflectors as returned by qr_factor. + * the elementary reflectors as returned by @ref qr_factor. * @param jpvt The N-element array that was used to track the column * pivoting operations in the QR factorization. * @param b On input, the M-by-K right-hand-side matrix. On output, @@ -1403,10 +1403,10 @@ int la_solve_qr_pvt(int m, int n, int k, double *a, int lda, const double *tau, * @param n The number of unknowns (columns in matrix A). * @param k The number of columns in the right-hand-side matrix. * @param a On input, the M-by-N QR factored matrix as returned by - * qr_factor. On output, the contents of this matrix are restored. + * @ref qr_factor. On output, the contents of this matrix are restored. * @param lda The leading dimension of matrix A. * @param tau A MIN(M, N)-element array containing the scalar factors of - * the elementary reflectors as returned by qr_factor. + * the elementary reflectors as returned by @ref qr_factor. * @param jpvt The N-element array that was used to track the column * pivoting operations in the QR factorization. * @param b On input, the M-by-K right-hand-side matrix. On output, @@ -1742,6 +1742,216 @@ int la_sort_eigen(bool ascend, int n, double *vals, double *vecs, int ldv); int la_sort_eigen_cmplx(bool ascend, int n, double complex *vals, double complex *vecs, int ldv); +/** + * Computes the LQ factorization of an M-by-N matrix without + * pivoting. + * + * @param m The number of rows in the matrix. + * @param n The number of columns in the matrix. + * @param a On input, the M-by-N matrix to factor. On output, the + * elements on and above the diagonal contain the MIN(M, N)-by-N upper + * trapezoidal matrix R (R is upper triangular if M >= N). The elements + * below the diagonal, along with the array @p tau, represent the + * orthogonal matrix Q as a product of elementary reflectors. + * @param lda The leading dimension of matrix A. + * @param tau A MIN(M, N)-element array used to store the scalar + * factors of the elementary reflectors. + * + * @return An error code. The following codes are possible. + * - LA_NO_ERROR: No error occurred. Successful operation. + * - LA_INVALID_INPUT_ERROR: Occurs if @p lda is not correct. + * - LA_OUT_OF_MEMORY_ERROR: Occurs if there is insufficient memory + * available. + */ +int la_lq_factor(int m, int n, double *a, int lda, double *tau); + +/** + * Computes the LQ factorization of an M-by-N matrix without + * pivoting. + * + * @param m The number of rows in the matrix. + * @param n The number of columns in the matrix. + * @param a On input, the M-by-N matrix to factor. On output, the + * elements on and above the diagonal contain the MIN(M, N)-by-N upper + * trapezoidal matrix R (R is upper triangular if M >= N). The elements + * below the diagonal, along with the array @p tau, represent the + * orthogonal matrix Q as a product of elementary reflectors. + * @param lda The leading dimension of matrix A. + * @param tau A MIN(M, N)-element array used to store the scalar + * factors of the elementary reflectors. + * + * @return An error code. The following codes are possible. + * - LA_NO_ERROR: No error occurred. Successful operation. + * - LA_INVALID_INPUT_ERROR: Occurs if @p lda is not correct. + * - LA_OUT_OF_MEMORY_ERROR: Occurs if there is insufficient memory + * available. + */ +int la_lq_factor_cmplx(int m, int n, double complex *a, int lda, + double complex *tau); + +/** + * Forms the matrix Q with orthonormal rows from the elementary + * reflectors returned by the base QR factorization algorithm. + * + * @param m The number of rows in R. + * @param n The number of columns in R. + * @param l On input, the M-by-N factored matrix as returned by the + * LQ factorization routine. On output, the lower triangular matrix L. + * @param ldl The leading dimension of matrix L. + * @param tau A MIN(M, N)-element array containing the scalar factors of + * each elementary reflector defined in @p r. + * @param q An M-by-N matrix where the Q matrix will be written. + * @param ldq The leading dimension of matrix Q. + * + * @return An error code. The following codes are possible. + * - LA_NO_ERROR: No error occurred. Successful operation. + * - LA_INVALID_INPUT_ERROR: Occurs if @p ldl or @p ldq are not correct. + * - LA_OUT_OF_MEMORY_ERROR: Occurs if there is insufficient memory + * available. + */ +int la_form_lq(int m, int n, double *l, int ldl, const double *tau, double *q, + int ldq); + +/** + * Forms the matrix Q with orthonormal rows from the elementary + * reflectors returned by the base QR factorization algorithm. + * + * @param m The number of rows in R. + * @param n The number of columns in R. + * @param l On input, the M-by-N factored matrix as returned by the + * LQ factorization routine. On output, the lower triangular matrix L. + * @param ldl The leading dimension of matrix L. + * @param tau A MIN(M, N)-element array containing the scalar factors of + * each elementary reflector defined in @p r. + * @param q An M-by-N matrix where the Q matrix will be written. + * @param ldq The leading dimension of matrix Q. + * + * @return An error code. The following codes are possible. + * - LA_NO_ERROR: No error occurred. Successful operation. + * - LA_INVALID_INPUT_ERROR: Occurs if @p ldl or @p ldq are not correct. + * - LA_OUT_OF_MEMORY_ERROR: Occurs if there is insufficient memory + * available. + */ +int la_form_lq_cmplx(int m, int n, double complex *l, int ldl, + const double complex *tau, double complex *q, int ldq); + +/** + * Multiplies a general matrix by the orthogonal matrix Q from a LQ + * factorization such that: \f$ C = op(Q) C \f$, or \f$ C = C op(Q) \f$. + * + * @param lside Set to true to apply \f$ Q \f$ or \f$ Q^T \f$ from the left; + * else, set to false to apply \f$ Q \f$ or \f$ Q^T \f$ from the right. + * @param trans Set to true to apply \f$ Q^T \f$; else, set to false. + * @param m The number of rows in matrix C. + * @param n The number of columns in matrix C. + * @param k The number of elementary reflectors whose product defines + * the matrix Q. + * @param a On input, an LDA-by-K matrix containing the elementary + * reflectors output from the LQ factorization. If @p lside is set to + * true, LDA = M, and M >= K >= 0; else, if @p lside is set to false, + * LDA = N, and N >= K >= 0. Notice, the contents of this matrix are + * restored on exit. + * @param lda The leading dimension of matrix A. + * @param tau A K-element array containing the scalar factors of each + * elementary reflector defined in @p a. + * @param c On input, the M-by-N matrix C. On output, the product + * of the orthogonal matrix Q and the original matrix C. + * @param ldc The leading dimension of matrix C. + * + * @return An error code. The following codes are possible. + * - LA_NO_ERROR: No error occurred. Successful operation. + * - LA_INVALID_INPUT_ERROR: Occurs if @p lda or @p ldc are not correct. + * - LA_OUT_OF_MEMORY_ERROR: Occurs if there is insufficient memory + * available. + */ +int la_mult_lq(bool lside, bool trans, int m, int n, int k, const double *a, + int lda, const double *tau, double *c, int ldc); + +/** + * Multiplies a general matrix by the orthogonal matrix Q from a LQ + * factorization such that: \f$ C = op(Q) C \f$, or \f$ C = C op(Q) \f$. + * + * @param lside Set to true to apply \f$ Q \f$ or \f$ Q^H \f$ from the left; + * else, set to false to apply \f$ Q \f$ or \f$ Q^H \f$ from the right. + * @param trans Set to true to apply \f$ Q^H \f$; else, set to false. + * @param m The number of rows in matrix C. + * @param n The number of columns in matrix C. + * @param k The number of elementary reflectors whose product defines + * the matrix Q. + * @param a On input, an LDA-by-K matrix containing the elementary + * reflectors output from the LQ factorization. If @p lside is set to + * true, LDA = M, and M >= K >= 0; else, if @p lside is set to false, + * LDA = N, and N >= K >= 0. Notice, the contents of this matrix are + * restored on exit. + * @param lda The leading dimension of matrix A. + * @param tau A K-element array containing the scalar factors of each + * elementary reflector defined in @p a. + * @param c On input, the M-by-N matrix C. On output, the product + * of the orthogonal matrix Q and the original matrix C. + * @param ldc The leading dimension of matrix C. + * + * @return An error code. The following codes are possible. + * - LA_NO_ERROR: No error occurred. Successful operation. + * - LA_INVALID_INPUT_ERROR: Occurs if @p lda or @p ldc are not correct. + * - LA_OUT_OF_MEMORY_ERROR: Occurs if there is insufficient memory + * available. + */ +int la_mult_lq_cmplx(bool lside, bool trans, int m, int n, int k, + const double complex *a, int lda, const double complex *tau, + double complex *c, int ldc); + +/** + * Solves a system of M QR-factored equations of N unknowns where + * N >= M. + * + * @param m The number of equations (rows in matrix A). + * @param n The number of unknowns (columns in matrix A). + * @param k The number of columns in the right-hand-side matrix. + * @param a On input, the M-by-N QR factored matrix as returned by + * @ref lq_factor. + * @param lda The leading dimension of matrix A. + * @param tau A MIN(M, N)-element array containing the scalar factors of + * the elementary reflectors as returned by @ref lq_factor. + * @param b On input, an N-by-K matrix containing the first M rows of the + * right-hand-side matrix. On output, the solution matrix X. + * @param ldb The leading dimension of matrix B. + * + * @return An error code. The following codes are possible. + * - LA_NO_ERROR: No error occurred. Successful operation. + * - LA_INVALID_INPUT_ERROR: Occurs if @p lda, or @p ldb is not correct, or + * if @p m is less than @p n. + * - LA_OUT_OF_MEMORY_ERROR: Occurs if local memory must be allocated, and + * there is insufficient memory available. + */ +int la_solve_lq(int m, int n, int k, const double *a, int lda, + const double *tau, double *b, int ldb); + +/** + * Solves a system of M QR-factored equations of N unknowns where + * N >= M. + * + * @param m The number of equations (rows in matrix A). + * @param n The number of unknowns (columns in matrix A). + * @param k The number of columns in the right-hand-side matrix. + * @param a On input, the M-by-N QR factored matrix as returned by + * @ref lq_factor. + * @param lda The leading dimension of matrix A. + * @param tau A MIN(M, N)-element array containing the scalar factors of + * the elementary reflectors as returned by @ref lq_factor. + * @param b On input, an N-by-K matrix containing the first M rows of the + * right-hand-side matrix. On output, the solution matrix X. + * @param ldb The leading dimension of matrix B. + * + * @return An error code. The following codes are possible. + * - LA_NO_ERROR: No error occurred. Successful operation. + * - LA_INVALID_INPUT_ERROR: Occurs if @p lda, or @p ldb is not correct, or + * if @p m is less than @p n. + * - LA_OUT_OF_MEMORY_ERROR: Occurs if local memory must be allocated, and + * there is insufficient memory available. + */ +int la_solve_lq_cmplx(int m, int n, int k, const double complex *a, int lda, + const double complex *tau, double complex *b, int ldb); + #ifdef __cplusplus } #endif // __cplusplus diff --git a/src/linalg_c_api.f90 b/src/linalg_c_api.f90 index 762b22f0..9fa13a76 100644 --- a/src/linalg_c_api.f90 +++ b/src/linalg_c_api.f90 @@ -3153,8 +3153,260 @@ function la_sort_eigen_cmplx(ascend, n, vals, vecs, ldv) & end function ! ------------------------------------------------------------------------------ + function la_lq_factor(m, n, a, lda, tau) bind(C, name = "la_lq_factor") & + result(flag) + ! Arguments + integer(c_int), intent(in), value :: m, n, lda + real(c_double), intent(inout) :: a(lda,*) + real(c_double), intent(out) :: tau(*) + integer(c_int) :: flag + + ! Local Variables + type(errors) err + integer(c_int) :: mn + + ! Initialization + mn = min(m, n) + call err%set_exit_on_error(.false.) + flag = LA_NO_ERROR + if (lda < m) then + flag = LA_INVALID_INPUT_ERROR + return + end if + + ! Process + call lq_factor(a(1:m,1:n), tau(1:mn), err = err) + if (err%has_error_occurred()) then + flag = err%get_error_flag() + return + end if + end function ! ------------------------------------------------------------------------------ + function la_lq_factor_cmplx(m, n, a, lda, tau) & + bind(C, name = "la_lq_factor_cmplx") result(flag) + ! Arguments + integer(c_int), intent(in), value :: m, n, lda + complex(c_double), intent(inout) :: a(lda,*) + complex(c_double), intent(out) :: tau(*) + integer(c_int) :: flag + + ! Local Variables + type(errors) err + integer(c_int) :: mn + + ! Initialization + mn = min(m, n) + call err%set_exit_on_error(.false.) + flag = LA_NO_ERROR + if (lda < m) then + flag = LA_INVALID_INPUT_ERROR + return + end if + + ! Process + call lq_factor(a(1:m,1:n), tau(1:mn), err = err) + if (err%has_error_occurred()) then + flag = err%get_error_flag() + return + end if + end function + +! ------------------------------------------------------------------------------ + function la_form_lq(m, n, l, ldl, tau, q, ldq) & + bind(C, name = "la_form_lq") result(flag) + ! Arguments + integer(c_int), intent(in), value :: m, n, ldl, ldq + real(c_double), intent(inout) :: l(ldl,*) + real(c_double), intent(in) :: tau(*) + real(c_double), intent(out) :: q(ldq,*) + integer(c_int) :: flag + + ! Local Variables + type(errors) err + integer(c_int) :: mn + + ! Initialization + mn = min(m, n) + flag = LA_NO_ERROR + if (ldl < m .or. ldq < m) then + flag = LA_INVALID_INPUT_ERROR + return + end if + + ! Process + call form_lq(l(1:m,1:n), tau(1:mn), q(1:m,1:n), err = err) + if (err%has_error_occurred()) then + flag = err%get_error_flag() + return + end if + end function + +! ------------------------------------------------------------------------------ + function la_form_lq_cmplx(m, n, l, ldl, tau, q, ldq) & + bind(C, name = "la_form_lq_cmplx") result(flag) + ! Arguments + integer(c_int), intent(in), value :: m, n, ldl, ldq + complex(c_double), intent(inout) :: l(ldl,*) + complex(c_double), intent(in) :: tau(*) + complex(c_double), intent(out) :: q(ldq,*) + integer(c_int) :: flag + + ! Local Variables + type(errors) err + integer(c_int) :: mn + + ! Initialization + mn = min(m, n) + flag = LA_NO_ERROR + if (ldl < m .or. ldq < m) then + flag = LA_INVALID_INPUT_ERROR + return + end if + + ! Process + call form_lq(l(1:m,1:n), tau(1:mn), q(1:m,1:n), err = err) + if (err%has_error_occurred()) then + flag = err%get_error_flag() + return + end if +end function + +! ------------------------------------------------------------------------------ +function la_mult_lq(lside, trans, m, n, k, a, lda, tau, c, ldc) & + bind(C, name = "la_mult_lq") result(flag) + ! Local Variables + logical(c_bool), intent(in), value :: lside, trans + integer(c_int), intent(in), value :: m, n, k, lda, ldc + real(c_double), intent(in) :: a(lda,*) + real(c_double), intent(inout) :: c(ldc,*) + real(c_double), intent(in) :: tau(*) + integer(c_int) :: flag + + ! Local Variables + type(errors) :: err + integer(c_int) :: ma + + ! Initialization + call err%set_exit_on_error(.false.) + flag = LA_NO_ERROR + if (lside) then + ma = m + else + ma = n + end if + if (lda < ma .or. ldc < m .or. k < ma) then + flag = LA_INVALID_INPUT_ERROR + return + end if + + ! Process + call mult_lq(logical(lside), logical(trans), a(1:ma,1:k), tau(1:k), & + c(1:m,1:n), err = err) + if (err%has_error_occurred()) then + flag = err%get_error_flag() + return + end if +end function + +! ------------------------------------------------------------------------------ +function la_mult_lq_cmplx(lside, trans, m, n, k, a, lda, tau, c, ldc) & + bind(C, name = "la_mult_lq_cmplx") result(flag) + ! Local Variables + logical(c_bool), intent(in), value :: lside, trans + integer(c_int), intent(in), value :: m, n, k, lda, ldc + complex(c_double), intent(in) :: a(lda,*) + complex(c_double), intent(inout) :: c(ldc,*) + complex(c_double), intent(in) :: tau(*) + integer(c_int) :: flag + + ! Local Variables + type(errors) :: err + integer(c_int) :: ma + + ! Initialization + call err%set_exit_on_error(.false.) + flag = LA_NO_ERROR + if (lside) then + ma = m + else + ma = n + end if + if (lda < ma .or. ldc < m .or. k < ma) then + flag = LA_INVALID_INPUT_ERROR + return + end if + + ! Process + call mult_lq(logical(lside), logical(trans), a(1:ma,1:k), tau(1:k), & + c(1:m,1:n), err = err) + if (err%has_error_occurred()) then + flag = err%get_error_flag() + return + end if +end function + +! ------------------------------------------------------------------------------ +function la_solve_lq(m, n, k, a, lda, tau, b, ldb) & + bind(C, name = "la_solve_lq") result(flag) + ! Arguments + integer(c_int), intent(in), value :: m, n, k, lda, ldb + real(c_double), intent(in) :: a(lda,*) + real(c_double), intent(inout) :: b(ldb,*) + real(c_double), intent(in) :: tau(*) + integer(c_int) :: flag + + ! Local Variables + type(errors) :: err + integer(c_int) :: mn + + ! Initialization + mn = min(m, n) + call err%set_exit_on_error(.false.) + flag = LA_NO_ERROR + if (lda < m .or. ldb < n) then + flag = LA_INVALID_INPUT_ERROR + return + end if + + ! Process + call solve_lq(a(1:m,1:n), tau(1:mn), b(1:n,1:k), err = err) + if (err%has_error_occurred()) then + flag = err%get_error_flag() + return + end if +end function + +! ------------------------------------------------------------------------------ +function la_solve_lq_cmplx(m, n, k, a, lda, tau, b, ldb) & + bind(C, name = "la_solve_lq_cmplx") result(flag) + ! Arguments + integer(c_int), intent(in), value :: m, n, k, lda, ldb + complex(c_double), intent(in) :: a(lda,*) + complex(c_double), intent(inout) :: b(ldb,*) + complex(c_double), intent(in) :: tau(*) + integer(c_int) :: flag + + ! Local Variables + type(errors) :: err + integer(c_int) :: mn + + ! Initialization + mn = min(m, n) + call err%set_exit_on_error(.false.) + flag = LA_NO_ERROR + if (lda < m .or. ldb < n) then + flag = LA_INVALID_INPUT_ERROR + return + end if + + ! Process + call solve_lq(a(1:m,1:n), tau(1:mn), b(1:n,1:k), err = err) + if (err%has_error_occurred()) then + flag = err%get_error_flag() + return + end if +end function ! ------------------------------------------------------------------------------ end module From b81c9b739f442088d52da05516e146cb859c9934 Mon Sep 17 00:00:00 2001 From: jchristopherson Date: Mon, 19 Dec 2022 21:53:50 -0600 Subject: [PATCH 48/65] Add tests --- src/linalg_factor.f90 | 36 +++--- tests/CMakeLists.txt | 1 + tests/linalg_test.f90 | 19 ++++ tests/test_lq.f90 | 249 ++++++++++++++++++++++++++++++++++++++++++ 4 files changed, 285 insertions(+), 20 deletions(-) create mode 100644 tests/test_lq.f90 diff --git a/src/linalg_factor.f90 b/src/linalg_factor.f90 index 26e34178..21cb71b5 100644 --- a/src/linalg_factor.f90 +++ b/src/linalg_factor.f90 @@ -3016,7 +3016,7 @@ module subroutine form_lq_no_pivot(l, tau, q, work, olwork, err) real(real64), parameter :: zero = 0.0d0 ! Local Variables - integer(int32) :: i, m, n, mn, istat, flag, lwork + integer(int32) :: i, m, n, mn, k, istat, flag, lwork real(real64), pointer, dimension(:) :: wptr real(real64), allocatable, target, dimension(:) :: wrk real(real64), dimension(1) :: temp @@ -3084,13 +3084,11 @@ module subroutine form_lq_no_pivot(l, tau, q, work, olwork, err) end if ! Copy the upper triangular portion of L to Q, and then zero it out in L - do j = 2, mn - q(1:j-1,j) = l(1:j-1,j) - l(1:j-1,j) = zero + do j = 2, n + k = min(j - 1, m) + q(1:j-1,j) = l(1:k,j) + l(1:k,j) = zero end do - if (n > m) then - l(:,m+1:n) = zero - end if ! Build Q call DORGLQ(m, n, mn, q, m, tau, wptr, lwork, flag) @@ -3113,7 +3111,7 @@ module subroutine form_lq_no_pivot_cmplx(l, tau, q, work, olwork, err) complex(real64), parameter :: zero = (0.0d0, 0.0d0) ! Local Variables - integer(int32) :: i, m, n, mn, istat, flag, lwork + integer(int32) :: i, m, n, mn, k, istat, flag, lwork complex(real64), pointer, dimension(:) :: wptr complex(real64), allocatable, target, dimension(:) :: wrk complex(real64), dimension(1) :: temp @@ -3181,13 +3179,11 @@ module subroutine form_lq_no_pivot_cmplx(l, tau, q, work, olwork, err) end if ! Copy the upper triangular portion of L to Q, and then zero it out in L - do j = 2, mn - q(1:j-1,j) = l(1:j-1,j) - l(1:j-1,j) = zero + do j = 2, n + k = min(j - 1, m) + q(1:j-1,j) = l(1:k,j) + l(1:k,j) = zero end do - if (n > m) then - l(:,m+1:n) = zero - end if ! Build Q call ZUNGLQ(m, n, mn, q, m, tau, wptr, lwork, flag) @@ -3224,11 +3220,11 @@ module subroutine mult_lq_mtx(lside, trans, a, tau, c, work, olwork, err) if (lside) then side = 'L' nrowa = m - ncola = n + ncola = m else side = 'R' nrowa = n - ncola = m + ncola = n end if if (trans) then t = 'T' @@ -3320,11 +3316,11 @@ module subroutine mult_lq_mtx_cmplx(lside, trans, a, tau, c, work, olwork, err) if (lside) then side = 'L' nrowa = m - ncola = n + ncola = m else side = 'R' nrowa = n - ncola = m + ncola = n end if if (trans) then t = 'T' @@ -3427,7 +3423,7 @@ module subroutine mult_lq_vec(trans, a, tau, c, work, olwork, err) ! Input Check flag = 0 - if (size(a, 1) /= m .or. size(a, 2) < m) then + if (size(a, 1) /= m .or. size(a, 2) /= m) then flag = 3 end if if (flag /= 0) then @@ -3515,7 +3511,7 @@ module subroutine mult_lq_vec_cmplx(trans, a, tau, c, work, olwork, err) ! Input Check flag = 0 - if (size(a, 1) /= m .or. size(a, 2) < m) then + if (size(a, 1) /= m .or. size(a, 2) /= m) then flag = 3 end if if (flag /= 0) then diff --git a/tests/CMakeLists.txt b/tests/CMakeLists.txt index 946a5333..13b3ff3a 100644 --- a/tests/CMakeLists.txt +++ b/tests/CMakeLists.txt @@ -12,6 +12,7 @@ set(linalg_test_sources test_misc.f90 test_lu.f90 test_sort.f90 + test_lq.f90 ) # Build the Fortran API tests diff --git a/tests/linalg_test.f90 b/tests/linalg_test.f90 index abb0c760..cf507b39 100644 --- a/tests/linalg_test.f90 +++ b/tests/linalg_test.f90 @@ -11,6 +11,7 @@ program main use test_misc use test_lu use test_sort + use test_lq ! Local Variables logical :: rst, overall @@ -160,10 +161,28 @@ program main rst = test_dbl_descend_sort() if (.not.rst) overall = .false. + ! LQ Factorization Tests + rst = test_lq_factor() + if (.not.rst) overall = .false. + + rst = test_lq_factor_ud() + if (.not.rst) overall = .false. + + rst = test_lq_factor_cmplx() + if (.not.rst) overall = .false. + + rst = test_lq_mult() + if (.not.rst) overall = .false. + + rst = test_lq_mult_ud() + if (.not.rst) overall = .false. + ! End if (overall) then print '(A)', "LINALG TEST STATUS: PASS" + call exit(0) else print '(A)', "LINALG TEST STATUS: FAILED" + call exit(1) end if end program diff --git a/tests/test_lq.f90 b/tests/test_lq.f90 new file mode 100644 index 00000000..b3eb7fe0 --- /dev/null +++ b/tests/test_lq.f90 @@ -0,0 +1,249 @@ +! test_lq.f90 + +! Tests for LQ factorization/solution operations. +module test_lq + use iso_fortran_env + use test_core + use linalg + implicit none +contains +! ****************************************************************************** +! LQ FACTORIZATION TESTS +! ------------------------------------------------------------------------------ + function test_lq_factor() result(rst) + ! Parameters + integer(int32), parameter :: m = 50 + integer(int32), parameter :: n = 50 + real(real64), parameter :: tol = 1.0d-8 + + ! Local Variables + real(real64) :: a(m, n), aref(m, n), tau(m), q(m, n) + logical :: rst + + ! Initialization + rst = .true. + call random_number(a) + aref = a + + ! Compute the LQ factorization of A + call lq_factor(a, tau) + + ! Extract L and Q and check that L * Q = A + call form_lq(a, tau, q) + + ! Perform the check + if (.not.is_mtx_equal(matmul(a, q), aref, tol)) then + rst = .false. + print '(A)', "Test Failed: LQ Factorization Test 1" + end if + end function + +! ------------------------------------------------------------------------------ + function test_lq_factor_ud() result(rst) + ! Parameters + integer(int32), parameter :: m = 50 + integer(int32), parameter :: n = 60 + real(real64), parameter :: tol = 1.0d-8 + + ! Local Variables + real(real64) :: a(m, n), aref(m, n), tau(m), q(m, n), temp(m, n) + logical :: rst + + ! Initialization + rst = .true. + call random_number(a) + aref = a + + ! Compute the LQ factorization of A + call lq_factor(a, tau) + + ! Extract L and Q and check that L * Q = A + call form_lq(a, tau, q) + + ! Perform the check + if (.not.is_mtx_equal(matmul(a(:,1:m), q), aref, tol)) then + rst = .false. + print '(A)', "Test Failed: Underdetermined LQ Factorization Test 1" + end if + end function + +! ------------------------------------------------------------------------------ + function test_lq_factor_cmplx() result(rst) + ! Parameters + integer(int32), parameter :: m = 50 + integer(int32), parameter :: n = 50 + real(real64), parameter :: tol = 1.0d-8 + + ! Local Variables + real(real64) :: ar(m, n), ai(m, n) + complex(real64) :: a(m, n), aref(m, n), tau(m), q(m, n) + logical :: rst + + ! Initialization + rst = .true. + call random_number(ar) + call random_number(ai) + a = cmplx(ar, ai, real64) + aref = a + + ! Compute the LQ factorization of A + call lq_factor(a, tau) + + ! Extract L and Q and check that L * Q = A + call form_lq(a, tau, q) + + ! Perform the check + if (.not.is_mtx_equal(matmul(a, q), aref, tol)) then + rst = .false. + print '(A)', "Test Failed: Complex LQ Factorization Test 1" + end if + end function + +! ------------------------------------------------------------------------------ + function test_lq_factor_cmplx_ud() result(rst) + ! Parameters + integer(int32), parameter :: m = 50 + integer(int32), parameter :: n = 60 + real(real64), parameter :: tol = 1.0d-8 + + ! Local Variables + real(real64) :: ar(m, n), ai(m, n) + complex(real64) :: a(m, n), aref(m, n), tau(m), q(m, n) + logical :: rst + + ! Initialization + rst = .true. + call random_number(ar) + call random_number(ai) + a = cmplx(ar, ai, real64) + aref = a + + ! Compute the LQ factorization of A + call lq_factor(a, tau) + + ! Extract L and Q and check that L * Q = A + call form_lq(a, tau, q) + + ! Perform the check + if (.not.is_mtx_equal(matmul(a(:,1:m), q), aref, tol)) then + rst = .false. + print '(A)', "Test Failed: Underdetermined Complex LQ Factorization Test 1" + end if + end function + +! ****************************************************************************** +! LQ MULTIPLICATION TEST +! ------------------------------------------------------------------------------ + function test_lq_mult() result(rst) + ! Parameters + integer(int32), parameter :: m = 50 + integer(int32), parameter :: n = 50 + real(real64), parameter :: tol = 1.0d-8 + + ! Local Variables + real(real64) :: a(m, n), l(m, n), tau(m), q(m, n), c1(m, n), c2(m, n), & + ans(m, n), c3(m), c4(m), ans2(m) + logical :: rst + + ! Initialization + rst = .true. + call random_number(a) + call random_number(c1) + call random_number(c3) + c2 = c1 + c4 = c3 + + ! Compute the LQ factorization of A + call lq_factor(a, tau) + l = a + + ! Extract L and Q and check that L * Q = A + call form_lq(l, tau, q) + + ! Compute C = Q * C + call mult_lq(.true., .false., a, tau, c1) + + ! Compute the answer + ans = matmul(q, c2) + + ! Test + if (.not.is_mtx_equal(c1, ans, tol)) then + rst = .false. + print '(A)', "Test Failed: LQ Multiplication Test 1" + end if + + ! Vector RHS + call mult_lq(.false., a, tau, c3) + + ! Compute the answer + ans2 = matmul(q, c4) + + ! Test + if (.not.is_mtx_equal(c3, ans2, tol)) then + rst = .false. + print '(A)', "Test Failed: LQ Multiplication Test 2" + end if + end function + +! ------------------------------------------------------------------------------ + function test_lq_mult_ud() result(rst) + ! Parameters + integer(int32), parameter :: m = 50 + integer(int32), parameter :: n = 60 + real(real64), parameter :: tol = 1.0d-8 + + ! Local Variables + real(real64) :: a(m, n), l(m, n), tau(m), q(m, n), c1(m, n), c2(m, n), & + ans(m, n), c3(m), c4(m), ans2(m) + logical :: rst + + ! Initialization + rst = .true. + call random_number(a) + call random_number(c1) + call random_number(c3) + c2 = c1 + c4 = c3 + + ! Compute the LQ factorization of A + call lq_factor(a, tau) + l = a + + ! Extract L and Q and check that L * Q = A + call form_lq(l, tau, q) + + ! Compute C = Q * C + call mult_lq(.true., .false., a(:,1:m), tau, c1) + + ! Compute the answer + ans = matmul(q(:,1:m), c2) + + ! Test + if (.not.is_mtx_equal(c1, ans, tol)) then + rst = .false. + print '(A)', "Test Failed: Underdetermined LQ Multiplication Test 1" + end if + + ! Vector RHS + call mult_lq(.false., a(:,1:m), tau, c3) + + ! Compute the answer + ans2 = matmul(q(:,1:m), c4) + + ! Test + if (.not.is_mtx_equal(c3, ans2, tol)) then + rst = .false. + print '(A)', "Test Failed: Underdetermined LQ Multiplication Test 2" + end if + end function + +! ------------------------------------------------------------------------------ + +! ------------------------------------------------------------------------------ + +! ------------------------------------------------------------------------------ + +! ------------------------------------------------------------------------------ + +! ------------------------------------------------------------------------------ +end module \ No newline at end of file From b7522ee15309d82c263f4e85e73371ffb66f7ddd Mon Sep 17 00:00:00 2001 From: jchristopherson Date: Tue, 20 Dec 2022 06:12:40 -0600 Subject: [PATCH 49/65] Update tests --- tests/test_lq.f90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/tests/test_lq.f90 b/tests/test_lq.f90 index b3eb7fe0..e4633dd1 100644 --- a/tests/test_lq.f90 +++ b/tests/test_lq.f90 @@ -221,7 +221,7 @@ function test_lq_mult_ud() result(rst) ! Test if (.not.is_mtx_equal(c1, ans, tol)) then rst = .false. - print '(A)', "Test Failed: Underdetermined LQ Multiplication Test 1" + print '(A)', "Test Failed: LQ Multiplication Test 1" end if ! Vector RHS @@ -233,7 +233,7 @@ function test_lq_mult_ud() result(rst) ! Test if (.not.is_mtx_equal(c3, ans2, tol)) then rst = .false. - print '(A)', "Test Failed: Underdetermined LQ Multiplication Test 2" + print '(A)', "Test Failed: LQ Multiplication Test 2" end if end function From b03f57f09ee424007d5189870631d56ce49aaed0 Mon Sep 17 00:00:00 2001 From: jchristopherson Date: Tue, 20 Dec 2022 06:12:45 -0600 Subject: [PATCH 50/65] Bug fix --- src/linalg_factor.f90 | 20 ++++++++------------ 1 file changed, 8 insertions(+), 12 deletions(-) diff --git a/src/linalg_factor.f90 b/src/linalg_factor.f90 index 21cb71b5..6f8ff53a 100644 --- a/src/linalg_factor.f90 +++ b/src/linalg_factor.f90 @@ -3205,7 +3205,7 @@ module subroutine mult_lq_mtx(lside, trans, a, tau, c, work, olwork, err) ! Local Variables character :: side, t - integer(int32) :: m, n, k, nrowa, ncola, istat, flag, lwork + integer(int32) :: m, n, k, ncola, istat, flag, lwork real(real64), pointer, dimension(:) :: wptr real(real64), allocatable, target, dimension(:) :: wrk real(real64), dimension(1) :: temp @@ -3219,11 +3219,9 @@ module subroutine mult_lq_mtx(lside, trans, a, tau, c, work, olwork, err) k = size(tau) if (lside) then side = 'L' - nrowa = m ncola = m else side = 'R' - nrowa = n ncola = n end if if (trans) then @@ -3239,7 +3237,7 @@ module subroutine mult_lq_mtx(lside, trans, a, tau, c, work, olwork, err) ! Input Check flag = 0 - if (size(a, 1) /= nrowa .or. size(a, 2) /= ncola) then + if (size(a, 1) /= k .or. size(a, 2) /= ncola) then flag = 3 end if if (flag /= 0) then @@ -3252,7 +3250,7 @@ module subroutine mult_lq_mtx(lside, trans, a, tau, c, work, olwork, err) end if ! Workspace Query - call DORMLQ(side, t, m, n, k, a, nrowa, tau, c, m, temp, -1, flag) + call DORMLQ(side, t, m, n, k, a, k, tau, c, m, temp, -1, flag) lwork = int(temp(1), int32) if (present(olwork)) then olwork = lwork @@ -3282,7 +3280,7 @@ module subroutine mult_lq_mtx(lside, trans, a, tau, c, work, olwork, err) end if ! Call DORMLQ - call DORMLQ(side, t, m, n, k, a, nrowa, tau, c, m, wptr, lwork, flag) + call DORMLQ(side, t, m, n, k, a, k, tau, c, m, wptr, lwork, flag) ! Formatting 100 format(A, I0, A) @@ -3301,7 +3299,7 @@ module subroutine mult_lq_mtx_cmplx(lside, trans, a, tau, c, work, olwork, err) ! Local Variables character :: side, t - integer(int32) :: m, n, k, nrowa, ncola, istat, flag, lwork + integer(int32) :: m, n, k, ncola, istat, flag, lwork complex(real64), pointer, dimension(:) :: wptr complex(real64), allocatable, target, dimension(:) :: wrk complex(real64), dimension(1) :: temp @@ -3315,11 +3313,9 @@ module subroutine mult_lq_mtx_cmplx(lside, trans, a, tau, c, work, olwork, err) k = size(tau) if (lside) then side = 'L' - nrowa = m ncola = m else side = 'R' - nrowa = n ncola = n end if if (trans) then @@ -3335,7 +3331,7 @@ module subroutine mult_lq_mtx_cmplx(lside, trans, a, tau, c, work, olwork, err) ! Input Check flag = 0 - if (size(a, 1) /= nrowa .or. size(a, 2) /= ncola) then + if (size(a, 1) /= k .or. size(a, 2) /= ncola) then flag = 3 end if if (flag /= 0) then @@ -3348,7 +3344,7 @@ module subroutine mult_lq_mtx_cmplx(lside, trans, a, tau, c, work, olwork, err) end if ! Workspace Query - call ZUNMLQ(side, t, m, n, k, a, nrowa, tau, c, m, temp, -1, flag) + call ZUNMLQ(side, t, m, n, k, a, k, tau, c, m, temp, -1, flag) lwork = int(temp(1), int32) if (present(olwork)) then olwork = lwork @@ -3378,7 +3374,7 @@ module subroutine mult_lq_mtx_cmplx(lside, trans, a, tau, c, work, olwork, err) end if ! Call ZUNMLQ - call ZUNMLQ(side, t, m, n, k, a, nrowa, tau, c, m, wptr, lwork, flag) + call ZUNMLQ(side, t, m, n, k, a, k, tau, c, m, wptr, lwork, flag) ! Formatting 100 format(A, I0, A) From 2d1b05e4ff3ad934cfd7a672d5089b17430c459c Mon Sep 17 00:00:00 2001 From: jchristopherson Date: Tue, 20 Dec 2022 06:15:45 -0600 Subject: [PATCH 51/65] Update documentation --- doc/html/annotated.html | 56 +- doc/html/annotated_dup.js | 4 + doc/html/classes.html | 8 +- doc/html/globals.html | 8 + doc/html/globals_func.html | 8 + doc/html/index.html | 6 +- .../interfacelinalg_1_1cholesky__factor.html | 8 +- ...celinalg_1_1cholesky__rank1__downdate.html | 8 +- ...facelinalg_1_1cholesky__rank1__update.html | 8 +- doc/html/interfacelinalg_1_1det.html | 2 +- .../interfacelinalg_1_1diag__mtx__mult.html | 6 +- doc/html/interfacelinalg_1_1eigen.html | 4 +- .../interfacelinalg_1_1form__lq-members.html | 114 + doc/html/interfacelinalg_1_1form__lq.html | 212 ++ doc/html/interfacelinalg_1_1form__lu.html | 8 +- doc/html/interfacelinalg_1_1form__qr.html | 8 +- ...interfacelinalg_1_1lq__factor-members.html | 114 + doc/html/interfacelinalg_1_1lq__factor.html | 211 ++ doc/html/interfacelinalg_1_1lu__factor.html | 6 +- doc/html/interfacelinalg_1_1mtx__inverse.html | 4 +- doc/html/interfacelinalg_1_1mtx__mult.html | 2 +- .../interfacelinalg_1_1mtx__pinverse.html | 4 +- doc/html/interfacelinalg_1_1mtx__rank.html | 2 +- .../interfacelinalg_1_1mult__lq-members.html | 114 + doc/html/interfacelinalg_1_1mult__lq.html | 229 ++ doc/html/interfacelinalg_1_1mult__qr.html | 12 +- doc/html/interfacelinalg_1_1mult__rz.html | 2 +- doc/html/interfacelinalg_1_1qr__factor.html | 6 +- .../interfacelinalg_1_1qr__rank1__update.html | 10 +- .../interfacelinalg_1_1rank1__update.html | 2 +- ...interfacelinalg_1_1recip__mult__array.html | 2 +- doc/html/interfacelinalg_1_1rz__factor.html | 2 +- .../interfacelinalg_1_1solve__cholesky.html | 8 +- ...erfacelinalg_1_1solve__least__squares.html | 4 +- ...linalg_1_1solve__least__squares__full.html | 4 +- ...elinalg_1_1solve__least__squares__svd.html | 4 +- .../interfacelinalg_1_1solve__lq-members.html | 114 + doc/html/interfacelinalg_1_1solve__lq.html | 195 ++ doc/html/interfacelinalg_1_1solve__lu.html | 6 +- doc/html/interfacelinalg_1_1solve__qr.html | 6 +- ...celinalg_1_1solve__triangular__system.html | 8 +- doc/html/interfacelinalg_1_1sort.html | 2 +- doc/html/interfacelinalg_1_1svd.html | 6 +- doc/html/interfacelinalg_1_1swap.html | 2 +- doc/html/interfacelinalg_1_1trace.html | 2 +- .../interfacelinalg_1_1tri__mtx__mult.html | 2 +- doc/html/linalg_8f90_source.html | 2471 +++++++++-------- doc/html/linalg_8h.html | 820 +++++- doc/html/linalg_8h.js | 8 + doc/html/linalg_8h_source.html | 428 +-- doc/html/linalg__factor_8f90_source.html | 700 ++++- doc/html/linalg__solve_8f90_source.html | 377 ++- doc/html/namespacelinalg.html | 34 +- doc/html/namespacelinalg.js | 4 + doc/html/namespaces.html | 56 +- doc/html/navtreeindex0.js | 242 +- doc/html/search/all_3.js | 5 +- doc/html/search/all_4.js | 125 +- doc/html/search/all_5.js | 5 +- doc/html/search/all_8.js | 13 +- doc/html/search/classes_3.js | 5 +- doc/html/search/classes_4.js | 3 +- doc/html/search/classes_5.js | 5 +- doc/html/search/classes_8.js | 13 +- doc/html/search/functions_0.js | 100 +- 65 files changed, 5133 insertions(+), 1834 deletions(-) create mode 100644 doc/html/interfacelinalg_1_1form__lq-members.html create mode 100644 doc/html/interfacelinalg_1_1form__lq.html create mode 100644 doc/html/interfacelinalg_1_1lq__factor-members.html create mode 100644 doc/html/interfacelinalg_1_1lq__factor.html create mode 100644 doc/html/interfacelinalg_1_1mult__lq-members.html create mode 100644 doc/html/interfacelinalg_1_1mult__lq.html create mode 100644 doc/html/interfacelinalg_1_1solve__lq-members.html create mode 100644 doc/html/interfacelinalg_1_1solve__lq.html diff --git a/doc/html/annotated.html b/doc/html/annotated.html index 1365f35e..554d05ce 100644 --- a/doc/html/annotated.html +++ b/doc/html/annotated.html @@ -109,32 +109,36 @@  CdetComputes the determinant of a square matrix  Cdiag_mtx_multMultiplies a diagonal matrix with another matrix or array  CeigenComputes the eigenvalues, and optionally the eigenvectors, of a matrix - Cform_luExtracts the L and U matrices from the condensed [L\U] storage format used by the lu_factor - Cform_qrForms the full M-by-M orthogonal matrix Q from the elementary reflectors returned by the base QR factorization algorithm - Clu_factorComputes the LU factorization of an M-by-N matrix - Cmtx_inverseComputes the inverse of a square matrix - Cmtx_multPerforms the matrix operation: \( C = \alpha op(A) op(B) + \beta C \) - Cmtx_pinverseComputes the Moore-Penrose pseudo-inverse of a M-by-N matrix using the singular value decomposition of the matrix - Cmtx_rankComputes the rank of a matrix - Cmult_qrMultiplies a general matrix by the orthogonal matrix Q from a QR factorization - Cmult_rzMultiplies a general matrix by the orthogonal matrix Z from an RZ factorization - Cqr_factorComputes the QR factorization of an M-by-N matrix - Cqr_rank1_updateComputes the rank 1 update to an M-by-N QR factored matrix A (M >= N) where \( A = Q R \), and \( A1 = A + U V^T \) such that \( A1 = Q1 R1 \). In the event \( V \) is complex-valued, \( V^H \) is computed instead of \( V^T \) - Crank1_updatePerforms the rank-1 update to matrix A such that: \( A = \alpha X Y^T + A \), where \( A \) is an M-by-N matrix, \( \alpha \)is a scalar, \( X \) is an M-element array, and \( Y \) is an N-element array. In the event that \( Y \) is complex, \( Y^H \) is used instead of \( Y^T \) - Crecip_mult_arrayMultiplies a vector by the reciprocal of a real scalar - Crz_factorFactors an upper trapezoidal matrix by means of orthogonal transformations such that \( A = R Z = (R 0) Z \). Z is an orthogonal matrix of dimension N-by-N, and R is an M-by-M upper triangular matrix - Csolve_choleskySolves a system of Cholesky factored equations - Csolve_least_squaresSolves the overdetermined or underdetermined system \( A X = B \) of M equations of N unknowns. Notice, it is assumed that matrix A has full rank - Csolve_least_squares_fullSolves the overdetermined or underdetermined system \( A X = B \) of M equations of N unknowns, but uses a full orthogonal factorization of the system - Csolve_least_squares_svdSolves the overdetermined or underdetermined system \( A X = B \) of M equations of N unknowns using a singular value decomposition of matrix A - Csolve_luSolves a system of LU-factored equations - Csolve_qrSolves a system of M QR-factored equations of N unknowns - Csolve_triangular_systemSolves a triangular system of equations - CsortSorts an array - CsvdComputes the singular value decomposition of a matrix A. The SVD is defined as: \( A = U S V^T \), where \( U \) is an M-by-M orthogonal matrix, \( S \) is an M-by-N diagonal matrix, and \( V \) is an N-by-N orthogonal matrix. In the event that \( V \) is complex valued, \( V^H \) is computed instead of \( V^T \) - CswapSwaps the contents of two arrays - CtraceComputes the trace of a matrix (the sum of the main diagonal elements) - Ctri_mtx_multComputes the triangular matrix operation: \( B = \alpha A^T A + \beta B \), or \( B = \alpha A A^T + \beta B \), where A is a triangular matrix + Cform_lqForms the matrix Q with orthonormal rows from the elementary reflectors returned by the LQ factorization algorithm + Cform_luExtracts the L and U matrices from the condensed [L\U] storage format used by the lu_factor + Cform_qrForms the full M-by-M orthogonal matrix Q from the elementary reflectors returned by the base QR factorization algorithm + Clq_factorComputes the LQ factorization of an M-by-N matrix + Clu_factorComputes the LU factorization of an M-by-N matrix + Cmtx_inverseComputes the inverse of a square matrix + Cmtx_multPerforms the matrix operation: \( C = \alpha op(A) op(B) + \beta C \) + Cmtx_pinverseComputes the Moore-Penrose pseudo-inverse of a M-by-N matrix using the singular value decomposition of the matrix + Cmtx_rankComputes the rank of a matrix + Cmult_lqMultiplies a general matrix by the orthogonal matrix Q from a LQ factorization + Cmult_qrMultiplies a general matrix by the orthogonal matrix Q from a QR factorization + Cmult_rzMultiplies a general matrix by the orthogonal matrix Z from an RZ factorization + Cqr_factorComputes the QR factorization of an M-by-N matrix + Cqr_rank1_updateComputes the rank 1 update to an M-by-N QR factored matrix A (M >= N) where \( A = Q R \), and \( A1 = A + U V^T \) such that \( A1 = Q1 R1 \). In the event \( V \) is complex-valued, \( V^H \) is computed instead of \( V^T \) + Crank1_updatePerforms the rank-1 update to matrix A such that: \( A = \alpha X Y^T + A \), where \( A \) is an M-by-N matrix, \( \alpha \)is a scalar, \( X \) is an M-element array, and \( Y \) is an N-element array. In the event that \( Y \) is complex, \( Y^H \) is used instead of \( Y^T \) + Crecip_mult_arrayMultiplies a vector by the reciprocal of a real scalar + Crz_factorFactors an upper trapezoidal matrix by means of orthogonal transformations such that \( A = R Z = (R 0) Z \). Z is an orthogonal matrix of dimension N-by-N, and R is an M-by-M upper triangular matrix + Csolve_choleskySolves a system of Cholesky factored equations + Csolve_least_squaresSolves the overdetermined or underdetermined system \( A X = B \) of M equations of N unknowns. Notice, it is assumed that matrix A has full rank + Csolve_least_squares_fullSolves the overdetermined or underdetermined system \( A X = B \) of M equations of N unknowns, but uses a full orthogonal factorization of the system + Csolve_least_squares_svdSolves the overdetermined or underdetermined system \( A X = B \) of M equations of N unknowns using a singular value decomposition of matrix A + Csolve_lqSolves a system of M LQ-factored equations of N unknowns. N must be greater than or equal to M + Csolve_luSolves a system of LU-factored equations + Csolve_qrSolves a system of M QR-factored equations of N unknowns + Csolve_triangular_systemSolves a triangular system of equations + CsortSorts an array + CsvdComputes the singular value decomposition of a matrix A. The SVD is defined as: \( A = U S V^T \), where \( U \) is an M-by-M orthogonal matrix, \( S \) is an M-by-N diagonal matrix, and \( V \) is an N-by-N orthogonal matrix. In the event that \( V \) is complex valued, \( V^H \) is computed instead of \( V^T \) + CswapSwaps the contents of two arrays + CtraceComputes the trace of a matrix (the sum of the main diagonal elements) + Ctri_mtx_multComputes the triangular matrix operation: \( B = \alpha A^T A + \beta B \), or \( B = \alpha A A^T + \beta B \), where A is a triangular matrix
    diff --git a/doc/html/annotated_dup.js b/doc/html/annotated_dup.js index f71f057e..a2c59fd0 100644 --- a/doc/html/annotated_dup.js +++ b/doc/html/annotated_dup.js @@ -7,13 +7,16 @@ var annotated_dup = [ "det", "interfacelinalg_1_1det.html", null ], [ "diag_mtx_mult", "interfacelinalg_1_1diag__mtx__mult.html", null ], [ "eigen", "interfacelinalg_1_1eigen.html", null ], + [ "form_lq", "interfacelinalg_1_1form__lq.html", null ], [ "form_lu", "interfacelinalg_1_1form__lu.html", null ], [ "form_qr", "interfacelinalg_1_1form__qr.html", null ], + [ "lq_factor", "interfacelinalg_1_1lq__factor.html", null ], [ "lu_factor", "interfacelinalg_1_1lu__factor.html", null ], [ "mtx_inverse", "interfacelinalg_1_1mtx__inverse.html", null ], [ "mtx_mult", "interfacelinalg_1_1mtx__mult.html", null ], [ "mtx_pinverse", "interfacelinalg_1_1mtx__pinverse.html", null ], [ "mtx_rank", "interfacelinalg_1_1mtx__rank.html", null ], + [ "mult_lq", "interfacelinalg_1_1mult__lq.html", null ], [ "mult_qr", "interfacelinalg_1_1mult__qr.html", null ], [ "mult_rz", "interfacelinalg_1_1mult__rz.html", null ], [ "qr_factor", "interfacelinalg_1_1qr__factor.html", null ], @@ -25,6 +28,7 @@ var annotated_dup = [ "solve_least_squares", "interfacelinalg_1_1solve__least__squares.html", null ], [ "solve_least_squares_full", "interfacelinalg_1_1solve__least__squares__full.html", null ], [ "solve_least_squares_svd", "interfacelinalg_1_1solve__least__squares__svd.html", null ], + [ "solve_lq", "interfacelinalg_1_1solve__lq.html", null ], [ "solve_lu", "interfacelinalg_1_1solve__lu.html", null ], [ "solve_qr", "interfacelinalg_1_1solve__qr.html", null ], [ "solve_triangular_system", "interfacelinalg_1_1solve__triangular__system.html", null ], diff --git a/doc/html/classes.html b/doc/html/classes.html index cbcb5b1a..751dc4d2 100644 --- a/doc/html/classes.html +++ b/doc/html/classes.html @@ -113,13 +113,13 @@
    eigen (linalg)
    F
    -
    form_lu (linalg)
    form_qr (linalg)
    +
    form_lq (linalg)
    form_lu (linalg)
    form_qr (linalg)
    L
    -
    lu_factor (linalg)
    +
    lq_factor (linalg)
    lu_factor (linalg)
    M
    -
    mtx_inverse (linalg)
    mtx_mult (linalg)
    mtx_pinverse (linalg)
    mtx_rank (linalg)
    mult_qr (linalg)
    mult_rz (linalg)
    +
    mtx_inverse (linalg)
    mtx_mult (linalg)
    mtx_pinverse (linalg)
    mtx_rank (linalg)
    mult_lq (linalg)
    mult_qr (linalg)
    mult_rz (linalg)
    Q
    qr_factor (linalg)
    qr_rank1_update (linalg)
    @@ -128,7 +128,7 @@
    rank1_update (linalg)
    recip_mult_array (linalg)
    rz_factor (linalg)
    S
    -
    solve_cholesky (linalg)
    solve_least_squares (linalg)
    solve_least_squares_full (linalg)
    solve_least_squares_svd (linalg)
    solve_lu (linalg)
    solve_qr (linalg)
    solve_triangular_system (linalg)
    sort (linalg)
    svd (linalg)
    swap (linalg)
    +
    solve_cholesky (linalg)
    solve_least_squares (linalg)
    solve_least_squares_full (linalg)
    solve_least_squares_svd (linalg)
    solve_lq (linalg)
    solve_lu (linalg)
    solve_qr (linalg)
    solve_triangular_system (linalg)
    sort (linalg)
    svd (linalg)
    swap (linalg)
    T
    trace (linalg)
    tri_mtx_mult (linalg)
    diff --git a/doc/html/globals.html b/doc/html/globals.html index bceec022..40a27cc9 100644 --- a/doc/html/globals.html +++ b/doc/html/globals.html @@ -115,6 +115,8 @@

    - l -

    The program generates the following output.

    LU Solution: X =
    0.3333
    @@ -207,7 +207,7 @@
    print '(F10.3)', (real(modeshapes(j,i)), j = 1, size(natfreq))
    end do
    end program
    -
    Computes the eigenvalues, and optionally the eigenvectors, of a matrix.
    Definition: linalg.f90:3229
    +
    Computes the eigenvalues, and optionally the eigenvectors, of a matrix.
    Definition: linalg.f90:3237

    The above program produces the following output.

    Modal Information:
    Mode 1: (232.9225 Hz)
    -0.718
    diff --git a/doc/html/interfacelinalg_1_1cholesky__factor.html b/doc/html/interfacelinalg_1_1cholesky__factor.html index 9db20e5d..38860e7c 100644 --- a/doc/html/interfacelinalg_1_1cholesky__factor.html +++ b/doc/html/interfacelinalg_1_1cholesky__factor.html @@ -173,9 +173,9 @@
    print '(A)', "Cholesky Solution (Manual Approach): X = "
    print '(F8.4)', (bu(i), i = 1, size(bu))
    end program
    -
    Computes the Cholesky factorization of a symmetric, positive definite matrix.
    Definition: linalg.f90:1563
    -
    Solves a system of Cholesky factored equations.
    Definition: linalg.f90:2521
    -
    Solves a triangular system of equations.
    Definition: linalg.f90:2192
    +
    Computes the Cholesky factorization of a symmetric, positive definite matrix.
    Definition: linalg.f90:1571
    +
    Solves a system of Cholesky factored equations.
    Definition: linalg.f90:2529
    +
    Solves a triangular system of equations.
    Definition: linalg.f90:2200
    Provides a set of common linear algebra routines.
    Definition: linalg.f90:145
    The above program produces the following output.
    Cholesky Solution: X =
    239.5833
    @@ -187,7 +187,7 @@
    10.3333
    -

    Definition at line 1563 of file linalg.f90.

    +

    Definition at line 1571 of file linalg.f90.


    The documentation for this interface was generated from the following file: diff --git a/doc/html/interfacelinalg_1_1cholesky__rank1__downdate.html b/doc/html/interfacelinalg_1_1cholesky__rank1__downdate.html index e0c21512..287fc6d6 100644 --- a/doc/html/interfacelinalg_1_1cholesky__rank1__downdate.html +++ b/doc/html/interfacelinalg_1_1cholesky__rank1__downdate.html @@ -174,9 +174,9 @@
    print *, ad(i,:)
    end do
    end program
    -
    Computes the Cholesky factorization of a symmetric, positive definite matrix.
    Definition: linalg.f90:1563
    -
    Computes the rank 1 downdate to a Cholesky factored matrix (upper triangular).
    Definition: linalg.f90:1769
    -
    Performs the rank-1 update to matrix A such that: , where is an M-by-N matrix, is a scalar,...
    Definition: linalg.f90:324
    +
    Computes the Cholesky factorization of a symmetric, positive definite matrix.
    Definition: linalg.f90:1571
    +
    Computes the rank 1 downdate to a Cholesky factored matrix (upper triangular).
    Definition: linalg.f90:1777
    +
    Performs the rank-1 update to matrix A such that: , where is an M-by-N matrix, is a scalar,...
    Definition: linalg.f90:328
    Provides a set of common linear algebra routines.
    Definition: linalg.f90:145
    The above program produces the following output.
    Downdating the Factored Form:
    2.0000000000000000 6.0000000000000000 -8.0000000000000000
    @@ -188,7 +188,7 @@
    0.0000000000000000 0.0000000000000000 3.0000000000000000
    -

    Definition at line 1769 of file linalg.f90.

    +

    Definition at line 1777 of file linalg.f90.


    The documentation for this interface was generated from the following file: diff --git a/doc/html/interfacelinalg_1_1cholesky__rank1__update.html b/doc/html/interfacelinalg_1_1cholesky__rank1__update.html index 56a3f558..a7075811 100644 --- a/doc/html/interfacelinalg_1_1cholesky__rank1__update.html +++ b/doc/html/interfacelinalg_1_1cholesky__rank1__update.html @@ -168,9 +168,9 @@
    print *, au(i,:)
    end do
    end program
    -
    Computes the Cholesky factorization of a symmetric, positive definite matrix.
    Definition: linalg.f90:1563
    -
    Computes the rank 1 update to a Cholesky factored matrix (upper triangular).
    Definition: linalg.f90:1662
    -
    Performs the rank-1 update to matrix A such that: , where is an M-by-N matrix, is a scalar,...
    Definition: linalg.f90:324
    +
    Computes the Cholesky factorization of a symmetric, positive definite matrix.
    Definition: linalg.f90:1571
    +
    Computes the rank 1 update to a Cholesky factored matrix (upper triangular).
    Definition: linalg.f90:1670
    +
    Performs the rank-1 update to matrix A such that: , where is an M-by-N matrix, is a scalar,...
    Definition: linalg.f90:328
    Provides a set of common linear algebra routines.
    Definition: linalg.f90:145
    The above program produces the following output.
    Updating the Factored Form:
    2.0615528128088303 5.4570515633174921 -7.2760687510899889
    @@ -182,7 +182,7 @@
    0.0000000000000000 0.0000000000000000 6.6989384530323557
    -

    Definition at line 1662 of file linalg.f90.

    +

    Definition at line 1670 of file linalg.f90.


    The documentation for this interface was generated from the following file: diff --git a/doc/html/interfacelinalg_1_1det.html b/doc/html/interfacelinalg_1_1det.html index 21cb4eed..f856e86c 100644 --- a/doc/html/interfacelinalg_1_1det.html +++ b/doc/html/interfacelinalg_1_1det.html @@ -124,7 +124,7 @@
    Returns
    The determinant of a.
    -

    Definition at line 564 of file linalg.f90.

    +

    Definition at line 568 of file linalg.f90.


    The documentation for this interface was generated from the following file: diff --git a/doc/html/interfacelinalg_1_1diag__mtx__mult.html b/doc/html/interfacelinalg_1_1diag__mtx__mult.html index 81f389cc..f4ac6a5f 100644 --- a/doc/html/interfacelinalg_1_1diag__mtx__mult.html +++ b/doc/html/interfacelinalg_1_1diag__mtx__mult.html @@ -193,8 +193,8 @@
    print *, ac(i,:)
    end do
    end program
    -
    Multiplies a diagonal matrix with another matrix or array.
    Definition: linalg.f90:459
    -
    Computes the singular value decomposition of a matrix A. The SVD is defined as: , where is an M-by-M...
    Definition: linalg.f90:2058
    +
    Multiplies a diagonal matrix with another matrix or array.
    Definition: linalg.f90:463
    +
    Computes the singular value decomposition of a matrix A. The SVD is defined as: , where is an M-by-M...
    Definition: linalg.f90:2066
    Provides a set of common linear algebra routines.
    Definition: linalg.f90:145
    The above program produces the following output.
    U =
    -0.47411577501825380 -0.81850539032073777 -0.32444284226152509
    @@ -212,7 +212,7 @@
    -1.0000000000000000 0.99999999999999967
    -

    Definition at line 459 of file linalg.f90.

    +

    Definition at line 463 of file linalg.f90.


    The documentation for this interface was generated from the following file: diff --git a/doc/html/interfacelinalg_1_1eigen.html b/doc/html/interfacelinalg_1_1eigen.html index 7dd88b83..93a3f881 100644 --- a/doc/html/interfacelinalg_1_1eigen.html +++ b/doc/html/interfacelinalg_1_1eigen.html @@ -225,7 +225,7 @@
    print '(F10.3)', (real(modeshapes(j,i)), j = 1, size(natfreq))
    end do
    end program
    -
    Computes the eigenvalues, and optionally the eigenvectors, of a matrix.
    Definition: linalg.f90:3229
    +
    Computes the eigenvalues, and optionally the eigenvectors, of a matrix.
    Definition: linalg.f90:3237
    Provides a set of common linear algebra routines.
    Definition: linalg.f90:145
    The above program produces the following output.
    Modal Information:
    Mode 1: (232.9225 Hz)
    @@ -248,7 +248,7 @@ -

    Definition at line 3229 of file linalg.f90.

    +

    Definition at line 3237 of file linalg.f90.


    The documentation for this interface was generated from the following file: diff --git a/doc/html/interfacelinalg_1_1form__lq-members.html b/doc/html/interfacelinalg_1_1form__lq-members.html new file mode 100644 index 00000000..45d6f62c --- /dev/null +++ b/doc/html/interfacelinalg_1_1form__lq-members.html @@ -0,0 +1,114 @@ + + + + + + + +linalg: Member List + + + + + + + + + + + + + + + +
    +
    + + + + + + +
    +
    linalg 1.6.1 +
    +
    A linear algebra library that provides a user-friendly interface to several BLAS and LAPACK routines.
    +
    +
    + + + + + + + +
    +
    + +
    +
    +
    + +
    + +
    +
    + + +
    +
    +
    +
    +
    +
    Loading...
    +
    Searching...
    +
    No Matches
    +
    +
    +
    +
    + +
    +
    linalg::form_lq Member List
    +
    +
    + +

    This is the complete list of members for linalg::form_lq, including all inherited members.

    +
    +
    + + + + diff --git a/doc/html/interfacelinalg_1_1form__lq.html b/doc/html/interfacelinalg_1_1form__lq.html new file mode 100644 index 00000000..790df832 --- /dev/null +++ b/doc/html/interfacelinalg_1_1form__lq.html @@ -0,0 +1,212 @@ + + + + + + + +linalg: linalg::form_lq Interface Reference + + + + + + + + + + + + + + + +
    +
    + + + + + + +
    +
    linalg 1.6.1 +
    +
    A linear algebra library that provides a user-friendly interface to several BLAS and LAPACK routines.
    +
    +
    + + + + + + + +
    +
    + +
    +
    +
    + +
    + +
    +
    + + +
    +
    +
    +
    +
    +
    Loading...
    +
    Searching...
    +
    No Matches
    +
    +
    +
    +
    + +
    + +
    linalg::form_lq Interface Reference
    +
    +
    + +

    Forms the matrix Q with orthonormal rows from the elementary reflectors returned by the LQ factorization algorithm. + More...

    +

    Detailed Description

    +

    Forms the matrix Q with orthonormal rows from the elementary reflectors returned by the LQ factorization algorithm.

    +
    Syntax
    subroutine form_lq(real(real64) l(:,:), real(real64) tau(:), real(real64) q(:,:), optional real(real64) work(:), optional integer(int32) olwork, optional class(errors) err)
    +
    subroutine form_lq(complex(real64) l(:,:), complex(real64) tau(:), complex(real64) q(:,:), optional complex(real64) work(:), optional integer(int32) olwork, optional class(errors) err)
    +
    +
    Parameters
    + + + + + + + +
    [in,out]lOn input, an M-by-N matrix where the elements above the diagonal contain the elementary reflectors generated from the LQ factorization performed by lq_factor. On and below the diagonal the matrix contains the matrix L. On output, the elements above the diagonal are zeroed sucht hat the remaining matrix is the M-by-N lower trapezoidal matrix L where only the M-by-M submatrix is the lower triangular matrix L. Notice, M must be less than or equal to N for this routine.
    [in]tauA MIN(M, N)-element array containing the scalar factors of each elementary reflector defined in l.
    [out]qAn M-by-N matrix where the matrix Q with orhtonormal rows will be written.
    [out]workAn optional input, that if provided, prevents any local memory allocation. If not provided, the memory required is allocated within. If provided, the length of the array must be at least olwork.
    [out]olworkAn optional output used to determine workspace size. If supplied, the routine determines the optimal size for work, and returns without performing any actual calculations.
    [in,out]errAn optional errors-based object that if provided can be used to retrieve information relating to any errors encountered during execution. If not provided, a default implementation of the errors class is used internally to provide error handling. Possible errors and warning messages that may be encountered are as follows.
      +
    • LA_ARRAY_SIZE_ERROR: Occurs if any of the input arrays are not sized appropriately.
    • +
    • LA_OUT_OF_MEMORY_ERROR: Occurs if local memory must be allocated, and there is insufficient memory available.
    • +
    +
    +
    +
    +
    Notes
    This routine utilizes the LAPACK routine DORGLQ (ZUNGLQ in the complex case).
    +
    Usage
    The folowing example illustrates the solution of a system of equations using LQ factorization.
    program example
    +
    use iso_fortran_env, only : real64, int32
    +
    use linalg
    +
    implicit none
    +
    +
    ! Variables
    +
    real(real64) :: a(3,3), b(3), q(3,3), tau(3), x(3)
    +
    integer(int32) :: i
    +
    +
    ! Build the 3-by-3 matrix A.
    +
    ! | 1 2 3 |
    +
    ! A = | 4 5 6 |
    +
    ! | 7 8 0 |
    +
    a = reshape( &
    +
    [1.0d0, 4.0d0, 7.0d0, 2.0d0, 5.0d0, 8.0d0, 3.0d0, 6.0d0, 0.0d0], &
    +
    [3, 3])
    +
    +
    ! Build the right-hand-side vector B.
    +
    ! | -1 |
    +
    ! b = | -2 |
    +
    ! | -3 |
    +
    b = [-1.0d0, -2.0d0, -3.0d0]
    +
    +
    ! The solution is:
    +
    ! | 1/3 |
    +
    ! x = | -2/3 |
    +
    ! | 0 |
    +
    +
    ! Compute the LQ factorization
    +
    call lq_factor(a, tau)
    +
    +
    ! Build L and Q. A is overwritten with L
    +
    call form_lq(a, tau, q)
    +
    +
    ! Solve the lower triangular problem and store the solution in B.
    +
    !
    +
    ! A few notes about this solution noting we've factored A = L * Q.
    +
    !
    +
    ! We then have to solve: L * Q * X = B for X. If we let Y = Q * X, then
    +
    ! we solve the lower triangular system L * Y = B for Y.
    +
    call solve_triangular_system(.false., .false., .true., a, b)
    +
    +
    ! Now we've solved the lower triangular system L * Y = B for Y. At
    +
    ! this point we solve the problem: Q * X = Y. Q is an orthogonal matrix;
    +
    ! therefore, inv(Q) = Q**T. We can solve this by multiplying both
    +
    ! sides by Q**T:
    +
    !
    +
    ! Compute Q**T * B = X
    +
    call mtx_mult(.true., 1.0d0, q, b, 0.0d0, x)
    +
    +
    ! Display the results
    +
    print '(A)', "LQ Solution: X = "
    +
    print '(F8.4)', (x(i), i = 1, size(x))
    +
    end program
    +
    Forms the matrix Q with orthonormal rows from the elementary reflectors returned by the LQ factorizat...
    Definition: linalg.f90:3548
    +
    Computes the LQ factorization of an M-by-N matrix.
    Definition: linalg.f90:3434
    +
    Performs the matrix operation: .
    Definition: linalg.f90:293
    +
    Solves a triangular system of equations.
    Definition: linalg.f90:2200
    +
    Provides a set of common linear algebra routines.
    Definition: linalg.f90:145
    +
    The above program produces the following output.
    LQ Solution: X =
    +
    0.3333
    +
    -0.6667
    +
    0.0000
    +
    +
    See Also
    +
    + +

    Definition at line 3548 of file linalg.f90.

    +

    The documentation for this interface was generated from the following file: +
    +
    + + + + diff --git a/doc/html/interfacelinalg_1_1form__lu.html b/doc/html/interfacelinalg_1_1form__lu.html index a642fd59..fad23c5f 100644 --- a/doc/html/interfacelinalg_1_1form__lu.html +++ b/doc/html/interfacelinalg_1_1form__lu.html @@ -197,9 +197,9 @@
    print '(A)', "LU Solution: X = "
    print '(F8.4)', (b(i), i = 1, size(b))
    end program
    -
    Extracts the L and U matrices from the condensed [L\U] storage format used by the lu_factor.
    Definition: linalg.f90:847
    -
    Computes the LU factorization of an M-by-N matrix.
    Definition: linalg.f90:725
    -
    Solves a triangular system of equations.
    Definition: linalg.f90:2192
    +
    Extracts the L and U matrices from the condensed [L\U] storage format used by the lu_factor.
    Definition: linalg.f90:851
    +
    Computes the LU factorization of an M-by-N matrix.
    Definition: linalg.f90:729
    +
    Solves a triangular system of equations.
    Definition: linalg.f90:2200
    Provides a set of common linear algebra routines.
    Definition: linalg.f90:145
    The above program produces the following output.
    LU Solution: X =
    0.3333
    @@ -207,7 +207,7 @@
    0.0000
    -

    Definition at line 847 of file linalg.f90.

    +

    Definition at line 851 of file linalg.f90.


    The documentation for this interface was generated from the following file: diff --git a/doc/html/interfacelinalg_1_1form__qr.html b/doc/html/interfacelinalg_1_1form__qr.html index 10c30a0f..9e97285d 100644 --- a/doc/html/interfacelinalg_1_1form__qr.html +++ b/doc/html/interfacelinalg_1_1form__qr.html @@ -202,9 +202,9 @@
    ! for by noting that Q * R = A * P, where P is an N-by-N matrix describing
    ! the column pivoting operations.
    end program
    -
    Forms the full M-by-M orthogonal matrix Q from the elementary reflectors returned by the base QR fact...
    Definition: linalg.f90:1161
    -
    Computes the QR factorization of an M-by-N matrix.
    Definition: linalg.f90:1001
    -
    Solves a triangular system of equations.
    Definition: linalg.f90:2192
    +
    Forms the full M-by-M orthogonal matrix Q from the elementary reflectors returned by the base QR fact...
    Definition: linalg.f90:1165
    +
    Computes the QR factorization of an M-by-N matrix.
    Definition: linalg.f90:1005
    +
    Solves a triangular system of equations.
    Definition: linalg.f90:2200
    Provides a set of common linear algebra routines.
    Definition: linalg.f90:145
    The above program produces the following output.
    QR Solution: X =
    0.3333
    @@ -217,7 +217,7 @@ -

    Definition at line 1161 of file linalg.f90.

    +

    Definition at line 1165 of file linalg.f90.


    The documentation for this interface was generated from the following file: diff --git a/doc/html/interfacelinalg_1_1lq__factor-members.html b/doc/html/interfacelinalg_1_1lq__factor-members.html new file mode 100644 index 00000000..d7026863 --- /dev/null +++ b/doc/html/interfacelinalg_1_1lq__factor-members.html @@ -0,0 +1,114 @@ + + + + + + + +linalg: Member List + + + + + + + + + + + + + + + +
    +
    + + + + + + +
    +
    linalg 1.6.1 +
    +
    A linear algebra library that provides a user-friendly interface to several BLAS and LAPACK routines.
    +
    +
    + + + + + + + +
    +
    + +
    +
    +
    + +
    + +
    +
    + + +
    +
    +
    +
    +
    +
    Loading...
    +
    Searching...
    +
    No Matches
    +
    +
    +
    +
    + +
    +
    linalg::lq_factor Member List
    +
    +
    + +

    This is the complete list of members for linalg::lq_factor, including all inherited members.

    +
    +
    + + + + diff --git a/doc/html/interfacelinalg_1_1lq__factor.html b/doc/html/interfacelinalg_1_1lq__factor.html new file mode 100644 index 00000000..69080558 --- /dev/null +++ b/doc/html/interfacelinalg_1_1lq__factor.html @@ -0,0 +1,211 @@ + + + + + + + +linalg: linalg::lq_factor Interface Reference + + + + + + + + + + + + + + + +
    +
    + + + + + + +
    +
    linalg 1.6.1 +
    +
    A linear algebra library that provides a user-friendly interface to several BLAS and LAPACK routines.
    +
    +
    + + + + + + + +
    +
    + +
    +
    +
    + +
    + +
    +
    + + +
    +
    +
    +
    +
    +
    Loading...
    +
    Searching...
    +
    No Matches
    +
    +
    +
    +
    + +
    + +
    linalg::lq_factor Interface Reference
    +
    +
    + +

    Computes the LQ factorization of an M-by-N matrix. + More...

    +

    Detailed Description

    +

    Computes the LQ factorization of an M-by-N matrix.

    +
    Syntax
    subroutine lq_factor(real(real64) a(:,:), real(real64) tau(:), optional real(real64) work(:), optional integer(int32) olwork, optional class(errors) err)
    +
    subroutine lq_factor(complex(real64) a(:,:), complex(real64) tau(:), optional complex(real64) work(:), optional integer(int32) olwork, optional class(errors) err)
    +
    +
    Parameters
    + + + + + + +
    [in,out]aOn input, the M-by-N matrix to factor. On output, the elements on and below the diagonal contain the MIN(M, N)-by-N lower trapezoidal matrix L (L is lower triangular if M >= N). The elements above the diagonal, along with the array tau, represent the orthogonal matrix Q as a product of elementary reflectors.
    [out]tauA MIN(M, N)-element array used to store the scalar factors of the elementary reflectors.
    [out]workAn optional input, that if provided, prevents any local memory allocation. If not provided, the memory required is allocated within. If provided, the length of the array must be at least olwork.
    [out]olworkAn optional output used to determine workspace size. If supplied, the routine determines the optimal size for work, and returns without performing any actual calculations.
    [in,out]errAn optional errors-based object that if provided can be used to retrieve information relating to any errors encountered during execution. If not provided, a default implementation of the errors class is used internally to provide error handling. Possible errors and warning messages that may be encountered are as follows.
      +
    • LA_ARRAY_SIZE_ERROR: Occurs if tau or work are not sized appropriately.
    • +
    • LA_OUT_OF_MEMORY_ERROR: Occurs if local memory must be allocated, and there is insufficient memory available.
    • +
    +
    +
    +
    +
    Notes
    This routine utilizes the LAPACK routine DGELQF (ZGELQF for the complex case).
    +
    Usage
    The folowing example illustrates the solution of a system of equations using LQ factorization.
    program example
    +
    use iso_fortran_env, only : real64, int32
    +
    use linalg
    +
    implicit none
    +
    +
    ! Variables
    +
    real(real64) :: a(3,3), b(3), q(3,3), tau(3), x(3)
    +
    integer(int32) :: i
    +
    +
    ! Build the 3-by-3 matrix A.
    +
    ! | 1 2 3 |
    +
    ! A = | 4 5 6 |
    +
    ! | 7 8 0 |
    +
    a = reshape( &
    +
    [1.0d0, 4.0d0, 7.0d0, 2.0d0, 5.0d0, 8.0d0, 3.0d0, 6.0d0, 0.0d0], &
    +
    [3, 3])
    +
    +
    ! Build the right-hand-side vector B.
    +
    ! | -1 |
    +
    ! b = | -2 |
    +
    ! | -3 |
    +
    b = [-1.0d0, -2.0d0, -3.0d0]
    +
    +
    ! The solution is:
    +
    ! | 1/3 |
    +
    ! x = | -2/3 |
    +
    ! | 0 |
    +
    +
    ! Compute the LQ factorization
    +
    call lq_factor(a, tau)
    +
    +
    ! Build L and Q. A is overwritten with L
    +
    call form_lq(a, tau, q)
    +
    +
    ! Solve the lower triangular problem and store the solution in B.
    +
    !
    +
    ! A few notes about this solution noting we've factored A = L * Q.
    +
    !
    +
    ! We then have to solve: L * Q * X = B for X. If we let Y = Q * X, then
    +
    ! we solve the lower triangular system L * Y = B for Y.
    +
    call solve_triangular_system(.false., .false., .true., a, b)
    +
    +
    ! Now we've solved the lower triangular system L * Y = B for Y. At
    +
    ! this point we solve the problem: Q * X = Y. Q is an orthogonal matrix;
    +
    ! therefore, inv(Q) = Q**T. We can solve this by multiplying both
    +
    ! sides by Q**T:
    +
    !
    +
    ! Compute Q**T * B = X
    +
    call mtx_mult(.true., 1.0d0, q, b, 0.0d0, x)
    +
    +
    ! Display the results
    +
    print '(A)', "LQ Solution: X = "
    +
    print '(F8.4)', (x(i), i = 1, size(x))
    +
    end program
    +
    Forms the matrix Q with orthonormal rows from the elementary reflectors returned by the LQ factorizat...
    Definition: linalg.f90:3548
    +
    Computes the LQ factorization of an M-by-N matrix.
    Definition: linalg.f90:3434
    +
    Performs the matrix operation: .
    Definition: linalg.f90:293
    +
    Solves a triangular system of equations.
    Definition: linalg.f90:2200
    +
    Provides a set of common linear algebra routines.
    Definition: linalg.f90:145
    +
    The above program produces the following output.
    LQ Solution: X =
    +
    0.3333
    +
    -0.6667
    +
    0.0000
    +
    +
    See Also
    +
    + +

    Definition at line 3434 of file linalg.f90.

    +

    The documentation for this interface was generated from the following file: +
    +
    + + + + diff --git a/doc/html/interfacelinalg_1_1lu__factor.html b/doc/html/interfacelinalg_1_1lu__factor.html index d5e24803..686e0967 100644 --- a/doc/html/interfacelinalg_1_1lu__factor.html +++ b/doc/html/interfacelinalg_1_1lu__factor.html @@ -166,8 +166,8 @@
    print '(A)', "LU Solution: X = "
    print '(F8.4)', (b(i), i = 1, size(b))
    end program
    -
    Computes the LU factorization of an M-by-N matrix.
    Definition: linalg.f90:725
    -
    Solves a system of LU-factored equations.
    Definition: linalg.f90:2280
    +
    Computes the LU factorization of an M-by-N matrix.
    Definition: linalg.f90:729
    +
    Solves a system of LU-factored equations.
    Definition: linalg.f90:2288
    Provides a set of common linear algebra routines.
    Definition: linalg.f90:145
    The program generates the following output.
    LU Solution: X =
    0.3333
    @@ -175,7 +175,7 @@
    0.0000
    -

    Definition at line 725 of file linalg.f90.

    +

    Definition at line 729 of file linalg.f90.


    The documentation for this interface was generated from the following file: diff --git a/doc/html/interfacelinalg_1_1mtx__inverse.html b/doc/html/interfacelinalg_1_1mtx__inverse.html index c197fbe8..680051f0 100644 --- a/doc/html/interfacelinalg_1_1mtx__inverse.html +++ b/doc/html/interfacelinalg_1_1mtx__inverse.html @@ -167,7 +167,7 @@
    print *, c(i,:)
    end do
    end program
    -
    Computes the inverse of a square matrix.
    Definition: linalg.f90:2909
    +
    Computes the inverse of a square matrix.
    Definition: linalg.f90:2917
    Provides a set of common linear algebra routines.
    Definition: linalg.f90:145
    The above program produces the following output.
    Inverse:
    -1.7777777777777777 0.88888888888888884 -0.11111111111111110
    @@ -179,7 +179,7 @@
    1.7763568394002505E-015 -8.8817841970012523E-016 1.0000000000000000
    -

    Definition at line 2909 of file linalg.f90.

    +

    Definition at line 2917 of file linalg.f90.


    The documentation for this interface was generated from the following file: diff --git a/doc/html/interfacelinalg_1_1mtx__mult.html b/doc/html/interfacelinalg_1_1mtx__mult.html index 00c2b81a..e94b4c95 100644 --- a/doc/html/interfacelinalg_1_1mtx__mult.html +++ b/doc/html/interfacelinalg_1_1mtx__mult.html @@ -146,7 +146,7 @@
    Notes
    This routine utilizes the BLAS routines DGEMM, ZGEMM, DGEMV, or ZGEMV.
    -

    Definition at line 289 of file linalg.f90.

    +

    Definition at line 293 of file linalg.f90.


    The documentation for this interface was generated from the following file: diff --git a/doc/html/interfacelinalg_1_1mtx__pinverse.html b/doc/html/interfacelinalg_1_1mtx__pinverse.html index d2e839bd..cf4db6f6 100644 --- a/doc/html/interfacelinalg_1_1mtx__pinverse.html +++ b/doc/html/interfacelinalg_1_1mtx__pinverse.html @@ -171,7 +171,7 @@
    print *, c(i,:)
    end do
    end program
    -
    Computes the Moore-Penrose pseudo-inverse of a M-by-N matrix using the singular value decomposition o...
    Definition: linalg.f90:3015
    +
    Computes the Moore-Penrose pseudo-inverse of a M-by-N matrix using the singular value decomposition o...
    Definition: linalg.f90:3023
    Provides a set of common linear algebra routines.
    Definition: linalg.f90:145
    The above program produces the following output.
    Inverse:
    1.0000000000000000 0.0000000000000000 0.0000000000000000
    @@ -181,7 +181,7 @@
    0.0000000000000000 0.99999999999999967
    -

    Definition at line 3015 of file linalg.f90.

    +

    Definition at line 3023 of file linalg.f90.


    The documentation for this interface was generated from the following file: diff --git a/doc/html/interfacelinalg_1_1mtx__rank.html b/doc/html/interfacelinalg_1_1mtx__rank.html index d089127e..85898b6b 100644 --- a/doc/html/interfacelinalg_1_1mtx__rank.html +++ b/doc/html/interfacelinalg_1_1mtx__rank.html @@ -131,7 +131,7 @@ -

    Definition at line 531 of file linalg.f90.

    +

    Definition at line 535 of file linalg.f90.


    The documentation for this interface was generated from the following file: diff --git a/doc/html/interfacelinalg_1_1mult__lq-members.html b/doc/html/interfacelinalg_1_1mult__lq-members.html new file mode 100644 index 00000000..830009f5 --- /dev/null +++ b/doc/html/interfacelinalg_1_1mult__lq-members.html @@ -0,0 +1,114 @@ + + + + + + + +linalg: Member List + + + + + + + + + + + + + + + +
    +
    + + + + + + +
    +
    linalg 1.6.1 +
    +
    A linear algebra library that provides a user-friendly interface to several BLAS and LAPACK routines.
    +
    +
    + + + + + + + +
    +
    + +
    +
    +
    + +
    + +
    +
    + + +
    +
    +
    +
    +
    +
    Loading...
    +
    Searching...
    +
    No Matches
    +
    +
    +
    +
    + +
    +
    linalg::mult_lq Member List
    +
    +
    + +

    This is the complete list of members for linalg::mult_lq, including all inherited members.

    +
    +
    + + + + diff --git a/doc/html/interfacelinalg_1_1mult__lq.html b/doc/html/interfacelinalg_1_1mult__lq.html new file mode 100644 index 00000000..1195dce2 --- /dev/null +++ b/doc/html/interfacelinalg_1_1mult__lq.html @@ -0,0 +1,229 @@ + + + + + + + +linalg: linalg::mult_lq Interface Reference + + + + + + + + + + + + + + + +
    +
    + + + + + + +
    +
    linalg 1.6.1 +
    +
    A linear algebra library that provides a user-friendly interface to several BLAS and LAPACK routines.
    +
    +
    + + + + + + + +
    +
    + +
    +
    +
    + +
    + +
    +
    + + +
    +
    +
    +
    +
    +
    Loading...
    +
    Searching...
    +
    No Matches
    +
    +
    +
    +
    + +
    + +
    linalg::mult_lq Interface Reference
    +
    +
    + +

    Multiplies a general matrix by the orthogonal matrix Q from a LQ factorization. + More...

    +

    Detailed Description

    +

    Multiplies a general matrix by the orthogonal matrix Q from a LQ factorization.

    +
    Syntax 1
    Multiplies a general matrix by the orthogonal matrix \( Q \) from a LQ factorization such that: \( C = op(Q) C \), or \( C = C op(Q) \).
    subroutine mult_qr(logical lside, logical trans, real(real64) a(:,:), real(real64) tau(:), real(real64) c(:,:), optional real(real64) work(:), optional integer(int32) olwork, optional class(errors) err)
    +
    subroutine mult_qr(logical lside, logical trans, complex(real64) a(:,:), complex(real64) tau(:), complex(real64) c(:,:), optional complex(real64) work(:), optional integer(int32) olwork, optional class(errors) err)
    +
    +
    Parameters
    + + + + + + + + + +
    [in]lsideSet to true to apply \( Q \) or \( Q^T \) from the left; else, set to false to apply \( Q \) or \( Q^T \) from the right.
    [in]transSet to true to apply \( Q^T \); else, set to false. In the event \( Q \) is complex-valued, \( Q^H \) is computed instead of \( Q^T \).
    [in]aOn input, an LDA-by-K matrix containing the elementary reflectors output from the QR factorization. If lside is set to true, LDA = M, and M >= K >= 0; else, if lside is set to false, LDA = N, and N >= K >= 0. Notice, the contents of this matrix are restored on exit.
    [in]tauA K-element array containing the scalar factors of each elementary reflector defined in a.
    [in,out]cOn input, the M-by-N matrix C. On output, the product of the orthogonal matrix Q and the original matrix C.
    [out]workAn optional input, that if provided, prevents any local memory allocation. If not provided, the memory required is allocated within. If provided, the length of the array must be at least olwork.
    [in,out]olworkAn optional output used to determine workspace size. If supplied, the routine determines the optimal size for work, and returns without performing any actual calculations.
    [in,out]errAn optional errors-based object that if provided can be used to retrieve information relating to any errors encountered during execution. If not provided, a default implementation of the errors class is used internally to provide error handling. Possible errors and warning messages that may be encountered are as follows.
      +
    • LA_ARRAY_SIZE_ERROR: Occurs if any of the input arrays are not sized appropriately.
    • +
    • LA_OUT_OF_MEMORY_ERROR: Occurs if local memory must be allocated, and there is insufficient memory available.
    • +
    +
    +
    +
    +
    Syntax 2
    Multiplies a vector by the orthogonal matrix \( Q \) from a QR factorization such that: \( C = op(Q) C\).
    subroutine mult_qr(logical trans, real(real64) a(:,:), real(real64) tau(:), real(real64) c(:), optional real(real64) work(:), optional integer(int32) olwork, optional class(errors) err)
    +
    subroutine mult_qr(logical trans, complex(real64) a(:,:), complex(real64) tau(:), complex(real64) c(:), optional complex(real64) work(:), optional integer(int32) olwork, optional class(errors) err)
    +
    +
    Parameters
    + + + + + + + + +
    [in]transSet to true to apply \( Q^T \); else, set to false. In the event \( Q \) is complex-valued, \( Q^H \) is computed instead of \( Q^T \).
    [in]aOn input, an M-by-K matrix containing the elementary reflectors output from the QR factorization. Notice, the contents of this matrix are restored on exit.
    [in]tauA K-element array containing the scalar factors of each elementary reflector defined in a.
    [in,out]cOn input, the M-element vector C. On output, the product of the orthogonal matrix Q and the original vector C.
    [out]workAn optional input, that if provided, prevents any local memory allocation. If not provided, the memory required is allocated within. If provided, the length of the array must be at least olwork.
    [out]olworkAn optional output used to determine workspace size. If supplied, the routine determines the optimal size for work, and returns without performing any actual calculations.
    [in,out]errAn optional errors-based object that if provided can be used to retrieve information relating to any errors encountered during execution. If not provided, a default implementation of the errors class is used internally to provide error handling. Possible errors and warning messages that may be encountered are as follows.
      +
    • LA_ARRAY_SIZE_ERROR: Occurs if any of the input arrays are not sized appropriately.
    • +
    • LA_OUT_OF_MEMORY_ERROR: Occurs if local memory must be allocated, and there is insufficient memory available.
    • +
    +
    +
    +
    +
    Notes
    This routine utilizes the LAPACK routine DORMLQ (ZUNMLQ in the complex case).
    +
    Usage
    The folowing example illustrates the solution of a system of equations using LQ factorization.
    program example
    +
    use iso_fortran_env, only : real64, int32
    +
    use linalg
    +
    implicit none
    +
    +
    ! Local Variables
    +
    real(real64) :: a(3,3), tau(3), b(3)
    +
    integer(int32) :: i, pvt(3)
    +
    +
    ! Build the 3-by-3 matrix A.
    +
    ! | 1 2 3 |
    +
    ! A = | 4 5 6 |
    +
    ! | 7 8 0 |
    +
    a = reshape( &
    +
    [1.0d0, 4.0d0, 7.0d0, 2.0d0, 5.0d0, 8.0d0, 3.0d0, 6.0d0, 0.0d0], &
    +
    [3, 3])
    +
    +
    ! Build the right-hand-side vector B.
    +
    ! | -1 |
    +
    ! b = | -2 |
    +
    ! | -3 |
    +
    b = [-1.0d0, -2.0d0, -3.0d0]
    +
    +
    ! The solution is:
    +
    ! | 1/3 |
    +
    ! x = | -2/3 |
    +
    ! | 0 |
    +
    +
    ! Compute the LQ factorization
    +
    call lq_factor(a, tau)
    +
    +
    ! Solve the lower triangular problem and store the solution in B.
    +
    !
    +
    ! A comment about this solution noting we've factored A = L * Q.
    +
    !
    +
    ! We then have to solve: L * Q * X = B for X. If we let Y = Q * X, then
    +
    ! we solve the lower triangular system L * Y = B for Y.
    +
    call solve_triangular_system(.false., .false., .true., a, b)
    +
    +
    ! Now we've solved the lower triangular system L * Y = B for Y. At
    +
    ! this point we solve the problem: Q * X = Y. Q is an orthogonal matrix;
    +
    ! therefore, inv(Q) = Q**T. We can solve this by multiplying both
    +
    ! sides by Q**T:
    +
    !
    +
    ! Compute Q**T * B = X
    +
    call mult_lq(.true., a, tau, b)
    +
    +
    ! Display the results
    +
    print '(A)', "LQ Solution: X = "
    +
    print '(F8.4)', (b(i), i = 1, size(b))
    +
    end program
    +
    Computes the LQ factorization of an M-by-N matrix.
    Definition: linalg.f90:3434
    +
    Multiplies a general matrix by the orthogonal matrix Q from a LQ factorization.
    Definition: linalg.f90:3699
    +
    Solves a triangular system of equations.
    Definition: linalg.f90:2200
    +
    Provides a set of common linear algebra routines.
    Definition: linalg.f90:145
    +
    The above program produces the following output.
    LQ Solution: X =
    +
    0.3333
    +
    -0.6667
    +
    0.0000
    +
    +
    See Also
    +
    + +

    Definition at line 3699 of file linalg.f90.

    +

    The documentation for this interface was generated from the following file: +
    +
    + + + + diff --git a/doc/html/interfacelinalg_1_1mult__qr.html b/doc/html/interfacelinalg_1_1mult__qr.html index 888f0370..a909ca41 100644 --- a/doc/html/interfacelinalg_1_1mult__qr.html +++ b/doc/html/interfacelinalg_1_1mult__qr.html @@ -113,7 +113,7 @@
    Parameters
    - + @@ -133,7 +133,7 @@
    Parameters
    [in]lsideSet to true to apply \( Q \) or \( Q^T \) from the left; else, set to false to apply \( Q \) or \( Q^T \) from the right.
    [in]transSet to true to apply \( Q^T \); else, set to false.
    [in]transSet to true to apply \( Q^T \); else, set to false. In the event \( Q \) is complex-valued, \( Q^H \) is computed instead of \( Q^T \).
    [in]aOn input, an LDA-by-K matrix containing the elementary reflectors output from the QR factorization. If lside is set to true, LDA = M, and M >= K >= 0; else, if lside is set to false, LDA = N, and N >= K >= 0. Notice, the contents of this matrix are restored on exit.
    [in]tauA K-element array containing the scalar factors of each elementary reflector defined in a.
    [in,out]cOn input, the M-by-N matrix C. On output, the product of the orthogonal matrix Q and the original matrix C.
    - + @@ -201,9 +201,9 @@
    ! for by noting that Q * R = A * P, where P is an N-by-N matrix describing
    ! the column pivoting operations.
    end program
    -
    Multiplies a general matrix by the orthogonal matrix Q from a QR factorization.
    Definition: linalg.f90:1314
    -
    Computes the QR factorization of an M-by-N matrix.
    Definition: linalg.f90:1001
    -
    Solves a triangular system of equations.
    Definition: linalg.f90:2192
    +
    Multiplies a general matrix by the orthogonal matrix Q from a QR factorization.
    Definition: linalg.f90:1322
    +
    Computes the QR factorization of an M-by-N matrix.
    Definition: linalg.f90:1005
    +
    Solves a triangular system of equations.
    Definition: linalg.f90:2200
    Provides a set of common linear algebra routines.
    Definition: linalg.f90:145
    The above program produces the following output.
    QR Solution: X =
    0.3333
    @@ -211,7 +211,7 @@
    0.0000
    -

    Definition at line 1314 of file linalg.f90.

    +

    Definition at line 1322 of file linalg.f90.


    The documentation for this interface was generated from the following file: diff --git a/doc/html/interfacelinalg_1_1mult__rz.html b/doc/html/interfacelinalg_1_1mult__rz.html index d5bf1e4e..ec61427e 100644 --- a/doc/html/interfacelinalg_1_1mult__rz.html +++ b/doc/html/interfacelinalg_1_1mult__rz.html @@ -150,7 +150,7 @@
    Notes
    This routine utilizes the LAPACK routine DORMRZ (ZUNMRZ in the complex case).
    -

    Definition at line 1933 of file linalg.f90.

    +

    Definition at line 1941 of file linalg.f90.


    The documentation for this interface was generated from the following file: diff --git a/doc/html/interfacelinalg_1_1qr__factor.html b/doc/html/interfacelinalg_1_1qr__factor.html index 778be8f6..b806296d 100644 --- a/doc/html/interfacelinalg_1_1qr__factor.html +++ b/doc/html/interfacelinalg_1_1qr__factor.html @@ -189,8 +189,8 @@
    ! same manner. The only difference is to omit the PVT array (column pivot
    ! tracking array).
    end program
    -
    Computes the QR factorization of an M-by-N matrix.
    Definition: linalg.f90:1001
    -
    Solves a system of M QR-factored equations of N unknowns.
    Definition: linalg.f90:2415
    +
    Computes the QR factorization of an M-by-N matrix.
    Definition: linalg.f90:1005
    +
    Solves a system of M QR-factored equations of N unknowns.
    Definition: linalg.f90:2423
    Provides a set of common linear algebra routines.
    Definition: linalg.f90:145
    The above program produces the following output.
    QR Solution: X =
    0.3333
    @@ -204,7 +204,7 @@ -

    Definition at line 1001 of file linalg.f90.

    +

    Definition at line 1005 of file linalg.f90.


    The documentation for this interface was generated from the following file: diff --git a/doc/html/interfacelinalg_1_1qr__rank1__update.html b/doc/html/interfacelinalg_1_1qr__rank1__update.html index 0e76583a..9ad6d407 100644 --- a/doc/html/interfacelinalg_1_1qr__rank1__update.html +++ b/doc/html/interfacelinalg_1_1qr__rank1__update.html @@ -194,10 +194,10 @@
    print *, a(i,:)
    end do
    end program
    -
    Forms the full M-by-M orthogonal matrix Q from the elementary reflectors returned by the base QR fact...
    Definition: linalg.f90:1161
    -
    Computes the QR factorization of an M-by-N matrix.
    Definition: linalg.f90:1001
    -
    Computes the rank 1 update to an M-by-N QR factored matrix A (M >= N) where , and such that ....
    Definition: linalg.f90:1464
    -
    Performs the rank-1 update to matrix A such that: , where is an M-by-N matrix, is a scalar,...
    Definition: linalg.f90:324
    +
    Forms the full M-by-M orthogonal matrix Q from the elementary reflectors returned by the base QR fact...
    Definition: linalg.f90:1165
    +
    Computes the QR factorization of an M-by-N matrix.
    Definition: linalg.f90:1005
    +
    Computes the rank 1 update to an M-by-N QR factored matrix A (M >= N) where , and such that ....
    Definition: linalg.f90:1472
    +
    Performs the rank-1 update to matrix A such that: , where is an M-by-N matrix, is a scalar,...
    Definition: linalg.f90:328
    Provides a set of common linear algebra routines.
    Definition: linalg.f90:145
    The above program produces the following output.
    Updating the Factored Form:
    Q =
    @@ -219,7 +219,7 @@
    0.0000000000000000 0.0000000000000000 -5.2929341121113058
    -

    Definition at line 1464 of file linalg.f90.

    +

    Definition at line 1472 of file linalg.f90.


    The documentation for this interface was generated from the following file: diff --git a/doc/html/interfacelinalg_1_1rank1__update.html b/doc/html/interfacelinalg_1_1rank1__update.html index e1711d11..fa6b8625 100644 --- a/doc/html/interfacelinalg_1_1rank1__update.html +++ b/doc/html/interfacelinalg_1_1rank1__update.html @@ -125,7 +125,7 @@
    Notes
    This routine is based upon the BLAS routine DGER or ZGER.
    -

    Definition at line 324 of file linalg.f90.

    +

    Definition at line 328 of file linalg.f90.


    The documentation for this interface was generated from the following file: diff --git a/doc/html/interfacelinalg_1_1recip__mult__array.html b/doc/html/interfacelinalg_1_1recip__mult__array.html index 0337afcc..d235e9a9 100644 --- a/doc/html/interfacelinalg_1_1recip__mult__array.html +++ b/doc/html/interfacelinalg_1_1recip__mult__array.html @@ -118,7 +118,7 @@
    Notes
    This routine is based upon the LAPACK routine DRSCL.
    -

    Definition at line 605 of file linalg.f90.

    +

    Definition at line 609 of file linalg.f90.


    The documentation for this interface was generated from the following file: diff --git a/doc/html/interfacelinalg_1_1rz__factor.html b/doc/html/interfacelinalg_1_1rz__factor.html index c78461cb..22fae493 100644 --- a/doc/html/interfacelinalg_1_1rz__factor.html +++ b/doc/html/interfacelinalg_1_1rz__factor.html @@ -135,7 +135,7 @@ -

    Definition at line 1842 of file linalg.f90.

    +

    Definition at line 1850 of file linalg.f90.


    The documentation for this interface was generated from the following file: diff --git a/doc/html/interfacelinalg_1_1solve__cholesky.html b/doc/html/interfacelinalg_1_1solve__cholesky.html index 16b9fd07..01bb7f88 100644 --- a/doc/html/interfacelinalg_1_1solve__cholesky.html +++ b/doc/html/interfacelinalg_1_1solve__cholesky.html @@ -175,9 +175,9 @@
    print '(A)', "Cholesky Solution (Manual Approach): X = "
    print '(F8.4)', (bu(i), i = 1, size(bu))
    end program
    -
    Computes the Cholesky factorization of a symmetric, positive definite matrix.
    Definition: linalg.f90:1563
    -
    Solves a system of Cholesky factored equations.
    Definition: linalg.f90:2521
    -
    Solves a triangular system of equations.
    Definition: linalg.f90:2192
    +
    Computes the Cholesky factorization of a symmetric, positive definite matrix.
    Definition: linalg.f90:1571
    +
    Solves a system of Cholesky factored equations.
    Definition: linalg.f90:2529
    +
    Solves a triangular system of equations.
    Definition: linalg.f90:2200
    Provides a set of common linear algebra routines.
    Definition: linalg.f90:145
    The above program produces the following output.
    Cholesky Solution: X =
    239.5833
    @@ -189,7 +189,7 @@
    10.3333
    -

    Definition at line 2521 of file linalg.f90.

    +

    Definition at line 2529 of file linalg.f90.


    The documentation for this interface was generated from the following file: diff --git a/doc/html/interfacelinalg_1_1solve__least__squares.html b/doc/html/interfacelinalg_1_1solve__least__squares.html index a596c46f..2623eeed 100644 --- a/doc/html/interfacelinalg_1_1solve__least__squares.html +++ b/doc/html/interfacelinalg_1_1solve__least__squares.html @@ -160,14 +160,14 @@
    print '(A)', "Least Squares Solution: X = "
    print '(F9.5)', (b(i), i = 1, size(a, 2))
    end program
    -
    Solves the overdetermined or underdetermined system of M equations of N unknowns....
    Definition: linalg.f90:2611
    +
    Solves the overdetermined or underdetermined system of M equations of N unknowns....
    Definition: linalg.f90:2619
    Provides a set of common linear algebra routines.
    Definition: linalg.f90:145
    The above program produces the following output.
    Least Squares Solution: X =
    0.13158
    -0.57895
    -

    Definition at line 2611 of file linalg.f90.

    +

    Definition at line 2619 of file linalg.f90.


    The documentation for this interface was generated from the following file: diff --git a/doc/html/interfacelinalg_1_1solve__least__squares__full.html b/doc/html/interfacelinalg_1_1solve__least__squares__full.html index fd139a4d..916fcd4b 100644 --- a/doc/html/interfacelinalg_1_1solve__least__squares__full.html +++ b/doc/html/interfacelinalg_1_1solve__least__squares__full.html @@ -162,14 +162,14 @@
    print '(A)', "Least Squares Solution: X = "
    print '(F9.5)', (b(i), i = 1, size(a, 2))
    end program
    -
    Solves the overdetermined or underdetermined system of M equations of N unknowns,...
    Definition: linalg.f90:2712
    +
    Solves the overdetermined or underdetermined system of M equations of N unknowns,...
    Definition: linalg.f90:2720
    Provides a set of common linear algebra routines.
    Definition: linalg.f90:145
    The above program produces the following output.
    Least Squares Solution: X =
    0.13158
    -0.57895
    -

    Definition at line 2712 of file linalg.f90.

    +

    Definition at line 2720 of file linalg.f90.


    The documentation for this interface was generated from the following file: diff --git a/doc/html/interfacelinalg_1_1solve__least__squares__svd.html b/doc/html/interfacelinalg_1_1solve__least__squares__svd.html index a5f0d16a..b6b570fc 100644 --- a/doc/html/interfacelinalg_1_1solve__least__squares__svd.html +++ b/doc/html/interfacelinalg_1_1solve__least__squares__svd.html @@ -164,14 +164,14 @@
    print '(A)', "Least Squares Solution: X = "
    print '(F9.5)', (b(i), i = 1, size(a, 2))
    end program
    -
    Solves the overdetermined or underdetermined system of M equations of N unknowns using a singular va...
    Definition: linalg.f90:2814
    +
    Solves the overdetermined or underdetermined system of M equations of N unknowns using a singular va...
    Definition: linalg.f90:2822
    Provides a set of common linear algebra routines.
    Definition: linalg.f90:145
    The above program produces the following output.
    Least Squares Solution: X =
    0.13158
    -0.57895
    -

    Definition at line 2814 of file linalg.f90.

    +

    Definition at line 2822 of file linalg.f90.


    The documentation for this interface was generated from the following file: diff --git a/doc/html/interfacelinalg_1_1solve__lq-members.html b/doc/html/interfacelinalg_1_1solve__lq-members.html new file mode 100644 index 00000000..1c900adc --- /dev/null +++ b/doc/html/interfacelinalg_1_1solve__lq-members.html @@ -0,0 +1,114 @@ + + + + + + + +linalg: Member List + + + + + + + + + + + + + + + +
    +
    +
    [in]transSet to true to apply \( Q^T \); else, set to false.
    [in]transSet to true to apply \( Q^T \); else, set to false. In the event \( Q \) is complex-valued, \( Q^H \) is computed instead of \( Q^T \).
    [in]aOn input, an M-by-K matrix containing the elementary reflectors output from the QR factorization. Notice, the contents of this matrix are restored on exit.
    [in]tauA K-element array containing the scalar factors of each elementary reflector defined in a.
    [in,out]cOn input, the M-element vector C. On output, the product of the orthogonal matrix Q and the original vector C.
    + + + + + +
    +
    linalg 1.6.1 +
    +
    A linear algebra library that provides a user-friendly interface to several BLAS and LAPACK routines.
    +
    + + + + + + + + + +
    + +
    +
    +
    + +
    + +
    +
    + + +
    +
    +
    +
    +
    +
    Loading...
    +
    Searching...
    +
    No Matches
    +
    +
    +
    +
    + +
    +
    linalg::solve_lq Member List
    +
    +
    + +

    This is the complete list of members for linalg::solve_lq, including all inherited members.

    +
    +
    + + + + diff --git a/doc/html/interfacelinalg_1_1solve__lq.html b/doc/html/interfacelinalg_1_1solve__lq.html new file mode 100644 index 00000000..03c95ca2 --- /dev/null +++ b/doc/html/interfacelinalg_1_1solve__lq.html @@ -0,0 +1,195 @@ + + + + + + + +linalg: linalg::solve_lq Interface Reference + + + + + + + + + + + + + + + +
    +
    + + + + + + +
    +
    linalg 1.6.1 +
    +
    A linear algebra library that provides a user-friendly interface to several BLAS and LAPACK routines.
    +
    +
    + + + + + + + +
    +
    + +
    +
    +
    + +
    + +
    +
    + + +
    +
    +
    +
    +
    +
    Loading...
    +
    Searching...
    +
    No Matches
    +
    +
    +
    +
    + +
    + +
    linalg::solve_lq Interface Reference
    +
    +
    + +

    Solves a system of M LQ-factored equations of N unknowns. N must be greater than or equal to M. + More...

    +

    Detailed Description

    +

    Solves a system of M LQ-factored equations of N unknowns. N must be greater than or equal to M.

    +
    Syntax
    subroutine solve_lq(real(real64) a(:,:), real(real64) tau(:), real(real64) b(:,:), optional real(real64) work(:), optional integer(int32) olwork, optional class(errors) err)
    +
    subroutine solve_lq(complex(real64) a(:,:), complex(real64) tau(:), complex(real64) b(:,:), optional complex(real64) work(:), optional integer(int32) olwork, optional class(errors) err)
    +
    subroutine solve_lq(real(real64) a(:,:), real(real64) tau(:), real(real64) b(:), optional real(real64) work(:), optional integer(int32) olwork, optional class(errors) err)
    +
    subroutine solve_lq(complex(real64) a(:,:), complex(real64) tau(:), complex(real64) b(:), optional complex(real64) work(:), optional integer(int32) olwork, optional class(errors) err)
    +
    +
    Parameters
    + + + + + + + +
    [in]aOn input, the M-by-N LQ factored matrix as returned by lq_factor. On output, the contents of this matrix are restored. Notice, N must be greater than or equal to M.
    [in]tauA MIN(M, N)-element array containing the scalar factors of the elementary reflectors as returned by lq_factor.
    [in]bOn input, an N-by-NRHS matrix where the first M rows contain the right-hand-side matrix. On output, the N-by-NRHS solution matrix X.
    [out]workAn optional input, that if provided, prevents any local memory allocation. If not provided, the memory required is allocated within. If provided, the length of the array must be at least olwork.
    [out]olworkAn optional output used to determine workspace size. If supplied, the routine determines the optimal size for work, and returns without performing any actual calculations.
    [in,out]errAn optional errors-based object that if provided can be used to retrieve information relating to any errors encountered during execution. If not provided, a default implementation of the errors class is used internally to provide error handling. Possible errors and warning messages that may be encountered are as follows.
      +
    • LA_ARRAY_SIZE_ERROR: Occurs if any of the input arrays are not sized appropriately.
    • +
    • LA_OUT_OF_MEMORY_ERROR: Occurs if local memory must be allocated, and there is insufficient memory available.
    • +
    +
    +
    +
    +
    Usage
    The following example illustrates the solution of a system of equations using LQ factorization.
    program example
    +
    use iso_fortran_env, only : real64, int32
    +
    use linalg
    +
    implicit none
    +
    +
    ! Local Variables
    +
    real(real64) :: a(3,3), tau(3), b(3)
    +
    integer(int32) :: i, pvt(3)
    +
    +
    ! Build the 3-by-3 matrix A.
    +
    ! | 1 2 3 |
    +
    ! A = | 4 5 6 |
    +
    ! | 7 8 0 |
    +
    a = reshape( &
    +
    [1.0d0, 4.0d0, 7.0d0, 2.0d0, 5.0d0, 8.0d0, 3.0d0, 6.0d0, 0.0d0], &
    +
    [3, 3])
    +
    +
    ! Build the right-hand-side vector B.
    +
    ! | -1 |
    +
    ! b = | -2 |
    +
    ! | -3 |
    +
    b = [-1.0d0, -2.0d0, -3.0d0]
    +
    +
    ! The solution is:
    +
    ! | 1/3 |
    +
    ! x = | -2/3 |
    +
    ! | 0 |
    +
    +
    ! Compute the LQ factorization
    +
    call lq_factor(a, tau)
    +
    +
    ! Compute the solution. The results overwrite b.
    +
    call solve_lq(a, tau, b)
    +
    +
    ! Display the results
    +
    print '(A)', "LQ Solution: X = "
    +
    print '(F8.4)', (b(i), i = 1, size(b))
    +
    end program
    +
    Computes the LQ factorization of an M-by-N matrix.
    Definition: linalg.f90:3434
    +
    Solves a system of M LQ-factored equations of N unknowns. N must be greater than or equal to M.
    Definition: linalg.f90:3794
    +
    Provides a set of common linear algebra routines.
    Definition: linalg.f90:145
    +
    The above program produces the following output.
    QR Solution: X =
    +
    0.3333
    +
    -0.6667
    +
    0.0000
    +
    +
    See Also
    +
    + +

    Definition at line 3794 of file linalg.f90.

    +

    The documentation for this interface was generated from the following file: +
    +
    + + + + diff --git a/doc/html/interfacelinalg_1_1solve__lu.html b/doc/html/interfacelinalg_1_1solve__lu.html index dc299efd..a46404b5 100644 --- a/doc/html/interfacelinalg_1_1solve__lu.html +++ b/doc/html/interfacelinalg_1_1solve__lu.html @@ -163,8 +163,8 @@
    print '(A)', "LU Solution: X = "
    print '(F8.4)', (b(i), i = 1, size(b))
    end program
    -
    Computes the LU factorization of an M-by-N matrix.
    Definition: linalg.f90:725
    -
    Solves a system of LU-factored equations.
    Definition: linalg.f90:2280
    +
    Computes the LU factorization of an M-by-N matrix.
    Definition: linalg.f90:729
    +
    Solves a system of LU-factored equations.
    Definition: linalg.f90:2288
    Provides a set of common linear algebra routines.
    Definition: linalg.f90:145
    The program generates the following output.
    LU Solution: X =
    0.3333
    @@ -177,7 +177,7 @@
    -

    Definition at line 2280 of file linalg.f90.

    +

    Definition at line 2288 of file linalg.f90.


    The documentation for this interface was generated from the following file: diff --git a/doc/html/interfacelinalg_1_1solve__qr.html b/doc/html/interfacelinalg_1_1solve__qr.html index 5a65087f..4bc608a3 100644 --- a/doc/html/interfacelinalg_1_1solve__qr.html +++ b/doc/html/interfacelinalg_1_1solve__qr.html @@ -191,8 +191,8 @@
    ! same manner. The only difference is to omit the PVT array (column pivot
    ! tracking array).
    end program
    -
    Computes the QR factorization of an M-by-N matrix.
    Definition: linalg.f90:1001
    -
    Solves a system of M QR-factored equations of N unknowns.
    Definition: linalg.f90:2415
    +
    Computes the QR factorization of an M-by-N matrix.
    Definition: linalg.f90:1005
    +
    Solves a system of M QR-factored equations of N unknowns.
    Definition: linalg.f90:2423
    Provides a set of common linear algebra routines.
    Definition: linalg.f90:145
    The above program produces the following output.
    QR Solution: X =
    0.3333
    @@ -205,7 +205,7 @@ -

    Definition at line 2415 of file linalg.f90.

    +

    Definition at line 2423 of file linalg.f90.


    The documentation for this interface was generated from the following file: diff --git a/doc/html/interfacelinalg_1_1solve__triangular__system.html b/doc/html/interfacelinalg_1_1solve__triangular__system.html index 11166375..d0e562bd 100644 --- a/doc/html/interfacelinalg_1_1solve__triangular__system.html +++ b/doc/html/interfacelinalg_1_1solve__triangular__system.html @@ -194,9 +194,9 @@
    print '(A)', "LU Solution: X = "
    print '(F8.4)', (b(i), i = 1, size(b))
    end program
    -
    Extracts the L and U matrices from the condensed [L\U] storage format used by the lu_factor.
    Definition: linalg.f90:847
    -
    Computes the LU factorization of an M-by-N matrix.
    Definition: linalg.f90:725
    -
    Solves a triangular system of equations.
    Definition: linalg.f90:2192
    +
    Extracts the L and U matrices from the condensed [L\U] storage format used by the lu_factor.
    Definition: linalg.f90:851
    +
    Computes the LU factorization of an M-by-N matrix.
    Definition: linalg.f90:729
    +
    Solves a triangular system of equations.
    Definition: linalg.f90:2200
    Provides a set of common linear algebra routines.
    Definition: linalg.f90:145
    The above program produces the following output.
    LU Solution: X =
    0.3333
    @@ -204,7 +204,7 @@
    0.0000
    -

    Definition at line 2192 of file linalg.f90.

    +

    Definition at line 2200 of file linalg.f90.


    The documentation for this interface was generated from the following file: diff --git a/doc/html/interfacelinalg_1_1sort.html b/doc/html/interfacelinalg_1_1sort.html index a1086d26..0b35af4a 100644 --- a/doc/html/interfacelinalg_1_1sort.html +++ b/doc/html/interfacelinalg_1_1sort.html @@ -152,7 +152,7 @@ -

    Definition at line 3312 of file linalg.f90.

    +

    Definition at line 3320 of file linalg.f90.


    The documentation for this interface was generated from the following file: diff --git a/doc/html/interfacelinalg_1_1svd.html b/doc/html/interfacelinalg_1_1svd.html index 7e809635..2ee1b376 100644 --- a/doc/html/interfacelinalg_1_1svd.html +++ b/doc/html/interfacelinalg_1_1svd.html @@ -175,8 +175,8 @@
    print *, ac(i,:)
    end do
    end program
    -
    Multiplies a diagonal matrix with another matrix or array.
    Definition: linalg.f90:459
    -
    Computes the singular value decomposition of a matrix A. The SVD is defined as: , where is an M-by-M...
    Definition: linalg.f90:2058
    +
    Multiplies a diagonal matrix with another matrix or array.
    Definition: linalg.f90:463
    +
    Computes the singular value decomposition of a matrix A. The SVD is defined as: , where is an M-by-M...
    Definition: linalg.f90:2066
    Provides a set of common linear algebra routines.
    Definition: linalg.f90:145
    The above program produces the following output.
    U =
    -0.47411577501825380 -0.81850539032073777 -0.32444284226152509
    @@ -194,7 +194,7 @@
    -1.0000000000000000 0.99999999999999967
    -

    Definition at line 2058 of file linalg.f90.

    +

    Definition at line 2066 of file linalg.f90.


    The documentation for this interface was generated from the following file: diff --git a/doc/html/interfacelinalg_1_1swap.html b/doc/html/interfacelinalg_1_1swap.html index 551b5b9f..bb64657b 100644 --- a/doc/html/interfacelinalg_1_1swap.html +++ b/doc/html/interfacelinalg_1_1swap.html @@ -122,7 +122,7 @@ -

    Definition at line 586 of file linalg.f90.

    +

    Definition at line 590 of file linalg.f90.


    The documentation for this interface was generated from the following file: diff --git a/doc/html/interfacelinalg_1_1trace.html b/doc/html/interfacelinalg_1_1trace.html index 2ecefd26..5040cc4a 100644 --- a/doc/html/interfacelinalg_1_1trace.html +++ b/doc/html/interfacelinalg_1_1trace.html @@ -118,7 +118,7 @@
    Returns
    The trace of x.
    -

    Definition at line 483 of file linalg.f90.

    +

    Definition at line 487 of file linalg.f90.


    The documentation for this interface was generated from the following file: diff --git a/doc/html/interfacelinalg_1_1tri__mtx__mult.html b/doc/html/interfacelinalg_1_1tri__mtx__mult.html index 2537ae66..e13e26e4 100644 --- a/doc/html/interfacelinalg_1_1tri__mtx__mult.html +++ b/doc/html/interfacelinalg_1_1tri__mtx__mult.html @@ -125,7 +125,7 @@ -

    Definition at line 639 of file linalg.f90.

    +

    Definition at line 643 of file linalg.f90.


    The documentation for this interface was generated from the following file: diff --git a/doc/html/linalg_8f90_source.html b/doc/html/linalg_8f90_source.html index a78b2869..f4be569e 100644 --- a/doc/html/linalg_8f90_source.html +++ b/doc/html/linalg_8f90_source.html @@ -142,1188 +142,1329 @@
    181 public :: eigen
    182 public :: sort
    -
    183 public :: la_no_operation
    -
    184 public :: la_transpose
    -
    185 public :: la_hermitian_transpose
    -
    186 public :: la_no_error
    -
    187 public :: la_invalid_input_error
    -
    188 public :: la_array_size_error
    -
    189 public :: la_singular_matrix_error
    -
    190 public :: la_matrix_format_error
    -
    191 public :: la_out_of_memory_error
    -
    192 public :: la_convergence_error
    -
    193 public :: la_invalid_operation_error
    -
    194
    -
    195! ******************************************************************************
    -
    196! CONSTANTS
    -
    197! ------------------------------------------------------------------------------
    -
    199 integer(int32), parameter :: la_no_operation = 0
    -
    201 integer(int32), parameter :: la_transpose = 1
    -
    203 integer(int32), parameter :: la_hermitian_transpose = 2
    -
    204
    -
    205! ******************************************************************************
    -
    206! ERROR FLAGS
    -
    207! ------------------------------------------------------------------------------
    -
    209 integer(int32), parameter :: la_no_error = 0
    -
    211 integer(int32), parameter :: la_invalid_input_error = 101
    -
    213 integer(int32), parameter :: la_array_size_error = 102
    -
    215 integer(int32), parameter :: la_singular_matrix_error = 103
    -
    217 integer(int32), parameter :: la_matrix_format_error = 104
    -
    219 integer(int32), parameter :: la_out_of_memory_error = 105
    -
    221 integer(int32), parameter :: la_convergence_error = 106
    -
    223 integer(int32), parameter :: la_invalid_operation_error = 107
    -
    224
    -
    225! ******************************************************************************
    -
    226! INTERFACES
    -
    227! ------------------------------------------------------------------------------
    -
    289interface mtx_mult
    -
    290 module procedure :: mtx_mult_mtx
    -
    291 module procedure :: mtx_mult_vec
    -
    292 module procedure :: cmtx_mult_mtx
    -
    293 module procedure :: cmtx_mult_vec
    -
    294end interface
    -
    295
    -
    296! ------------------------------------------------------------------------------
    - -
    325 module procedure :: rank1_update_dbl
    -
    326 module procedure :: rank1_update_cmplx
    -
    327end interface
    -
    328
    -
    329! ------------------------------------------------------------------------------
    - -
    460 module procedure :: diag_mtx_mult_mtx
    -
    461 module procedure :: diag_mtx_mult_mtx2
    -
    462 module procedure :: diag_mtx_mult_mtx3
    -
    463 module procedure :: diag_mtx_mult_mtx4
    -
    464 module procedure :: diag_mtx_mult_mtx_cmplx
    -
    465 module procedure :: diag_mtx_mult_mtx2_cmplx
    -
    466 module procedure :: diag_mtx_mult_mtx_mix
    -
    467 module procedure :: diag_mtx_mult_mtx2_mix
    -
    468end interface
    -
    469
    -
    470! ------------------------------------------------------------------------------
    -
    483interface trace
    -
    484 module procedure :: trace_dbl
    -
    485 module procedure :: trace_cmplx
    -
    486end interface
    -
    487
    -
    488! ------------------------------------------------------------------------------
    -
    531interface mtx_rank
    -
    532 module procedure :: mtx_rank_dbl
    -
    533 module procedure :: mtx_rank_cmplx
    -
    534end interface
    -
    535
    -
    536! ------------------------------------------------------------------------------
    -
    564interface det
    -
    565 module procedure :: det_dbl
    -
    566 module procedure :: det_cmplx
    -
    567end interface
    -
    568
    -
    569! ------------------------------------------------------------------------------
    -
    586interface swap
    -
    587 module procedure :: swap_dbl
    -
    588 module procedure :: swap_cmplx
    -
    589end interface
    -
    590
    -
    591! ------------------------------------------------------------------------------
    - -
    606 module procedure :: recip_mult_array_dbl
    -
    607end interface
    -
    608
    -
    609! ------------------------------------------------------------------------------
    - -
    640 module procedure :: tri_mtx_mult_dbl
    -
    641 module procedure :: tri_mtx_mult_cmplx
    -
    642end interface
    -
    643
    -
    644! ------------------------------------------------------------------------------
    -
    725interface lu_factor
    -
    726 module procedure :: lu_factor_dbl
    -
    727 module procedure :: lu_factor_cmplx
    -
    728end interface
    -
    729
    -
    847interface form_lu
    -
    848 module procedure :: form_lu_all
    -
    849 module procedure :: form_lu_all_cmplx
    -
    850 module procedure :: form_lu_only
    -
    851 module procedure :: form_lu_only_cmplx
    -
    852end interface
    -
    853
    -
    854! ------------------------------------------------------------------------------
    -
    1001interface qr_factor
    -
    1002 module procedure :: qr_factor_no_pivot
    -
    1003 module procedure :: qr_factor_no_pivot_cmplx
    -
    1004 module procedure :: qr_factor_pivot
    -
    1005 module procedure :: qr_factor_pivot_cmplx
    -
    1006end interface
    -
    1007
    -
    1008! ------------------------------------------------------------------------------
    -
    1161interface form_qr
    -
    1162 module procedure :: form_qr_no_pivot
    -
    1163 module procedure :: form_qr_no_pivot_cmplx
    -
    1164 module procedure :: form_qr_pivot
    -
    1165 module procedure :: form_qr_pivot_cmplx
    -
    1166end interface
    -
    1167
    -
    1168! ------------------------------------------------------------------------------
    -
    1314interface mult_qr
    -
    1315 module procedure :: mult_qr_mtx
    -
    1316 module procedure :: mult_qr_mtx_cmplx
    -
    1317 module procedure :: mult_qr_vec
    -
    1318 module procedure :: mult_qr_vec_cmplx
    -
    1319end interface
    -
    1320
    -
    1321! ------------------------------------------------------------------------------
    - -
    1465 module procedure :: qr_rank1_update_dbl
    -
    1466 module procedure :: qr_rank1_update_cmplx
    -
    1467end interface
    -
    1468
    -
    1469! ------------------------------------------------------------------------------
    - -
    1564 module procedure :: cholesky_factor_dbl
    -
    1565 module procedure :: cholesky_factor_cmplx
    -
    1566end interface
    -
    1567
    -
    1568! ------------------------------------------------------------------------------
    - -
    1663 module procedure :: cholesky_rank1_update_dbl
    -
    1664 module procedure :: cholesky_rank1_update_cmplx
    -
    1665end interface
    -
    1666
    -
    1667! ------------------------------------------------------------------------------
    - -
    1770 module procedure :: cholesky_rank1_downdate_dbl
    -
    1771 module procedure :: cholesky_rank1_downdate_cmplx
    -
    1772end interface
    -
    1773
    -
    1774! ------------------------------------------------------------------------------
    -
    1842interface rz_factor
    -
    1843 module procedure :: rz_factor_dbl
    -
    1844 module procedure :: rz_factor_cmplx
    -
    1845end interface
    -
    1846
    -
    1847! ------------------------------------------------------------------------------
    -
    1933interface mult_rz
    -
    1934 module procedure :: mult_rz_mtx
    -
    1935 module procedure :: mult_rz_mtx_cmplx
    -
    1936 module procedure :: mult_rz_vec
    -
    1937 module procedure :: mult_rz_vec_cmplx
    -
    1938end interface
    -
    1939
    -
    1940! ------------------------------------------------------------------------------
    -
    2058interface svd
    -
    2059 module procedure :: svd_dbl
    -
    2060 module procedure :: svd_cmplx
    -
    2061end interface
    -
    2062
    -
    2063! ------------------------------------------------------------------------------
    - -
    2193 module procedure :: solve_tri_mtx
    -
    2194 module procedure :: solve_tri_mtx_cmplx
    -
    2195 module procedure :: solve_tri_vec
    -
    2196 module procedure :: solve_tri_vec_cmplx
    -
    2197end interface
    -
    2198
    -
    2199! ------------------------------------------------------------------------------
    -
    2280interface solve_lu
    -
    2281 module procedure :: solve_lu_mtx
    -
    2282 module procedure :: solve_lu_mtx_cmplx
    -
    2283 module procedure :: solve_lu_vec
    -
    2284 module procedure :: solve_lu_vec_cmplx
    -
    2285end interface
    -
    2286
    -
    2287! ------------------------------------------------------------------------------
    -
    2415interface solve_qr
    -
    2416 module procedure :: solve_qr_no_pivot_mtx
    -
    2417 module procedure :: solve_qr_no_pivot_mtx_cmplx
    -
    2418 module procedure :: solve_qr_no_pivot_vec
    -
    2419 module procedure :: solve_qr_no_pivot_vec_cmplx
    -
    2420 module procedure :: solve_qr_pivot_mtx
    -
    2421 module procedure :: solve_qr_pivot_mtx_cmplx
    -
    2422 module procedure :: solve_qr_pivot_vec
    -
    2423 module procedure :: solve_qr_pivot_vec_cmplx
    -
    2424end interface
    -
    2425
    -
    2426! ------------------------------------------------------------------------------
    - -
    2522 module procedure :: solve_cholesky_mtx
    -
    2523 module procedure :: solve_cholesky_mtx_cmplx
    -
    2524 module procedure :: solve_cholesky_vec
    -
    2525 module procedure :: solve_cholesky_vec_cmplx
    -
    2526end interface
    -
    2527
    -
    2528! ------------------------------------------------------------------------------
    - -
    2612 module procedure :: solve_least_squares_mtx
    -
    2613 module procedure :: solve_least_squares_mtx_cmplx
    -
    2614 module procedure :: solve_least_squares_vec
    -
    2615 module procedure :: solve_least_squares_vec_cmplx
    -
    2616end interface
    -
    2617
    -
    2618! ------------------------------------------------------------------------------
    - -
    2713 module procedure :: solve_least_squares_mtx_pvt
    -
    2714 module procedure :: solve_least_squares_mtx_pvt_cmplx
    -
    2715 module procedure :: solve_least_squares_vec_pvt
    -
    2716 module procedure :: solve_least_squares_vec_pvt_cmplx
    -
    2717end interface
    -
    2718
    -
    2719! ------------------------------------------------------------------------------
    - -
    2815 module procedure :: solve_least_squares_mtx_svd
    -
    2816 module procedure :: solve_least_squares_vec_svd
    -
    2817end interface
    -
    2818
    -
    2819! ------------------------------------------------------------------------------
    - -
    2910 module procedure :: mtx_inverse_dbl
    -
    2911 module procedure :: mtx_inverse_cmplx
    -
    2912end interface
    -
    2913
    -
    2914! ------------------------------------------------------------------------------
    - -
    3016 module procedure :: mtx_pinverse_dbl
    -
    3017 module procedure :: mtx_pinverse_cmplx
    -
    3018end interface
    -
    3019
    -
    3020! ------------------------------------------------------------------------------
    -
    3229interface eigen
    -
    3230 module procedure :: eigen_symm
    -
    3231 module procedure :: eigen_asymm
    -
    3232 module procedure :: eigen_gen
    -
    3233 module procedure :: eigen_cmplx
    -
    3234end interface
    -
    3235
    -
    3236! ------------------------------------------------------------------------------
    -
    3312interface sort
    -
    3313 module procedure :: sort_dbl_array
    -
    3314 module procedure :: sort_dbl_array_ind
    -
    3315 module procedure :: sort_cmplx_array
    -
    3316 module procedure :: sort_cmplx_array_ind
    -
    3317 module procedure :: sort_eigen_cmplx
    -
    3318 module procedure :: sort_eigen_dbl
    -
    3319end interface
    -
    3320
    -
    3321! ******************************************************************************
    -
    3322! LINALG_BASIC.F90
    -
    3323! ------------------------------------------------------------------------------
    -
    3324interface
    -
    3325 module subroutine mtx_mult_mtx(transa, transb, alpha, a, b, beta, c, err)
    -
    3326 logical, intent(in) :: transa, transb
    -
    3327 real(real64), intent(in) :: alpha, beta
    -
    3328 real(real64), intent(in), dimension(:,:) :: a, b
    -
    3329 real(real64), intent(inout), dimension(:,:) :: c
    -
    3330 class(errors), intent(inout), optional, target :: err
    -
    3331 end subroutine
    -
    3332
    -
    3333 module subroutine mtx_mult_vec(trans, alpha, a, b, beta, c, err)
    -
    3334 logical, intent(in) :: trans
    -
    3335 real(real64), intent(in) :: alpha, beta
    -
    3336 real(real64), intent(in), dimension(:,:) :: a
    -
    3337 real(real64), intent(in), dimension(:) :: b
    -
    3338 real(real64), intent(inout), dimension(:) :: c
    -
    3339 class(errors), intent(inout), optional, target :: err
    -
    3340 end subroutine
    -
    3341
    -
    3342 module subroutine cmtx_mult_mtx(opa, opb, alpha, a, b, beta, c, err)
    -
    3343 integer(int32), intent(in) :: opa, opb
    -
    3344 complex(real64), intent(in) :: alpha, beta
    -
    3345 complex(real64), intent(in), dimension(:,:) :: a, b
    -
    3346 complex(real64), intent(inout), dimension(:,:) :: c
    -
    3347 class(errors), intent(inout), optional, target :: err
    -
    3348 end subroutine
    -
    3349
    -
    3350 module subroutine cmtx_mult_vec(opa, alpha, a, b, beta, c, err)
    -
    3351 integer(int32), intent(in) :: opa
    -
    3352 complex(real64), intent(in) :: alpha, beta
    -
    3353 complex(real64), intent(in), dimension(:,:) :: a
    -
    3354 complex(real64), intent(in), dimension(:) :: b
    -
    3355 complex(real64), intent(inout), dimension(:) :: c
    -
    3356 class(errors), intent(inout), optional, target :: err
    -
    3357 end subroutine
    -
    3358
    -
    3359 module subroutine rank1_update_dbl(alpha, x, y, a, err)
    -
    3360 real(real64), intent(in) :: alpha
    -
    3361 real(real64), intent(in), dimension(:) :: x, y
    -
    3362 real(real64), intent(inout), dimension(:,:) :: a
    -
    3363 class(errors), intent(inout), optional, target :: err
    -
    3364 end subroutine
    -
    3365
    -
    3366 module subroutine rank1_update_cmplx(alpha, x, y, a, err)
    -
    3367 complex(real64), intent(in) :: alpha
    -
    3368 complex(real64), intent(in), dimension(:) :: x, y
    -
    3369 complex(real64), intent(inout), dimension(:,:) :: a
    -
    3370 class(errors), intent(inout), optional, target :: err
    -
    3371 end subroutine
    -
    3372
    -
    3373 module subroutine diag_mtx_mult_mtx(lside, trans, alpha, a, b, beta, c, err)
    -
    3374 logical, intent(in) :: lside, trans
    -
    3375 real(real64) :: alpha, beta
    -
    3376 real(real64), intent(in), dimension(:) :: a
    -
    3377 real(real64), intent(in), dimension(:,:) :: b
    -
    3378 real(real64), intent(inout), dimension(:,:) :: c
    -
    3379 class(errors), intent(inout), optional, target :: err
    -
    3380 end subroutine
    -
    3381
    -
    3382 module subroutine diag_mtx_mult_mtx2(lside, alpha, a, b, err)
    -
    3383 logical, intent(in) :: lside
    -
    3384 real(real64), intent(in) :: alpha
    -
    3385 real(real64), intent(in), dimension(:) :: a
    -
    3386 real(real64), intent(inout), dimension(:,:) :: b
    -
    3387 class(errors), intent(inout), optional, target :: err
    -
    3388 end subroutine
    -
    3389
    -
    3390 module subroutine diag_mtx_mult_mtx3(lside, trans, alpha, a, b, beta, c, err)
    -
    3391 logical, intent(in) :: lside, trans
    -
    3392 real(real64) :: alpha, beta
    -
    3393 complex(real64), intent(in), dimension(:) :: a
    -
    3394 real(real64), intent(in), dimension(:,:) :: b
    -
    3395 complex(real64), intent(inout), dimension(:,:) :: c
    -
    3396 class(errors), intent(inout), optional, target :: err
    -
    3397 end subroutine
    -
    3398
    -
    3399 module subroutine diag_mtx_mult_mtx4(lside, opb, alpha, a, b, beta, c, err)
    -
    3400 logical, intent(in) :: lside
    -
    3401 integer(int32), intent(in) :: opb
    -
    3402 real(real64) :: alpha, beta
    -
    3403 complex(real64), intent(in), dimension(:) :: a
    -
    3404 complex(real64), intent(in), dimension(:,:) :: b
    -
    3405 complex(real64), intent(inout), dimension(:,:) :: c
    -
    3406 class(errors), intent(inout), optional, target :: err
    -
    3407 end subroutine
    -
    3408
    -
    3409 module subroutine diag_mtx_mult_mtx_cmplx(lside, opb, alpha, a, b, beta, c, err)
    -
    3410 logical, intent(in) :: lside
    -
    3411 integer(int32), intent(in) :: opb
    -
    3412 complex(real64) :: alpha, beta
    -
    3413 complex(real64), intent(in), dimension(:) :: a
    -
    3414 complex(real64), intent(in), dimension(:,:) :: b
    -
    3415 complex(real64), intent(inout), dimension(:,:) :: c
    -
    3416 class(errors), intent(inout), optional, target :: err
    -
    3417 end subroutine
    -
    3418
    -
    3419 module subroutine diag_mtx_mult_mtx2_cmplx(lside, alpha, a, b, err)
    -
    3420 logical, intent(in) :: lside
    -
    3421 complex(real64), intent(in) :: alpha
    -
    3422 complex(real64), intent(in), dimension(:) :: a
    -
    3423 complex(real64), intent(inout), dimension(:,:) :: b
    -
    3424 class(errors), intent(inout), optional, target :: err
    -
    3425 end subroutine
    -
    3426
    -
    3427 module subroutine diag_mtx_mult_mtx_mix(lside, opb, alpha, a, b, beta, c, err)
    -
    3428 logical, intent(in) :: lside
    -
    3429 integer(int32), intent(in) :: opb
    -
    3430 complex(real64) :: alpha, beta
    -
    3431 real(real64), intent(in), dimension(:) :: a
    -
    3432 complex(real64), intent(in), dimension(:,:) :: b
    -
    3433 complex(real64), intent(inout), dimension(:,:) :: c
    -
    3434 class(errors), intent(inout), optional, target :: err
    -
    3435 end subroutine
    -
    3436
    -
    3437 module subroutine diag_mtx_mult_mtx2_mix(lside, alpha, a, b, err)
    -
    3438 logical, intent(in) :: lside
    -
    3439 complex(real64), intent(in) :: alpha
    -
    3440 real(real64), intent(in), dimension(:) :: a
    -
    3441 complex(real64), intent(inout), dimension(:,:) :: b
    -
    3442 class(errors), intent(inout), optional, target :: err
    -
    3443 end subroutine
    -
    3444
    -
    3445 pure module function trace_dbl(x) result(y)
    -
    3446 real(real64), intent(in), dimension(:,:) :: x
    -
    3447 real(real64) :: y
    -
    3448 end function
    -
    3449
    -
    3450 pure module function trace_cmplx(x) result(y)
    -
    3451 complex(real64), intent(in), dimension(:,:) :: x
    -
    3452 complex(real64) :: y
    -
    3453 end function
    -
    3454
    -
    3455 module function mtx_rank_dbl(a, tol, work, olwork, err) result(rnk)
    -
    3456 real(real64), intent(inout), dimension(:,:) :: a
    -
    3457 real(real64), intent(in), optional :: tol
    -
    3458 real(real64), intent(out), target, optional, dimension(:) :: work
    -
    3459 integer(int32), intent(out), optional :: olwork
    -
    3460 class(errors), intent(inout), optional, target :: err
    -
    3461 integer(int32) :: rnk
    -
    3462 end function
    -
    3463
    -
    3464 module function mtx_rank_cmplx(a, tol, work, olwork, rwork, err) result(rnk)
    -
    3465 complex(real64), intent(inout), dimension(:,:) :: a
    -
    3466 real(real64), intent(in), optional :: tol
    -
    3467 complex(real64), intent(out), target, optional, dimension(:) :: work
    -
    3468 integer(int32), intent(out), optional :: olwork
    -
    3469 real(real64), intent(out), target, optional, dimension(:) :: rwork
    -
    3470 class(errors), intent(inout), optional, target :: err
    -
    3471 integer(int32) :: rnk
    -
    3472 end function
    -
    3473
    -
    3474 module function det_dbl(a, iwork, err) result(x)
    -
    3475 real(real64), intent(inout), dimension(:,:) :: a
    -
    3476 integer(int32), intent(out), target, optional, dimension(:) :: iwork
    -
    3477 class(errors), intent(inout), optional, target :: err
    -
    3478 real(real64) :: x
    -
    3479 end function
    -
    3480
    -
    3481 module function det_cmplx(a, iwork, err) result(x)
    -
    3482 complex(real64), intent(inout), dimension(:,:) :: a
    -
    3483 integer(int32), intent(out), target, optional, dimension(:) :: iwork
    -
    3484 class(errors), intent(inout), optional, target :: err
    -
    3485 complex(real64) :: x
    -
    3486 end function
    -
    3487
    -
    3488 module subroutine swap_dbl(x, y, err)
    -
    3489 real(real64), intent(inout), dimension(:) :: x, y
    -
    3490 class(errors), intent(inout), optional, target :: err
    -
    3491 end subroutine
    -
    3492
    -
    3493 module subroutine swap_cmplx(x, y, err)
    -
    3494 complex(real64), intent(inout), dimension(:) :: x, y
    -
    3495 class(errors), intent(inout), optional, target :: err
    -
    3496 end subroutine
    -
    3497
    -
    3498 module subroutine recip_mult_array_dbl(a, x)
    -
    3499 real(real64), intent(in) :: a
    -
    3500 real(real64), intent(inout), dimension(:) :: x
    -
    3501 end subroutine
    -
    3502
    -
    3503 module subroutine tri_mtx_mult_dbl(upper, alpha, a, beta, b, err)
    -
    3504 logical, intent(in) :: upper
    -
    3505 real(real64), intent(in) :: alpha, beta
    -
    3506 real(real64), intent(in), dimension(:,:) :: a
    -
    3507 real(real64), intent(inout), dimension(:,:) :: b
    -
    3508 class(errors), intent(inout), optional, target :: err
    -
    3509 end subroutine
    -
    3510
    -
    3511 module subroutine tri_mtx_mult_cmplx(upper, alpha, a, beta, b, err)
    -
    3512 logical, intent(in) :: upper
    -
    3513 complex(real64), intent(in) :: alpha, beta
    -
    3514 complex(real64), intent(in), dimension(:,:) :: a
    -
    3515 complex(real64), intent(inout), dimension(:,:) :: b
    -
    3516 class(errors), intent(inout), optional, target :: err
    -
    3517 end subroutine
    -
    3518
    -
    3519end interface
    -
    3520
    -
    3521! ******************************************************************************
    -
    3522! LINALG_FACTOR.F90
    -
    3523! ------------------------------------------------------------------------------
    -
    3524interface
    -
    3525 module subroutine lu_factor_dbl(a, ipvt, err)
    -
    3526 real(real64), intent(inout), dimension(:,:) :: a
    -
    3527 integer(int32), intent(out), dimension(:) :: ipvt
    -
    3528 class(errors), intent(inout), optional, target :: err
    -
    3529 end subroutine
    -
    3530
    -
    3531 module subroutine lu_factor_cmplx(a, ipvt, err)
    -
    3532 complex(real64), intent(inout), dimension(:,:) :: a
    -
    3533 integer(int32), intent(out), dimension(:) :: ipvt
    -
    3534 class(errors), intent(inout), optional, target :: err
    -
    3535 end subroutine
    -
    3536
    -
    3537 module subroutine form_lu_all(lu, ipvt, u, p, err)
    -
    3538 real(real64), intent(inout), dimension(:,:) :: lu
    -
    3539 integer(int32), intent(in), dimension(:) :: ipvt
    -
    3540 real(real64), intent(out), dimension(:,:) :: u, p
    -
    3541 class(errors), intent(inout), optional, target :: err
    -
    3542 end subroutine
    -
    3543
    -
    3544 module subroutine form_lu_all_cmplx(lu, ipvt, u, p, err)
    -
    3545 complex(real64), intent(inout), dimension(:,:) :: lu
    -
    3546 integer(int32), intent(in), dimension(:) :: ipvt
    -
    3547 complex(real64), intent(out), dimension(:,:) :: u
    -
    3548 real(real64), intent(out), dimension(:,:) :: p
    -
    3549 class(errors), intent(inout), optional, target :: err
    -
    3550 end subroutine
    -
    3551
    -
    3552 module subroutine form_lu_only(lu, u, err)
    -
    3553 real(real64), intent(inout), dimension(:,:) :: lu
    -
    3554 real(real64), intent(out), dimension(:,:) :: u
    -
    3555 class(errors), intent(inout), optional, target :: err
    -
    3556 end subroutine
    -
    3557
    -
    3558 module subroutine form_lu_only_cmplx(lu, u, err)
    -
    3559 complex(real64), intent(inout), dimension(:,:) :: lu
    -
    3560 complex(real64), intent(out), dimension(:,:) :: u
    -
    3561 class(errors), intent(inout), optional, target :: err
    -
    3562 end subroutine
    -
    3563
    -
    3564 module subroutine qr_factor_no_pivot(a, tau, work, olwork, err)
    -
    3565 real(real64), intent(inout), dimension(:,:) :: a
    -
    3566 real(real64), intent(out), dimension(:) :: tau
    -
    3567 real(real64), intent(out), target, dimension(:), optional :: work
    -
    3568 integer(int32), intent(out), optional :: olwork
    -
    3569 class(errors), intent(inout), optional, target :: err
    -
    3570 end subroutine
    -
    3571
    -
    3572 module subroutine qr_factor_no_pivot_cmplx(a, tau, work, olwork, err)
    -
    3573 complex(real64), intent(inout), dimension(:,:) :: a
    -
    3574 complex(real64), intent(out), dimension(:) :: tau
    -
    3575 complex(real64), intent(out), target, dimension(:), optional :: work
    -
    3576 integer(int32), intent(out), optional :: olwork
    -
    3577 class(errors), intent(inout), optional, target :: err
    -
    3578 end subroutine
    -
    3579
    -
    3580 module subroutine qr_factor_pivot(a, tau, jpvt, work, olwork, err)
    -
    3581 real(real64), intent(inout), dimension(:,:) :: a
    -
    3582 real(real64), intent(out), dimension(:) :: tau
    -
    3583 integer(int32), intent(inout), dimension(:) :: jpvt
    -
    3584 real(real64), intent(out), target, dimension(:), optional :: work
    -
    3585 integer(int32), intent(out), optional :: olwork
    -
    3586 class(errors), intent(inout), optional, target :: err
    -
    3587 end subroutine
    -
    3588
    -
    3589 module subroutine qr_factor_pivot_cmplx(a, tau, jpvt, work, olwork, rwork, &
    -
    3590 err)
    -
    3591 complex(real64), intent(inout), dimension(:,:) :: a
    -
    3592 complex(real64), intent(out), dimension(:) :: tau
    -
    3593 integer(int32), intent(inout), dimension(:) :: jpvt
    -
    3594 complex(real64), intent(out), target, dimension(:), optional :: work
    -
    3595 integer(int32), intent(out), optional :: olwork
    -
    3596 real(real64), intent(out), target, dimension(:), optional :: rwork
    -
    3597 class(errors), intent(inout), optional, target :: err
    -
    3598 end subroutine
    -
    3599
    -
    3600 module subroutine form_qr_no_pivot(r, tau, q, work, olwork, err)
    -
    3601 real(real64), intent(inout), dimension(:,:) :: r
    -
    3602 real(real64), intent(in), dimension(:) :: tau
    -
    3603 real(real64), intent(out), dimension(:,:) :: q
    -
    3604 real(real64), intent(out), target, dimension(:), optional :: work
    -
    3605 integer(int32), intent(out), optional :: olwork
    -
    3606 class(errors), intent(inout), optional, target :: err
    -
    3607 end subroutine
    -
    3608
    -
    3609 module subroutine form_qr_no_pivot_cmplx(r, tau, q, work, olwork, err)
    -
    3610 complex(real64), intent(inout), dimension(:,:) :: r
    -
    3611 complex(real64), intent(in), dimension(:) :: tau
    -
    3612 complex(real64), intent(out), dimension(:,:) :: q
    -
    3613 complex(real64), intent(out), target, dimension(:), optional :: work
    -
    3614 integer(int32), intent(out), optional :: olwork
    -
    3615 class(errors), intent(inout), optional, target :: err
    -
    3616 end subroutine
    -
    3617
    -
    3618 module subroutine form_qr_pivot(r, tau, pvt, q, p, work, olwork, err)
    -
    3619 real(real64), intent(inout), dimension(:,:) :: r
    -
    3620 real(real64), intent(in), dimension(:) :: tau
    -
    3621 integer(int32), intent(in), dimension(:) :: pvt
    -
    3622 real(real64), intent(out), dimension(:,:) :: q, p
    -
    3623 real(real64), intent(out), target, dimension(:), optional :: work
    -
    3624 integer(int32), intent(out), optional :: olwork
    -
    3625 class(errors), intent(inout), optional, target :: err
    -
    3626 end subroutine
    -
    3627
    -
    3628 module subroutine form_qr_pivot_cmplx(r, tau, pvt, q, p, work, olwork, err)
    -
    3629 complex(real64), intent(inout), dimension(:,:) :: r
    -
    3630 complex(real64), intent(in), dimension(:) :: tau
    -
    3631 integer(int32), intent(in), dimension(:) :: pvt
    -
    3632 complex(real64), intent(out), dimension(:,:) :: q, p
    -
    3633 complex(real64), intent(out), target, dimension(:), optional :: work
    -
    3634 integer(int32), intent(out), optional :: olwork
    -
    3635 class(errors), intent(inout), optional, target :: err
    -
    3636 end subroutine
    -
    3637
    -
    3638 module subroutine mult_qr_mtx(lside, trans, a, tau, c, work, olwork, err)
    -
    3639 logical, intent(in) :: lside, trans
    -
    3640 real(real64), intent(in), dimension(:) :: tau
    -
    3641 real(real64), intent(inout), dimension(:,:) :: a, c
    -
    3642 real(real64), intent(out), target, dimension(:), optional :: work
    -
    3643 integer(int32), intent(out), optional :: olwork
    -
    3644 class(errors), intent(inout), optional, target :: err
    -
    3645 end subroutine
    -
    3646
    -
    3647 module subroutine mult_qr_mtx_cmplx(lside, trans, a, tau, c, work, olwork, err)
    -
    3648 logical, intent(in) :: lside, trans
    -
    3649 complex(real64), intent(in), dimension(:) :: tau
    -
    3650 complex(real64), intent(inout), dimension(:,:) :: a, c
    -
    3651 complex(real64), intent(out), target, dimension(:), optional :: work
    -
    3652 integer(int32), intent(out), optional :: olwork
    -
    3653 class(errors), intent(inout), optional, target :: err
    -
    3654 end subroutine
    -
    3655
    -
    3656 module subroutine mult_qr_vec(trans, a, tau, c, work, olwork, err)
    -
    3657 logical, intent(in) :: trans
    -
    3658 real(real64), intent(inout), dimension(:,:) :: a
    -
    3659 real(real64), intent(in), dimension(:) :: tau
    -
    3660 real(real64), intent(inout), dimension(:) :: c
    -
    3661 real(real64), intent(out), target, dimension(:), optional :: work
    -
    3662 integer(int32), intent(out), optional :: olwork
    -
    3663 class(errors), intent(inout), optional, target :: err
    -
    3664 end subroutine
    -
    3665
    -
    3666 module subroutine mult_qr_vec_cmplx(trans, a, tau, c, work, olwork, err)
    -
    3667 logical, intent(in) :: trans
    -
    3668 complex(real64), intent(inout), dimension(:,:) :: a
    -
    3669 complex(real64), intent(in), dimension(:) :: tau
    -
    3670 complex(real64), intent(inout), dimension(:) :: c
    -
    3671 complex(real64), intent(out), target, dimension(:), optional :: work
    -
    3672 integer(int32), intent(out), optional :: olwork
    -
    3673 class(errors), intent(inout), optional, target :: err
    -
    3674 end subroutine
    -
    3675
    -
    3676 module subroutine qr_rank1_update_dbl(q, r, u, v, work, err)
    -
    3677 real(real64), intent(inout), dimension(:,:) :: q, r
    -
    3678 real(real64), intent(inout), dimension(:) :: u, v
    -
    3679 real(real64), intent(out), target, optional, dimension(:) :: work
    -
    3680 class(errors), intent(inout), optional, target :: err
    -
    3681 end subroutine
    -
    3682
    -
    3683 module subroutine qr_rank1_update_cmplx(q, r, u, v, work, rwork, err)
    -
    3684 complex(real64), intent(inout), dimension(:,:) :: q, r
    -
    3685 complex(real64), intent(inout), dimension(:) :: u, v
    -
    3686 complex(real64), intent(out), target, optional, dimension(:) :: work
    -
    3687 real(real64), intent(out), target, optional, dimension(:) :: rwork
    -
    3688 class(errors), intent(inout), optional, target :: err
    -
    3689 end subroutine
    -
    3690
    -
    3691 module subroutine cholesky_factor_dbl(a, upper, err)
    -
    3692 real(real64), intent(inout), dimension(:,:) :: a
    -
    3693 logical, intent(in), optional :: upper
    -
    3694 class(errors), intent(inout), optional, target :: err
    -
    3695 end subroutine
    -
    3696
    -
    3697 module subroutine cholesky_factor_cmplx(a, upper, err)
    -
    3698 complex(real64), intent(inout), dimension(:,:) :: a
    -
    3699 logical, intent(in), optional :: upper
    -
    3700 class(errors), intent(inout), optional, target :: err
    -
    3701 end subroutine
    -
    3702
    -
    3703 module subroutine cholesky_rank1_update_dbl(r, u, work, err)
    -
    3704 real(real64), intent(inout), dimension(:,:) :: r
    -
    3705 real(real64), intent(inout), dimension(:) :: u
    -
    3706 real(real64), intent(out), target, optional, dimension(:) :: work
    -
    3707 class(errors), intent(inout), optional, target :: err
    -
    3708 end subroutine
    -
    3709
    -
    3710 module subroutine cholesky_rank1_update_cmplx(r, u, work, err)
    -
    3711 complex(real64), intent(inout), dimension(:,:) :: r
    -
    3712 complex(real64), intent(inout), dimension(:) :: u
    -
    3713 real(real64), intent(out), target, optional, dimension(:) :: work
    -
    3714 class(errors), intent(inout), optional, target :: err
    -
    3715 end subroutine
    -
    3716
    -
    3717 module subroutine cholesky_rank1_downdate_dbl(r, u, work, err)
    -
    3718 real(real64), intent(inout), dimension(:,:) :: r
    -
    3719 real(real64), intent(inout), dimension(:) :: u
    -
    3720 real(real64), intent(out), target, optional, dimension(:) :: work
    -
    3721 class(errors), intent(inout), optional, target :: err
    -
    3722 end subroutine
    -
    3723
    -
    3724 module subroutine cholesky_rank1_downdate_cmplx(r, u, work, err)
    -
    3725 complex(real64), intent(inout), dimension(:,:) :: r
    -
    3726 complex(real64), intent(inout), dimension(:) :: u
    -
    3727 real(real64), intent(out), target, optional, dimension(:) :: work
    -
    3728 class(errors), intent(inout), optional, target :: err
    -
    3729 end subroutine
    -
    3730
    -
    3731 module subroutine rz_factor_dbl(a, tau, work, olwork, err)
    -
    3732 real(real64), intent(inout), dimension(:,:) :: a
    -
    3733 real(real64), intent(out), dimension(:) :: tau
    -
    3734 real(real64), intent(out), target, optional, dimension(:) :: work
    -
    3735 integer(int32), intent(out), optional :: olwork
    -
    3736 class(errors), intent(inout), optional, target :: err
    -
    3737 end subroutine
    -
    3738
    -
    3739 module subroutine rz_factor_cmplx(a, tau, work, olwork, err)
    -
    3740 complex(real64), intent(inout), dimension(:,:) :: a
    -
    3741 complex(real64), intent(out), dimension(:) :: tau
    -
    3742 complex(real64), intent(out), target, optional, dimension(:) :: work
    -
    3743 integer(int32), intent(out), optional :: olwork
    -
    3744 class(errors), intent(inout), optional, target :: err
    -
    3745 end subroutine
    -
    3746
    -
    3747 module subroutine mult_rz_mtx(lside, trans, l, a, tau, c, work, olwork, err)
    -
    3748 logical, intent(in) :: lside, trans
    -
    3749 integer(int32), intent(in) :: l
    -
    3750 real(real64), intent(inout), dimension(:,:) :: a, c
    -
    3751 real(real64), intent(in), dimension(:) :: tau
    -
    3752 real(real64), intent(out), target, optional, dimension(:) :: work
    -
    3753 integer(int32), intent(out), optional :: olwork
    -
    3754 class(errors), intent(inout), optional, target :: err
    -
    3755 end subroutine
    -
    3756
    -
    3757 module subroutine mult_rz_mtx_cmplx(lside, trans, l, a, tau, c, work, olwork, err)
    -
    3758 logical, intent(in) :: lside, trans
    -
    3759 integer(int32), intent(in) :: l
    -
    3760 complex(real64), intent(inout), dimension(:,:) :: a, c
    -
    3761 complex(real64), intent(in), dimension(:) :: tau
    -
    3762 complex(real64), intent(out), target, optional, dimension(:) :: work
    -
    3763 integer(int32), intent(out), optional :: olwork
    -
    3764 class(errors), intent(inout), optional, target :: err
    -
    3765 end subroutine
    -
    3766
    -
    3767 module subroutine mult_rz_vec(trans, l, a, tau, c, work, olwork, err)
    -
    3768 logical, intent(in) :: trans
    -
    3769 integer(int32), intent(in) :: l
    -
    3770 real(real64), intent(inout), dimension(:,:) :: a
    -
    3771 real(real64), intent(in), dimension(:) :: tau
    -
    3772 real(real64), intent(inout), dimension(:) :: c
    -
    3773 real(real64), intent(out), target, optional, dimension(:) :: work
    -
    3774 integer(int32), intent(out), optional :: olwork
    -
    3775 class(errors), intent(inout), optional, target :: err
    -
    3776 end subroutine
    -
    3777
    -
    3778 module subroutine mult_rz_vec_cmplx(trans, l, a, tau, c, work, olwork, err)
    -
    3779 logical, intent(in) :: trans
    -
    3780 integer(int32), intent(in) :: l
    -
    3781 complex(real64), intent(inout), dimension(:,:) :: a
    -
    3782 complex(real64), intent(in), dimension(:) :: tau
    -
    3783 complex(real64), intent(inout), dimension(:) :: c
    -
    3784 complex(real64), intent(out), target, optional, dimension(:) :: work
    -
    3785 integer(int32), intent(out), optional :: olwork
    -
    3786 class(errors), intent(inout), optional, target :: err
    -
    3787 end subroutine
    -
    3788
    -
    3789 module subroutine svd_dbl(a, s, u, vt, work, olwork, err)
    -
    3790 real(real64), intent(inout), dimension(:,:) :: a
    -
    3791 real(real64), intent(out), dimension(:) :: s
    -
    3792 real(real64), intent(out), optional, dimension(:,:) :: u, vt
    -
    3793 real(real64), intent(out), target, optional, dimension(:) :: work
    -
    3794 integer(int32), intent(out), optional :: olwork
    -
    3795 class(errors), intent(inout), optional, target :: err
    -
    3796 end subroutine
    -
    3797
    -
    3798 module subroutine svd_cmplx(a, s, u, vt, work, olwork, rwork, err)
    -
    3799 complex(real64), intent(inout), dimension(:,:) :: a
    -
    3800 real(real64), intent(out), dimension(:) :: s
    -
    3801 complex(real64), intent(out), optional, dimension(:,:) :: u, vt
    -
    3802 complex(real64), intent(out), target, optional, dimension(:) :: work
    -
    3803 integer(int32), intent(out), optional :: olwork
    -
    3804 real(real64), intent(out), target, optional, dimension(:) :: rwork
    -
    3805 class(errors), intent(inout), optional, target :: err
    -
    3806 end subroutine
    -
    3807end interface
    -
    3808
    -
    3809! ******************************************************************************
    -
    3810! LINALG_SOLVE.F90
    -
    3811! ------------------------------------------------------------------------------
    -
    3812interface
    -
    3813 module subroutine solve_tri_mtx(lside, upper, trans, nounit, alpha, a, b, err)
    -
    3814 logical, intent(in) :: lside, upper, trans, nounit
    -
    3815 real(real64), intent(in) :: alpha
    +
    183 public :: lq_factor
    +
    184 public :: form_lq
    +
    185 public :: mult_lq
    +
    186 public :: solve_lq
    +
    187 public :: la_no_operation
    +
    188 public :: la_transpose
    +
    189 public :: la_hermitian_transpose
    +
    190 public :: la_no_error
    +
    191 public :: la_invalid_input_error
    +
    192 public :: la_array_size_error
    +
    193 public :: la_singular_matrix_error
    +
    194 public :: la_matrix_format_error
    +
    195 public :: la_out_of_memory_error
    +
    196 public :: la_convergence_error
    +
    197 public :: la_invalid_operation_error
    +
    198
    +
    199! ******************************************************************************
    +
    200! CONSTANTS
    +
    201! ------------------------------------------------------------------------------
    +
    203 integer(int32), parameter :: la_no_operation = 0
    +
    205 integer(int32), parameter :: la_transpose = 1
    +
    207 integer(int32), parameter :: la_hermitian_transpose = 2
    +
    208
    +
    209! ******************************************************************************
    +
    210! ERROR FLAGS
    +
    211! ------------------------------------------------------------------------------
    +
    213 integer(int32), parameter :: la_no_error = 0
    +
    215 integer(int32), parameter :: la_invalid_input_error = 101
    +
    217 integer(int32), parameter :: la_array_size_error = 102
    +
    219 integer(int32), parameter :: la_singular_matrix_error = 103
    +
    221 integer(int32), parameter :: la_matrix_format_error = 104
    +
    223 integer(int32), parameter :: la_out_of_memory_error = 105
    +
    225 integer(int32), parameter :: la_convergence_error = 106
    +
    227 integer(int32), parameter :: la_invalid_operation_error = 107
    +
    228
    +
    229! ******************************************************************************
    +
    230! INTERFACES
    +
    231! ------------------------------------------------------------------------------
    +
    293interface mtx_mult
    +
    294 module procedure :: mtx_mult_mtx
    +
    295 module procedure :: mtx_mult_vec
    +
    296 module procedure :: cmtx_mult_mtx
    +
    297 module procedure :: cmtx_mult_vec
    +
    298end interface
    +
    299
    +
    300! ------------------------------------------------------------------------------
    + +
    329 module procedure :: rank1_update_dbl
    +
    330 module procedure :: rank1_update_cmplx
    +
    331end interface
    +
    332
    +
    333! ------------------------------------------------------------------------------
    + +
    464 module procedure :: diag_mtx_mult_mtx
    +
    465 module procedure :: diag_mtx_mult_mtx2
    +
    466 module procedure :: diag_mtx_mult_mtx3
    +
    467 module procedure :: diag_mtx_mult_mtx4
    +
    468 module procedure :: diag_mtx_mult_mtx_cmplx
    +
    469 module procedure :: diag_mtx_mult_mtx2_cmplx
    +
    470 module procedure :: diag_mtx_mult_mtx_mix
    +
    471 module procedure :: diag_mtx_mult_mtx2_mix
    +
    472end interface
    +
    473
    +
    474! ------------------------------------------------------------------------------
    +
    487interface trace
    +
    488 module procedure :: trace_dbl
    +
    489 module procedure :: trace_cmplx
    +
    490end interface
    +
    491
    +
    492! ------------------------------------------------------------------------------
    +
    535interface mtx_rank
    +
    536 module procedure :: mtx_rank_dbl
    +
    537 module procedure :: mtx_rank_cmplx
    +
    538end interface
    +
    539
    +
    540! ------------------------------------------------------------------------------
    +
    568interface det
    +
    569 module procedure :: det_dbl
    +
    570 module procedure :: det_cmplx
    +
    571end interface
    +
    572
    +
    573! ------------------------------------------------------------------------------
    +
    590interface swap
    +
    591 module procedure :: swap_dbl
    +
    592 module procedure :: swap_cmplx
    +
    593end interface
    +
    594
    +
    595! ------------------------------------------------------------------------------
    + +
    610 module procedure :: recip_mult_array_dbl
    +
    611end interface
    +
    612
    +
    613! ------------------------------------------------------------------------------
    + +
    644 module procedure :: tri_mtx_mult_dbl
    +
    645 module procedure :: tri_mtx_mult_cmplx
    +
    646end interface
    +
    647
    +
    648! ------------------------------------------------------------------------------
    +
    729interface lu_factor
    +
    730 module procedure :: lu_factor_dbl
    +
    731 module procedure :: lu_factor_cmplx
    +
    732end interface
    +
    733
    +
    851interface form_lu
    +
    852 module procedure :: form_lu_all
    +
    853 module procedure :: form_lu_all_cmplx
    +
    854 module procedure :: form_lu_only
    +
    855 module procedure :: form_lu_only_cmplx
    +
    856end interface
    +
    857
    +
    858! ------------------------------------------------------------------------------
    +
    1005interface qr_factor
    +
    1006 module procedure :: qr_factor_no_pivot
    +
    1007 module procedure :: qr_factor_no_pivot_cmplx
    +
    1008 module procedure :: qr_factor_pivot
    +
    1009 module procedure :: qr_factor_pivot_cmplx
    +
    1010end interface
    +
    1011
    +
    1012! ------------------------------------------------------------------------------
    +
    1165interface form_qr
    +
    1166 module procedure :: form_qr_no_pivot
    +
    1167 module procedure :: form_qr_no_pivot_cmplx
    +
    1168 module procedure :: form_qr_pivot
    +
    1169 module procedure :: form_qr_pivot_cmplx
    +
    1170end interface
    +
    1171
    +
    1172! ------------------------------------------------------------------------------
    +
    1322interface mult_qr
    +
    1323 module procedure :: mult_qr_mtx
    +
    1324 module procedure :: mult_qr_mtx_cmplx
    +
    1325 module procedure :: mult_qr_vec
    +
    1326 module procedure :: mult_qr_vec_cmplx
    +
    1327end interface
    +
    1328
    +
    1329! ------------------------------------------------------------------------------
    + +
    1473 module procedure :: qr_rank1_update_dbl
    +
    1474 module procedure :: qr_rank1_update_cmplx
    +
    1475end interface
    +
    1476
    +
    1477! ------------------------------------------------------------------------------
    + +
    1572 module procedure :: cholesky_factor_dbl
    +
    1573 module procedure :: cholesky_factor_cmplx
    +
    1574end interface
    +
    1575
    +
    1576! ------------------------------------------------------------------------------
    + +
    1671 module procedure :: cholesky_rank1_update_dbl
    +
    1672 module procedure :: cholesky_rank1_update_cmplx
    +
    1673end interface
    +
    1674
    +
    1675! ------------------------------------------------------------------------------
    + +
    1778 module procedure :: cholesky_rank1_downdate_dbl
    +
    1779 module procedure :: cholesky_rank1_downdate_cmplx
    +
    1780end interface
    +
    1781
    +
    1782! ------------------------------------------------------------------------------
    +
    1850interface rz_factor
    +
    1851 module procedure :: rz_factor_dbl
    +
    1852 module procedure :: rz_factor_cmplx
    +
    1853end interface
    +
    1854
    +
    1855! ------------------------------------------------------------------------------
    +
    1941interface mult_rz
    +
    1942 module procedure :: mult_rz_mtx
    +
    1943 module procedure :: mult_rz_mtx_cmplx
    +
    1944 module procedure :: mult_rz_vec
    +
    1945 module procedure :: mult_rz_vec_cmplx
    +
    1946end interface
    +
    1947
    +
    1948! ------------------------------------------------------------------------------
    +
    2066interface svd
    +
    2067 module procedure :: svd_dbl
    +
    2068 module procedure :: svd_cmplx
    +
    2069end interface
    +
    2070
    +
    2071! ------------------------------------------------------------------------------
    + +
    2201 module procedure :: solve_tri_mtx
    +
    2202 module procedure :: solve_tri_mtx_cmplx
    +
    2203 module procedure :: solve_tri_vec
    +
    2204 module procedure :: solve_tri_vec_cmplx
    +
    2205end interface
    +
    2206
    +
    2207! ------------------------------------------------------------------------------
    +
    2288interface solve_lu
    +
    2289 module procedure :: solve_lu_mtx
    +
    2290 module procedure :: solve_lu_mtx_cmplx
    +
    2291 module procedure :: solve_lu_vec
    +
    2292 module procedure :: solve_lu_vec_cmplx
    +
    2293end interface
    +
    2294
    +
    2295! ------------------------------------------------------------------------------
    +
    2423interface solve_qr
    +
    2424 module procedure :: solve_qr_no_pivot_mtx
    +
    2425 module procedure :: solve_qr_no_pivot_mtx_cmplx
    +
    2426 module procedure :: solve_qr_no_pivot_vec
    +
    2427 module procedure :: solve_qr_no_pivot_vec_cmplx
    +
    2428 module procedure :: solve_qr_pivot_mtx
    +
    2429 module procedure :: solve_qr_pivot_mtx_cmplx
    +
    2430 module procedure :: solve_qr_pivot_vec
    +
    2431 module procedure :: solve_qr_pivot_vec_cmplx
    +
    2432end interface
    +
    2433
    +
    2434! ------------------------------------------------------------------------------
    + +
    2530 module procedure :: solve_cholesky_mtx
    +
    2531 module procedure :: solve_cholesky_mtx_cmplx
    +
    2532 module procedure :: solve_cholesky_vec
    +
    2533 module procedure :: solve_cholesky_vec_cmplx
    +
    2534end interface
    +
    2535
    +
    2536! ------------------------------------------------------------------------------
    + +
    2620 module procedure :: solve_least_squares_mtx
    +
    2621 module procedure :: solve_least_squares_mtx_cmplx
    +
    2622 module procedure :: solve_least_squares_vec
    +
    2623 module procedure :: solve_least_squares_vec_cmplx
    +
    2624end interface
    +
    2625
    +
    2626! ------------------------------------------------------------------------------
    + +
    2721 module procedure :: solve_least_squares_mtx_pvt
    +
    2722 module procedure :: solve_least_squares_mtx_pvt_cmplx
    +
    2723 module procedure :: solve_least_squares_vec_pvt
    +
    2724 module procedure :: solve_least_squares_vec_pvt_cmplx
    +
    2725end interface
    +
    2726
    +
    2727! ------------------------------------------------------------------------------
    + +
    2823 module procedure :: solve_least_squares_mtx_svd
    +
    2824 module procedure :: solve_least_squares_vec_svd
    +
    2825end interface
    +
    2826
    +
    2827! ------------------------------------------------------------------------------
    + +
    2918 module procedure :: mtx_inverse_dbl
    +
    2919 module procedure :: mtx_inverse_cmplx
    +
    2920end interface
    +
    2921
    +
    2922! ------------------------------------------------------------------------------
    + +
    3024 module procedure :: mtx_pinverse_dbl
    +
    3025 module procedure :: mtx_pinverse_cmplx
    +
    3026end interface
    +
    3027
    +
    3028! ------------------------------------------------------------------------------
    +
    3237interface eigen
    +
    3238 module procedure :: eigen_symm
    +
    3239 module procedure :: eigen_asymm
    +
    3240 module procedure :: eigen_gen
    +
    3241 module procedure :: eigen_cmplx
    +
    3242end interface
    +
    3243
    +
    3244! ------------------------------------------------------------------------------
    +
    3320interface sort
    +
    3321 module procedure :: sort_dbl_array
    +
    3322 module procedure :: sort_dbl_array_ind
    +
    3323 module procedure :: sort_cmplx_array
    +
    3324 module procedure :: sort_cmplx_array_ind
    +
    3325 module procedure :: sort_eigen_cmplx
    +
    3326 module procedure :: sort_eigen_dbl
    +
    3327end interface
    +
    3328
    +
    3434interface lq_factor
    +
    3435 module procedure :: lq_factor_no_pivot
    +
    3436 module procedure :: lq_factor_no_pivot_cmplx
    +
    3437end interface
    +
    3438
    +
    3548interface form_lq
    +
    3549 module procedure :: form_lq_no_pivot
    +
    3550 module procedure :: form_lq_no_pivot_cmplx
    +
    3551end interface
    +
    3552
    +
    3699interface mult_lq
    +
    3700 module procedure :: mult_lq_mtx
    +
    3701 module procedure :: mult_lq_mtx_cmplx
    +
    3702 module procedure :: mult_lq_vec
    +
    3703 module procedure :: mult_lq_vec_cmplx
    +
    3704end interface
    +
    3705
    +
    3794interface solve_lq
    +
    3795 module procedure :: solve_lq_mtx
    +
    3796 module procedure :: solve_lq_mtx_cmplx
    +
    3797 module procedure :: solve_lq_vec
    +
    3798 module procedure :: solve_lq_vec_cmplx
    +
    3799end interface
    +
    3800
    +
    3801! ******************************************************************************
    +
    3802! LINALG_BASIC.F90
    +
    3803! ------------------------------------------------------------------------------
    +
    3804interface
    +
    3805 module subroutine mtx_mult_mtx(transa, transb, alpha, a, b, beta, c, err)
    +
    3806 logical, intent(in) :: transa, transb
    +
    3807 real(real64), intent(in) :: alpha, beta
    +
    3808 real(real64), intent(in), dimension(:,:) :: a, b
    +
    3809 real(real64), intent(inout), dimension(:,:) :: c
    +
    3810 class(errors), intent(inout), optional, target :: err
    +
    3811 end subroutine
    +
    3812
    +
    3813 module subroutine mtx_mult_vec(trans, alpha, a, b, beta, c, err)
    +
    3814 logical, intent(in) :: trans
    +
    3815 real(real64), intent(in) :: alpha, beta
    3816 real(real64), intent(in), dimension(:,:) :: a
    -
    3817 real(real64), intent(inout), dimension(:,:) :: b
    -
    3818 class(errors), intent(inout), optional, target :: err
    -
    3819 end subroutine
    -
    3820
    -
    3821 module subroutine solve_tri_mtx_cmplx(lside, upper, trans, nounit, alpha, a, b, err)
    -
    3822 logical, intent(in) :: lside, upper, trans, nounit
    -
    3823 complex(real64), intent(in) :: alpha
    -
    3824 complex(real64), intent(in), dimension(:,:) :: a
    -
    3825 complex(real64), intent(inout), dimension(:,:) :: b
    -
    3826 class(errors), intent(inout), optional, target :: err
    -
    3827 end subroutine
    -
    3828
    -
    3829 module subroutine solve_tri_vec(upper, trans, nounit, a, x, err)
    -
    3830 logical, intent(in) :: upper, trans, nounit
    -
    3831 real(real64), intent(in), dimension(:,:) :: a
    -
    3832 real(real64), intent(inout), dimension(:) :: x
    -
    3833 class(errors), intent(inout), optional, target :: err
    -
    3834 end subroutine
    -
    3835
    -
    3836 module subroutine solve_tri_vec_cmplx(upper, trans, nounit, a, x, err)
    -
    3837 logical, intent(in) :: upper, trans, nounit
    -
    3838 complex(real64), intent(in), dimension(:,:) :: a
    -
    3839 complex(real64), intent(inout), dimension(:) :: x
    -
    3840 class(errors), intent(inout), optional, target :: err
    -
    3841 end subroutine
    -
    3842
    -
    3843 module subroutine solve_lu_mtx(a, ipvt, b, err)
    -
    3844 real(real64), intent(in), dimension(:,:) :: a
    -
    3845 integer(int32), intent(in), dimension(:) :: ipvt
    -
    3846 real(real64), intent(inout), dimension(:,:) :: b
    -
    3847 class(errors), intent(inout), optional, target :: err
    -
    3848 end subroutine
    -
    3849
    -
    3850 module subroutine solve_lu_mtx_cmplx(a, ipvt, b, err)
    -
    3851 complex(real64), intent(in), dimension(:,:) :: a
    -
    3852 integer(int32), intent(in), dimension(:) :: ipvt
    -
    3853 complex(real64), intent(inout), dimension(:,:) :: b
    -
    3854 class(errors), intent(inout), optional, target :: err
    -
    3855 end subroutine
    -
    3856
    -
    3857 module subroutine solve_lu_vec(a, ipvt, b, err)
    -
    3858 real(real64), intent(in), dimension(:,:) :: a
    -
    3859 integer(int32), intent(in), dimension(:) :: ipvt
    -
    3860 real(real64), intent(inout), dimension(:) :: b
    -
    3861 class(errors), intent(inout), optional, target :: err
    -
    3862 end subroutine
    -
    3863
    -
    3864 module subroutine solve_lu_vec_cmplx(a, ipvt, b, err)
    -
    3865 complex(real64), intent(in), dimension(:,:) :: a
    -
    3866 integer(int32), intent(in), dimension(:) :: ipvt
    -
    3867 complex(real64), intent(inout), dimension(:) :: b
    -
    3868 class(errors), intent(inout), optional, target :: err
    -
    3869 end subroutine
    -
    3870
    -
    3871 module subroutine solve_qr_no_pivot_mtx(a, tau, b, work, olwork, err)
    -
    3872 real(real64), intent(inout), dimension(:,:) :: a, b
    -
    3873 real(real64), intent(in), dimension(:) :: tau
    -
    3874 real(real64), intent(out), target, optional, dimension(:) :: work
    -
    3875 integer(int32), intent(out), optional :: olwork
    +
    3817 real(real64), intent(in), dimension(:) :: b
    +
    3818 real(real64), intent(inout), dimension(:) :: c
    +
    3819 class(errors), intent(inout), optional, target :: err
    +
    3820 end subroutine
    +
    3821
    +
    3822 module subroutine cmtx_mult_mtx(opa, opb, alpha, a, b, beta, c, err)
    +
    3823 integer(int32), intent(in) :: opa, opb
    +
    3824 complex(real64), intent(in) :: alpha, beta
    +
    3825 complex(real64), intent(in), dimension(:,:) :: a, b
    +
    3826 complex(real64), intent(inout), dimension(:,:) :: c
    +
    3827 class(errors), intent(inout), optional, target :: err
    +
    3828 end subroutine
    +
    3829
    +
    3830 module subroutine cmtx_mult_vec(opa, alpha, a, b, beta, c, err)
    +
    3831 integer(int32), intent(in) :: opa
    +
    3832 complex(real64), intent(in) :: alpha, beta
    +
    3833 complex(real64), intent(in), dimension(:,:) :: a
    +
    3834 complex(real64), intent(in), dimension(:) :: b
    +
    3835 complex(real64), intent(inout), dimension(:) :: c
    +
    3836 class(errors), intent(inout), optional, target :: err
    +
    3837 end subroutine
    +
    3838
    +
    3839 module subroutine rank1_update_dbl(alpha, x, y, a, err)
    +
    3840 real(real64), intent(in) :: alpha
    +
    3841 real(real64), intent(in), dimension(:) :: x, y
    +
    3842 real(real64), intent(inout), dimension(:,:) :: a
    +
    3843 class(errors), intent(inout), optional, target :: err
    +
    3844 end subroutine
    +
    3845
    +
    3846 module subroutine rank1_update_cmplx(alpha, x, y, a, err)
    +
    3847 complex(real64), intent(in) :: alpha
    +
    3848 complex(real64), intent(in), dimension(:) :: x, y
    +
    3849 complex(real64), intent(inout), dimension(:,:) :: a
    +
    3850 class(errors), intent(inout), optional, target :: err
    +
    3851 end subroutine
    +
    3852
    +
    3853 module subroutine diag_mtx_mult_mtx(lside, trans, alpha, a, b, beta, c, err)
    +
    3854 logical, intent(in) :: lside, trans
    +
    3855 real(real64) :: alpha, beta
    +
    3856 real(real64), intent(in), dimension(:) :: a
    +
    3857 real(real64), intent(in), dimension(:,:) :: b
    +
    3858 real(real64), intent(inout), dimension(:,:) :: c
    +
    3859 class(errors), intent(inout), optional, target :: err
    +
    3860 end subroutine
    +
    3861
    +
    3862 module subroutine diag_mtx_mult_mtx2(lside, alpha, a, b, err)
    +
    3863 logical, intent(in) :: lside
    +
    3864 real(real64), intent(in) :: alpha
    +
    3865 real(real64), intent(in), dimension(:) :: a
    +
    3866 real(real64), intent(inout), dimension(:,:) :: b
    +
    3867 class(errors), intent(inout), optional, target :: err
    +
    3868 end subroutine
    +
    3869
    +
    3870 module subroutine diag_mtx_mult_mtx3(lside, trans, alpha, a, b, beta, c, err)
    +
    3871 logical, intent(in) :: lside, trans
    +
    3872 real(real64) :: alpha, beta
    +
    3873 complex(real64), intent(in), dimension(:) :: a
    +
    3874 real(real64), intent(in), dimension(:,:) :: b
    +
    3875 complex(real64), intent(inout), dimension(:,:) :: c
    3876 class(errors), intent(inout), optional, target :: err
    3877 end subroutine
    3878
    -
    3879 module subroutine solve_qr_no_pivot_mtx_cmplx(a, tau, b, work, olwork, err)
    -
    3880 complex(real64), intent(inout), dimension(:,:) :: a, b
    -
    3881 complex(real64), intent(in), dimension(:) :: tau
    -
    3882 complex(real64), intent(out), target, optional, dimension(:) :: work
    -
    3883 integer(int32), intent(out), optional :: olwork
    -
    3884 class(errors), intent(inout), optional, target :: err
    -
    3885 end subroutine
    -
    3886
    -
    3887 module subroutine solve_qr_no_pivot_vec(a, tau, b, work, olwork, err)
    -
    3888 real(real64), intent(inout), dimension(:,:) :: a
    -
    3889 real(real64), intent(in), dimension(:) :: tau
    -
    3890 real(real64), intent(inout), dimension(:) :: b
    -
    3891 real(real64), intent(out), target, optional, dimension(:) :: work
    -
    3892 integer(int32), intent(out), optional :: olwork
    -
    3893 class(errors), intent(inout), optional, target :: err
    -
    3894 end subroutine
    -
    3895
    -
    3896 module subroutine solve_qr_no_pivot_vec_cmplx(a, tau, b, work, olwork, err)
    -
    3897 complex(real64), intent(inout), dimension(:,:) :: a
    -
    3898 complex(real64), intent(in), dimension(:) :: tau
    -
    3899 complex(real64), intent(inout), dimension(:) :: b
    -
    3900 complex(real64), intent(out), target, optional, dimension(:) :: work
    -
    3901 integer(int32), intent(out), optional :: olwork
    -
    3902 class(errors), intent(inout), optional, target :: err
    -
    3903 end subroutine
    -
    3904
    -
    3905 module subroutine solve_qr_pivot_mtx(a, tau, jpvt, b, work, olwork, err)
    -
    3906 real(real64), intent(inout), dimension(:,:) :: a
    -
    3907 real(real64), intent(in), dimension(:) :: tau
    -
    3908 integer(int32), intent(in), dimension(:) :: jpvt
    -
    3909 real(real64), intent(inout), dimension(:,:) :: b
    -
    3910 real(real64), intent(out), target, optional, dimension(:) :: work
    -
    3911 integer(int32), intent(out), optional :: olwork
    -
    3912 class(errors), intent(inout), optional, target :: err
    -
    3913 end subroutine
    -
    3914
    -
    3915 module subroutine solve_qr_pivot_mtx_cmplx(a, tau, jpvt, b, work, olwork, err)
    -
    3916 complex(real64), intent(inout), dimension(:,:) :: a
    -
    3917 complex(real64), intent(in), dimension(:) :: tau
    -
    3918 integer(int32), intent(in), dimension(:) :: jpvt
    -
    3919 complex(real64), intent(inout), dimension(:,:) :: b
    -
    3920 complex(real64), intent(out), target, optional, dimension(:) :: work
    -
    3921 integer(int32), intent(out), optional :: olwork
    +
    3879 module subroutine diag_mtx_mult_mtx4(lside, opb, alpha, a, b, beta, c, err)
    +
    3880 logical, intent(in) :: lside
    +
    3881 integer(int32), intent(in) :: opb
    +
    3882 real(real64) :: alpha, beta
    +
    3883 complex(real64), intent(in), dimension(:) :: a
    +
    3884 complex(real64), intent(in), dimension(:,:) :: b
    +
    3885 complex(real64), intent(inout), dimension(:,:) :: c
    +
    3886 class(errors), intent(inout), optional, target :: err
    +
    3887 end subroutine
    +
    3888
    +
    3889 module subroutine diag_mtx_mult_mtx_cmplx(lside, opb, alpha, a, b, beta, c, err)
    +
    3890 logical, intent(in) :: lside
    +
    3891 integer(int32), intent(in) :: opb
    +
    3892 complex(real64) :: alpha, beta
    +
    3893 complex(real64), intent(in), dimension(:) :: a
    +
    3894 complex(real64), intent(in), dimension(:,:) :: b
    +
    3895 complex(real64), intent(inout), dimension(:,:) :: c
    +
    3896 class(errors), intent(inout), optional, target :: err
    +
    3897 end subroutine
    +
    3898
    +
    3899 module subroutine diag_mtx_mult_mtx2_cmplx(lside, alpha, a, b, err)
    +
    3900 logical, intent(in) :: lside
    +
    3901 complex(real64), intent(in) :: alpha
    +
    3902 complex(real64), intent(in), dimension(:) :: a
    +
    3903 complex(real64), intent(inout), dimension(:,:) :: b
    +
    3904 class(errors), intent(inout), optional, target :: err
    +
    3905 end subroutine
    +
    3906
    +
    3907 module subroutine diag_mtx_mult_mtx_mix(lside, opb, alpha, a, b, beta, c, err)
    +
    3908 logical, intent(in) :: lside
    +
    3909 integer(int32), intent(in) :: opb
    +
    3910 complex(real64) :: alpha, beta
    +
    3911 real(real64), intent(in), dimension(:) :: a
    +
    3912 complex(real64), intent(in), dimension(:,:) :: b
    +
    3913 complex(real64), intent(inout), dimension(:,:) :: c
    +
    3914 class(errors), intent(inout), optional, target :: err
    +
    3915 end subroutine
    +
    3916
    +
    3917 module subroutine diag_mtx_mult_mtx2_mix(lside, alpha, a, b, err)
    +
    3918 logical, intent(in) :: lside
    +
    3919 complex(real64), intent(in) :: alpha
    +
    3920 real(real64), intent(in), dimension(:) :: a
    +
    3921 complex(real64), intent(inout), dimension(:,:) :: b
    3922 class(errors), intent(inout), optional, target :: err
    3923 end subroutine
    3924
    -
    3925 module subroutine solve_qr_pivot_vec(a, tau, jpvt, b, work, olwork, err)
    -
    3926 real(real64), intent(inout), dimension(:,:) :: a
    -
    3927 real(real64), intent(in), dimension(:) :: tau
    -
    3928 integer(int32), intent(in), dimension(:) :: jpvt
    -
    3929 real(real64), intent(inout), dimension(:) :: b
    -
    3930 real(real64), intent(out), target, optional, dimension(:) :: work
    -
    3931 integer(int32), intent(out), optional :: olwork
    -
    3932 class(errors), intent(inout), optional, target :: err
    -
    3933 end subroutine
    +
    3925 pure module function trace_dbl(x) result(y)
    +
    3926 real(real64), intent(in), dimension(:,:) :: x
    +
    3927 real(real64) :: y
    +
    3928 end function
    +
    3929
    +
    3930 pure module function trace_cmplx(x) result(y)
    +
    3931 complex(real64), intent(in), dimension(:,:) :: x
    +
    3932 complex(real64) :: y
    +
    3933 end function
    3934
    -
    3935 module subroutine solve_qr_pivot_vec_cmplx(a, tau, jpvt, b, work, olwork, err)
    -
    3936 complex(real64), intent(inout), dimension(:,:) :: a
    -
    3937 complex(real64), intent(in), dimension(:) :: tau
    -
    3938 integer(int32), intent(in), dimension(:) :: jpvt
    -
    3939 complex(real64), intent(inout), dimension(:) :: b
    -
    3940 complex(real64), intent(out), target, optional, dimension(:) :: work
    -
    3941 integer(int32), intent(out), optional :: olwork
    -
    3942 class(errors), intent(inout), optional, target :: err
    -
    3943 end subroutine
    -
    3944
    -
    3945 module subroutine solve_cholesky_mtx(upper, a, b, err)
    -
    3946 logical, intent(in) :: upper
    -
    3947 real(real64), intent(in), dimension(:,:) :: a
    -
    3948 real(real64), intent(inout), dimension(:,:) :: b
    -
    3949 class(errors), intent(inout), optional, target :: err
    -
    3950 end subroutine
    -
    3951
    -
    3952 module subroutine solve_cholesky_mtx_cmplx(upper, a, b, err)
    -
    3953 logical, intent(in) :: upper
    -
    3954 complex(real64), intent(in), dimension(:,:) :: a
    -
    3955 complex(real64), intent(inout), dimension(:,:) :: b
    -
    3956 class(errors), intent(inout), optional, target :: err
    -
    3957 end subroutine
    -
    3958
    -
    3959 module subroutine solve_cholesky_vec(upper, a, b, err)
    -
    3960 logical, intent(in) :: upper
    -
    3961 real(real64), intent(in), dimension(:,:) :: a
    -
    3962 real(real64), intent(inout), dimension(:) :: b
    -
    3963 class(errors), intent(inout), optional, target :: err
    -
    3964 end subroutine
    -
    3965
    -
    3966 module subroutine solve_cholesky_vec_cmplx(upper, a, b, err)
    -
    3967 logical, intent(in) :: upper
    -
    3968 complex(real64), intent(in), dimension(:,:) :: a
    -
    3969 complex(real64), intent(inout), dimension(:) :: b
    +
    3935 module function mtx_rank_dbl(a, tol, work, olwork, err) result(rnk)
    +
    3936 real(real64), intent(inout), dimension(:,:) :: a
    +
    3937 real(real64), intent(in), optional :: tol
    +
    3938 real(real64), intent(out), target, optional, dimension(:) :: work
    +
    3939 integer(int32), intent(out), optional :: olwork
    +
    3940 class(errors), intent(inout), optional, target :: err
    +
    3941 integer(int32) :: rnk
    +
    3942 end function
    +
    3943
    +
    3944 module function mtx_rank_cmplx(a, tol, work, olwork, rwork, err) result(rnk)
    +
    3945 complex(real64), intent(inout), dimension(:,:) :: a
    +
    3946 real(real64), intent(in), optional :: tol
    +
    3947 complex(real64), intent(out), target, optional, dimension(:) :: work
    +
    3948 integer(int32), intent(out), optional :: olwork
    +
    3949 real(real64), intent(out), target, optional, dimension(:) :: rwork
    +
    3950 class(errors), intent(inout), optional, target :: err
    +
    3951 integer(int32) :: rnk
    +
    3952 end function
    +
    3953
    +
    3954 module function det_dbl(a, iwork, err) result(x)
    +
    3955 real(real64), intent(inout), dimension(:,:) :: a
    +
    3956 integer(int32), intent(out), target, optional, dimension(:) :: iwork
    +
    3957 class(errors), intent(inout), optional, target :: err
    +
    3958 real(real64) :: x
    +
    3959 end function
    +
    3960
    +
    3961 module function det_cmplx(a, iwork, err) result(x)
    +
    3962 complex(real64), intent(inout), dimension(:,:) :: a
    +
    3963 integer(int32), intent(out), target, optional, dimension(:) :: iwork
    +
    3964 class(errors), intent(inout), optional, target :: err
    +
    3965 complex(real64) :: x
    +
    3966 end function
    +
    3967
    +
    3968 module subroutine swap_dbl(x, y, err)
    +
    3969 real(real64), intent(inout), dimension(:) :: x, y
    3970 class(errors), intent(inout), optional, target :: err
    3971 end subroutine
    3972
    -
    3973 module subroutine solve_least_squares_mtx(a, b, work, olwork, err)
    -
    3974 real(real64), intent(inout), dimension(:,:) :: a, b
    -
    3975 real(real64), intent(out), target, optional, dimension(:) :: work
    -
    3976 integer(int32), intent(out), optional :: olwork
    -
    3977 class(errors), intent(inout), optional, target :: err
    -
    3978 end subroutine
    -
    3979
    -
    3980 module subroutine solve_least_squares_mtx_cmplx(a, b, work, olwork, err)
    -
    3981 complex(real64), intent(inout), dimension(:,:) :: a, b
    -
    3982 complex(real64), intent(out), target, optional, dimension(:) :: work
    -
    3983 integer(int32), intent(out), optional :: olwork
    -
    3984 class(errors), intent(inout), optional, target :: err
    -
    3985 end subroutine
    -
    3986
    -
    3987 module subroutine solve_least_squares_vec(a, b, work, olwork, err)
    -
    3988 real(real64), intent(inout), dimension(:,:) :: a
    -
    3989 real(real64), intent(inout), dimension(:) :: b
    -
    3990 real(real64), intent(out), target, optional, dimension(:) :: work
    -
    3991 integer(int32), intent(out), optional :: olwork
    -
    3992 class(errors), intent(inout), optional, target :: err
    -
    3993 end subroutine
    -
    3994
    -
    3995 module subroutine solve_least_squares_vec_cmplx(a, b, work, olwork, err)
    -
    3996 complex(real64), intent(inout), dimension(:,:) :: a
    -
    3997 complex(real64), intent(inout), dimension(:) :: b
    -
    3998 complex(real64), intent(out), target, optional, dimension(:) :: work
    -
    3999 integer(int32), intent(out), optional :: olwork
    -
    4000 class(errors), intent(inout), optional, target :: err
    -
    4001 end subroutine
    -
    4002
    -
    4003 module subroutine solve_least_squares_mtx_pvt(a, b, ipvt, arnk, work, olwork, err)
    -
    4004 real(real64), intent(inout), dimension(:,:) :: a, b
    -
    4005 integer(int32), intent(inout), target, optional, dimension(:) :: ipvt
    -
    4006 integer(int32), intent(out), optional :: arnk
    -
    4007 real(real64), intent(out), target, optional, dimension(:) :: work
    -
    4008 integer(int32), intent(out), optional :: olwork
    -
    4009 class(errors), intent(inout), optional, target :: err
    -
    4010 end subroutine
    -
    4011
    -
    4012 module subroutine solve_least_squares_mtx_pvt_cmplx(a, b, ipvt, arnk, &
    -
    4013 work, olwork, rwork, err)
    -
    4014 complex(real64), intent(inout), dimension(:,:) :: a, b
    -
    4015 integer(int32), intent(inout), target, optional, dimension(:) :: ipvt
    -
    4016 integer(int32), intent(out), optional :: arnk
    -
    4017 complex(real64), intent(out), target, optional, dimension(:) :: work
    -
    4018 integer(int32), intent(out), optional :: olwork
    -
    4019 real(real64), intent(out), target, optional, dimension(:) :: rwork
    -
    4020 class(errors), intent(inout), optional, target :: err
    -
    4021 end subroutine
    -
    4022
    -
    4023 module subroutine solve_least_squares_vec_pvt(a, b, ipvt, arnk, work, olwork, err)
    -
    4024 real(real64), intent(inout), dimension(:,:) :: a
    -
    4025 real(real64), intent(inout), dimension(:) :: b
    -
    4026 integer(int32), intent(inout), target, optional, dimension(:) :: ipvt
    -
    4027 integer(int32), intent(out), optional :: arnk
    -
    4028 real(real64), intent(out), target, optional, dimension(:) :: work
    -
    4029 integer(int32), intent(out), optional :: olwork
    -
    4030 class(errors), intent(inout), optional, target :: err
    -
    4031 end subroutine
    -
    4032
    -
    4033 module subroutine solve_least_squares_vec_pvt_cmplx(a, b, ipvt, arnk, &
    -
    4034 work, olwork, rwork, err)
    -
    4035 complex(real64), intent(inout), dimension(:,:) :: a
    -
    4036 complex(real64), intent(inout), dimension(:) :: b
    -
    4037 integer(int32), intent(inout), target, optional, dimension(:) :: ipvt
    -
    4038 integer(int32), intent(out), optional :: arnk
    -
    4039 complex(real64), intent(out), target, optional, dimension(:) :: work
    -
    4040 integer(int32), intent(out), optional :: olwork
    -
    4041 real(real64), intent(out), target, optional, dimension(:) :: rwork
    -
    4042 class(errors), intent(inout), optional, target :: err
    -
    4043 end subroutine
    -
    4044
    -
    4045 module subroutine solve_least_squares_mtx_svd(a, b, s, arnk, work, olwork, err)
    -
    4046 real(real64), intent(inout), dimension(:,:) :: a, b
    -
    4047 integer(int32), intent(out), optional :: arnk
    -
    4048 real(real64), intent(out), target, optional, dimension(:) :: work, s
    -
    4049 integer(int32), intent(out), optional :: olwork
    -
    4050 class(errors), intent(inout), optional, target :: err
    -
    4051 end subroutine
    -
    4052
    -
    4053 module subroutine solve_least_squares_mtx_svd_cmplx(a, b, s, arnk, work, &
    -
    4054 olwork, rwork, err)
    -
    4055 complex(real64), intent(inout), dimension(:,:) :: a, b
    -
    4056 integer(int32), intent(out), optional :: arnk
    -
    4057 complex(real64), intent(out), target, optional, dimension(:) :: work
    -
    4058 real(real64), intent(out), target, optional, dimension(:) :: rwork, s
    -
    4059 integer(int32), intent(out), optional :: olwork
    -
    4060 class(errors), intent(inout), optional, target :: err
    -
    4061 end subroutine
    -
    4062
    -
    4063 module subroutine solve_least_squares_vec_svd(a, b, s, arnk, work, olwork, err)
    -
    4064 real(real64), intent(inout), dimension(:,:) :: a
    -
    4065 real(real64), intent(inout), dimension(:) :: b
    -
    4066 integer(int32), intent(out), optional :: arnk
    -
    4067 real(real64), intent(out), target, optional, dimension(:) :: work, s
    -
    4068 integer(int32), intent(out), optional :: olwork
    -
    4069 class(errors), intent(inout), optional, target :: err
    -
    4070 end subroutine
    -
    4071
    -
    4072 module subroutine solve_least_squares_vec_svd_cmplx(a, b, s, arnk, work, &
    -
    4073 olwork, rwork, err)
    -
    4074 complex(real64), intent(inout), dimension(:,:) :: a
    -
    4075 complex(real64), intent(inout), dimension(:) :: b
    -
    4076 integer(int32), intent(out), optional :: arnk
    -
    4077 complex(real64), intent(out), target, optional, dimension(:) :: work
    -
    4078 real(real64), intent(out), target, optional, dimension(:) :: rwork, s
    -
    4079 integer(int32), intent(out), optional :: olwork
    -
    4080 class(errors), intent(inout), optional, target :: err
    -
    4081 end subroutine
    -
    4082
    -
    4083 module subroutine mtx_inverse_dbl(a, iwork, work, olwork, err)
    -
    4084 real(real64), intent(inout), dimension(:,:) :: a
    -
    4085 integer(int32), intent(out), target, optional, dimension(:) :: iwork
    -
    4086 real(real64), intent(out), target, optional, dimension(:) :: work
    -
    4087 integer(int32), intent(out), optional :: olwork
    -
    4088 class(errors), intent(inout), optional, target :: err
    -
    4089 end subroutine
    -
    4090
    -
    4091 module subroutine mtx_inverse_cmplx(a, iwork, work, olwork, err)
    -
    4092 complex(real64), intent(inout), dimension(:,:) :: a
    -
    4093 integer(int32), intent(out), target, optional, dimension(:) :: iwork
    -
    4094 complex(real64), intent(out), target, optional, dimension(:) :: work
    -
    4095 integer(int32), intent(out), optional :: olwork
    -
    4096 class(errors), intent(inout), optional, target :: err
    -
    4097 end subroutine
    -
    4098
    -
    4099 module subroutine mtx_pinverse_dbl(a, ainv, tol, work, olwork, err)
    -
    4100 real(real64), intent(inout), dimension(:,:) :: a
    -
    4101 real(real64), intent(out), dimension(:,:) :: ainv
    -
    4102 real(real64), intent(in), optional :: tol
    +
    3973 module subroutine swap_cmplx(x, y, err)
    +
    3974 complex(real64), intent(inout), dimension(:) :: x, y
    +
    3975 class(errors), intent(inout), optional, target :: err
    +
    3976 end subroutine
    +
    3977
    +
    3978 module subroutine recip_mult_array_dbl(a, x)
    +
    3979 real(real64), intent(in) :: a
    +
    3980 real(real64), intent(inout), dimension(:) :: x
    +
    3981 end subroutine
    +
    3982
    +
    3983 module subroutine tri_mtx_mult_dbl(upper, alpha, a, beta, b, err)
    +
    3984 logical, intent(in) :: upper
    +
    3985 real(real64), intent(in) :: alpha, beta
    +
    3986 real(real64), intent(in), dimension(:,:) :: a
    +
    3987 real(real64), intent(inout), dimension(:,:) :: b
    +
    3988 class(errors), intent(inout), optional, target :: err
    +
    3989 end subroutine
    +
    3990
    +
    3991 module subroutine tri_mtx_mult_cmplx(upper, alpha, a, beta, b, err)
    +
    3992 logical, intent(in) :: upper
    +
    3993 complex(real64), intent(in) :: alpha, beta
    +
    3994 complex(real64), intent(in), dimension(:,:) :: a
    +
    3995 complex(real64), intent(inout), dimension(:,:) :: b
    +
    3996 class(errors), intent(inout), optional, target :: err
    +
    3997 end subroutine
    +
    3998
    +
    3999end interface
    +
    4000
    +
    4001! ******************************************************************************
    +
    4002! LINALG_FACTOR.F90
    +
    4003! ------------------------------------------------------------------------------
    +
    4004interface
    +
    4005 module subroutine lu_factor_dbl(a, ipvt, err)
    +
    4006 real(real64), intent(inout), dimension(:,:) :: a
    +
    4007 integer(int32), intent(out), dimension(:) :: ipvt
    +
    4008 class(errors), intent(inout), optional, target :: err
    +
    4009 end subroutine
    +
    4010
    +
    4011 module subroutine lu_factor_cmplx(a, ipvt, err)
    +
    4012 complex(real64), intent(inout), dimension(:,:) :: a
    +
    4013 integer(int32), intent(out), dimension(:) :: ipvt
    +
    4014 class(errors), intent(inout), optional, target :: err
    +
    4015 end subroutine
    +
    4016
    +
    4017 module subroutine form_lu_all(lu, ipvt, u, p, err)
    +
    4018 real(real64), intent(inout), dimension(:,:) :: lu
    +
    4019 integer(int32), intent(in), dimension(:) :: ipvt
    +
    4020 real(real64), intent(out), dimension(:,:) :: u, p
    +
    4021 class(errors), intent(inout), optional, target :: err
    +
    4022 end subroutine
    +
    4023
    +
    4024 module subroutine form_lu_all_cmplx(lu, ipvt, u, p, err)
    +
    4025 complex(real64), intent(inout), dimension(:,:) :: lu
    +
    4026 integer(int32), intent(in), dimension(:) :: ipvt
    +
    4027 complex(real64), intent(out), dimension(:,:) :: u
    +
    4028 real(real64), intent(out), dimension(:,:) :: p
    +
    4029 class(errors), intent(inout), optional, target :: err
    +
    4030 end subroutine
    +
    4031
    +
    4032 module subroutine form_lu_only(lu, u, err)
    +
    4033 real(real64), intent(inout), dimension(:,:) :: lu
    +
    4034 real(real64), intent(out), dimension(:,:) :: u
    +
    4035 class(errors), intent(inout), optional, target :: err
    +
    4036 end subroutine
    +
    4037
    +
    4038 module subroutine form_lu_only_cmplx(lu, u, err)
    +
    4039 complex(real64), intent(inout), dimension(:,:) :: lu
    +
    4040 complex(real64), intent(out), dimension(:,:) :: u
    +
    4041 class(errors), intent(inout), optional, target :: err
    +
    4042 end subroutine
    +
    4043
    +
    4044 module subroutine qr_factor_no_pivot(a, tau, work, olwork, err)
    +
    4045 real(real64), intent(inout), dimension(:,:) :: a
    +
    4046 real(real64), intent(out), dimension(:) :: tau
    +
    4047 real(real64), intent(out), target, dimension(:), optional :: work
    +
    4048 integer(int32), intent(out), optional :: olwork
    +
    4049 class(errors), intent(inout), optional, target :: err
    +
    4050 end subroutine
    +
    4051
    +
    4052 module subroutine qr_factor_no_pivot_cmplx(a, tau, work, olwork, err)
    +
    4053 complex(real64), intent(inout), dimension(:,:) :: a
    +
    4054 complex(real64), intent(out), dimension(:) :: tau
    +
    4055 complex(real64), intent(out), target, dimension(:), optional :: work
    +
    4056 integer(int32), intent(out), optional :: olwork
    +
    4057 class(errors), intent(inout), optional, target :: err
    +
    4058 end subroutine
    +
    4059
    +
    4060 module subroutine qr_factor_pivot(a, tau, jpvt, work, olwork, err)
    +
    4061 real(real64), intent(inout), dimension(:,:) :: a
    +
    4062 real(real64), intent(out), dimension(:) :: tau
    +
    4063 integer(int32), intent(inout), dimension(:) :: jpvt
    +
    4064 real(real64), intent(out), target, dimension(:), optional :: work
    +
    4065 integer(int32), intent(out), optional :: olwork
    +
    4066 class(errors), intent(inout), optional, target :: err
    +
    4067 end subroutine
    +
    4068
    +
    4069 module subroutine qr_factor_pivot_cmplx(a, tau, jpvt, work, olwork, rwork, &
    +
    4070 err)
    +
    4071 complex(real64), intent(inout), dimension(:,:) :: a
    +
    4072 complex(real64), intent(out), dimension(:) :: tau
    +
    4073 integer(int32), intent(inout), dimension(:) :: jpvt
    +
    4074 complex(real64), intent(out), target, dimension(:), optional :: work
    +
    4075 integer(int32), intent(out), optional :: olwork
    +
    4076 real(real64), intent(out), target, dimension(:), optional :: rwork
    +
    4077 class(errors), intent(inout), optional, target :: err
    +
    4078 end subroutine
    +
    4079
    +
    4080 module subroutine form_qr_no_pivot(r, tau, q, work, olwork, err)
    +
    4081 real(real64), intent(inout), dimension(:,:) :: r
    +
    4082 real(real64), intent(in), dimension(:) :: tau
    +
    4083 real(real64), intent(out), dimension(:,:) :: q
    +
    4084 real(real64), intent(out), target, dimension(:), optional :: work
    +
    4085 integer(int32), intent(out), optional :: olwork
    +
    4086 class(errors), intent(inout), optional, target :: err
    +
    4087 end subroutine
    +
    4088
    +
    4089 module subroutine form_qr_no_pivot_cmplx(r, tau, q, work, olwork, err)
    +
    4090 complex(real64), intent(inout), dimension(:,:) :: r
    +
    4091 complex(real64), intent(in), dimension(:) :: tau
    +
    4092 complex(real64), intent(out), dimension(:,:) :: q
    +
    4093 complex(real64), intent(out), target, dimension(:), optional :: work
    +
    4094 integer(int32), intent(out), optional :: olwork
    +
    4095 class(errors), intent(inout), optional, target :: err
    +
    4096 end subroutine
    +
    4097
    +
    4098 module subroutine form_qr_pivot(r, tau, pvt, q, p, work, olwork, err)
    +
    4099 real(real64), intent(inout), dimension(:,:) :: r
    +
    4100 real(real64), intent(in), dimension(:) :: tau
    +
    4101 integer(int32), intent(in), dimension(:) :: pvt
    +
    4102 real(real64), intent(out), dimension(:,:) :: q, p
    4103 real(real64), intent(out), target, dimension(:), optional :: work
    4104 integer(int32), intent(out), optional :: olwork
    4105 class(errors), intent(inout), optional, target :: err
    4106 end subroutine
    -
    4107
    -
    4108 module subroutine mtx_pinverse_cmplx(a, ainv, tol, work, olwork, rwork, err)
    -
    4109 complex(real64), intent(inout), dimension(:,:) :: a
    -
    4110 complex(real64), intent(out), dimension(:,:) :: ainv
    -
    4111 real(real64), intent(in), optional :: tol
    -
    4112 complex(real64), intent(out), target, dimension(:), optional :: work
    -
    4113 integer(int32), intent(out), optional :: olwork
    -
    4114 real(real64), intent(out), target, dimension(:), optional :: rwork
    +
    4107
    +
    4108 module subroutine form_qr_pivot_cmplx(r, tau, pvt, q, p, work, olwork, err)
    +
    4109 complex(real64), intent(inout), dimension(:,:) :: r
    +
    4110 complex(real64), intent(in), dimension(:) :: tau
    +
    4111 integer(int32), intent(in), dimension(:) :: pvt
    +
    4112 complex(real64), intent(out), dimension(:,:) :: q, p
    +
    4113 complex(real64), intent(out), target, dimension(:), optional :: work
    +
    4114 integer(int32), intent(out), optional :: olwork
    4115 class(errors), intent(inout), optional, target :: err
    4116 end subroutine
    -
    4117
    -
    4118end interface
    -
    4119
    -
    4120! ******************************************************************************
    -
    4121! LINALG_EIGEN.F90
    -
    4122! ------------------------------------------------------------------------------
    -
    4123interface
    -
    4124 module subroutine eigen_symm(vecs, a, vals, work, olwork, err)
    -
    4125 logical, intent(in) :: vecs
    -
    4126 real(real64), intent(inout), dimension(:,:) :: a
    -
    4127 real(real64), intent(out), dimension(:) :: vals
    -
    4128 real(real64), intent(out), pointer, optional, dimension(:) :: work
    -
    4129 integer(int32), intent(out), optional :: olwork
    -
    4130 class(errors), intent(inout), optional, target :: err
    -
    4131 end subroutine
    -
    4132
    -
    4133 module subroutine eigen_asymm(a, vals, vecs, work, olwork, err)
    -
    4134 real(real64), intent(inout), dimension(:,:) :: a
    -
    4135 complex(real64), intent(out), dimension(:) :: vals
    -
    4136 complex(real64), intent(out), optional, dimension(:,:) :: vecs
    -
    4137 real(real64), intent(out), pointer, optional, dimension(:) :: work
    -
    4138 integer(int32), intent(out), optional :: olwork
    -
    4139 class(errors), intent(inout), optional, target :: err
    -
    4140 end subroutine
    -
    4141
    -
    4142 module subroutine eigen_gen(a, b, alpha, beta, vecs, work, olwork, err)
    -
    4143 real(real64), intent(inout), dimension(:,:) :: a, b
    -
    4144 complex(real64), intent(out), dimension(:) :: alpha
    -
    4145 real(real64), intent(out), optional, dimension(:) :: beta
    -
    4146 complex(real64), intent(out), optional, dimension(:,:) :: vecs
    -
    4147 real(real64), intent(out), optional, pointer, dimension(:) :: work
    -
    4148 integer(int32), intent(out), optional :: olwork
    -
    4149 class(errors), intent(inout), optional, target :: err
    -
    4150 end subroutine
    -
    4151
    -
    4152 module subroutine eigen_cmplx(a, vals, vecs, work, olwork, rwork, err)
    -
    4153 complex(real64), intent(inout), dimension(:,:) :: a
    -
    4154 complex(real64), intent(out), dimension(:) :: vals
    -
    4155 complex(real64), intent(out), optional, dimension(:,:) :: vecs
    -
    4156 complex(real64), intent(out), target, optional, dimension(:) :: work
    -
    4157 real(real64), intent(out), target, optional, dimension(:) :: rwork
    -
    4158 integer(int32), intent(out), optional :: olwork
    -
    4159 class(errors), intent(inout), optional, target :: err
    -
    4160 end subroutine
    -
    4161end interface
    -
    4162
    -
    4163! ******************************************************************************
    -
    4164! LINALG_SORTING.F90
    -
    4165! ------------------------------------------------------------------------------
    -
    4166interface
    -
    4167 module subroutine sort_dbl_array(x, ascend)
    -
    4168 real(real64), intent(inout), dimension(:) :: x
    -
    4169 logical, intent(in), optional :: ascend
    -
    4170 end subroutine
    -
    4171
    -
    4172 module subroutine sort_dbl_array_ind(x, ind, ascend, err)
    -
    4173 real(real64), intent(inout), dimension(:) :: x
    -
    4174 integer(int32), intent(inout), dimension(:) :: ind
    -
    4175 logical, intent(in), optional :: ascend
    -
    4176 class(errors), intent(inout), optional, target :: err
    -
    4177 end subroutine
    -
    4178
    -
    4179 module subroutine sort_cmplx_array(x, ascend)
    -
    4180 complex(real64), intent(inout), dimension(:) :: x
    -
    4181 logical, intent(in), optional :: ascend
    -
    4182 end subroutine
    -
    4183
    -
    4184 module subroutine sort_cmplx_array_ind(x, ind, ascend, err)
    -
    4185 complex(real64), intent(inout), dimension(:) :: x
    -
    4186 integer(int32), intent(inout), dimension(:) :: ind
    -
    4187 logical, intent(in), optional :: ascend
    -
    4188 class(errors), intent(inout), optional, target :: err
    -
    4189 end subroutine
    -
    4190
    -
    4191 module subroutine sort_eigen_cmplx(vals, vecs, ascend, err)
    -
    4192 complex(real64), intent(inout), dimension(:) :: vals
    -
    4193 complex(real64), intent(inout), dimension(:,:) :: vecs
    -
    4194 logical, intent(in), optional :: ascend
    -
    4195 class(errors), intent(inout), optional, target :: err
    -
    4196 end subroutine
    -
    4197
    -
    4198 module subroutine sort_eigen_dbl(vals, vecs, ascend, err)
    -
    4199 real(real64), intent(inout), dimension(:) :: vals
    -
    4200 real(real64), intent(inout), dimension(:,:) :: vecs
    -
    4201 logical, intent(in), optional :: ascend
    -
    4202 class(errors), intent(inout), optional, target :: err
    -
    4203 end subroutine
    -
    4204
    -
    4205end interface
    -
    4206
    -
    4207end module
    -
    Computes the Cholesky factorization of a symmetric, positive definite matrix.
    Definition: linalg.f90:1563
    -
    Computes the rank 1 downdate to a Cholesky factored matrix (upper triangular).
    Definition: linalg.f90:1769
    -
    Computes the rank 1 update to a Cholesky factored matrix (upper triangular).
    Definition: linalg.f90:1662
    -
    Computes the determinant of a square matrix.
    Definition: linalg.f90:564
    -
    Multiplies a diagonal matrix with another matrix or array.
    Definition: linalg.f90:459
    -
    Computes the eigenvalues, and optionally the eigenvectors, of a matrix.
    Definition: linalg.f90:3229
    -
    Extracts the L and U matrices from the condensed [L\U] storage format used by the lu_factor.
    Definition: linalg.f90:847
    -
    Forms the full M-by-M orthogonal matrix Q from the elementary reflectors returned by the base QR fact...
    Definition: linalg.f90:1161
    -
    Computes the LU factorization of an M-by-N matrix.
    Definition: linalg.f90:725
    -
    Computes the inverse of a square matrix.
    Definition: linalg.f90:2909
    -
    Performs the matrix operation: .
    Definition: linalg.f90:289
    -
    Computes the Moore-Penrose pseudo-inverse of a M-by-N matrix using the singular value decomposition o...
    Definition: linalg.f90:3015
    -
    Computes the rank of a matrix.
    Definition: linalg.f90:531
    -
    Multiplies a general matrix by the orthogonal matrix Q from a QR factorization.
    Definition: linalg.f90:1314
    -
    Multiplies a general matrix by the orthogonal matrix Z from an RZ factorization.
    Definition: linalg.f90:1933
    -
    Computes the QR factorization of an M-by-N matrix.
    Definition: linalg.f90:1001
    -
    Computes the rank 1 update to an M-by-N QR factored matrix A (M >= N) where , and such that ....
    Definition: linalg.f90:1464
    -
    Performs the rank-1 update to matrix A such that: , where is an M-by-N matrix, is a scalar,...
    Definition: linalg.f90:324
    -
    Multiplies a vector by the reciprocal of a real scalar.
    Definition: linalg.f90:605
    -
    Factors an upper trapezoidal matrix by means of orthogonal transformations such that ....
    Definition: linalg.f90:1842
    -
    Solves a system of Cholesky factored equations.
    Definition: linalg.f90:2521
    -
    Solves the overdetermined or underdetermined system of M equations of N unknowns,...
    Definition: linalg.f90:2712
    -
    Solves the overdetermined or underdetermined system of M equations of N unknowns using a singular va...
    Definition: linalg.f90:2814
    -
    Solves the overdetermined or underdetermined system of M equations of N unknowns....
    Definition: linalg.f90:2611
    -
    Solves a system of LU-factored equations.
    Definition: linalg.f90:2280
    -
    Solves a system of M QR-factored equations of N unknowns.
    Definition: linalg.f90:2415
    -
    Solves a triangular system of equations.
    Definition: linalg.f90:2192
    -
    Sorts an array.
    Definition: linalg.f90:3312
    -
    Computes the singular value decomposition of a matrix A. The SVD is defined as: , where is an M-by-M...
    Definition: linalg.f90:2058
    -
    Swaps the contents of two arrays.
    Definition: linalg.f90:586
    -
    Computes the trace of a matrix (the sum of the main diagonal elements).
    Definition: linalg.f90:483
    -
    Computes the triangular matrix operation: , or , where A is a triangular matrix.
    Definition: linalg.f90:639
    +
    4117
    +
    4118 module subroutine mult_qr_mtx(lside, trans, a, tau, c, work, olwork, err)
    +
    4119 logical, intent(in) :: lside, trans
    +
    4120 real(real64), intent(in), dimension(:) :: tau
    +
    4121 real(real64), intent(inout), dimension(:,:) :: a, c
    +
    4122 real(real64), intent(out), target, dimension(:), optional :: work
    +
    4123 integer(int32), intent(out), optional :: olwork
    +
    4124 class(errors), intent(inout), optional, target :: err
    +
    4125 end subroutine
    +
    4126
    +
    4127 module subroutine mult_qr_mtx_cmplx(lside, trans, a, tau, c, work, olwork, err)
    +
    4128 logical, intent(in) :: lside, trans
    +
    4129 complex(real64), intent(in), dimension(:) :: tau
    +
    4130 complex(real64), intent(inout), dimension(:,:) :: a, c
    +
    4131 complex(real64), intent(out), target, dimension(:), optional :: work
    +
    4132 integer(int32), intent(out), optional :: olwork
    +
    4133 class(errors), intent(inout), optional, target :: err
    +
    4134 end subroutine
    +
    4135
    +
    4136 module subroutine mult_qr_vec(trans, a, tau, c, work, olwork, err)
    +
    4137 logical, intent(in) :: trans
    +
    4138 real(real64), intent(inout), dimension(:,:) :: a
    +
    4139 real(real64), intent(in), dimension(:) :: tau
    +
    4140 real(real64), intent(inout), dimension(:) :: c
    +
    4141 real(real64), intent(out), target, dimension(:), optional :: work
    +
    4142 integer(int32), intent(out), optional :: olwork
    +
    4143 class(errors), intent(inout), optional, target :: err
    +
    4144 end subroutine
    +
    4145
    +
    4146 module subroutine mult_qr_vec_cmplx(trans, a, tau, c, work, olwork, err)
    +
    4147 logical, intent(in) :: trans
    +
    4148 complex(real64), intent(inout), dimension(:,:) :: a
    +
    4149 complex(real64), intent(in), dimension(:) :: tau
    +
    4150 complex(real64), intent(inout), dimension(:) :: c
    +
    4151 complex(real64), intent(out), target, dimension(:), optional :: work
    +
    4152 integer(int32), intent(out), optional :: olwork
    +
    4153 class(errors), intent(inout), optional, target :: err
    +
    4154 end subroutine
    +
    4155
    +
    4156 module subroutine qr_rank1_update_dbl(q, r, u, v, work, err)
    +
    4157 real(real64), intent(inout), dimension(:,:) :: q, r
    +
    4158 real(real64), intent(inout), dimension(:) :: u, v
    +
    4159 real(real64), intent(out), target, optional, dimension(:) :: work
    +
    4160 class(errors), intent(inout), optional, target :: err
    +
    4161 end subroutine
    +
    4162
    +
    4163 module subroutine qr_rank1_update_cmplx(q, r, u, v, work, rwork, err)
    +
    4164 complex(real64), intent(inout), dimension(:,:) :: q, r
    +
    4165 complex(real64), intent(inout), dimension(:) :: u, v
    +
    4166 complex(real64), intent(out), target, optional, dimension(:) :: work
    +
    4167 real(real64), intent(out), target, optional, dimension(:) :: rwork
    +
    4168 class(errors), intent(inout), optional, target :: err
    +
    4169 end subroutine
    +
    4170
    +
    4171 module subroutine cholesky_factor_dbl(a, upper, err)
    +
    4172 real(real64), intent(inout), dimension(:,:) :: a
    +
    4173 logical, intent(in), optional :: upper
    +
    4174 class(errors), intent(inout), optional, target :: err
    +
    4175 end subroutine
    +
    4176
    +
    4177 module subroutine cholesky_factor_cmplx(a, upper, err)
    +
    4178 complex(real64), intent(inout), dimension(:,:) :: a
    +
    4179 logical, intent(in), optional :: upper
    +
    4180 class(errors), intent(inout), optional, target :: err
    +
    4181 end subroutine
    +
    4182
    +
    4183 module subroutine cholesky_rank1_update_dbl(r, u, work, err)
    +
    4184 real(real64), intent(inout), dimension(:,:) :: r
    +
    4185 real(real64), intent(inout), dimension(:) :: u
    +
    4186 real(real64), intent(out), target, optional, dimension(:) :: work
    +
    4187 class(errors), intent(inout), optional, target :: err
    +
    4188 end subroutine
    +
    4189
    +
    4190 module subroutine cholesky_rank1_update_cmplx(r, u, work, err)
    +
    4191 complex(real64), intent(inout), dimension(:,:) :: r
    +
    4192 complex(real64), intent(inout), dimension(:) :: u
    +
    4193 real(real64), intent(out), target, optional, dimension(:) :: work
    +
    4194 class(errors), intent(inout), optional, target :: err
    +
    4195 end subroutine
    +
    4196
    +
    4197 module subroutine cholesky_rank1_downdate_dbl(r, u, work, err)
    +
    4198 real(real64), intent(inout), dimension(:,:) :: r
    +
    4199 real(real64), intent(inout), dimension(:) :: u
    +
    4200 real(real64), intent(out), target, optional, dimension(:) :: work
    +
    4201 class(errors), intent(inout), optional, target :: err
    +
    4202 end subroutine
    +
    4203
    +
    4204 module subroutine cholesky_rank1_downdate_cmplx(r, u, work, err)
    +
    4205 complex(real64), intent(inout), dimension(:,:) :: r
    +
    4206 complex(real64), intent(inout), dimension(:) :: u
    +
    4207 real(real64), intent(out), target, optional, dimension(:) :: work
    +
    4208 class(errors), intent(inout), optional, target :: err
    +
    4209 end subroutine
    +
    4210
    +
    4211 module subroutine rz_factor_dbl(a, tau, work, olwork, err)
    +
    4212 real(real64), intent(inout), dimension(:,:) :: a
    +
    4213 real(real64), intent(out), dimension(:) :: tau
    +
    4214 real(real64), intent(out), target, optional, dimension(:) :: work
    +
    4215 integer(int32), intent(out), optional :: olwork
    +
    4216 class(errors), intent(inout), optional, target :: err
    +
    4217 end subroutine
    +
    4218
    +
    4219 module subroutine rz_factor_cmplx(a, tau, work, olwork, err)
    +
    4220 complex(real64), intent(inout), dimension(:,:) :: a
    +
    4221 complex(real64), intent(out), dimension(:) :: tau
    +
    4222 complex(real64), intent(out), target, optional, dimension(:) :: work
    +
    4223 integer(int32), intent(out), optional :: olwork
    +
    4224 class(errors), intent(inout), optional, target :: err
    +
    4225 end subroutine
    +
    4226
    +
    4227 module subroutine mult_rz_mtx(lside, trans, l, a, tau, c, work, olwork, err)
    +
    4228 logical, intent(in) :: lside, trans
    +
    4229 integer(int32), intent(in) :: l
    +
    4230 real(real64), intent(inout), dimension(:,:) :: a, c
    +
    4231 real(real64), intent(in), dimension(:) :: tau
    +
    4232 real(real64), intent(out), target, optional, dimension(:) :: work
    +
    4233 integer(int32), intent(out), optional :: olwork
    +
    4234 class(errors), intent(inout), optional, target :: err
    +
    4235 end subroutine
    +
    4236
    +
    4237 module subroutine mult_rz_mtx_cmplx(lside, trans, l, a, tau, c, work, olwork, err)
    +
    4238 logical, intent(in) :: lside, trans
    +
    4239 integer(int32), intent(in) :: l
    +
    4240 complex(real64), intent(inout), dimension(:,:) :: a, c
    +
    4241 complex(real64), intent(in), dimension(:) :: tau
    +
    4242 complex(real64), intent(out), target, optional, dimension(:) :: work
    +
    4243 integer(int32), intent(out), optional :: olwork
    +
    4244 class(errors), intent(inout), optional, target :: err
    +
    4245 end subroutine
    +
    4246
    +
    4247 module subroutine mult_rz_vec(trans, l, a, tau, c, work, olwork, err)
    +
    4248 logical, intent(in) :: trans
    +
    4249 integer(int32), intent(in) :: l
    +
    4250 real(real64), intent(inout), dimension(:,:) :: a
    +
    4251 real(real64), intent(in), dimension(:) :: tau
    +
    4252 real(real64), intent(inout), dimension(:) :: c
    +
    4253 real(real64), intent(out), target, optional, dimension(:) :: work
    +
    4254 integer(int32), intent(out), optional :: olwork
    +
    4255 class(errors), intent(inout), optional, target :: err
    +
    4256 end subroutine
    +
    4257
    +
    4258 module subroutine mult_rz_vec_cmplx(trans, l, a, tau, c, work, olwork, err)
    +
    4259 logical, intent(in) :: trans
    +
    4260 integer(int32), intent(in) :: l
    +
    4261 complex(real64), intent(inout), dimension(:,:) :: a
    +
    4262 complex(real64), intent(in), dimension(:) :: tau
    +
    4263 complex(real64), intent(inout), dimension(:) :: c
    +
    4264 complex(real64), intent(out), target, optional, dimension(:) :: work
    +
    4265 integer(int32), intent(out), optional :: olwork
    +
    4266 class(errors), intent(inout), optional, target :: err
    +
    4267 end subroutine
    +
    4268
    +
    4269 module subroutine svd_dbl(a, s, u, vt, work, olwork, err)
    +
    4270 real(real64), intent(inout), dimension(:,:) :: a
    +
    4271 real(real64), intent(out), dimension(:) :: s
    +
    4272 real(real64), intent(out), optional, dimension(:,:) :: u, vt
    +
    4273 real(real64), intent(out), target, optional, dimension(:) :: work
    +
    4274 integer(int32), intent(out), optional :: olwork
    +
    4275 class(errors), intent(inout), optional, target :: err
    +
    4276 end subroutine
    +
    4277
    +
    4278 module subroutine svd_cmplx(a, s, u, vt, work, olwork, rwork, err)
    +
    4279 complex(real64), intent(inout), dimension(:,:) :: a
    +
    4280 real(real64), intent(out), dimension(:) :: s
    +
    4281 complex(real64), intent(out), optional, dimension(:,:) :: u, vt
    +
    4282 complex(real64), intent(out), target, optional, dimension(:) :: work
    +
    4283 integer(int32), intent(out), optional :: olwork
    +
    4284 real(real64), intent(out), target, optional, dimension(:) :: rwork
    +
    4285 class(errors), intent(inout), optional, target :: err
    +
    4286 end subroutine
    +
    4287
    +
    4288 module subroutine lq_factor_no_pivot(a, tau, work, olwork, err)
    +
    4289 real(real64), intent(inout), dimension(:,:) :: a
    +
    4290 real(real64), intent(out), dimension(:) :: tau
    +
    4291 real(real64), intent(out), target, dimension(:), optional :: work
    +
    4292 integer(int32), intent(out), optional :: olwork
    +
    4293 class(errors), intent(inout), optional, target :: err
    +
    4294 end subroutine
    +
    4295
    +
    4296 module subroutine lq_factor_no_pivot_cmplx(a, tau, work, olwork, err)
    +
    4297 complex(real64), intent(inout), dimension(:,:) :: a
    +
    4298 complex(real64), intent(out), dimension(:) :: tau
    +
    4299 complex(real64), intent(out), target, dimension(:), optional :: work
    +
    4300 integer(int32), intent(out), optional :: olwork
    +
    4301 class(errors), intent(inout), optional, target :: err
    +
    4302 end subroutine
    +
    4303
    +
    4304 module subroutine form_lq_no_pivot(l, tau, q, work, olwork, err)
    +
    4305 real(real64), intent(inout), dimension(:,:) :: l
    +
    4306 real(real64), intent(in), dimension(:) :: tau
    +
    4307 real(real64), intent(out), dimension(:,:) :: q
    +
    4308 real(real64), intent(out), target, dimension(:), optional :: work
    +
    4309 integer(int32), intent(out), optional :: olwork
    +
    4310 class(errors), intent(inout), optional, target :: err
    +
    4311 end subroutine
    +
    4312
    +
    4313 module subroutine form_lq_no_pivot_cmplx(l, tau, q, work, olwork, err)
    +
    4314 complex(real64), intent(inout), dimension(:,:) :: l
    +
    4315 complex(real64), intent(in), dimension(:) :: tau
    +
    4316 complex(real64), intent(out), dimension(:,:) :: q
    +
    4317 complex(real64), intent(out), target, dimension(:), optional :: work
    +
    4318 integer(int32), intent(out), optional :: olwork
    +
    4319 class(errors), intent(inout), optional, target :: err
    +
    4320 end subroutine
    +
    4321
    +
    4322 module subroutine mult_lq_mtx(lside, trans, a, tau, c, work, olwork, err)
    +
    4323 logical, intent(in) :: lside, trans
    +
    4324 real(real64), intent(in), dimension(:,:) :: a
    +
    4325 real(real64), intent(in), dimension(:) :: tau
    +
    4326 real(real64), intent(inout), dimension(:,:) :: c
    +
    4327 real(real64), intent(out), target, dimension(:), optional :: work
    +
    4328 integer(int32), intent(out), optional :: olwork
    +
    4329 class(errors), intent(inout), optional, target :: err
    +
    4330 end subroutine
    +
    4331
    +
    4332 module subroutine mult_lq_mtx_cmplx(lside, trans, a, tau, c, work, olwork, err)
    +
    4333 logical, intent(in) :: lside, trans
    +
    4334 complex(real64), intent(in), dimension(:,:) :: a
    +
    4335 complex(real64), intent(in), dimension(:) :: tau
    +
    4336 complex(real64), intent(inout), dimension(:,:) :: c
    +
    4337 complex(real64), intent(out), target, dimension(:), optional :: work
    +
    4338 integer(int32), intent(out), optional :: olwork
    +
    4339 class(errors), intent(inout), optional, target :: err
    +
    4340 end subroutine
    +
    4341
    +
    4342 module subroutine mult_lq_vec(trans, a, tau, c, work, olwork, err)
    +
    4343 logical, intent(in) :: trans
    +
    4344 real(real64), intent(in), dimension(:,:) :: a
    +
    4345 real(real64), intent(in), dimension(:) :: tau
    +
    4346 real(real64), intent(inout), dimension(:) :: c
    +
    4347 real(real64), intent(out), target, dimension(:), optional :: work
    +
    4348 integer(int32), intent(out), optional :: olwork
    +
    4349 class(errors), intent(inout), optional, target :: err
    +
    4350 end subroutine
    +
    4351
    +
    4352 module subroutine mult_lq_vec_cmplx(trans, a, tau, c, work, olwork, err)
    +
    4353 logical, intent(in) :: trans
    +
    4354 complex(real64), intent(in), dimension(:,:) :: a
    +
    4355 complex(real64), intent(in), dimension(:) :: tau
    +
    4356 complex(real64), intent(inout), dimension(:) :: c
    +
    4357 complex(real64), intent(out), target, dimension(:), optional :: work
    +
    4358 integer(int32), intent(out), optional :: olwork
    +
    4359 class(errors), intent(inout), optional, target :: err
    +
    4360 end subroutine
    +
    4361end interface
    +
    4362
    +
    4363! ******************************************************************************
    +
    4364! LINALG_SOLVE.F90
    +
    4365! ------------------------------------------------------------------------------
    +
    4366interface
    +
    4367 module subroutine solve_tri_mtx(lside, upper, trans, nounit, alpha, a, b, err)
    +
    4368 logical, intent(in) :: lside, upper, trans, nounit
    +
    4369 real(real64), intent(in) :: alpha
    +
    4370 real(real64), intent(in), dimension(:,:) :: a
    +
    4371 real(real64), intent(inout), dimension(:,:) :: b
    +
    4372 class(errors), intent(inout), optional, target :: err
    +
    4373 end subroutine
    +
    4374
    +
    4375 module subroutine solve_tri_mtx_cmplx(lside, upper, trans, nounit, alpha, a, b, err)
    +
    4376 logical, intent(in) :: lside, upper, trans, nounit
    +
    4377 complex(real64), intent(in) :: alpha
    +
    4378 complex(real64), intent(in), dimension(:,:) :: a
    +
    4379 complex(real64), intent(inout), dimension(:,:) :: b
    +
    4380 class(errors), intent(inout), optional, target :: err
    +
    4381 end subroutine
    +
    4382
    +
    4383 module subroutine solve_tri_vec(upper, trans, nounit, a, x, err)
    +
    4384 logical, intent(in) :: upper, trans, nounit
    +
    4385 real(real64), intent(in), dimension(:,:) :: a
    +
    4386 real(real64), intent(inout), dimension(:) :: x
    +
    4387 class(errors), intent(inout), optional, target :: err
    +
    4388 end subroutine
    +
    4389
    +
    4390 module subroutine solve_tri_vec_cmplx(upper, trans, nounit, a, x, err)
    +
    4391 logical, intent(in) :: upper, trans, nounit
    +
    4392 complex(real64), intent(in), dimension(:,:) :: a
    +
    4393 complex(real64), intent(inout), dimension(:) :: x
    +
    4394 class(errors), intent(inout), optional, target :: err
    +
    4395 end subroutine
    +
    4396
    +
    4397 module subroutine solve_lu_mtx(a, ipvt, b, err)
    +
    4398 real(real64), intent(in), dimension(:,:) :: a
    +
    4399 integer(int32), intent(in), dimension(:) :: ipvt
    +
    4400 real(real64), intent(inout), dimension(:,:) :: b
    +
    4401 class(errors), intent(inout), optional, target :: err
    +
    4402 end subroutine
    +
    4403
    +
    4404 module subroutine solve_lu_mtx_cmplx(a, ipvt, b, err)
    +
    4405 complex(real64), intent(in), dimension(:,:) :: a
    +
    4406 integer(int32), intent(in), dimension(:) :: ipvt
    +
    4407 complex(real64), intent(inout), dimension(:,:) :: b
    +
    4408 class(errors), intent(inout), optional, target :: err
    +
    4409 end subroutine
    +
    4410
    +
    4411 module subroutine solve_lu_vec(a, ipvt, b, err)
    +
    4412 real(real64), intent(in), dimension(:,:) :: a
    +
    4413 integer(int32), intent(in), dimension(:) :: ipvt
    +
    4414 real(real64), intent(inout), dimension(:) :: b
    +
    4415 class(errors), intent(inout), optional, target :: err
    +
    4416 end subroutine
    +
    4417
    +
    4418 module subroutine solve_lu_vec_cmplx(a, ipvt, b, err)
    +
    4419 complex(real64), intent(in), dimension(:,:) :: a
    +
    4420 integer(int32), intent(in), dimension(:) :: ipvt
    +
    4421 complex(real64), intent(inout), dimension(:) :: b
    +
    4422 class(errors), intent(inout), optional, target :: err
    +
    4423 end subroutine
    +
    4424
    +
    4425 module subroutine solve_qr_no_pivot_mtx(a, tau, b, work, olwork, err)
    +
    4426 real(real64), intent(inout), dimension(:,:) :: a, b
    +
    4427 real(real64), intent(in), dimension(:) :: tau
    +
    4428 real(real64), intent(out), target, optional, dimension(:) :: work
    +
    4429 integer(int32), intent(out), optional :: olwork
    +
    4430 class(errors), intent(inout), optional, target :: err
    +
    4431 end subroutine
    +
    4432
    +
    4433 module subroutine solve_qr_no_pivot_mtx_cmplx(a, tau, b, work, olwork, err)
    +
    4434 complex(real64), intent(inout), dimension(:,:) :: a, b
    +
    4435 complex(real64), intent(in), dimension(:) :: tau
    +
    4436 complex(real64), intent(out), target, optional, dimension(:) :: work
    +
    4437 integer(int32), intent(out), optional :: olwork
    +
    4438 class(errors), intent(inout), optional, target :: err
    +
    4439 end subroutine
    +
    4440
    +
    4441 module subroutine solve_qr_no_pivot_vec(a, tau, b, work, olwork, err)
    +
    4442 real(real64), intent(inout), dimension(:,:) :: a
    +
    4443 real(real64), intent(in), dimension(:) :: tau
    +
    4444 real(real64), intent(inout), dimension(:) :: b
    +
    4445 real(real64), intent(out), target, optional, dimension(:) :: work
    +
    4446 integer(int32), intent(out), optional :: olwork
    +
    4447 class(errors), intent(inout), optional, target :: err
    +
    4448 end subroutine
    +
    4449
    +
    4450 module subroutine solve_qr_no_pivot_vec_cmplx(a, tau, b, work, olwork, err)
    +
    4451 complex(real64), intent(inout), dimension(:,:) :: a
    +
    4452 complex(real64), intent(in), dimension(:) :: tau
    +
    4453 complex(real64), intent(inout), dimension(:) :: b
    +
    4454 complex(real64), intent(out), target, optional, dimension(:) :: work
    +
    4455 integer(int32), intent(out), optional :: olwork
    +
    4456 class(errors), intent(inout), optional, target :: err
    +
    4457 end subroutine
    +
    4458
    +
    4459 module subroutine solve_qr_pivot_mtx(a, tau, jpvt, b, work, olwork, err)
    +
    4460 real(real64), intent(inout), dimension(:,:) :: a
    +
    4461 real(real64), intent(in), dimension(:) :: tau
    +
    4462 integer(int32), intent(in), dimension(:) :: jpvt
    +
    4463 real(real64), intent(inout), dimension(:,:) :: b
    +
    4464 real(real64), intent(out), target, optional, dimension(:) :: work
    +
    4465 integer(int32), intent(out), optional :: olwork
    +
    4466 class(errors), intent(inout), optional, target :: err
    +
    4467 end subroutine
    +
    4468
    +
    4469 module subroutine solve_qr_pivot_mtx_cmplx(a, tau, jpvt, b, work, olwork, err)
    +
    4470 complex(real64), intent(inout), dimension(:,:) :: a
    +
    4471 complex(real64), intent(in), dimension(:) :: tau
    +
    4472 integer(int32), intent(in), dimension(:) :: jpvt
    +
    4473 complex(real64), intent(inout), dimension(:,:) :: b
    +
    4474 complex(real64), intent(out), target, optional, dimension(:) :: work
    +
    4475 integer(int32), intent(out), optional :: olwork
    +
    4476 class(errors), intent(inout), optional, target :: err
    +
    4477 end subroutine
    +
    4478
    +
    4479 module subroutine solve_qr_pivot_vec(a, tau, jpvt, b, work, olwork, err)
    +
    4480 real(real64), intent(inout), dimension(:,:) :: a
    +
    4481 real(real64), intent(in), dimension(:) :: tau
    +
    4482 integer(int32), intent(in), dimension(:) :: jpvt
    +
    4483 real(real64), intent(inout), dimension(:) :: b
    +
    4484 real(real64), intent(out), target, optional, dimension(:) :: work
    +
    4485 integer(int32), intent(out), optional :: olwork
    +
    4486 class(errors), intent(inout), optional, target :: err
    +
    4487 end subroutine
    +
    4488
    +
    4489 module subroutine solve_qr_pivot_vec_cmplx(a, tau, jpvt, b, work, olwork, err)
    +
    4490 complex(real64), intent(inout), dimension(:,:) :: a
    +
    4491 complex(real64), intent(in), dimension(:) :: tau
    +
    4492 integer(int32), intent(in), dimension(:) :: jpvt
    +
    4493 complex(real64), intent(inout), dimension(:) :: b
    +
    4494 complex(real64), intent(out), target, optional, dimension(:) :: work
    +
    4495 integer(int32), intent(out), optional :: olwork
    +
    4496 class(errors), intent(inout), optional, target :: err
    +
    4497 end subroutine
    +
    4498
    +
    4499 module subroutine solve_cholesky_mtx(upper, a, b, err)
    +
    4500 logical, intent(in) :: upper
    +
    4501 real(real64), intent(in), dimension(:,:) :: a
    +
    4502 real(real64), intent(inout), dimension(:,:) :: b
    +
    4503 class(errors), intent(inout), optional, target :: err
    +
    4504 end subroutine
    +
    4505
    +
    4506 module subroutine solve_cholesky_mtx_cmplx(upper, a, b, err)
    +
    4507 logical, intent(in) :: upper
    +
    4508 complex(real64), intent(in), dimension(:,:) :: a
    +
    4509 complex(real64), intent(inout), dimension(:,:) :: b
    +
    4510 class(errors), intent(inout), optional, target :: err
    +
    4511 end subroutine
    +
    4512
    +
    4513 module subroutine solve_cholesky_vec(upper, a, b, err)
    +
    4514 logical, intent(in) :: upper
    +
    4515 real(real64), intent(in), dimension(:,:) :: a
    +
    4516 real(real64), intent(inout), dimension(:) :: b
    +
    4517 class(errors), intent(inout), optional, target :: err
    +
    4518 end subroutine
    +
    4519
    +
    4520 module subroutine solve_cholesky_vec_cmplx(upper, a, b, err)
    +
    4521 logical, intent(in) :: upper
    +
    4522 complex(real64), intent(in), dimension(:,:) :: a
    +
    4523 complex(real64), intent(inout), dimension(:) :: b
    +
    4524 class(errors), intent(inout), optional, target :: err
    +
    4525 end subroutine
    +
    4526
    +
    4527 module subroutine solve_least_squares_mtx(a, b, work, olwork, err)
    +
    4528 real(real64), intent(inout), dimension(:,:) :: a, b
    +
    4529 real(real64), intent(out), target, optional, dimension(:) :: work
    +
    4530 integer(int32), intent(out), optional :: olwork
    +
    4531 class(errors), intent(inout), optional, target :: err
    +
    4532 end subroutine
    +
    4533
    +
    4534 module subroutine solve_least_squares_mtx_cmplx(a, b, work, olwork, err)
    +
    4535 complex(real64), intent(inout), dimension(:,:) :: a, b
    +
    4536 complex(real64), intent(out), target, optional, dimension(:) :: work
    +
    4537 integer(int32), intent(out), optional :: olwork
    +
    4538 class(errors), intent(inout), optional, target :: err
    +
    4539 end subroutine
    +
    4540
    +
    4541 module subroutine solve_least_squares_vec(a, b, work, olwork, err)
    +
    4542 real(real64), intent(inout), dimension(:,:) :: a
    +
    4543 real(real64), intent(inout), dimension(:) :: b
    +
    4544 real(real64), intent(out), target, optional, dimension(:) :: work
    +
    4545 integer(int32), intent(out), optional :: olwork
    +
    4546 class(errors), intent(inout), optional, target :: err
    +
    4547 end subroutine
    +
    4548
    +
    4549 module subroutine solve_least_squares_vec_cmplx(a, b, work, olwork, err)
    +
    4550 complex(real64), intent(inout), dimension(:,:) :: a
    +
    4551 complex(real64), intent(inout), dimension(:) :: b
    +
    4552 complex(real64), intent(out), target, optional, dimension(:) :: work
    +
    4553 integer(int32), intent(out), optional :: olwork
    +
    4554 class(errors), intent(inout), optional, target :: err
    +
    4555 end subroutine
    +
    4556
    +
    4557 module subroutine solve_least_squares_mtx_pvt(a, b, ipvt, arnk, work, olwork, err)
    +
    4558 real(real64), intent(inout), dimension(:,:) :: a, b
    +
    4559 integer(int32), intent(inout), target, optional, dimension(:) :: ipvt
    +
    4560 integer(int32), intent(out), optional :: arnk
    +
    4561 real(real64), intent(out), target, optional, dimension(:) :: work
    +
    4562 integer(int32), intent(out), optional :: olwork
    +
    4563 class(errors), intent(inout), optional, target :: err
    +
    4564 end subroutine
    +
    4565
    +
    4566 module subroutine solve_least_squares_mtx_pvt_cmplx(a, b, ipvt, arnk, &
    +
    4567 work, olwork, rwork, err)
    +
    4568 complex(real64), intent(inout), dimension(:,:) :: a, b
    +
    4569 integer(int32), intent(inout), target, optional, dimension(:) :: ipvt
    +
    4570 integer(int32), intent(out), optional :: arnk
    +
    4571 complex(real64), intent(out), target, optional, dimension(:) :: work
    +
    4572 integer(int32), intent(out), optional :: olwork
    +
    4573 real(real64), intent(out), target, optional, dimension(:) :: rwork
    +
    4574 class(errors), intent(inout), optional, target :: err
    +
    4575 end subroutine
    +
    4576
    +
    4577 module subroutine solve_least_squares_vec_pvt(a, b, ipvt, arnk, work, olwork, err)
    +
    4578 real(real64), intent(inout), dimension(:,:) :: a
    +
    4579 real(real64), intent(inout), dimension(:) :: b
    +
    4580 integer(int32), intent(inout), target, optional, dimension(:) :: ipvt
    +
    4581 integer(int32), intent(out), optional :: arnk
    +
    4582 real(real64), intent(out), target, optional, dimension(:) :: work
    +
    4583 integer(int32), intent(out), optional :: olwork
    +
    4584 class(errors), intent(inout), optional, target :: err
    +
    4585 end subroutine
    +
    4586
    +
    4587 module subroutine solve_least_squares_vec_pvt_cmplx(a, b, ipvt, arnk, &
    +
    4588 work, olwork, rwork, err)
    +
    4589 complex(real64), intent(inout), dimension(:,:) :: a
    +
    4590 complex(real64), intent(inout), dimension(:) :: b
    +
    4591 integer(int32), intent(inout), target, optional, dimension(:) :: ipvt
    +
    4592 integer(int32), intent(out), optional :: arnk
    +
    4593 complex(real64), intent(out), target, optional, dimension(:) :: work
    +
    4594 integer(int32), intent(out), optional :: olwork
    +
    4595 real(real64), intent(out), target, optional, dimension(:) :: rwork
    +
    4596 class(errors), intent(inout), optional, target :: err
    +
    4597 end subroutine
    +
    4598
    +
    4599 module subroutine solve_least_squares_mtx_svd(a, b, s, arnk, work, olwork, err)
    +
    4600 real(real64), intent(inout), dimension(:,:) :: a, b
    +
    4601 integer(int32), intent(out), optional :: arnk
    +
    4602 real(real64), intent(out), target, optional, dimension(:) :: work, s
    +
    4603 integer(int32), intent(out), optional :: olwork
    +
    4604 class(errors), intent(inout), optional, target :: err
    +
    4605 end subroutine
    +
    4606
    +
    4607 module subroutine solve_least_squares_mtx_svd_cmplx(a, b, s, arnk, work, &
    +
    4608 olwork, rwork, err)
    +
    4609 complex(real64), intent(inout), dimension(:,:) :: a, b
    +
    4610 integer(int32), intent(out), optional :: arnk
    +
    4611 complex(real64), intent(out), target, optional, dimension(:) :: work
    +
    4612 real(real64), intent(out), target, optional, dimension(:) :: rwork, s
    +
    4613 integer(int32), intent(out), optional :: olwork
    +
    4614 class(errors), intent(inout), optional, target :: err
    +
    4615 end subroutine
    +
    4616
    +
    4617 module subroutine solve_least_squares_vec_svd(a, b, s, arnk, work, olwork, err)
    +
    4618 real(real64), intent(inout), dimension(:,:) :: a
    +
    4619 real(real64), intent(inout), dimension(:) :: b
    +
    4620 integer(int32), intent(out), optional :: arnk
    +
    4621 real(real64), intent(out), target, optional, dimension(:) :: work, s
    +
    4622 integer(int32), intent(out), optional :: olwork
    +
    4623 class(errors), intent(inout), optional, target :: err
    +
    4624 end subroutine
    +
    4625
    +
    4626 module subroutine solve_least_squares_vec_svd_cmplx(a, b, s, arnk, work, &
    +
    4627 olwork, rwork, err)
    +
    4628 complex(real64), intent(inout), dimension(:,:) :: a
    +
    4629 complex(real64), intent(inout), dimension(:) :: b
    +
    4630 integer(int32), intent(out), optional :: arnk
    +
    4631 complex(real64), intent(out), target, optional, dimension(:) :: work
    +
    4632 real(real64), intent(out), target, optional, dimension(:) :: rwork, s
    +
    4633 integer(int32), intent(out), optional :: olwork
    +
    4634 class(errors), intent(inout), optional, target :: err
    +
    4635 end subroutine
    +
    4636
    +
    4637 module subroutine mtx_inverse_dbl(a, iwork, work, olwork, err)
    +
    4638 real(real64), intent(inout), dimension(:,:) :: a
    +
    4639 integer(int32), intent(out), target, optional, dimension(:) :: iwork
    +
    4640 real(real64), intent(out), target, optional, dimension(:) :: work
    +
    4641 integer(int32), intent(out), optional :: olwork
    +
    4642 class(errors), intent(inout), optional, target :: err
    +
    4643 end subroutine
    +
    4644
    +
    4645 module subroutine mtx_inverse_cmplx(a, iwork, work, olwork, err)
    +
    4646 complex(real64), intent(inout), dimension(:,:) :: a
    +
    4647 integer(int32), intent(out), target, optional, dimension(:) :: iwork
    +
    4648 complex(real64), intent(out), target, optional, dimension(:) :: work
    +
    4649 integer(int32), intent(out), optional :: olwork
    +
    4650 class(errors), intent(inout), optional, target :: err
    +
    4651 end subroutine
    +
    4652
    +
    4653 module subroutine mtx_pinverse_dbl(a, ainv, tol, work, olwork, err)
    +
    4654 real(real64), intent(inout), dimension(:,:) :: a
    +
    4655 real(real64), intent(out), dimension(:,:) :: ainv
    +
    4656 real(real64), intent(in), optional :: tol
    +
    4657 real(real64), intent(out), target, dimension(:), optional :: work
    +
    4658 integer(int32), intent(out), optional :: olwork
    +
    4659 class(errors), intent(inout), optional, target :: err
    +
    4660 end subroutine
    +
    4661
    +
    4662 module subroutine mtx_pinverse_cmplx(a, ainv, tol, work, olwork, rwork, err)
    +
    4663 complex(real64), intent(inout), dimension(:,:) :: a
    +
    4664 complex(real64), intent(out), dimension(:,:) :: ainv
    +
    4665 real(real64), intent(in), optional :: tol
    +
    4666 complex(real64), intent(out), target, dimension(:), optional :: work
    +
    4667 integer(int32), intent(out), optional :: olwork
    +
    4668 real(real64), intent(out), target, dimension(:), optional :: rwork
    +
    4669 class(errors), intent(inout), optional, target :: err
    +
    4670 end subroutine
    +
    4671
    +
    4672 module subroutine solve_lq_mtx(a, tau, b, work, olwork, err)
    +
    4673 real(real64), intent(in), dimension(:,:) :: a
    +
    4674 real(real64), intent(in), dimension(:) :: tau
    +
    4675 real(real64), intent(inout), dimension(:,:) :: b
    +
    4676 real(real64), intent(out), target, optional, dimension(:) :: work
    +
    4677 integer(int32), intent(out), optional :: olwork
    +
    4678 class(errors), intent(inout), optional, target :: err
    +
    4679 end subroutine
    +
    4680
    +
    4681 module subroutine solve_lq_mtx_cmplx(a, tau, b, work, olwork, err)
    +
    4682 complex(real64), intent(in), dimension(:,:) :: a
    +
    4683 complex(real64), intent(in), dimension(:) :: tau
    +
    4684 complex(real64), intent(inout), dimension(:,:) :: b
    +
    4685 complex(real64), intent(out), target, optional, dimension(:) :: work
    +
    4686 integer(int32), intent(out), optional :: olwork
    +
    4687 class(errors), intent(inout), optional, target :: err
    +
    4688 end subroutine
    +
    4689
    +
    4690 module subroutine solve_lq_vec(a, tau, b, work, olwork, err)
    +
    4691 real(real64), intent(in), dimension(:,:) :: a
    +
    4692 real(real64), intent(in), dimension(:) :: tau
    +
    4693 real(real64), intent(inout), dimension(:) :: b
    +
    4694 real(real64), intent(out), target, optional, dimension(:) :: work
    +
    4695 integer(int32), intent(out), optional :: olwork
    +
    4696 class(errors), intent(inout), optional, target :: err
    +
    4697 end subroutine
    +
    4698
    +
    4699 module subroutine solve_lq_vec_cmplx(a, tau, b, work, olwork, err)
    +
    4700 complex(real64), intent(in), dimension(:,:) :: a
    +
    4701 complex(real64), intent(in), dimension(:) :: tau
    +
    4702 complex(real64), intent(inout), dimension(:) :: b
    +
    4703 complex(real64), intent(out), target, optional, dimension(:) :: work
    +
    4704 integer(int32), intent(out), optional :: olwork
    +
    4705 class(errors), intent(inout), optional, target :: err
    +
    4706 end subroutine
    +
    4707end interface
    +
    4708
    +
    4709! ******************************************************************************
    +
    4710! LINALG_EIGEN.F90
    +
    4711! ------------------------------------------------------------------------------
    +
    4712interface
    +
    4713 module subroutine eigen_symm(vecs, a, vals, work, olwork, err)
    +
    4714 logical, intent(in) :: vecs
    +
    4715 real(real64), intent(inout), dimension(:,:) :: a
    +
    4716 real(real64), intent(out), dimension(:) :: vals
    +
    4717 real(real64), intent(out), pointer, optional, dimension(:) :: work
    +
    4718 integer(int32), intent(out), optional :: olwork
    +
    4719 class(errors), intent(inout), optional, target :: err
    +
    4720 end subroutine
    +
    4721
    +
    4722 module subroutine eigen_asymm(a, vals, vecs, work, olwork, err)
    +
    4723 real(real64), intent(inout), dimension(:,:) :: a
    +
    4724 complex(real64), intent(out), dimension(:) :: vals
    +
    4725 complex(real64), intent(out), optional, dimension(:,:) :: vecs
    +
    4726 real(real64), intent(out), pointer, optional, dimension(:) :: work
    +
    4727 integer(int32), intent(out), optional :: olwork
    +
    4728 class(errors), intent(inout), optional, target :: err
    +
    4729 end subroutine
    +
    4730
    +
    4731 module subroutine eigen_gen(a, b, alpha, beta, vecs, work, olwork, err)
    +
    4732 real(real64), intent(inout), dimension(:,:) :: a, b
    +
    4733 complex(real64), intent(out), dimension(:) :: alpha
    +
    4734 real(real64), intent(out), optional, dimension(:) :: beta
    +
    4735 complex(real64), intent(out), optional, dimension(:,:) :: vecs
    +
    4736 real(real64), intent(out), optional, pointer, dimension(:) :: work
    +
    4737 integer(int32), intent(out), optional :: olwork
    +
    4738 class(errors), intent(inout), optional, target :: err
    +
    4739 end subroutine
    +
    4740
    +
    4741 module subroutine eigen_cmplx(a, vals, vecs, work, olwork, rwork, err)
    +
    4742 complex(real64), intent(inout), dimension(:,:) :: a
    +
    4743 complex(real64), intent(out), dimension(:) :: vals
    +
    4744 complex(real64), intent(out), optional, dimension(:,:) :: vecs
    +
    4745 complex(real64), intent(out), target, optional, dimension(:) :: work
    +
    4746 real(real64), intent(out), target, optional, dimension(:) :: rwork
    +
    4747 integer(int32), intent(out), optional :: olwork
    +
    4748 class(errors), intent(inout), optional, target :: err
    +
    4749 end subroutine
    +
    4750end interface
    +
    4751
    +
    4752! ******************************************************************************
    +
    4753! LINALG_SORTING.F90
    +
    4754! ------------------------------------------------------------------------------
    +
    4755interface
    +
    4756 module subroutine sort_dbl_array(x, ascend)
    +
    4757 real(real64), intent(inout), dimension(:) :: x
    +
    4758 logical, intent(in), optional :: ascend
    +
    4759 end subroutine
    +
    4760
    +
    4761 module subroutine sort_dbl_array_ind(x, ind, ascend, err)
    +
    4762 real(real64), intent(inout), dimension(:) :: x
    +
    4763 integer(int32), intent(inout), dimension(:) :: ind
    +
    4764 logical, intent(in), optional :: ascend
    +
    4765 class(errors), intent(inout), optional, target :: err
    +
    4766 end subroutine
    +
    4767
    +
    4768 module subroutine sort_cmplx_array(x, ascend)
    +
    4769 complex(real64), intent(inout), dimension(:) :: x
    +
    4770 logical, intent(in), optional :: ascend
    +
    4771 end subroutine
    +
    4772
    +
    4773 module subroutine sort_cmplx_array_ind(x, ind, ascend, err)
    +
    4774 complex(real64), intent(inout), dimension(:) :: x
    +
    4775 integer(int32), intent(inout), dimension(:) :: ind
    +
    4776 logical, intent(in), optional :: ascend
    +
    4777 class(errors), intent(inout), optional, target :: err
    +
    4778 end subroutine
    +
    4779
    +
    4780 module subroutine sort_eigen_cmplx(vals, vecs, ascend, err)
    +
    4781 complex(real64), intent(inout), dimension(:) :: vals
    +
    4782 complex(real64), intent(inout), dimension(:,:) :: vecs
    +
    4783 logical, intent(in), optional :: ascend
    +
    4784 class(errors), intent(inout), optional, target :: err
    +
    4785 end subroutine
    +
    4786
    +
    4787 module subroutine sort_eigen_dbl(vals, vecs, ascend, err)
    +
    4788 real(real64), intent(inout), dimension(:) :: vals
    +
    4789 real(real64), intent(inout), dimension(:,:) :: vecs
    +
    4790 logical, intent(in), optional :: ascend
    +
    4791 class(errors), intent(inout), optional, target :: err
    +
    4792 end subroutine
    +
    4793
    +
    4794end interface
    +
    4795
    +
    4796end module
    +
    Computes the Cholesky factorization of a symmetric, positive definite matrix.
    Definition: linalg.f90:1571
    +
    Computes the rank 1 downdate to a Cholesky factored matrix (upper triangular).
    Definition: linalg.f90:1777
    +
    Computes the rank 1 update to a Cholesky factored matrix (upper triangular).
    Definition: linalg.f90:1670
    +
    Computes the determinant of a square matrix.
    Definition: linalg.f90:568
    +
    Multiplies a diagonal matrix with another matrix or array.
    Definition: linalg.f90:463
    +
    Computes the eigenvalues, and optionally the eigenvectors, of a matrix.
    Definition: linalg.f90:3237
    +
    Forms the matrix Q with orthonormal rows from the elementary reflectors returned by the LQ factorizat...
    Definition: linalg.f90:3548
    +
    Extracts the L and U matrices from the condensed [L\U] storage format used by the lu_factor.
    Definition: linalg.f90:851
    +
    Forms the full M-by-M orthogonal matrix Q from the elementary reflectors returned by the base QR fact...
    Definition: linalg.f90:1165
    +
    Computes the LQ factorization of an M-by-N matrix.
    Definition: linalg.f90:3434
    +
    Computes the LU factorization of an M-by-N matrix.
    Definition: linalg.f90:729
    +
    Computes the inverse of a square matrix.
    Definition: linalg.f90:2917
    +
    Performs the matrix operation: .
    Definition: linalg.f90:293
    +
    Computes the Moore-Penrose pseudo-inverse of a M-by-N matrix using the singular value decomposition o...
    Definition: linalg.f90:3023
    +
    Computes the rank of a matrix.
    Definition: linalg.f90:535
    +
    Multiplies a general matrix by the orthogonal matrix Q from a LQ factorization.
    Definition: linalg.f90:3699
    +
    Multiplies a general matrix by the orthogonal matrix Q from a QR factorization.
    Definition: linalg.f90:1322
    +
    Multiplies a general matrix by the orthogonal matrix Z from an RZ factorization.
    Definition: linalg.f90:1941
    +
    Computes the QR factorization of an M-by-N matrix.
    Definition: linalg.f90:1005
    +
    Computes the rank 1 update to an M-by-N QR factored matrix A (M >= N) where , and such that ....
    Definition: linalg.f90:1472
    +
    Performs the rank-1 update to matrix A such that: , where is an M-by-N matrix, is a scalar,...
    Definition: linalg.f90:328
    +
    Multiplies a vector by the reciprocal of a real scalar.
    Definition: linalg.f90:609
    +
    Factors an upper trapezoidal matrix by means of orthogonal transformations such that ....
    Definition: linalg.f90:1850
    +
    Solves a system of Cholesky factored equations.
    Definition: linalg.f90:2529
    +
    Solves the overdetermined or underdetermined system of M equations of N unknowns,...
    Definition: linalg.f90:2720
    +
    Solves the overdetermined or underdetermined system of M equations of N unknowns using a singular va...
    Definition: linalg.f90:2822
    +
    Solves the overdetermined or underdetermined system of M equations of N unknowns....
    Definition: linalg.f90:2619
    +
    Solves a system of M LQ-factored equations of N unknowns. N must be greater than or equal to M.
    Definition: linalg.f90:3794
    +
    Solves a system of LU-factored equations.
    Definition: linalg.f90:2288
    +
    Solves a system of M QR-factored equations of N unknowns.
    Definition: linalg.f90:2423
    +
    Solves a triangular system of equations.
    Definition: linalg.f90:2200
    +
    Sorts an array.
    Definition: linalg.f90:3320
    +
    Computes the singular value decomposition of a matrix A. The SVD is defined as: , where is an M-by-M...
    Definition: linalg.f90:2066
    +
    Swaps the contents of two arrays.
    Definition: linalg.f90:590
    +
    Computes the trace of a matrix (the sum of the main diagonal elements).
    Definition: linalg.f90:487
    +
    Computes the triangular matrix operation: , or , where A is a triangular matrix.
    Definition: linalg.f90:643
    Provides a set of common linear algebra routines.
    Definition: linalg.f90:145
    diff --git a/doc/html/linalg_8h.html b/doc/html/linalg_8h.html index 0d163e24..ec5f4df2 100644 --- a/doc/html/linalg_8h.html +++ b/doc/html/linalg_8h.html @@ -262,6 +262,22 @@   int la_sort_eigen_cmplx (bool ascend, int n, double complex *vals, double complex *vecs, int ldv)   +int la_lq_factor (int m, int n, double *a, int lda, double *tau) +  +int la_lq_factor_cmplx (int m, int n, double complex *a, int lda, double complex *tau) +  +int la_form_lq (int m, int n, double *l, int ldl, const double *tau, double *q, int ldq) +  +int la_form_lq_cmplx (int m, int n, double complex *l, int ldl, const double complex *tau, double complex *q, int ldq) +  +int la_mult_lq (bool lside, bool trans, int m, int n, int k, const double *a, int lda, const double *tau, double *c, int ldc) +  +int la_mult_lq_cmplx (bool lside, bool trans, int m, int n, int k, const double complex *a, int lda, const double complex *tau, double complex *c, int ldc) +  +int la_solve_lq (int m, int n, int k, const double *a, int lda, const double *tau, double *b, int ldb) +  +int la_solve_lq_cmplx (int m, int n, int k, const double complex *a, int lda, const double complex *tau, double complex *b, int ldb) + 

    Macro Definition Documentation

    @@ -276,7 +292,7 @@

    -

    Definition at line 13 of file linalg.h.

    +

    Definition at line 200 of file linalg.h.

    @@ -292,7 +308,7 @@

    -

    Definition at line 17 of file linalg.h.

    +

    Definition at line 204 of file linalg.h.

    @@ -308,7 +324,7 @@

    -

    Definition at line 10 of file linalg.h.

    +

    Definition at line 197 of file linalg.h.

    @@ -324,7 +340,7 @@

    -

    Definition at line 12 of file linalg.h.

    +

    Definition at line 199 of file linalg.h.

    @@ -340,7 +356,7 @@

    -

    Definition at line 18 of file linalg.h.

    +

    Definition at line 205 of file linalg.h.

    @@ -356,7 +372,7 @@

    -

    Definition at line 15 of file linalg.h.

    +

    Definition at line 202 of file linalg.h.

    @@ -372,7 +388,7 @@

    -

    Definition at line 11 of file linalg.h.

    +

    Definition at line 198 of file linalg.h.

    @@ -388,7 +404,7 @@

    -

    Definition at line 8 of file linalg.h.

    +

    Definition at line 195 of file linalg.h.

    @@ -404,7 +420,7 @@

    -

    Definition at line 16 of file linalg.h.

    +

    Definition at line 203 of file linalg.h.

    @@ -420,7 +436,7 @@

    -

    Definition at line 14 of file linalg.h.

    +

    Definition at line 201 of file linalg.h.

    @@ -436,7 +452,7 @@

    -

    Definition at line 9 of file linalg.h.

    +

    Definition at line 196 of file linalg.h.

    @@ -1559,6 +1575,160 @@

    +

    ◆ la_form_lq()

    + +
    +
    + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
    int la_form_lq (int m,
    int n,
    double * l,
    int ldl,
    const double * tau,
    double * q,
    int ldq 
    )
    +
    +

    Forms the matrix Q with orthonormal rows from the elementary reflectors returned by the base QR factorization algorithm.

    +
    Parameters
    + + + + + + + + +
    mThe number of rows in R.
    nThe number of columns in R.
    lOn input, the M-by-N factored matrix as returned by the LQ factorization routine. On output, the lower triangular matrix L.
    ldlThe leading dimension of matrix L.
    tauA MIN(M, N)-element array containing the scalar factors of each elementary reflector defined in r.
    qAn M-by-N matrix where the Q matrix will be written.
    ldqThe leading dimension of matrix Q.
    +
    +
    +
    Returns
    An error code. The following codes are possible.
      +
    • LA_NO_ERROR: No error occurred. Successful operation.
    • +
    • LA_INVALID_INPUT_ERROR: Occurs if ldl or ldq are not correct.
    • +
    • LA_OUT_OF_MEMORY_ERROR: Occurs if there is insufficient memory available.
    • +
    +
    + +
    +
    + +

    ◆ la_form_lq_cmplx()

    + +
    +
    + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
    int la_form_lq_cmplx (int m,
    int n,
    double complex * l,
    int ldl,
    const double complex * tau,
    double complex * q,
    int ldq 
    )
    +
    +

    Forms the matrix Q with orthonormal rows from the elementary reflectors returned by the base QR factorization algorithm.

    +
    Parameters
    + + + + + + + + +
    mThe number of rows in R.
    nThe number of columns in R.
    lOn input, the M-by-N factored matrix as returned by the LQ factorization routine. On output, the lower triangular matrix L.
    ldlThe leading dimension of matrix L.
    tauA MIN(M, N)-element array containing the scalar factors of each elementary reflector defined in r.
    qAn M-by-N matrix where the Q matrix will be written.
    ldqThe leading dimension of matrix Q.
    +
    +
    +
    Returns
    An error code. The following codes are possible.
      +
    • LA_NO_ERROR: No error occurred. Successful operation.
    • +
    • LA_INVALID_INPUT_ERROR: Occurs if ldl or ldq are not correct.
    • +
    • LA_OUT_OF_MEMORY_ERROR: Occurs if there is insufficient memory available.
    • +
    +
    +
    @@ -1804,7 +1974,7 @@

    Returns
    An error code. The following codes are possible.
    • LA_NO_ERROR: No error occurred. Successful operation.
    • -
    • LA_INVALID_INPUT_ERROR: Occurs if lda is not correct.
    • +
    • LA_INVALID_INPUT_ERROR: Occurs if ldr or ldq are not correct.
    • LA_OUT_OF_MEMORY_ERROR: Occurs if there is insufficient memory available.
    @@ -1888,7 +2058,7 @@

    Returns
    An error code. The following codes are possible.
    • LA_NO_ERROR: No error occurred. Successful operation.
    • -
    • LA_INVALID_INPUT_ERROR: Occurs if lda is not correct.
    • +
    • LA_INVALID_INPUT_ERROR: Occurs if ldr or ldq are not correct.
    • LA_OUT_OF_MEMORY_ERROR: Occurs if there is insufficient memory available.
    @@ -2201,6 +2371,132 @@

    +

    ◆ la_lq_factor()

    + +
    +
    + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
    int la_lq_factor (int m,
    int n,
    double * a,
    int lda,
    double * tau 
    )
    +
    +

    Computes the LQ factorization of an M-by-N matrix without pivoting.

    +
    Parameters
    + + + + + + +
    mThe number of rows in the matrix.
    nThe number of columns in the matrix.
    aOn input, the M-by-N matrix to factor. On output, the elements on and above the diagonal contain the MIN(M, N)-by-N upper trapezoidal matrix R (R is upper triangular if M >= N). The elements below the diagonal, along with the array tau, represent the orthogonal matrix Q as a product of elementary reflectors.
    ldaThe leading dimension of matrix A.
    tauA MIN(M, N)-element array used to store the scalar factors of the elementary reflectors.
    +
    +
    +
    Returns
    An error code. The following codes are possible.
      +
    • LA_NO_ERROR: No error occurred. Successful operation.
    • +
    • LA_INVALID_INPUT_ERROR: Occurs if lda is not correct.
    • +
    • LA_OUT_OF_MEMORY_ERROR: Occurs if there is insufficient memory available.
    • +
    +
    + +
    +
    + +

    ◆ la_lq_factor_cmplx()

    + +
    +
    + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
    int la_lq_factor_cmplx (int m,
    int n,
    double complex * a,
    int lda,
    double complex * tau 
    )
    +
    +

    Computes the LQ factorization of an M-by-N matrix without pivoting.

    +
    Parameters
    + + + + + + +
    mThe number of rows in the matrix.
    nThe number of columns in the matrix.
    aOn input, the M-by-N matrix to factor. On output, the elements on and above the diagonal contain the MIN(M, N)-by-N upper trapezoidal matrix R (R is upper triangular if M >= N). The elements below the diagonal, along with the array tau, represent the orthogonal matrix Q as a product of elementary reflectors.
    ldaThe leading dimension of matrix A.
    tauA MIN(M, N)-element array used to store the scalar factors of the elementary reflectors.
    +
    +
    +
    Returns
    An error code. The following codes are possible.
      +
    • LA_NO_ERROR: No error occurred. Successful operation.
    • +
    • LA_INVALID_INPUT_ERROR: Occurs if lda is not correct.
    • +
    • LA_OUT_OF_MEMORY_ERROR: Occurs if there is insufficient memory available.
    • +
    +
    +
    @@ -2374,32 +2670,250 @@

    - const double *  - a, + const double *  + a, + + + + + int  + lda, + + + + + const double *  + b, + + + + + int  + ldb, + + + + + double  + beta, + + + + + double *  + c, + + + + + int  + ldc  + + + + ) + + + +
    +

    Computes the matrix operation \( C = \alpha op(A) op(B) + \beta C \).

    +
    Parameters
    + + + + + + + + + + + + + + +
    transaSet to true to compute op(A) as the transpose of A; else, set to false to compute op(A) as A.
    transbSet to true to compute op(B) as the transpose of B; else, set to false to compute op(B) as B.
    mThe number of rows in c.
    nThe number of columns in c.
    kThe interior dimension of the product a and b.
    alphaA scalar multiplier.
    aIf transa is true, this matrix must be k by m; else, if transa is false, this matrix must be m by k.
    ldaThe leading dimension of matrix a.
    bIf transb is true, this matrix must be n by k; else, if transb is false, this matrix must be k by n.
    ldbThe leading dimension of matrix b.
    betaA scalar multiplier.
    cThe m by n matrix C.
    ldcThe leading dimension of matrix c.
    +
    +
    +
    Returns
    An error code. The following codes are possible.
      +
    • LA_NO_ERROR: No error occurred. Successful operation.
    • +
    • LA_INVALID_INPUT_ERROR: Occurs if lda, ldb, or ldc are not correct.
    • +
    +
    + +
    + +
    +

    ◆ la_mtx_mult_cmplx()

    + +
    +
    + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
    int la_mtx_mult_cmplx (int opa,
    int opb,
    int m,
    int n,
    int k,
    double complex alpha,
    const double complex * a,
    int lda,
    const double complex * b,
    int ldb,
    double complex beta,
    double complex * c,
    int ldc 
    )
    +
    +

    Computes the matrix operation \( C = \alpha op(A) op(B) + \beta C \).

    +
    Parameters
    + + + + + + + + + + + + + + +
    opaSet to LA_TRANSPOSE to compute op(A) as a direct transpose of A, set to LA_HERMITIAN_TRANSPOSE to compute op(A) as the Hermitian transpose of A, otherwise, set to LA_NO_OPERATION to compute op(A) as A.
    opbSet to TLA_RANSPOSE to compute op(B) as a direct transpose of B, set to LA_HERMITIAN_TRANSPOSE to compute op(B) as the Hermitian transpose of B, otherwise, set to LA_NO_OPERATION to compute op(B) as B.
    mThenumber of rows in c.
    nThe number of columns in c.
    kThe interior dimension of the product a and b.
    alphaA scalar multiplier.
    aIf opa is LA_TRANSPOSE or LA_HERMITIAN_TRANSPOSE, this matrix must be k by m; else, this matrix must be m by k.
    ldaThe leading dimension of matrix a.
    bIf opb is LA_TRANSPOSE or LA_HERMITIAN_TRANSPOSE, this matrix must be n by k; else, this matrix must be k by n.
    ldbThe leading dimension of matrix b.
    betaA scalar multiplier.
    cThe m by n matrix C.
    ldcThe leading dimension of matrix c.
    +
    +
    +
    Returns
    An error code. The following codes are possible.
      +
    • LA_NO_ERROR: No error occurred. Successful operation.
    • +
    • LA_INVALID_INPUT_ERROR: Occurs if lda, ldb, or ldc are not correct.
    • +
    +
    + +
    +
    + +

    ◆ la_mult_lq()

    + +
    +
    + + + + + + + + + + + + + + + + + + + + + + + + - + - + - + - - + + @@ -2420,50 +2934,48 @@

    -

    Computes the matrix operation \( C = \alpha op(A) op(B) + \beta C \).

    +

    Multiplies a general matrix by the orthogonal matrix Q from a LQ factorization such that: \( C = op(Q) C \), or \( C = C op(Q) \).

    Parameters

    int la_mult_lq (bool lside,
    bool trans,
    int m,
    int n,
    int lda, k,
    const double * b, a,
    int ldb, lda,
    double beta, const double * tau,
    - - - - - - - - - - - - - + + + + + + + + + +
    transaSet to true to compute op(A) as the transpose of A; else, set to false to compute op(A) as A.
    transbSet to true to compute op(B) as the transpose of B; else, set to false to compute op(B) as B.
    mThe number of rows in c.
    nThe number of columns in c.
    kThe interior dimension of the product a and b.
    alphaA scalar multiplier.
    aIf transa is true, this matrix must be k by m; else, if transa is false, this matrix must be m by k.
    ldaThe leading dimension of matrix a.
    bIf transb is true, this matrix must be n by k; else, if transb is false, this matrix must be k by n.
    ldbThe leading dimension of matrix b.
    betaA scalar multiplier.
    cThe m by n matrix C.
    ldcThe leading dimension of matrix c.
    lsideSet to true to apply \( Q \) or \( Q^T \) from the left; else, set to false to apply \( Q \) or \( Q^T \) from the right.
    transSet to true to apply \( Q^T \); else, set to false.
    mThe number of rows in matrix C.
    nThe number of columns in matrix C.
    kThe number of elementary reflectors whose product defines the matrix Q.
    aOn input, an LDA-by-K matrix containing the elementary reflectors output from the LQ factorization. If lside is set to true, LDA = M, and M >= K >= 0; else, if lside is set to false, LDA = N, and N >= K >= 0. Notice, the contents of this matrix are restored on exit.
    ldaThe leading dimension of matrix A.
    tauA K-element array containing the scalar factors of each elementary reflector defined in a.
    cOn input, the M-by-N matrix C. On output, the product of the orthogonal matrix Q and the original matrix C.
    ldcThe leading dimension of matrix C.
    Returns
    An error code. The following codes are possible.
    • LA_NO_ERROR: No error occurred. Successful operation.
    • -
    • LA_INVALID_INPUT_ERROR: Occurs if lda, ldb, or ldc are not correct.
    • +
    • LA_INVALID_INPUT_ERROR: Occurs if lda or ldc are not correct.
    • +
    • LA_OUT_OF_MEMORY_ERROR: Occurs if there is insufficient memory available.
    - -

    ◆ la_mtx_mult_cmplx()

    + +

    ◆ la_mult_lq_cmplx()

    - + - - + + - - + + @@ -2483,12 +2995,6 @@

    int 

    - - - - - - @@ -2505,19 +3011,7 @@

    - - - - - - - - - - - - - + @@ -2538,28 +3032,26 @@

    -

    Computes the matrix operation \( C = \alpha op(A) op(B) + \beta C \).

    +

    Multiplies a general matrix by the orthogonal matrix Q from a LQ factorization such that: \( C = op(Q) C \), or \( C = C op(Q) \).

    Parameters

    int la_mtx_mult_cmplx int la_mult_lq_cmplx (int opa, bool lside,
    int opb, bool trans,
    k,
    double complex alpha,
    const double complex * b,
    int ldb,
    double complex beta, tau,
    - - - - - - - - - - - - - + + + + + + + + + +
    opaSet to LA_TRANSPOSE to compute op(A) as a direct transpose of A, set to LA_HERMITIAN_TRANSPOSE to compute op(A) as the Hermitian transpose of A, otherwise, set to LA_NO_OPERATION to compute op(A) as A.
    opbSet to TLA_RANSPOSE to compute op(B) as a direct transpose of B, set to LA_HERMITIAN_TRANSPOSE to compute op(B) as the Hermitian transpose of B, otherwise, set to LA_NO_OPERATION to compute op(B) as B.
    mThenumber of rows in c.
    nThe number of columns in c.
    kThe interior dimension of the product a and b.
    alphaA scalar multiplier.
    aIf opa is LA_TRANSPOSE or LA_HERMITIAN_TRANSPOSE, this matrix must be k by m; else, this matrix must be m by k.
    ldaThe leading dimension of matrix a.
    bIf opb is LA_TRANSPOSE or LA_HERMITIAN_TRANSPOSE, this matrix must be n by k; else, this matrix must be k by n.
    ldbThe leading dimension of matrix b.
    betaA scalar multiplier.
    cThe m by n matrix C.
    ldcThe leading dimension of matrix c.
    lsideSet to true to apply \( Q \) or \( Q^H \) from the left; else, set to false to apply \( Q \) or \( Q^H \) from the right.
    transSet to true to apply \( Q^H \); else, set to false.
    mThe number of rows in matrix C.
    nThe number of columns in matrix C.
    kThe number of elementary reflectors whose product defines the matrix Q.
    aOn input, an LDA-by-K matrix containing the elementary reflectors output from the LQ factorization. If lside is set to true, LDA = M, and M >= K >= 0; else, if lside is set to false, LDA = N, and N >= K >= 0. Notice, the contents of this matrix are restored on exit.
    ldaThe leading dimension of matrix A.
    tauA K-element array containing the scalar factors of each elementary reflector defined in a.
    cOn input, the M-by-N matrix C. On output, the product of the orthogonal matrix Q and the original matrix C.
    ldcThe leading dimension of matrix C.
    Returns
    An error code. The following codes are possible.
    • LA_NO_ERROR: No error occurred. Successful operation.
    • -
    • LA_INVALID_INPUT_ERROR: Occurs if lda, ldb, or ldc are not correct.
    • +
    • LA_INVALID_INPUT_ERROR: Occurs if lda or ldc are not correct.
    • +
    • LA_OUT_OF_MEMORY_ERROR: Occurs if there is insufficient memory available.
    @@ -2650,13 +3142,13 @@

    ldaThe leading dimension of matrix A. tauA K-element array containing the scalar factors of each elementary reflector defined in a. cOn input, the M-by-N matrix C. On output, the product of the orthogonal matrix Q and the original matrix C. - ldcTHe leading dimension of matrix C. + ldcThe leading dimension of matrix C.
    Returns
    An error code. The following codes are possible.
    • LA_NO_ERROR: No error occurred. Successful operation.
    • -
    • LA_INVALID_INPUT_ERROR: Occurs if lda is not correct.
    • +
    • LA_INVALID_INPUT_ERROR: Occurs if lda or ldc are not correct.
    • LA_OUT_OF_MEMORY_ERROR: Occurs if there is insufficient memory available.
    @@ -2748,13 +3240,13 @@

    ldaThe leading dimension of matrix A. tauA K-element array containing the scalar factors of each elementary reflector defined in a. cOn input, the M-by-N matrix C. On output, the product of the orthogonal matrix Q and the original matrix C. - ldcTHe leading dimension of matrix C. + ldcThe leading dimension of matrix C.
    Returns
    An error code. The following codes are possible.
    • LA_NO_ERROR: No error occurred. Successful operation.
    • -
    • LA_INVALID_INPUT_ERROR: Occurs if lda is not correct.
    • +
    • LA_INVALID_INPUT_ERROR: Occurs if lda or ldc are not correct.
    • LA_OUT_OF_MEMORY_ERROR: Occurs if there is insufficient memory available.
    @@ -3917,6 +4409,174 @@

    +

    ◆ la_solve_lq()

    + +
    +
    + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
    int la_solve_lq (int m,
    int n,
    int k,
    const double * a,
    int lda,
    const double * tau,
    double * b,
    int ldb 
    )
    +
    +

    Solves a system of M QR-factored equations of N unknowns where N >= M.

    +
    Parameters
    + + + + + + + + + +
    mThe number of equations (rows in matrix A).
    nThe number of unknowns (columns in matrix A).
    kThe number of columns in the right-hand-side matrix.
    aOn input, the M-by-N QR factored matrix as returned by lq_factor.
    ldaThe leading dimension of matrix A.
    tauA MIN(M, N)-element array containing the scalar factors of the elementary reflectors as returned by lq_factor.
    bOn input, an N-by-K matrix containing the first M rows of the right-hand-side matrix. On output, the solution matrix X.
    ldbThe leading dimension of matrix B.
    +
    +
    +
    Returns
    An error code. The following codes are possible.
      +
    • LA_NO_ERROR: No error occurred. Successful operation.
    • +
    • LA_INVALID_INPUT_ERROR: Occurs if lda, or ldb is not correct, or if m is less than n.
    • +
    • LA_OUT_OF_MEMORY_ERROR: Occurs if local memory must be allocated, and there is insufficient memory available.
    • +
    +
    + +
    +
    + +

    ◆ la_solve_lq_cmplx()

    + +
    +
    + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
    int la_solve_lq_cmplx (int m,
    int n,
    int k,
    const double complex * a,
    int lda,
    const double complex * tau,
    double complex * b,
    int ldb 
    )
    +
    +

    Solves a system of M QR-factored equations of N unknowns where N >= M.

    +
    Parameters
    + + + + + + + + + +
    mThe number of equations (rows in matrix A).
    nThe number of unknowns (columns in matrix A).
    kThe number of columns in the right-hand-side matrix.
    aOn input, the M-by-N QR factored matrix as returned by lq_factor.
    ldaThe leading dimension of matrix A.
    tauA MIN(M, N)-element array containing the scalar factors of the elementary reflectors as returned by lq_factor.
    bOn input, an N-by-K matrix containing the first M rows of the right-hand-side matrix. On output, the solution matrix X.
    ldbThe leading dimension of matrix B.
    +
    +
    +
    Returns
    An error code. The following codes are possible.
      +
    • LA_NO_ERROR: No error occurred. Successful operation.
    • +
    • LA_INVALID_INPUT_ERROR: Occurs if lda, or ldb is not correct, or if m is less than n.
    • +
    • LA_OUT_OF_MEMORY_ERROR: Occurs if local memory must be allocated, and there is insufficient memory available.
    • +
    +
    +
    diff --git a/doc/html/linalg_8h.js b/doc/html/linalg_8h.js index 32aee583..d3bd2485 100644 --- a/doc/html/linalg_8h.js +++ b/doc/html/linalg_8h.js @@ -15,6 +15,8 @@ var linalg_8h = [ "la_eigen_cmplx", "linalg_8h.html#ae5a16375c14c924836c33bafa747a1cf", null ], [ "la_eigen_gen", "linalg_8h.html#af3c6f1a45aee2f275d4b109c9bb660d2", null ], [ "la_eigen_symm", "linalg_8h.html#ac208d5e6849972a77ef261f2e368868c", null ], + [ "la_form_lq", "linalg_8h.html#ac54763802ad5c3966f8e14cdf93fdc96", null ], + [ "la_form_lq_cmplx", "linalg_8h.html#aa54b8d224976dca7ef384eed74f50bed", null ], [ "la_form_lu", "linalg_8h.html#a15774f6323c34d307c99b32ac4f188a7", null ], [ "la_form_lu_cmplx", "linalg_8h.html#a73bea3ca338925cfa4a58bcaea726a14", null ], [ "la_form_qr", "linalg_8h.html#afe39765d805c1d9ae93e9aa2f20d8548", null ], @@ -23,10 +25,14 @@ var linalg_8h = [ "la_form_qr_pvt", "linalg_8h.html#aace787c5b11959a457b936ace4995033", null ], [ "la_inverse", "linalg_8h.html#a95d6ed56844c62d553b940091837014b", null ], [ "la_inverse_cmplx", "linalg_8h.html#a7a821b41c61670f5710214a4d9178998", null ], + [ "la_lq_factor", "linalg_8h.html#a7b2048bb219e58f455175041558ac44f", null ], + [ "la_lq_factor_cmplx", "linalg_8h.html#a5e6786c40f8f91e5f16f06e92be71ffa", null ], [ "la_lu_factor", "linalg_8h.html#a248142a5f0826cddac5daf1c74f234a6", null ], [ "la_lu_factor_cmplx", "linalg_8h.html#ace554b62c12a5d9a2434c8171c756c47", null ], [ "la_mtx_mult", "linalg_8h.html#a968b10545320af7bbe1030867ae88e8c", null ], [ "la_mtx_mult_cmplx", "linalg_8h.html#aefefe80e13f74470d5afaf44b3a45e76", null ], + [ "la_mult_lq", "linalg_8h.html#ac575e10e20e9c2d8d40ed8df47179773", null ], + [ "la_mult_lq_cmplx", "linalg_8h.html#adcb07293cf47d090dfb89c20837ca7b5", null ], [ "la_mult_qr", "linalg_8h.html#a95f921847131eaedd62a439490d2a801", null ], [ "la_mult_qr_cmplx", "linalg_8h.html#acc25c0daa53c10ace21a61d78b2e79f3", null ], [ "la_pinverse", "linalg_8h.html#af7f8185c0f25ad3fb0b89cc98d77b3d6", null ], @@ -45,6 +51,8 @@ var linalg_8h = [ "la_solve_cholesky_cmplx", "linalg_8h.html#a719ffdff56c8fa0875409c4f4e5e95cf", null ], [ "la_solve_least_squares", "linalg_8h.html#a02eb049983dd41f2307bb52594fb210e", null ], [ "la_solve_least_squares_cmplx", "linalg_8h.html#ac3bb7b959d8cc7400e9b13290a895b64", null ], + [ "la_solve_lq", "linalg_8h.html#a2c485d619c24435be713cf4356285e9a", null ], + [ "la_solve_lq_cmplx", "linalg_8h.html#a54ee9d9ab89b88b0ca682f70bc6c3c54", null ], [ "la_solve_lu", "linalg_8h.html#aae725d3247301d1163c58f89edff3d4b", null ], [ "la_solve_lu_cmplx", "linalg_8h.html#aa067ac0d3f58e28371d413ab7419da74", null ], [ "la_solve_qr", "linalg_8h.html#aefdc2e6758482d02a3aa7978f7d5efe0", null ], diff --git a/doc/html/linalg_8h_source.html b/doc/html/linalg_8h_source.html index 7eba137e..8571d88e 100644 --- a/doc/html/linalg_8h_source.html +++ b/doc/html/linalg_8h_source.html @@ -101,208 +101,232 @@

    Go to the documentation of this file.
    1
    -
    2#ifndef LINALG_H_DEFINED
    -
    3#define LINALG_H_DEFINED
    -
    4
    -
    5#include <stdbool.h>
    -
    6#include <complex.h>
    -
    7
    -
    8#define LA_NO_OPERATION 0
    -
    9#define LA_TRANSPOSE 1
    -
    10#define LA_HERMITIAN_TRANSPOSE 2
    -
    11#define LA_NO_ERROR 0
    -
    12#define LA_INVALID_INPUT_ERROR 101
    -
    13#define LA_ARRAY_SIZE_ERROR 102
    -
    14#define LA_SINGULAR_MATRIX_ERROR 103
    -
    15#define LA_MATRIX_FORMAT_ERROR 104
    -
    16#define LA_OUT_OF_MEMORY_ERROR 105
    -
    17#define LA_CONVERGENCE_ERROR 106
    -
    18#define LA_INVALID_OPERATION_ERROR 107
    -
    19
    -
    20#ifdef __cplusplus
    -
    21extern "C" {
    -
    22#endif
    -
    23
    -
    43int la_rank1_update(int m, int n, double alpha, const double *x,
    -
    44 const double *y, double *a, int lda);
    -
    45
    -
    65int la_rank1_update_cmplx(int m, int n, double complex alpha,
    -
    66 const double complex *x, const double complex *y, double complex *a,
    -
    67 int lda);
    -
    68
    -
    83int la_trace(int m, int n, const double *a, int lda, double *rst);
    -
    84
    -
    99int la_trace_cmplx(int m, int n, const double complex *a, int lda,
    -
    100 double complex *rst);
    -
    101
    -
    128int la_mtx_mult(bool transa, bool transb, int m, int n, int k, double alpha,
    -
    129 const double *a, int lda, const double *b, int ldb, double beta,
    -
    130 double *c, int ldc);
    -
    131
    -
    160int la_mtx_mult_cmplx(int opa, int opb, int m, int n, int k,
    -
    161 double complex alpha, const double complex *a, int lda,
    -
    162 const double complex *b, int ldb, double complex beta, double complex *c,
    -
    163 int ldc);
    -
    164
    -
    198int la_diag_mtx_mult(bool lside, bool transb, int m, int n, int k,
    -
    199 double alpha, const double *a, const double *b, int ldb, double beta,
    -
    200 double *c, int ldc);
    -
    201
    -
    236int la_diag_mtx_mult_cmplx(bool lside, int opb, int m, int n, int k,
    -
    237 double complex alpha, const double complex *a, const double complex *b,
    -
    238 int ldb, double complex beta, double complex *c, int ldc);
    -
    239
    -
    274int la_diag_mtx_mult_mixed(bool lside, int opb, int m, int n, int k,
    -
    275 double complex alpha, const double *a, const double complex *b,
    -
    276 int ldb, double complex beta, double complex *c, int ldc);
    -
    277
    -
    296int la_rank(int m, int n, double *a, int lda, int *rnk);
    -
    297
    -
    316int la_rank_cmplx(int m, int n, double complex *a, int lda, int *rnk);
    -
    317
    -
    333int la_det(int n, double *a, int lda, double *d);
    -
    334
    -
    350int la_det_cmplx(int n, double complex *a, int lda, double complex *d);
    +
    189#ifndef LINALG_H_DEFINED
    +
    190#define LINALG_H_DEFINED
    +
    191
    +
    192#include <stdbool.h>
    +
    193#include <complex.h>
    +
    194
    +
    195#define LA_NO_OPERATION 0
    +
    196#define LA_TRANSPOSE 1
    +
    197#define LA_HERMITIAN_TRANSPOSE 2
    +
    198#define LA_NO_ERROR 0
    +
    199#define LA_INVALID_INPUT_ERROR 101
    +
    200#define LA_ARRAY_SIZE_ERROR 102
    +
    201#define LA_SINGULAR_MATRIX_ERROR 103
    +
    202#define LA_MATRIX_FORMAT_ERROR 104
    +
    203#define LA_OUT_OF_MEMORY_ERROR 105
    +
    204#define LA_CONVERGENCE_ERROR 106
    +
    205#define LA_INVALID_OPERATION_ERROR 107
    +
    206
    +
    207#ifdef __cplusplus
    +
    208extern "C" {
    +
    209#endif
    +
    210
    +
    230int la_rank1_update(int m, int n, double alpha, const double *x,
    +
    231 const double *y, double *a, int lda);
    +
    232
    +
    252int la_rank1_update_cmplx(int m, int n, double complex alpha,
    +
    253 const double complex *x, const double complex *y, double complex *a,
    +
    254 int lda);
    +
    255
    +
    270int la_trace(int m, int n, const double *a, int lda, double *rst);
    +
    271
    +
    286int la_trace_cmplx(int m, int n, const double complex *a, int lda,
    +
    287 double complex *rst);
    +
    288
    +
    315int la_mtx_mult(bool transa, bool transb, int m, int n, int k, double alpha,
    +
    316 const double *a, int lda, const double *b, int ldb, double beta,
    +
    317 double *c, int ldc);
    +
    318
    +
    347int la_mtx_mult_cmplx(int opa, int opb, int m, int n, int k,
    +
    348 double complex alpha, const double complex *a, int lda,
    +
    349 const double complex *b, int ldb, double complex beta, double complex *c,
    +
    350 int ldc);
    351
    -
    377int la_tri_mtx_mult(bool upper, double alpha, int n, const double *a, int lda,
    -
    378 double beta, double *b, int ldb);
    -
    379
    -
    405int la_tri_mtx_mult_cmplx(bool upper, double complex alpha, int n,
    -
    406 const double complex *a, int lda, double complex beta,
    -
    407 double complex *b, int ldb);
    -
    408
    -
    428int la_lu_factor(int m, int n, double *a, int lda, int *ipvt);
    -
    429
    -
    449int la_lu_factor_cmplx(int m, int n, double complex *a, int lda, int *ipvt);
    -
    450
    -
    472int la_form_lu(int n, double *a, int lda, int *ipvt, double *u, int ldu,
    -
    473 double *p, int ldp);
    -
    474
    -
    496int la_form_lu_cmplx(int n, double complex *a, int lda, int *ipvt,
    -
    497 double complex *u, int ldu, double *p, int ldp);
    -
    498
    -
    520int la_qr_factor(int m, int n, double *a, int lda, double *tau);
    +
    385int la_diag_mtx_mult(bool lside, bool transb, int m, int n, int k,
    +
    386 double alpha, const double *a, const double *b, int ldb, double beta,
    +
    387 double *c, int ldc);
    +
    388
    +
    423int la_diag_mtx_mult_cmplx(bool lside, int opb, int m, int n, int k,
    +
    424 double complex alpha, const double complex *a, const double complex *b,
    +
    425 int ldb, double complex beta, double complex *c, int ldc);
    +
    426
    +
    461int la_diag_mtx_mult_mixed(bool lside, int opb, int m, int n, int k,
    +
    462 double complex alpha, const double *a, const double complex *b,
    +
    463 int ldb, double complex beta, double complex *c, int ldc);
    +
    464
    +
    483int la_rank(int m, int n, double *a, int lda, int *rnk);
    +
    484
    +
    503int la_rank_cmplx(int m, int n, double complex *a, int lda, int *rnk);
    +
    504
    +
    520int la_det(int n, double *a, int lda, double *d);
    521
    -
    543int la_qr_factor_cmplx(int m, int n, double complex *a, int lda,
    -
    544 double complex *tau);
    -
    545
    -
    570int la_qr_factor_pvt(int m, int n, double *a, int lda, double *tau, int *jpvt);
    -
    571
    -
    596int la_qr_factor_cmplx_pvt(int m, int n, double complex *a, int lda,
    -
    597 double complex *tau, int *jpvt);
    -
    598
    -
    625int la_form_qr(bool fullq, int m, int n, double *r, int ldr, const double *tau,
    -
    626 double *q, int ldq);
    -
    627
    -
    654int la_form_qr_cmplx(bool fullq, int m, int n, double complex *r, int ldr,
    -
    655 const double complex *tau, double complex *q, int ldq);
    -
    656
    -
    689int la_form_qr_pvt(bool fullq, int m, int n, double *r, int ldr,
    -
    690 const double *tau, const int *pvt, double *q, int ldq, double *p, int ldp);
    -
    691
    -
    724int la_form_qr_cmplx_pvt(bool fullq, int m, int n, double complex *r, int ldr,
    -
    725 const double complex *tau, const int *pvt, double complex *q, int ldq,
    -
    726 double complex *p, int ldp);
    -
    727
    -
    757int la_mult_qr(bool lside, bool trans, int m, int n, int k, double *a, int lda,
    -
    758 const double *tau, double *c, int ldc);
    -
    759
    -
    789int la_mult_qr_cmplx(bool lside, bool trans, int m, int n, int k,
    -
    790 double complex *a, int lda, const double complex *tau, double complex *c,
    -
    791 int ldc);
    -
    792
    -
    817int la_qr_rank1_update(int m, int n, double *q, int ldq, double *r, int ldr,
    -
    818 double *u, double *v);
    -
    819
    -
    844int la_qr_rank1_update_cmplx(int m, int n, double complex *q, int ldq,
    -
    845 double complex *r, int ldr, double complex *u, double complex *v);
    -
    846
    -
    865int la_cholesky_factor(bool upper, int n, double *a, int lda);
    -
    866
    -
    885int la_cholesky_factor_cmplx(bool upper, int n, double complex *a, int lda);
    -
    886
    -
    904int la_cholesky_rank1_update(int n, double *r, int ldr, double *u);
    -
    905
    -
    923int la_cholesky_rank1_update_cmplx(int n, double complex *r, int ldr,
    -
    924 double complex *u);
    -
    925
    -
    945int la_cholesky_rank1_downdate(int n, double *r, int ldr, double *u);
    +
    537int la_det_cmplx(int n, double complex *a, int lda, double complex *d);
    +
    538
    +
    564int la_tri_mtx_mult(bool upper, double alpha, int n, const double *a, int lda,
    +
    565 double beta, double *b, int ldb);
    +
    566
    +
    592int la_tri_mtx_mult_cmplx(bool upper, double complex alpha, int n,
    +
    593 const double complex *a, int lda, double complex beta,
    +
    594 double complex *b, int ldb);
    +
    595
    +
    615int la_lu_factor(int m, int n, double *a, int lda, int *ipvt);
    +
    616
    +
    636int la_lu_factor_cmplx(int m, int n, double complex *a, int lda, int *ipvt);
    +
    637
    +
    659int la_form_lu(int n, double *a, int lda, int *ipvt, double *u, int ldu,
    +
    660 double *p, int ldp);
    +
    661
    +
    683int la_form_lu_cmplx(int n, double complex *a, int lda, int *ipvt,
    +
    684 double complex *u, int ldu, double *p, int ldp);
    +
    685
    +
    707int la_qr_factor(int m, int n, double *a, int lda, double *tau);
    +
    708
    +
    730int la_qr_factor_cmplx(int m, int n, double complex *a, int lda,
    +
    731 double complex *tau);
    +
    732
    +
    757int la_qr_factor_pvt(int m, int n, double *a, int lda, double *tau, int *jpvt);
    +
    758
    +
    783int la_qr_factor_cmplx_pvt(int m, int n, double complex *a, int lda,
    +
    784 double complex *tau, int *jpvt);
    +
    785
    +
    812int la_form_qr(bool fullq, int m, int n, double *r, int ldr, const double *tau,
    +
    813 double *q, int ldq);
    +
    814
    +
    841int la_form_qr_cmplx(bool fullq, int m, int n, double complex *r, int ldr,
    +
    842 const double complex *tau, double complex *q, int ldq);
    +
    843
    +
    876int la_form_qr_pvt(bool fullq, int m, int n, double *r, int ldr,
    +
    877 const double *tau, const int *pvt, double *q, int ldq, double *p, int ldp);
    +
    878
    +
    911int la_form_qr_cmplx_pvt(bool fullq, int m, int n, double complex *r, int ldr,
    +
    912 const double complex *tau, const int *pvt, double complex *q, int ldq,
    +
    913 double complex *p, int ldp);
    +
    914
    +
    944int la_mult_qr(bool lside, bool trans, int m, int n, int k, double *a, int lda,
    +
    945 const double *tau, double *c, int ldc);
    946
    -
    966int la_cholesky_rank1_downdate_cmplx(int n, double complex *r, int ldr,
    -
    967 double complex *u);
    -
    968
    -
    998int la_svd(int m, int n, double *a, int lda, double *s, double *u, int ldu,
    -
    999 double *vt, int ldv);
    -
    1000
    -
    1030int la_svd_cmplx(int m, int n, double complex *a, int lda, double *s,
    -
    1031 double complex *u, int ldu, double complex *vt, int ldv);
    -
    1032
    -
    1061int la_solve_tri_mtx(bool lside, bool upper, bool trans, bool nounit, int m,
    -
    1062 int n, double alpha, const double *a, int lda, double *b, int ldb);
    -
    1063
    -
    1092int la_solve_tri_mtx_cmplx(bool lside, bool upper, bool trans, bool nounit,
    -
    1093 int m, int n, double complex alpha, const double complex *a, int lda,
    -
    1094 double complex *b, int ldb);
    -
    1095
    -
    1112int la_solve_lu(int m, int n, const double *a, int lda, const int *ipvt,
    -
    1113 double *b, int ldb);
    -
    1114
    -
    1131int la_solve_lu_cmplx(int m, int n, const double complex *a, int lda,
    -
    1132 const int *ipvt, double complex *b, int ldb);
    +
    976int la_mult_qr_cmplx(bool lside, bool trans, int m, int n, int k,
    +
    977 double complex *a, int lda, const double complex *tau, double complex *c,
    +
    978 int ldc);
    +
    979
    +
    1004int la_qr_rank1_update(int m, int n, double *q, int ldq, double *r, int ldr,
    +
    1005 double *u, double *v);
    +
    1006
    +
    1031int la_qr_rank1_update_cmplx(int m, int n, double complex *q, int ldq,
    +
    1032 double complex *r, int ldr, double complex *u, double complex *v);
    +
    1033
    +
    1052int la_cholesky_factor(bool upper, int n, double *a, int lda);
    +
    1053
    +
    1072int la_cholesky_factor_cmplx(bool upper, int n, double complex *a, int lda);
    +
    1073
    +
    1091int la_cholesky_rank1_update(int n, double *r, int ldr, double *u);
    +
    1092
    +
    1110int la_cholesky_rank1_update_cmplx(int n, double complex *r, int ldr,
    +
    1111 double complex *u);
    +
    1112
    +
    1132int la_cholesky_rank1_downdate(int n, double *r, int ldr, double *u);
    1133
    -
    1157int la_solve_qr(int m, int n, int k, double *a, int lda, const double *tau,
    -
    1158 double *b, int ldb);
    -
    1159
    -
    1183int la_solve_qr_cmplx(int m, int n, int k, double complex *a, int lda,
    -
    1184 const double complex *tau, double complex *b, int ldb);
    -
    1185
    -
    1209int la_solve_qr_pvt(int m, int n, int k, double *a, int lda, const double *tau,
    -
    1210 const int *jpvt, double *b, int ldb);
    -
    1211
    -
    1235int la_solve_qr_cmplx_pvt(int m, int n, int k, double complex *a, int lda,
    -
    1236 const double complex *tau, const int *jpvt, double complex *b, int ldb);
    -
    1237
    -
    1256int la_solve_cholesky(bool upper, int m, int n, const double *a, int lda,
    -
    1257 double *b, int ldb);
    -
    1258
    -
    1277int la_solve_cholesky_cmplx(bool upper, int m, int n, const double complex *a,
    -
    1278 int lda, double complex *b, int ldb);
    -
    1279
    -
    1305int la_solve_least_squares(int m, int n, int k, double *a, int lda, double *b,
    -
    1306 int ldb);
    -
    1307
    -
    1333int la_solve_least_squares_cmplx(int m, int n, int k, double complex *a,
    -
    1334 int lda, double complex *b, int ldb);
    -
    1335
    -
    1349int la_inverse(int n, double *a, int lda);
    -
    1350
    -
    1364int la_inverse_cmplx(int n, double complex *a, int lda);
    -
    1365
    -
    1383int la_pinverse(int m, int n, double *a, int lda, double *ainv, int ldai);
    -
    1384
    -
    1402int la_pinverse_cmplx(int m, int n, double complex *a, int lda,
    -
    1403 double complex *ainv, int ldai);
    -
    1404
    -
    1428int la_eigen_symm(bool vecs, int n, double *a, int lda, double *vals);
    -
    1429
    -
    1452int la_eigen_asymm(bool vecs, int n, double *a, int lda,
    -
    1453 double complex *vals, double complex *v, int ldv);
    -
    1454
    -
    1487int la_eigen_gen(bool vecs, int n, double *a, int lda, double *b, int ldb,
    -
    1488 double complex *alpha, double *beta, double complex *v, int ldv);
    -
    1489
    -
    1512int la_eigen_cmplx(bool vecs, int n, double complex *a, int lda,
    -
    1513 double complex *vals, double complex *v, int ldv);
    -
    1514
    -
    1534int la_sort_eigen(bool ascend, int n, double *vals, double *vecs, int ldv);
    -
    1535
    -
    1555int la_sort_eigen_cmplx(bool ascend, int n, double complex *vals,
    -
    1556 double complex *vecs, int ldv);
    -
    1557
    -
    1558#ifdef __cplusplus
    -
    1559}
    -
    1560#endif // __cplusplus
    -
    1561#endif // LINALG_H_DEFINED
    +
    1153int la_cholesky_rank1_downdate_cmplx(int n, double complex *r, int ldr,
    +
    1154 double complex *u);
    +
    1155
    +
    1185int la_svd(int m, int n, double *a, int lda, double *s, double *u, int ldu,
    +
    1186 double *vt, int ldv);
    +
    1187
    +
    1217int la_svd_cmplx(int m, int n, double complex *a, int lda, double *s,
    +
    1218 double complex *u, int ldu, double complex *vt, int ldv);
    +
    1219
    +
    1248int la_solve_tri_mtx(bool lside, bool upper, bool trans, bool nounit, int m,
    +
    1249 int n, double alpha, const double *a, int lda, double *b, int ldb);
    +
    1250
    +
    1279int la_solve_tri_mtx_cmplx(bool lside, bool upper, bool trans, bool nounit,
    +
    1280 int m, int n, double complex alpha, const double complex *a, int lda,
    +
    1281 double complex *b, int ldb);
    +
    1282
    +
    1299int la_solve_lu(int m, int n, const double *a, int lda, const int *ipvt,
    +
    1300 double *b, int ldb);
    +
    1301
    +
    1318int la_solve_lu_cmplx(int m, int n, const double complex *a, int lda,
    +
    1319 const int *ipvt, double complex *b, int ldb);
    +
    1320
    +
    1344int la_solve_qr(int m, int n, int k, double *a, int lda, const double *tau,
    +
    1345 double *b, int ldb);
    +
    1346
    +
    1370int la_solve_qr_cmplx(int m, int n, int k, double complex *a, int lda,
    +
    1371 const double complex *tau, double complex *b, int ldb);
    +
    1372
    +
    1396int la_solve_qr_pvt(int m, int n, int k, double *a, int lda, const double *tau,
    +
    1397 const int *jpvt, double *b, int ldb);
    +
    1398
    +
    1422int la_solve_qr_cmplx_pvt(int m, int n, int k, double complex *a, int lda,
    +
    1423 const double complex *tau, const int *jpvt, double complex *b, int ldb);
    +
    1424
    +
    1443int la_solve_cholesky(bool upper, int m, int n, const double *a, int lda,
    +
    1444 double *b, int ldb);
    +
    1445
    +
    1464int la_solve_cholesky_cmplx(bool upper, int m, int n, const double complex *a,
    +
    1465 int lda, double complex *b, int ldb);
    +
    1466
    +
    1492int la_solve_least_squares(int m, int n, int k, double *a, int lda, double *b,
    +
    1493 int ldb);
    +
    1494
    +
    1520int la_solve_least_squares_cmplx(int m, int n, int k, double complex *a,
    +
    1521 int lda, double complex *b, int ldb);
    +
    1522
    +
    1536int la_inverse(int n, double *a, int lda);
    +
    1537
    +
    1551int la_inverse_cmplx(int n, double complex *a, int lda);
    +
    1552
    +
    1570int la_pinverse(int m, int n, double *a, int lda, double *ainv, int ldai);
    +
    1571
    +
    1589int la_pinverse_cmplx(int m, int n, double complex *a, int lda,
    +
    1590 double complex *ainv, int ldai);
    +
    1591
    +
    1615int la_eigen_symm(bool vecs, int n, double *a, int lda, double *vals);
    +
    1616
    +
    1639int la_eigen_asymm(bool vecs, int n, double *a, int lda,
    +
    1640 double complex *vals, double complex *v, int ldv);
    +
    1641
    +
    1674int la_eigen_gen(bool vecs, int n, double *a, int lda, double *b, int ldb,
    +
    1675 double complex *alpha, double *beta, double complex *v, int ldv);
    +
    1676
    +
    1699int la_eigen_cmplx(bool vecs, int n, double complex *a, int lda,
    +
    1700 double complex *vals, double complex *v, int ldv);
    +
    1701
    +
    1721int la_sort_eigen(bool ascend, int n, double *vals, double *vecs, int ldv);
    +
    1722
    +
    1742int la_sort_eigen_cmplx(bool ascend, int n, double complex *vals,
    +
    1743 double complex *vecs, int ldv);
    +
    1744
    +
    1766int la_lq_factor(int m, int n, double *a, int lda, double *tau);
    +
    1767
    +
    1789int la_lq_factor_cmplx(int m, int n, double complex *a, int lda,
    +
    1790 double complex *tau);
    +
    1791
    +
    1812int la_form_lq(int m, int n, double *l, int ldl, const double *tau, double *q,
    +
    1813 int ldq);
    +
    1814
    +
    1835int la_form_lq_cmplx(int m, int n, double complex *l, int ldl,
    +
    1836 const double complex *tau, double complex *q, int ldq);
    +
    1837
    +
    1867int la_mult_lq(bool lside, bool trans, int m, int n, int k, const double *a,
    +
    1868 int lda, const double *tau, double *c, int ldc);
    +
    1869
    +
    1899int la_mult_lq_cmplx(bool lside, bool trans, int m, int n, int k,
    +
    1900 const double complex *a, int lda, const double complex *tau,
    +
    1901 double complex *c, int ldc);
    +
    1902
    +
    1926int la_solve_lq(int m, int n, int k, const double *a, int lda,
    +
    1927 const double *tau, double *b, int ldb);
    +
    1928
    +
    1952int la_solve_lq_cmplx(int m, int n, int k, const double complex *a, int lda,
    +
    1953 const double complex *tau, double complex *b, int ldb);
    +
    1954
    +
    1955#ifdef __cplusplus
    +
    1956}
    +
    1957#endif // __cplusplus
    +
    1958#endif // LINALG_H_DEFINED
    int la_cholesky_rank1_downdate_cmplx(int n, double complex *r, int ldr, double complex *u)
    int la_trace_cmplx(int m, int n, const double complex *a, int lda, double complex *rst)
    int la_tri_mtx_mult_cmplx(bool upper, double complex alpha, int n, const double complex *a, int lda, double complex beta, double complex *b, int ldb)
    @@ -316,13 +340,16 @@
    int la_cholesky_factor_cmplx(bool upper, int n, double complex *a, int lda)
    int la_lu_factor(int m, int n, double *a, int lda, int *ipvt)
    int la_cholesky_rank1_downdate(int n, double *r, int ldr, double *u)
    +
    int la_solve_lq(int m, int n, int k, const double *a, int lda, const double *tau, double *b, int ldb)
    int la_cholesky_factor(bool upper, int n, double *a, int lda)
    int la_rank1_update_cmplx(int m, int n, double complex alpha, const double complex *x, const double complex *y, double complex *a, int lda)
    int la_qr_factor_cmplx_pvt(int m, int n, double complex *a, int lda, double complex *tau, int *jpvt)
    int la_diag_mtx_mult(bool lside, bool transb, int m, int n, int k, double alpha, const double *a, const double *b, int ldb, double beta, double *c, int ldc)
    int la_qr_factor_pvt(int m, int n, double *a, int lda, double *tau, int *jpvt)
    int la_diag_mtx_mult_mixed(bool lside, int opb, int m, int n, int k, double complex alpha, const double *a, const double complex *b, int ldb, double complex beta, double complex *c, int ldc)
    +
    int la_solve_lq_cmplx(int m, int n, int k, const double complex *a, int lda, const double complex *tau, double complex *b, int ldb)
    int la_svd(int m, int n, double *a, int lda, double *s, double *u, int ldu, double *vt, int ldv)
    +
    int la_lq_factor_cmplx(int m, int n, double complex *a, int lda, double complex *tau)
    int la_solve_qr_pvt(int m, int n, int k, double *a, int lda, const double *tau, const int *jpvt, double *b, int ldb)
    int la_diag_mtx_mult_cmplx(bool lside, int opb, int m, int n, int k, double complex alpha, const double complex *a, const double complex *b, int ldb, double complex beta, double complex *c, int ldc)
    int la_solve_cholesky_cmplx(bool upper, int m, int n, const double complex *a, int lda, double complex *b, int ldb)
    @@ -330,6 +357,7 @@
    int la_form_lu_cmplx(int n, double complex *a, int lda, int *ipvt, double complex *u, int ldu, double *p, int ldp)
    int la_qr_factor(int m, int n, double *a, int lda, double *tau)
    int la_inverse_cmplx(int n, double complex *a, int lda)
    +
    int la_lq_factor(int m, int n, double *a, int lda, double *tau)
    int la_trace(int m, int n, const double *a, int lda, double *rst)
    int la_eigen_asymm(bool vecs, int n, double *a, int lda, double complex *vals, double complex *v, int ldv)
    int la_inverse(int n, double *a, int lda)
    @@ -337,6 +365,7 @@
    int la_mtx_mult(bool transa, bool transb, int m, int n, int k, double alpha, const double *a, int lda, const double *b, int ldb, double beta, double *c, int ldc)
    int la_qr_rank1_update(int m, int n, double *q, int ldq, double *r, int ldr, double *u, double *v)
    int la_solve_lu_cmplx(int m, int n, const double complex *a, int lda, const int *ipvt, double complex *b, int ldb)
    +
    int la_form_lq_cmplx(int m, int n, double complex *l, int ldl, const double complex *tau, double complex *q, int ldq)
    int la_form_qr_pvt(bool fullq, int m, int n, double *r, int ldr, const double *tau, const int *pvt, double *q, int ldq, double *p, int ldp)
    int la_solve_lu(int m, int n, const double *a, int lda, const int *ipvt, double *b, int ldb)
    int la_rank1_update(int m, int n, double alpha, const double *x, const double *y, double *a, int lda)
    @@ -344,6 +373,8 @@
    int la_sort_eigen(bool ascend, int n, double *vals, double *vecs, int ldv)
    int la_eigen_symm(bool vecs, int n, double *a, int lda, double *vals)
    int la_solve_least_squares_cmplx(int m, int n, int k, double complex *a, int lda, double complex *b, int ldb)
    +
    int la_form_lq(int m, int n, double *l, int ldl, const double *tau, double *q, int ldq)
    +
    int la_mult_lq(bool lside, bool trans, int m, int n, int k, const double *a, int lda, const double *tau, double *c, int ldc)
    int la_det(int n, double *a, int lda, double *d)
    int la_mult_qr_cmplx(bool lside, bool trans, int m, int n, int k, double complex *a, int lda, const double complex *tau, double complex *c, int ldc)
    int la_lu_factor_cmplx(int m, int n, double complex *a, int lda, int *ipvt)
    @@ -351,6 +382,7 @@
    int la_qr_rank1_update_cmplx(int m, int n, double complex *q, int ldq, double complex *r, int ldr, double complex *u, double complex *v)
    int la_solve_qr_cmplx_pvt(int m, int n, int k, double complex *a, int lda, const double complex *tau, const int *jpvt, double complex *b, int ldb)
    int la_form_qr_cmplx_pvt(bool fullq, int m, int n, double complex *r, int ldr, const double complex *tau, const int *pvt, double complex *q, int ldq, double complex *p, int ldp)
    +
    int la_mult_lq_cmplx(bool lside, bool trans, int m, int n, int k, const double complex *a, int lda, const double complex *tau, double complex *c, int ldc)
    int la_eigen_cmplx(bool vecs, int n, double complex *a, int lda, double complex *vals, double complex *v, int ldv)
    int la_qr_factor_cmplx(int m, int n, double complex *a, int lda, double complex *tau)
    int la_tri_mtx_mult(bool upper, double alpha, int n, const double *a, int lda, double beta, double *b, int ldb)
    diff --git a/doc/html/linalg__factor_8f90_source.html b/doc/html/linalg__factor_8f90_source.html index 964d3aca..efc93441 100644 --- a/doc/html/linalg__factor_8f90_source.html +++ b/doc/html/linalg__factor_8f90_source.html @@ -2958,8 +2958,704 @@
    2860101 format(i0, a)
    2861 end subroutine
    2862
    -
    2863! ------------------------------------------------------------------------------
    -
    2864end submodule
    +
    2863! ******************************************************************************
    +
    2864! LQ FACTORIZATION
    +
    2865! ------------------------------------------------------------------------------
    +
    2866 module subroutine lq_factor_no_pivot(a, tau, work, olwork, err)
    +
    2867 ! Arguments
    +
    2868 real(real64), intent(inout), dimension(:,:) :: a
    +
    2869 real(real64), intent(out), dimension(:) :: tau
    +
    2870 real(real64), intent(out), target, dimension(:), optional :: work
    +
    2871 integer(int32), intent(out), optional :: olwork
    +
    2872 class(errors), intent(inout), optional, target :: err
    +
    2873
    +
    2874 ! Local Variables
    +
    2875 integer(int32) :: m, n, mn, istat, lwork, flag
    +
    2876 real(real64), dimension(1) :: temp
    +
    2877 real(real64), pointer, dimension(:) :: wptr
    +
    2878 real(real64), allocatable, target, dimension(:) :: wrk
    +
    2879 class(errors), pointer :: errmgr
    +
    2880 type(errors), target :: deferr
    +
    2881
    +
    2882 ! Initialization
    +
    2883 m = size(a, 1)
    +
    2884 n = size(a, 2)
    +
    2885 mn = min(m, n)
    +
    2886 if (present(err)) then
    +
    2887 errmgr => err
    +
    2888 else
    +
    2889 errmgr => deferr
    +
    2890 end if
    +
    2891
    +
    2892 ! Input Check
    +
    2893 if (size(tau) /= mn) then
    +
    2894 ! ERROR: TAU not sized correctly
    +
    2895 call errmgr%report_error("lq_factor_no_pivot", &
    +
    2896 "Incorrectly sized input array TAU, argument 2.", &
    +
    2897 la_array_size_error)
    +
    2898 return
    +
    2899 end if
    +
    2900
    +
    2901 ! Workspace Query
    +
    2902 call dgelqf(m, n, a, m, tau, temp, -1, flag)
    +
    2903 lwork = int(temp(1), int32)
    +
    2904 if (present(olwork)) then
    +
    2905 olwork = lwork
    +
    2906 return
    +
    2907 end if
    +
    2908
    +
    2909 ! Local Memory Allocation
    +
    2910 if (present(work)) then
    +
    2911 if (size(work) < lwork) then
    +
    2912 ! ERROR: WORK not sized correctly
    +
    2913 call errmgr%report_error("lq_factor_no_pivot", &
    +
    2914 "Incorrectly sized input array WORK, argument 3.", &
    +
    2915 la_array_size_error)
    +
    2916 return
    +
    2917 end if
    +
    2918 wptr => work(1:lwork)
    +
    2919 else
    +
    2920 allocate(wrk(lwork), stat = istat)
    +
    2921 if (istat /= 0) then
    +
    2922 ! ERROR: Out of memory
    +
    2923 call errmgr%report_error("lq_factor_no_pivot", &
    +
    2924 "Insufficient memory available.", &
    +
    2925 la_out_of_memory_error)
    +
    2926 return
    +
    2927 end if
    +
    2928 wptr => wrk
    +
    2929 end if
    +
    2930
    +
    2931 ! Call DGELQF
    +
    2932 call dgelqf(m, n, a, m, tau, wptr, lwork, flag)
    +
    2933 end subroutine
    +
    2934
    +
    2935! ------------------------------------------------------------------------------
    +
    2936 module subroutine lq_factor_no_pivot_cmplx(a, tau, work, olwork, err)
    +
    2937 ! Arguments
    +
    2938 complex(real64), intent(inout), dimension(:,:) :: a
    +
    2939 complex(real64), intent(out), dimension(:) :: tau
    +
    2940 complex(real64), intent(out), target, dimension(:), optional :: work
    +
    2941 integer(int32), intent(out), optional :: olwork
    +
    2942 class(errors), intent(inout), optional, target :: err
    +
    2943
    +
    2944 ! Local Variables
    +
    2945 integer(int32) :: m, n, mn, istat, lwork, flag
    +
    2946 complex(real64), dimension(1) :: temp
    +
    2947 complex(real64), pointer, dimension(:) :: wptr
    +
    2948 complex(real64), allocatable, target, dimension(:) :: wrk
    +
    2949 class(errors), pointer :: errmgr
    +
    2950 type(errors), target :: deferr
    +
    2951
    +
    2952 ! Initialization
    +
    2953 m = size(a, 1)
    +
    2954 n = size(a, 2)
    +
    2955 mn = min(m, n)
    +
    2956 if (present(err)) then
    +
    2957 errmgr => err
    +
    2958 else
    +
    2959 errmgr => deferr
    +
    2960 end if
    +
    2961
    +
    2962 ! Input Check
    +
    2963 if (size(tau) /= mn) then
    +
    2964 ! ERROR: TAU not sized correctly
    +
    2965 call errmgr%report_error("lq_factor_no_pivot_cmplx", &
    +
    2966 "Incorrectly sized input array TAU, argument 2.", &
    +
    2967 la_array_size_error)
    +
    2968 return
    +
    2969 end if
    +
    2970
    +
    2971 ! Workspace Query
    +
    2972 call zgelqf(m, n, a, m, tau, temp, -1, flag)
    +
    2973 lwork = int(temp(1), int32)
    +
    2974 if (present(olwork)) then
    +
    2975 olwork = lwork
    +
    2976 return
    +
    2977 end if
    +
    2978
    +
    2979 ! Local Memory Allocation
    +
    2980 if (present(work)) then
    +
    2981 if (size(work) < lwork) then
    +
    2982 ! ERROR: WORK not sized correctly
    +
    2983 call errmgr%report_error("lq_factor_no_pivot_cmplx", &
    +
    2984 "Incorrectly sized input array WORK, argument 3.", &
    +
    2985 la_array_size_error)
    +
    2986 return
    +
    2987 end if
    +
    2988 wptr => work(1:lwork)
    +
    2989 else
    +
    2990 allocate(wrk(lwork), stat = istat)
    +
    2991 if (istat /= 0) then
    +
    2992 ! ERROR: Out of memory
    +
    2993 call errmgr%report_error("lq_factor_no_pivot_cmplx", &
    +
    2994 "Insufficient memory available.", &
    +
    2995 la_out_of_memory_error)
    +
    2996 return
    +
    2997 end if
    +
    2998 wptr => wrk
    +
    2999 end if
    +
    3000
    +
    3001 ! Call ZGELQF
    +
    3002 call zgelqf(m, n, a, m, tau, wptr, lwork, flag)
    +
    3003 end subroutine
    +
    3004
    +
    3005! ------------------------------------------------------------------------------
    +
    3006 module subroutine form_lq_no_pivot(l, tau, q, work, olwork, err)
    +
    3007 ! Arguments
    +
    3008 real(real64), intent(inout), dimension(:,:) :: l
    +
    3009 real(real64), intent(in), dimension(:) :: tau
    +
    3010 real(real64), intent(out), dimension(:,:) :: q
    +
    3011 real(real64), intent(out), target, dimension(:), optional :: work
    +
    3012 integer(int32), intent(out), optional :: olwork
    +
    3013 class(errors), intent(inout), optional, target :: err
    +
    3014
    +
    3015 ! Parameters
    +
    3016 real(real64), parameter :: zero = 0.0d0
    +
    3017
    +
    3018 ! Local Variables
    +
    3019 integer(int32) :: i, m, n, mn, k, istat, flag, lwork
    +
    3020 real(real64), pointer, dimension(:) :: wptr
    +
    3021 real(real64), allocatable, target, dimension(:) :: wrk
    +
    3022 real(real64), dimension(1) :: temp
    +
    3023 class(errors), pointer :: errmgr
    +
    3024 type(errors), target :: deferr
    +
    3025 character(len = 128) :: errmsg
    +
    3026
    +
    3027 ! Initialization
    +
    3028 m = size(l, 1)
    +
    3029 n = size(l, 2)
    +
    3030 mn = min(m, n)
    +
    3031 qcol = size(q, 2)
    +
    3032 if (present(err)) then
    +
    3033 errmgr => err
    +
    3034 else
    +
    3035 errmgr => deferr
    +
    3036 end if
    +
    3037
    +
    3038 ! Input Check
    +
    3039 flag = 0
    +
    3040 if (m > n) then
    +
    3041 flag = 1
    +
    3042 else if (size(tau) /= mn) then
    +
    3043 flag = 2
    +
    3044 else if (size(q, 1) /= m .or. size(q, 2) /= n) then
    +
    3045 flag = 3
    +
    3046 end if
    +
    3047 if (flag /= 0) then
    +
    3048 ! ERROR: One of the input arrays is not sized correctly
    +
    3049 write(errmsg, 100) "Input number ", flag, &
    +
    3050 " is not sized correctly."
    +
    3051 call errmgr%report_error("form_lq_no_pivot", trim(errmsg), &
    +
    3052 la_array_size_error)
    +
    3053 return
    +
    3054 end if
    +
    3055
    +
    3056 ! Workspace Query
    +
    3057 call dorglq(m, n, mn, q, m, tau, temp, -1, flag)
    +
    3058 lwork = int(temp(1), int32)
    +
    3059 if (present(olwork)) then
    +
    3060 olwork = lwork
    +
    3061 return
    +
    3062 end if
    +
    3063
    +
    3064 ! Local Memory Allocation
    +
    3065 if (present(work)) then
    +
    3066 if (size(work) < lwork) then
    +
    3067 ! ERROR: WORK not sized correctly
    +
    3068 call errmgr%report_error("form_lq_no_pivot", &
    +
    3069 "Incorrectly sized input array WORK, argument 4.", &
    +
    3070 la_array_size_error)
    +
    3071 return
    +
    3072 end if
    +
    3073 wptr => work(1:lwork)
    +
    3074 else
    +
    3075 allocate(wrk(lwork), stat = istat)
    +
    3076 if (istat /= 0) then
    +
    3077 ! ERROR: Out of memory
    +
    3078 call errmgr%report_error("form_lq_no_pivot", &
    +
    3079 "Insufficient memory available.", &
    +
    3080 la_out_of_memory_error)
    +
    3081 return
    +
    3082 end if
    +
    3083 wptr => wrk
    +
    3084 end if
    +
    3085
    +
    3086 ! Copy the upper triangular portion of L to Q, and then zero it out in L
    +
    3087 do j = 2, n
    +
    3088 k = min(j - 1, m)
    +
    3089 q(1:j-1,j) = l(1:k,j)
    +
    3090 l(1:k,j) = zero
    +
    3091 end do
    +
    3092
    +
    3093 ! Build Q
    +
    3094 call dorglq(m, n, mn, q, m, tau, wptr, lwork, flag)
    +
    3095
    +
    3096 ! Formatting
    +
    3097100 format(a, i0, a)
    +
    3098 end subroutine
    +
    3099
    +
    3100! ------------------------------------------------------------------------------
    +
    3101 module subroutine form_lq_no_pivot_cmplx(l, tau, q, work, olwork, err)
    +
    3102 ! Arguments
    +
    3103 complex(real64), intent(inout), dimension(:,:) :: l
    +
    3104 complex(real64), intent(in), dimension(:) :: tau
    +
    3105 complex(real64), intent(out), dimension(:,:) :: q
    +
    3106 complex(real64), intent(out), target, dimension(:), optional :: work
    +
    3107 integer(int32), intent(out), optional :: olwork
    +
    3108 class(errors), intent(inout), optional, target :: err
    +
    3109
    +
    3110 ! Parameters
    +
    3111 complex(real64), parameter :: zero = (0.0d0, 0.0d0)
    +
    3112
    +
    3113 ! Local Variables
    +
    3114 integer(int32) :: i, m, n, mn, k, istat, flag, lwork
    +
    3115 complex(real64), pointer, dimension(:) :: wptr
    +
    3116 complex(real64), allocatable, target, dimension(:) :: wrk
    +
    3117 complex(real64), dimension(1) :: temp
    +
    3118 class(errors), pointer :: errmgr
    +
    3119 type(errors), target :: deferr
    +
    3120 character(len = 128) :: errmsg
    +
    3121
    +
    3122 ! Initialization
    +
    3123 m = size(l, 1)
    +
    3124 n = size(l, 2)
    +
    3125 mn = min(m, n)
    +
    3126 qcol = size(q, 2)
    +
    3127 if (present(err)) then
    +
    3128 errmgr => err
    +
    3129 else
    +
    3130 errmgr => deferr
    +
    3131 end if
    +
    3132
    +
    3133 ! Input Check
    +
    3134 flag = 0
    +
    3135 if (m > n) then
    +
    3136 flag = 1
    +
    3137 else if (size(tau) /= mn) then
    +
    3138 flag = 2
    +
    3139 else if (size(q, 1) /= m .or. size(q, 2) /= n) then
    +
    3140 flag = 3
    +
    3141 end if
    +
    3142 if (flag /= 0) then
    +
    3143 ! ERROR: One of the input arrays is not sized correctly
    +
    3144 write(errmsg, 100) "Input number ", flag, &
    +
    3145 " is not sized correctly."
    +
    3146 call errmgr%report_error("form_lq_no_pivot_cmplx", trim(errmsg), &
    +
    3147 la_array_size_error)
    +
    3148 return
    +
    3149 end if
    +
    3150
    +
    3151 ! Workspace Query
    +
    3152 call zunglq(m, n, mn, q, m, tau, temp, -1, flag)
    +
    3153 lwork = int(temp(1), int32)
    +
    3154 if (present(olwork)) then
    +
    3155 olwork = lwork
    +
    3156 return
    +
    3157 end if
    +
    3158
    +
    3159 ! Local Memory Allocation
    +
    3160 if (present(work)) then
    +
    3161 if (size(work) < lwork) then
    +
    3162 ! ERROR: WORK not sized correctly
    +
    3163 call errmgr%report_error("form_lq_no_pivot_cmplx", &
    +
    3164 "Incorrectly sized input array WORK, argument 4.", &
    +
    3165 la_array_size_error)
    +
    3166 return
    +
    3167 end if
    +
    3168 wptr => work(1:lwork)
    +
    3169 else
    +
    3170 allocate(wrk(lwork), stat = istat)
    +
    3171 if (istat /= 0) then
    +
    3172 ! ERROR: Out of memory
    +
    3173 call errmgr%report_error("form_lq_no_pivot_cmplx", &
    +
    3174 "Insufficient memory available.", &
    +
    3175 la_out_of_memory_error)
    +
    3176 return
    +
    3177 end if
    +
    3178 wptr => wrk
    +
    3179 end if
    +
    3180
    +
    3181 ! Copy the upper triangular portion of L to Q, and then zero it out in L
    +
    3182 do j = 2, n
    +
    3183 k = min(j - 1, m)
    +
    3184 q(1:j-1,j) = l(1:k,j)
    +
    3185 l(1:k,j) = zero
    +
    3186 end do
    +
    3187
    +
    3188 ! Build Q
    +
    3189 call zunglq(m, n, mn, q, m, tau, wptr, lwork, flag)
    +
    3190
    +
    3191 ! Formatting
    +
    3192100 format(a, i0, a)
    +
    3193 end subroutine
    +
    3194
    +
    3195! ------------------------------------------------------------------------------
    +
    3196 module subroutine mult_lq_mtx(lside, trans, a, tau, c, work, olwork, err)
    +
    3197 ! Arguments
    +
    3198 logical, intent(in) :: lside, trans
    +
    3199 real(real64), intent(in), dimension(:,:) :: a
    +
    3200 real(real64), intent(in), dimension(:) :: tau
    +
    3201 real(real64), intent(inout), dimension(:,:) :: c
    +
    3202 real(real64), intent(out), target, dimension(:), optional :: work
    +
    3203 integer(int32), intent(out), optional :: olwork
    +
    3204 class(errors), intent(inout), optional, target :: err
    +
    3205
    +
    3206 ! Local Variables
    +
    3207 character :: side, t
    +
    3208 integer(int32) :: m, n, k, ncola, istat, flag, lwork
    +
    3209 real(real64), pointer, dimension(:) :: wptr
    +
    3210 real(real64), allocatable, target, dimension(:) :: wrk
    +
    3211 real(real64), dimension(1) :: temp
    +
    3212 class(errors), pointer :: errmgr
    +
    3213 type(errors), target :: deferr
    +
    3214 character(len = 128) :: errmsg
    +
    3215
    +
    3216 ! Initialization
    +
    3217 m = size(c, 1)
    +
    3218 n = size(c, 2)
    +
    3219 k = size(tau)
    +
    3220 if (lside) then
    +
    3221 side = 'L'
    +
    3222 ncola = m
    +
    3223 else
    +
    3224 side = 'R'
    +
    3225 ncola = n
    +
    3226 end if
    +
    3227 if (trans) then
    +
    3228 t = 'T'
    +
    3229 else
    +
    3230 t = 'N'
    +
    3231 end if
    +
    3232 if (present(err)) then
    +
    3233 errmgr => err
    +
    3234 else
    +
    3235 errmgr => deferr
    +
    3236 end if
    +
    3237
    +
    3238 ! Input Check
    +
    3239 flag = 0
    +
    3240 if (size(a, 1) /= k .or. size(a, 2) /= ncola) then
    +
    3241 flag = 3
    +
    3242 end if
    +
    3243 if (flag /= 0) then
    +
    3244 ! ERROR: One of the input arrays is not sized correctly
    +
    3245 write(errmsg, 100) "Input number ", flag, &
    +
    3246 " is not sized correctly."
    +
    3247 call errmgr%report_error("mult_lq_mtx", trim(errmsg), &
    +
    3248 la_array_size_error)
    +
    3249 return
    +
    3250 end if
    +
    3251
    +
    3252 ! Workspace Query
    +
    3253 call dormlq(side, t, m, n, k, a, k, tau, c, m, temp, -1, flag)
    +
    3254 lwork = int(temp(1), int32)
    +
    3255 if (present(olwork)) then
    +
    3256 olwork = lwork
    +
    3257 return
    +
    3258 end if
    +
    3259
    +
    3260 ! Local Memory Allocation
    +
    3261 if (present(work)) then
    +
    3262 if (size(work) < lwork) then
    +
    3263 ! ERROR: WORK not sized correctly
    +
    3264 call errmgr%report_error("mult_lq_mtx", &
    +
    3265 "Incorrectly sized input array WORK, argument 6.", &
    +
    3266 la_array_size_error)
    +
    3267 return
    +
    3268 end if
    +
    3269 wptr => work(1:lwork)
    +
    3270 else
    +
    3271 allocate(wrk(lwork), stat = istat)
    +
    3272 if (istat /= 0) then
    +
    3273 ! ERROR: Out of memory
    +
    3274 call errmgr%report_error("mult_lq_mtx", &
    +
    3275 "Insufficient memory available.", &
    +
    3276 la_out_of_memory_error)
    +
    3277 return
    +
    3278 end if
    +
    3279 wptr => wrk
    +
    3280 end if
    +
    3281
    +
    3282 ! Call DORMLQ
    +
    3283 call dormlq(side, t, m, n, k, a, k, tau, c, m, wptr, lwork, flag)
    +
    3284
    +
    3285 ! Formatting
    +
    3286100 format(a, i0, a)
    +
    3287 end subroutine
    +
    3288
    +
    3289! ------------------------------------------------------------------------------
    +
    3290 module subroutine mult_lq_mtx_cmplx(lside, trans, a, tau, c, work, olwork, err)
    +
    3291 ! Arguments
    +
    3292 logical, intent(in) :: lside, trans
    +
    3293 complex(real64), intent(in), dimension(:,:) :: a
    +
    3294 complex(real64), intent(in), dimension(:) :: tau
    +
    3295 complex(real64), intent(inout), dimension(:,:) :: c
    +
    3296 complex(real64), intent(out), target, dimension(:), optional :: work
    +
    3297 integer(int32), intent(out), optional :: olwork
    +
    3298 class(errors), intent(inout), optional, target :: err
    +
    3299
    +
    3300 ! Local Variables
    +
    3301 character :: side, t
    +
    3302 integer(int32) :: m, n, k, ncola, istat, flag, lwork
    +
    3303 complex(real64), pointer, dimension(:) :: wptr
    +
    3304 complex(real64), allocatable, target, dimension(:) :: wrk
    +
    3305 complex(real64), dimension(1) :: temp
    +
    3306 class(errors), pointer :: errmgr
    +
    3307 type(errors), target :: deferr
    +
    3308 character(len = 128) :: errmsg
    +
    3309
    +
    3310 ! Initialization
    +
    3311 m = size(c, 1)
    +
    3312 n = size(c, 2)
    +
    3313 k = size(tau)
    +
    3314 if (lside) then
    +
    3315 side = 'L'
    +
    3316 ncola = m
    +
    3317 else
    +
    3318 side = 'R'
    +
    3319 ncola = n
    +
    3320 end if
    +
    3321 if (trans) then
    +
    3322 t = 'T'
    +
    3323 else
    +
    3324 t = 'N'
    +
    3325 end if
    +
    3326 if (present(err)) then
    +
    3327 errmgr => err
    +
    3328 else
    +
    3329 errmgr => deferr
    +
    3330 end if
    +
    3331
    +
    3332 ! Input Check
    +
    3333 flag = 0
    +
    3334 if (size(a, 1) /= k .or. size(a, 2) /= ncola) then
    +
    3335 flag = 3
    +
    3336 end if
    +
    3337 if (flag /= 0) then
    +
    3338 ! ERROR: One of the input arrays is not sized correctly
    +
    3339 write(errmsg, 100) "Input number ", flag, &
    +
    3340 " is not sized correctly."
    +
    3341 call errmgr%report_error("mult_lq_mtx_cmplx", trim(errmsg), &
    +
    3342 la_array_size_error)
    +
    3343 return
    +
    3344 end if
    +
    3345
    +
    3346 ! Workspace Query
    +
    3347 call zunmlq(side, t, m, n, k, a, k, tau, c, m, temp, -1, flag)
    +
    3348 lwork = int(temp(1), int32)
    +
    3349 if (present(olwork)) then
    +
    3350 olwork = lwork
    +
    3351 return
    +
    3352 end if
    +
    3353
    +
    3354 ! Local Memory Allocation
    +
    3355 if (present(work)) then
    +
    3356 if (size(work) < lwork) then
    +
    3357 ! ERROR: WORK not sized correctly
    +
    3358 call errmgr%report_error("mult_lq_mtx_cmplx", &
    +
    3359 "Incorrectly sized input array WORK, argument 6.", &
    +
    3360 la_array_size_error)
    +
    3361 return
    +
    3362 end if
    +
    3363 wptr => work(1:lwork)
    +
    3364 else
    +
    3365 allocate(wrk(lwork), stat = istat)
    +
    3366 if (istat /= 0) then
    +
    3367 ! ERROR: Out of memory
    +
    3368 call errmgr%report_error("mult_lq_mtx_cmplx", &
    +
    3369 "Insufficient memory available.", &
    +
    3370 la_out_of_memory_error)
    +
    3371 return
    +
    3372 end if
    +
    3373 wptr => wrk
    +
    3374 end if
    +
    3375
    +
    3376 ! Call ZUNMLQ
    +
    3377 call zunmlq(side, t, m, n, k, a, k, tau, c, m, wptr, lwork, flag)
    +
    3378
    +
    3379 ! Formatting
    +
    3380100 format(a, i0, a)
    +
    3381 end subroutine
    +
    3382
    +
    3383! ------------------------------------------------------------------------------
    +
    3384 module subroutine mult_lq_vec(trans, a, tau, c, work, olwork, err)
    +
    3385 ! Arguments
    +
    3386 logical, intent(in) :: trans
    +
    3387 real(real64), intent(in), dimension(:,:) :: a
    +
    3388 real(real64), intent(in), dimension(:) :: tau
    +
    3389 real(real64), intent(inout), dimension(:) :: c
    +
    3390 real(real64), intent(out), target, dimension(:), optional :: work
    +
    3391 integer(int32), intent(out), optional :: olwork
    +
    3392 class(errors), intent(inout), optional, target :: err
    +
    3393
    +
    3394 ! Local Variables
    +
    3395 character :: side, t
    +
    3396 integer(int32) :: m, n, k, istat, flag, lwork
    +
    3397 real(real64), pointer, dimension(:) :: wptr
    +
    3398 real(real64), allocatable, target, dimension(:) :: wrk
    +
    3399 real(real64), dimension(1) :: temp
    +
    3400 class(errors), pointer :: errmgr
    +
    3401 type(errors), target :: deferr
    +
    3402 character(len = 128) :: errmsg
    +
    3403
    +
    3404 ! Initialization
    +
    3405 m = size(c)
    +
    3406 n = 1
    +
    3407 k = size(tau)
    +
    3408 side = 'L'
    +
    3409 if (trans) then
    +
    3410 t = 'T'
    +
    3411 else
    +
    3412 t = 'N'
    +
    3413 end if
    +
    3414 if (present(err)) then
    +
    3415 errmgr => err
    +
    3416 else
    +
    3417 errmgr => deferr
    +
    3418 end if
    +
    3419
    +
    3420 ! Input Check
    +
    3421 flag = 0
    +
    3422 if (size(a, 1) /= m .or. size(a, 2) /= m) then
    +
    3423 flag = 3
    +
    3424 end if
    +
    3425 if (flag /= 0) then
    +
    3426 ! ERROR: One of the input arrays is not sized correctly
    +
    3427 write(errmsg, 100) "Input number ", flag, &
    +
    3428 " is not sized correctly."
    +
    3429 call errmgr%report_error("mult_lq_vec", trim(errmsg), &
    +
    3430 la_array_size_error)
    +
    3431 return
    +
    3432 end if
    +
    3433
    +
    3434 ! Workspace Query
    +
    3435 call dormlq(side, t, m, n, k, a, m, tau, c, m, temp, -1, flag)
    +
    3436 lwork = int(temp(1), int32)
    +
    3437 if (present(olwork)) then
    +
    3438 olwork = lwork
    +
    3439 return
    +
    3440 end if
    +
    3441
    +
    3442 ! Local Memory Allocation
    +
    3443 if (present(work)) then
    +
    3444 if (size(work) < lwork) then
    +
    3445 ! ERROR: WORK not sized correctly
    +
    3446 call errmgr%report_error("mult_lq_vec", &
    +
    3447 "Incorrectly sized input array WORK, argument 6.", &
    +
    3448 la_array_size_error)
    +
    3449 return
    +
    3450 end if
    +
    3451 wptr => work(1:lwork)
    +
    3452 else
    +
    3453 allocate(wrk(lwork), stat = istat)
    +
    3454 if (istat /= 0) then
    +
    3455 ! ERROR: Out of memory
    +
    3456 call errmgr%report_error("mult_lq_vec", &
    +
    3457 "Insufficient memory available.", &
    +
    3458 la_out_of_memory_error)
    +
    3459 return
    +
    3460 end if
    +
    3461 wptr => wrk
    +
    3462 end if
    +
    3463
    +
    3464 ! Call DORMLQ
    +
    3465 call dormlq(side, t, m, n, k, a, m, tau, c, m, wptr, lwork, flag)
    +
    3466
    +
    3467 ! Formatting
    +
    3468100 format(a, i0, a)
    +
    3469 end subroutine
    +
    3470
    +
    3471! ------------------------------------------------------------------------------
    +
    3472 module subroutine mult_lq_vec_cmplx(trans, a, tau, c, work, olwork, err)
    +
    3473 ! Arguments
    +
    3474 logical, intent(in) :: trans
    +
    3475 complex(real64), intent(in), dimension(:,:) :: a
    +
    3476 complex(real64), intent(in), dimension(:) :: tau
    +
    3477 complex(real64), intent(inout), dimension(:) :: c
    +
    3478 complex(real64), intent(out), target, dimension(:), optional :: work
    +
    3479 integer(int32), intent(out), optional :: olwork
    +
    3480 class(errors), intent(inout), optional, target :: err
    +
    3481
    +
    3482 ! Local Variables
    +
    3483 character :: side, t
    +
    3484 integer(int32) :: m, n, k, istat, flag, lwork
    +
    3485 complex(real64), pointer, dimension(:) :: wptr
    +
    3486 complex(real64), allocatable, target, dimension(:) :: wrk
    +
    3487 complex(real64), dimension(1) :: temp
    +
    3488 class(errors), pointer :: errmgr
    +
    3489 type(errors), target :: deferr
    +
    3490 character(len = 128) :: errmsg
    +
    3491
    +
    3492 ! Initialization
    +
    3493 m = size(c)
    +
    3494 n = 1
    +
    3495 k = size(tau)
    +
    3496 side = 'L'
    +
    3497 if (trans) then
    +
    3498 t = 'T'
    +
    3499 else
    +
    3500 t = 'N'
    +
    3501 end if
    +
    3502 if (present(err)) then
    +
    3503 errmgr => err
    +
    3504 else
    +
    3505 errmgr => deferr
    +
    3506 end if
    +
    3507
    +
    3508 ! Input Check
    +
    3509 flag = 0
    +
    3510 if (size(a, 1) /= m .or. size(a, 2) /= m) then
    +
    3511 flag = 3
    +
    3512 end if
    +
    3513 if (flag /= 0) then
    +
    3514 ! ERROR: One of the input arrays is not sized correctly
    +
    3515 write(errmsg, 100) "Input number ", flag, &
    +
    3516 " is not sized correctly."
    +
    3517 call errmgr%report_error("mult_lq_vec_cmplx", trim(errmsg), &
    +
    3518 la_array_size_error)
    +
    3519 return
    +
    3520 end if
    +
    3521
    +
    3522 ! Workspace Query
    +
    3523 call zunmlq(side, t, m, n, k, a, m, tau, c, m, temp, -1, flag)
    +
    3524 lwork = int(temp(1), int32)
    +
    3525 if (present(olwork)) then
    +
    3526 olwork = lwork
    +
    3527 return
    +
    3528 end if
    +
    3529
    +
    3530 ! Local Memory Allocation
    +
    3531 if (present(work)) then
    +
    3532 if (size(work) < lwork) then
    +
    3533 ! ERROR: WORK not sized correctly
    +
    3534 call errmgr%report_error("mult_lq_vec_cmplx", &
    +
    3535 "Incorrectly sized input array WORK, argument 6.", &
    +
    3536 la_array_size_error)
    +
    3537 return
    +
    3538 end if
    +
    3539 wptr => work(1:lwork)
    +
    3540 else
    +
    3541 allocate(wrk(lwork), stat = istat)
    +
    3542 if (istat /= 0) then
    +
    3543 ! ERROR: Out of memory
    +
    3544 call errmgr%report_error("mult_lq_vec_cmplx", &
    +
    3545 "Insufficient memory available.", &
    +
    3546 la_out_of_memory_error)
    +
    3547 return
    +
    3548 end if
    +
    3549 wptr => wrk
    +
    3550 end if
    +
    3551
    +
    3552 ! Call ZUNMLQ
    +
    3553 call zunmlq(side, t, m, n, k, a, m, tau, c, m, wptr, lwork, flag)
    +
    3554
    +
    3555 ! Formatting
    +
    3556100 format(a, i0, a)
    +
    3557 end subroutine
    +
    3558
    +
    3559! ------------------------------------------------------------------------------
    +
    3560end submodule
    Provides a set of common linear algebra routines.
    Definition: linalg.f90:145
    diff --git a/doc/html/linalg__solve_8f90_source.html b/doc/html/linalg__solve_8f90_source.html index c7ab519e..6da85cd8 100644 --- a/doc/html/linalg__solve_8f90_source.html +++ b/doc/html/linalg__solve_8f90_source.html @@ -3564,7 +3564,382 @@
    3466101 format(i0, a)
    3467 end subroutine
    3468
    -
    3469end submodule
    +
    3469! ******************************************************************************
    +
    3470! LQ SOLUTION
    +
    3471! ------------------------------------------------------------------------------
    +
    3472 module subroutine solve_lq_mtx(a, tau, b, work, olwork, err)
    +
    3473 ! Arguments
    +
    3474 real(real64), intent(in), dimension(:,:) :: a
    +
    3475 real(real64), intent(in), dimension(:) :: tau
    +
    3476 real(real64), intent(inout), dimension(:,:) :: b
    +
    3477 real(real64), intent(out), target, optional, dimension(:) :: work
    +
    3478 integer(int32), intent(out), optional :: olwork
    +
    3479 class(errors), intent(inout), optional, target :: err
    +
    3480
    +
    3481 ! Parameters
    +
    3482 real(real64), parameter :: one = 1.0d0
    +
    3483
    +
    3484 ! Local Variables
    +
    3485 integer(int32) :: m, n, nrhs, k, lwork, flag, istat
    +
    3486 real(real64), pointer, dimension(:) :: wptr
    +
    3487 real(real64), allocatable, target, dimension(:) :: wrk
    +
    3488 class(errors), pointer :: errmgr
    +
    3489 type(errors), target :: deferr
    +
    3490 character(len = 128) :: errmsg
    +
    3491
    +
    3492 ! Initialization
    +
    3493 m = size(a, 1)
    +
    3494 n = size(a, 2)
    +
    3495 nrhs = size(b, 2)
    +
    3496 k = min(m, n)
    +
    3497 if (present(err)) then
    +
    3498 errmgr => err
    +
    3499 else
    +
    3500 errmgr => deferr
    +
    3501 end if
    +
    3502
    +
    3503 ! Input Check
    +
    3504 flag = 0
    +
    3505 if (m > n) then
    +
    3506 flag = 1
    +
    3507 else if (size(tau) /= k) then
    +
    3508 flag = 2
    +
    3509 else if (size(b, 1) /= n) then
    +
    3510 flag = 3
    +
    3511 end if
    +
    3512
    +
    3513 if (flag /= 0) then
    +
    3514 ! ERROR: One of the input arrays is not sized correctly
    +
    3515 write(errmsg, 100) "Input number ", flag, &
    +
    3516 " is not sized correctly."
    +
    3517 call errmgr%report_error("solve_lq_mtx", trim(errmsg), &
    +
    3518 la_array_size_error)
    +
    3519 return
    +
    3520 end if
    +
    3521
    +
    3522 ! Workspace Query
    +
    3523 call mult_lq(.true., .true., a, tau, b, olwork = lwork)
    +
    3524
    +
    3525 if (present(olwork)) then
    +
    3526 olwork = lwork
    +
    3527 return
    +
    3528 end if
    +
    3529
    +
    3530 ! Local Memory Allocation
    +
    3531 if (present(work)) then
    +
    3532 if (size(work) < lwork) then
    +
    3533 ! ERROR: WORK not sized correctly
    +
    3534 call errmgr%report_error("solve_lq_mtx", &
    +
    3535 "Incorrectly sized input array WORK, argument 4.", &
    +
    3536 la_array_size_error)
    +
    3537 return
    +
    3538 end if
    +
    3539 wptr => work(1:lwork)
    +
    3540 else
    +
    3541 allocate(wrk(lwork), stat = istat)
    +
    3542 if (istat /= 0) then
    +
    3543 ! ERROR: Out of memory
    +
    3544 call errmgr%report_error("solve_lq_mtx", &
    +
    3545 "Insufficient memory available.", &
    +
    3546 la_out_of_memory_error)
    +
    3547 return
    +
    3548 end if
    +
    3549 wptr => wrk
    +
    3550 end if
    +
    3551
    +
    3552 ! Solve the lower triangular system L * Y = B for Y, where Y = Q * X.
    +
    3553 ! The lower triangular system is M-by-M and Y is M-by-NHRS.
    +
    3554 call solve_triangular_system(.true., .false., .false., .true., one, &
    +
    3555 a(1:m,1:m), b(1:m,:), errmgr)
    +
    3556 if (errmgr%has_error_occurred()) return
    +
    3557
    +
    3558 ! Compute Q**T * Y = X
    +
    3559 call mult_lq(.true., .true., a, tau, b, work = wptr, err = errmgr)
    +
    3560 if (errmgr%has_error_occurred()) return
    +
    3561
    +
    3562 ! Formatting
    +
    3563100 format(a, i0, a)
    +
    3564 end subroutine
    +
    3565
    +
    3566! ------------------------------------------------------------------------------
    +
    3567 module subroutine solve_lq_mtx_cmplx(a, tau, b, work, olwork, err)
    +
    3568 ! Arguments
    +
    3569 complex(real64), intent(in), dimension(:,:) :: a
    +
    3570 complex(real64), intent(in), dimension(:) :: tau
    +
    3571 complex(real64), intent(inout), dimension(:,:) :: b
    +
    3572 complex(real64), intent(out), target, optional, dimension(:) :: work
    +
    3573 integer(int32), intent(out), optional :: olwork
    +
    3574 class(errors), intent(inout), optional, target :: err
    +
    3575
    +
    3576 ! Parameters
    +
    3577 complex(real64), parameter :: one = (1.0d0, 0.0d0)
    +
    3578
    +
    3579 ! Local Variables
    +
    3580 integer(int32) :: m, n, nrhs, k, lwork, flag, istat
    +
    3581 complex(real64), pointer, dimension(:) :: wptr
    +
    3582 complex(real64), allocatable, target, dimension(:) :: wrk
    +
    3583 class(errors), pointer :: errmgr
    +
    3584 type(errors), target :: deferr
    +
    3585 character(len = 128) :: errmsg
    +
    3586
    +
    3587 ! Initialization
    +
    3588 m = size(a, 1)
    +
    3589 n = size(a, 2)
    +
    3590 nrhs = size(b, 2)
    +
    3591 k = min(m, n)
    +
    3592 if (present(err)) then
    +
    3593 errmgr => err
    +
    3594 else
    +
    3595 errmgr => deferr
    +
    3596 end if
    +
    3597
    +
    3598 ! Input Check
    +
    3599 flag = 0
    +
    3600 if (m > n) then
    +
    3601 flag = 1
    +
    3602 else if (size(tau) /= k) then
    +
    3603 flag = 2
    +
    3604 else if (size(b, 1) /= n) then
    +
    3605 flag = 3
    +
    3606 end if
    +
    3607
    +
    3608 if (flag /= 0) then
    +
    3609 ! ERROR: One of the input arrays is not sized correctly
    +
    3610 write(errmsg, 100) "Input number ", flag, &
    +
    3611 " is not sized correctly."
    +
    3612 call errmgr%report_error("solve_lq_mtx_cmplx", trim(errmsg), &
    +
    3613 la_array_size_error)
    +
    3614 return
    +
    3615 end if
    +
    3616
    +
    3617 ! Workspace Query
    +
    3618 call mult_lq(.true., .true., a, tau, b, olwork = lwork)
    +
    3619
    +
    3620 if (present(olwork)) then
    +
    3621 olwork = lwork
    +
    3622 return
    +
    3623 end if
    +
    3624
    +
    3625 ! Local Memory Allocation
    +
    3626 if (present(work)) then
    +
    3627 if (size(work) < lwork) then
    +
    3628 ! ERROR: WORK not sized correctly
    +
    3629 call errmgr%report_error("solve_lq_mtx_cmplx", &
    +
    3630 "Incorrectly sized input array WORK, argument 4.", &
    +
    3631 la_array_size_error)
    +
    3632 return
    +
    3633 end if
    +
    3634 wptr => work(1:lwork)
    +
    3635 else
    +
    3636 allocate(wrk(lwork), stat = istat)
    +
    3637 if (istat /= 0) then
    +
    3638 ! ERROR: Out of memory
    +
    3639 call errmgr%report_error("solve_lq_mtx_cmplx", &
    +
    3640 "Insufficient memory available.", &
    +
    3641 la_out_of_memory_error)
    +
    3642 return
    +
    3643 end if
    +
    3644 wptr => wrk
    +
    3645 end if
    +
    3646
    +
    3647 ! Solve the lower triangular system L * Y = B for Y, where Y = Q * X.
    +
    3648 ! The lower triangular system is M-by-M and Y is M-by-NHRS.
    +
    3649 call solve_triangular_system(.true., .false., .false., .true., one, &
    +
    3650 a(1:m,1:m), b(1:m,:), errmgr)
    +
    3651 if (errmgr%has_error_occurred()) return
    +
    3652
    +
    3653 ! Compute Q**T * Y = X
    +
    3654 call mult_lq(.true., .true., a, tau, b, work = wptr, err = errmgr)
    +
    3655 if (errmgr%has_error_occurred()) return
    +
    3656
    +
    3657 ! Formatting
    +
    3658100 format(a, i0, a)
    +
    3659 end subroutine
    +
    3660
    +
    3661! ------------------------------------------------------------------------------
    +
    3662 module subroutine solve_lq_vec(a, tau, b, work, olwork, err)
    +
    3663 ! Arguments
    +
    3664 real(real64), intent(in), dimension(:,:) :: a
    +
    3665 real(real64), intent(in), dimension(:) :: tau
    +
    3666 real(real64), intent(inout), dimension(:) :: b
    +
    3667 real(real64), intent(out), target, optional, dimension(:) :: work
    +
    3668 integer(int32), intent(out), optional :: olwork
    +
    3669 class(errors), intent(inout), optional, target :: err
    +
    3670
    +
    3671 ! Local Variables
    +
    3672 integer(int32) :: m, n, k, lwork, flag, istat
    +
    3673 real(real64), pointer, dimension(:) :: wptr
    +
    3674 real(real64), allocatable, target, dimension(:) :: wrk
    +
    3675 class(errors), pointer :: errmgr
    +
    3676 type(errors), target :: deferr
    +
    3677 character(len = 128) :: errmsg
    +
    3678
    +
    3679 ! Initialization
    +
    3680 m = size(a, 1)
    +
    3681 n = size(a, 2)
    +
    3682 k = min(m, n)
    +
    3683 if (present(err)) then
    +
    3684 errmgr => err
    +
    3685 else
    +
    3686 errmgr => deferr
    +
    3687 end if
    +
    3688
    +
    3689 ! Input Check
    +
    3690 flag = 0
    +
    3691 if (m > n) then
    +
    3692 flag = 1
    +
    3693 else if (size(tau) /= k) then
    +
    3694 flag = 2
    +
    3695 else if (size(b) /= n) then
    +
    3696 flag = 3
    +
    3697 end if
    +
    3698
    +
    3699 if (flag /= 0) then
    +
    3700 ! ERROR: One of the input arrays is not sized correctly
    +
    3701 write(errmsg, 100) "Input number ", flag, &
    +
    3702 " is not sized correctly."
    +
    3703 call errmgr%report_error("solve_lq_vec", trim(errmsg), &
    +
    3704 la_array_size_error)
    +
    3705 return
    +
    3706 end if
    +
    3707
    +
    3708 ! Workspace Query
    +
    3709 call mult_lq(.true., a, tau, b, olwork = lwork)
    +
    3710
    +
    3711 if (present(olwork)) then
    +
    3712 olwork = lwork
    +
    3713 return
    +
    3714 end if
    +
    3715
    +
    3716 ! Local Memory Allocation
    +
    3717 if (present(work)) then
    +
    3718 if (size(work) < lwork) then
    +
    3719 ! ERROR: WORK not sized correctly
    +
    3720 call errmgr%report_error("solve_lq_vec", &
    +
    3721 "Incorrectly sized input array WORK, argument 4.", &
    +
    3722 la_array_size_error)
    +
    3723 return
    +
    3724 end if
    +
    3725 wptr => work(1:lwork)
    +
    3726 else
    +
    3727 allocate(wrk(lwork), stat = istat)
    +
    3728 if (istat /= 0) then
    +
    3729 ! ERROR: Out of memory
    +
    3730 call errmgr%report_error("solve_lq_vec", &
    +
    3731 "Insufficient memory available.", &
    +
    3732 la_out_of_memory_error)
    +
    3733 return
    +
    3734 end if
    +
    3735 wptr => wrk
    +
    3736 end if
    +
    3737
    +
    3738 ! Solve the lower triangular system L * Y = B for Y, where Y = Q * X.
    +
    3739 ! The lower triangular system is M-by-M and Y is M-by-NHRS.
    +
    3740 call solve_triangular_system(.false., .false., .true., a(1:m,1:m), &
    +
    3741 b(1:m), errmgr)
    +
    3742 if (errmgr%has_error_occurred()) return
    +
    3743
    +
    3744 ! Compute Q**T * Y = X
    +
    3745 call mult_lq(.true., a, tau, b, work = wptr, err = errmgr)
    +
    3746 if (errmgr%has_error_occurred()) return
    +
    3747
    +
    3748 ! Formatting
    +
    3749100 format(a, i0, a)
    +
    3750 end subroutine
    +
    3751
    +
    3752! ------------------------------------------------------------------------------
    +
    3753 module subroutine solve_lq_vec_cmplx(a, tau, b, work, olwork, err)
    +
    3754 ! Arguments
    +
    3755 complex(real64), intent(in), dimension(:,:) :: a
    +
    3756 complex(real64), intent(in), dimension(:) :: tau
    +
    3757 complex(real64), intent(inout), dimension(:) :: b
    +
    3758 complex(real64), intent(out), target, optional, dimension(:) :: work
    +
    3759 integer(int32), intent(out), optional :: olwork
    +
    3760 class(errors), intent(inout), optional, target :: err
    +
    3761
    +
    3762 ! Local Variables
    +
    3763 integer(int32) :: m, n, k, lwork, flag, istat
    +
    3764 complex(real64), pointer, dimension(:) :: wptr
    +
    3765 complex(real64), allocatable, target, dimension(:) :: wrk
    +
    3766 class(errors), pointer :: errmgr
    +
    3767 type(errors), target :: deferr
    +
    3768 character(len = 128) :: errmsg
    +
    3769
    +
    3770 ! Initialization
    +
    3771 m = size(a, 1)
    +
    3772 n = size(a, 2)
    +
    3773 k = min(m, n)
    +
    3774 if (present(err)) then
    +
    3775 errmgr => err
    +
    3776 else
    +
    3777 errmgr => deferr
    +
    3778 end if
    +
    3779
    +
    3780 ! Input Check
    +
    3781 flag = 0
    +
    3782 if (m > n) then
    +
    3783 flag = 1
    +
    3784 else if (size(tau) /= k) then
    +
    3785 flag = 2
    +
    3786 else if (size(b) /= n) then
    +
    3787 flag = 3
    +
    3788 end if
    +
    3789
    +
    3790 if (flag /= 0) then
    +
    3791 ! ERROR: One of the input arrays is not sized correctly
    +
    3792 write(errmsg, 100) "Input number ", flag, &
    +
    3793 " is not sized correctly."
    +
    3794 call errmgr%report_error("solve_lq_vec_cmplx", trim(errmsg), &
    +
    3795 la_array_size_error)
    +
    3796 return
    +
    3797 end if
    +
    3798
    +
    3799 ! Workspace Query
    +
    3800 call mult_lq(.true., a, tau, b, olwork = lwork)
    +
    3801
    +
    3802 if (present(olwork)) then
    +
    3803 olwork = lwork
    +
    3804 return
    +
    3805 end if
    +
    3806
    +
    3807 ! Local Memory Allocation
    +
    3808 if (present(work)) then
    +
    3809 if (size(work) < lwork) then
    +
    3810 ! ERROR: WORK not sized correctly
    +
    3811 call errmgr%report_error("solve_lq_vec_cmplx", &
    +
    3812 "Incorrectly sized input array WORK, argument 4.", &
    +
    3813 la_array_size_error)
    +
    3814 return
    +
    3815 end if
    +
    3816 wptr => work(1:lwork)
    +
    3817 else
    +
    3818 allocate(wrk(lwork), stat = istat)
    +
    3819 if (istat /= 0) then
    +
    3820 ! ERROR: Out of memory
    +
    3821 call errmgr%report_error("solve_lq_vec_cmplx", &
    +
    3822 "Insufficient memory available.", &
    +
    3823 la_out_of_memory_error)
    +
    3824 return
    +
    3825 end if
    +
    3826 wptr => wrk
    +
    3827 end if
    +
    3828
    +
    3829 ! Solve the lower triangular system L * Y = B for Y, where Y = Q * X.
    +
    3830 ! The lower triangular system is M-by-M and Y is M-by-NHRS.
    +
    3831 call solve_triangular_system(.false., .false., .true., a(1:m,1:m), &
    +
    3832 b(1:m), errmgr)
    +
    3833 if (errmgr%has_error_occurred()) return
    +
    3834
    +
    3835 ! Compute Q**T * Y = X
    +
    3836 call mult_lq(.true., a, tau, b, work = wptr, err = errmgr)
    +
    3837 if (errmgr%has_error_occurred()) return
    +
    3838
    +
    3839 ! Formatting
    +
    3840100 format(a, i0, a)
    +
    3841 end subroutine
    +
    3842
    +
    3843! ------------------------------------------------------------------------------
    +
    3844end submodule
    Provides a set of common linear algebra routines.
    Definition: linalg.f90:145
    diff --git a/doc/html/namespacelinalg.html b/doc/html/namespacelinalg.html index ac5759ff..af93c0cd 100644 --- a/doc/html/namespacelinalg.html +++ b/doc/html/namespacelinalg.html @@ -127,12 +127,18 @@ interface  eigen  Computes the eigenvalues, and optionally the eigenvectors, of a matrix. More...
      +interface  form_lq + Forms the matrix Q with orthonormal rows from the elementary reflectors returned by the LQ factorization algorithm. More...
    +  interface  form_lu  Extracts the L and U matrices from the condensed [L\U] storage format used by the lu_factor. More...
      interface  form_qr  Forms the full M-by-M orthogonal matrix Q from the elementary reflectors returned by the base QR factorization algorithm. More...
      +interface  lq_factor + Computes the LQ factorization of an M-by-N matrix. More...
    +  interface  lu_factor  Computes the LU factorization of an M-by-N matrix. More...
      @@ -148,6 +154,9 @@ interface  mtx_rank  Computes the rank of a matrix. More...
      +interface  mult_lq + Multiplies a general matrix by the orthogonal matrix Q from a LQ factorization. More...
    +  interface  mult_qr  Multiplies a general matrix by the orthogonal matrix Q from a QR factorization. More...
      @@ -181,6 +190,9 @@ interface  solve_least_squares_svd  Solves the overdetermined or underdetermined system \( A X = B \) of M equations of N unknowns using a singular value decomposition of matrix A. More...
      +interface  solve_lq + Solves a system of M LQ-factored equations of N unknowns. N must be greater than or equal to M. More...
    +  interface  solve_lu  Solves a system of LU-factored equations. More...
      @@ -259,7 +271,7 @@

    Definition at line 213 of file linalg.f90.

    +

    Definition at line 217 of file linalg.f90.

    @@ -277,7 +289,7 @@

    Definition at line 221 of file linalg.f90.

    +

    Definition at line 225 of file linalg.f90.

    @@ -295,7 +307,7 @@

    Definition at line 203 of file linalg.f90.

    +

    Definition at line 207 of file linalg.f90.

    @@ -313,7 +325,7 @@

    Definition at line 211 of file linalg.f90.

    +

    Definition at line 215 of file linalg.f90.

    @@ -331,7 +343,7 @@

    Definition at line 223 of file linalg.f90.

    +

    Definition at line 227 of file linalg.f90.

    @@ -349,7 +361,7 @@

    Definition at line 217 of file linalg.f90.

    +

    Definition at line 221 of file linalg.f90.

    @@ -367,7 +379,7 @@

    Definition at line 209 of file linalg.f90.

    +

    Definition at line 213 of file linalg.f90.

    @@ -385,7 +397,7 @@

    Definition at line 199 of file linalg.f90.

    +

    Definition at line 203 of file linalg.f90.

    @@ -403,7 +415,7 @@

    Definition at line 219 of file linalg.f90.

    +

    Definition at line 223 of file linalg.f90.

    @@ -421,7 +433,7 @@

    Definition at line 215 of file linalg.f90.

    +

    Definition at line 219 of file linalg.f90.

    @@ -439,7 +451,7 @@

    Definition at line 201 of file linalg.f90.

    +

    Definition at line 205 of file linalg.f90.

    diff --git a/doc/html/namespacelinalg.js b/doc/html/namespacelinalg.js index 14f3facb..414c4131 100644 --- a/doc/html/namespacelinalg.js +++ b/doc/html/namespacelinalg.js @@ -6,13 +6,16 @@ var namespacelinalg = [ "det", "interfacelinalg_1_1det.html", null ], [ "diag_mtx_mult", "interfacelinalg_1_1diag__mtx__mult.html", null ], [ "eigen", "interfacelinalg_1_1eigen.html", null ], + [ "form_lq", "interfacelinalg_1_1form__lq.html", null ], [ "form_lu", "interfacelinalg_1_1form__lu.html", null ], [ "form_qr", "interfacelinalg_1_1form__qr.html", null ], + [ "lq_factor", "interfacelinalg_1_1lq__factor.html", null ], [ "lu_factor", "interfacelinalg_1_1lu__factor.html", null ], [ "mtx_inverse", "interfacelinalg_1_1mtx__inverse.html", null ], [ "mtx_mult", "interfacelinalg_1_1mtx__mult.html", null ], [ "mtx_pinverse", "interfacelinalg_1_1mtx__pinverse.html", null ], [ "mtx_rank", "interfacelinalg_1_1mtx__rank.html", null ], + [ "mult_lq", "interfacelinalg_1_1mult__lq.html", null ], [ "mult_qr", "interfacelinalg_1_1mult__qr.html", null ], [ "mult_rz", "interfacelinalg_1_1mult__rz.html", null ], [ "qr_factor", "interfacelinalg_1_1qr__factor.html", null ], @@ -24,6 +27,7 @@ var namespacelinalg = [ "solve_least_squares", "interfacelinalg_1_1solve__least__squares.html", null ], [ "solve_least_squares_full", "interfacelinalg_1_1solve__least__squares__full.html", null ], [ "solve_least_squares_svd", "interfacelinalg_1_1solve__least__squares__svd.html", null ], + [ "solve_lq", "interfacelinalg_1_1solve__lq.html", null ], [ "solve_lu", "interfacelinalg_1_1solve__lu.html", null ], [ "solve_qr", "interfacelinalg_1_1solve__qr.html", null ], [ "solve_triangular_system", "interfacelinalg_1_1solve__triangular__system.html", null ], diff --git a/doc/html/namespaces.html b/doc/html/namespaces.html index d6222f73..b472dfa2 100644 --- a/doc/html/namespaces.html +++ b/doc/html/namespaces.html @@ -109,32 +109,36 @@  CdetComputes the determinant of a square matrix  Cdiag_mtx_multMultiplies a diagonal matrix with another matrix or array  CeigenComputes the eigenvalues, and optionally the eigenvectors, of a matrix - Cform_luExtracts the L and U matrices from the condensed [L\U] storage format used by the lu_factor - Cform_qrForms the full M-by-M orthogonal matrix Q from the elementary reflectors returned by the base QR factorization algorithm - Clu_factorComputes the LU factorization of an M-by-N matrix - Cmtx_inverseComputes the inverse of a square matrix - Cmtx_multPerforms the matrix operation: \( C = \alpha op(A) op(B) + \beta C \) - Cmtx_pinverseComputes the Moore-Penrose pseudo-inverse of a M-by-N matrix using the singular value decomposition of the matrix - Cmtx_rankComputes the rank of a matrix - Cmult_qrMultiplies a general matrix by the orthogonal matrix Q from a QR factorization - Cmult_rzMultiplies a general matrix by the orthogonal matrix Z from an RZ factorization - Cqr_factorComputes the QR factorization of an M-by-N matrix - Cqr_rank1_updateComputes the rank 1 update to an M-by-N QR factored matrix A (M >= N) where \( A = Q R \), and \( A1 = A + U V^T \) such that \( A1 = Q1 R1 \). In the event \( V \) is complex-valued, \( V^H \) is computed instead of \( V^T \) - Crank1_updatePerforms the rank-1 update to matrix A such that: \( A = \alpha X Y^T + A \), where \( A \) is an M-by-N matrix, \( \alpha \)is a scalar, \( X \) is an M-element array, and \( Y \) is an N-element array. In the event that \( Y \) is complex, \( Y^H \) is used instead of \( Y^T \) - Crecip_mult_arrayMultiplies a vector by the reciprocal of a real scalar - Crz_factorFactors an upper trapezoidal matrix by means of orthogonal transformations such that \( A = R Z = (R 0) Z \). Z is an orthogonal matrix of dimension N-by-N, and R is an M-by-M upper triangular matrix - Csolve_choleskySolves a system of Cholesky factored equations - Csolve_least_squaresSolves the overdetermined or underdetermined system \( A X = B \) of M equations of N unknowns. Notice, it is assumed that matrix A has full rank - Csolve_least_squares_fullSolves the overdetermined or underdetermined system \( A X = B \) of M equations of N unknowns, but uses a full orthogonal factorization of the system - Csolve_least_squares_svdSolves the overdetermined or underdetermined system \( A X = B \) of M equations of N unknowns using a singular value decomposition of matrix A - Csolve_luSolves a system of LU-factored equations - Csolve_qrSolves a system of M QR-factored equations of N unknowns - Csolve_triangular_systemSolves a triangular system of equations - CsortSorts an array - CsvdComputes the singular value decomposition of a matrix A. The SVD is defined as: \( A = U S V^T \), where \( U \) is an M-by-M orthogonal matrix, \( S \) is an M-by-N diagonal matrix, and \( V \) is an N-by-N orthogonal matrix. In the event that \( V \) is complex valued, \( V^H \) is computed instead of \( V^T \) - CswapSwaps the contents of two arrays - CtraceComputes the trace of a matrix (the sum of the main diagonal elements) - Ctri_mtx_multComputes the triangular matrix operation: \( B = \alpha A^T A + \beta B \), or \( B = \alpha A A^T + \beta B \), where A is a triangular matrix + Cform_lqForms the matrix Q with orthonormal rows from the elementary reflectors returned by the LQ factorization algorithm + Cform_luExtracts the L and U matrices from the condensed [L\U] storage format used by the lu_factor + Cform_qrForms the full M-by-M orthogonal matrix Q from the elementary reflectors returned by the base QR factorization algorithm + Clq_factorComputes the LQ factorization of an M-by-N matrix + Clu_factorComputes the LU factorization of an M-by-N matrix + Cmtx_inverseComputes the inverse of a square matrix + Cmtx_multPerforms the matrix operation: \( C = \alpha op(A) op(B) + \beta C \) + Cmtx_pinverseComputes the Moore-Penrose pseudo-inverse of a M-by-N matrix using the singular value decomposition of the matrix + Cmtx_rankComputes the rank of a matrix + Cmult_lqMultiplies a general matrix by the orthogonal matrix Q from a LQ factorization + Cmult_qrMultiplies a general matrix by the orthogonal matrix Q from a QR factorization + Cmult_rzMultiplies a general matrix by the orthogonal matrix Z from an RZ factorization + Cqr_factorComputes the QR factorization of an M-by-N matrix + Cqr_rank1_updateComputes the rank 1 update to an M-by-N QR factored matrix A (M >= N) where \( A = Q R \), and \( A1 = A + U V^T \) such that \( A1 = Q1 R1 \). In the event \( V \) is complex-valued, \( V^H \) is computed instead of \( V^T \) + Crank1_updatePerforms the rank-1 update to matrix A such that: \( A = \alpha X Y^T + A \), where \( A \) is an M-by-N matrix, \( \alpha \)is a scalar, \( X \) is an M-element array, and \( Y \) is an N-element array. In the event that \( Y \) is complex, \( Y^H \) is used instead of \( Y^T \) + Crecip_mult_arrayMultiplies a vector by the reciprocal of a real scalar + Crz_factorFactors an upper trapezoidal matrix by means of orthogonal transformations such that \( A = R Z = (R 0) Z \). Z is an orthogonal matrix of dimension N-by-N, and R is an M-by-M upper triangular matrix + Csolve_choleskySolves a system of Cholesky factored equations + Csolve_least_squaresSolves the overdetermined or underdetermined system \( A X = B \) of M equations of N unknowns. Notice, it is assumed that matrix A has full rank + Csolve_least_squares_fullSolves the overdetermined or underdetermined system \( A X = B \) of M equations of N unknowns, but uses a full orthogonal factorization of the system + Csolve_least_squares_svdSolves the overdetermined or underdetermined system \( A X = B \) of M equations of N unknowns using a singular value decomposition of matrix A + Csolve_lqSolves a system of M LQ-factored equations of N unknowns. N must be greater than or equal to M + Csolve_luSolves a system of LU-factored equations + Csolve_qrSolves a system of M QR-factored equations of N unknowns + Csolve_triangular_systemSolves a triangular system of equations + CsortSorts an array + CsvdComputes the singular value decomposition of a matrix A. The SVD is defined as: \( A = U S V^T \), where \( U \) is an M-by-M orthogonal matrix, \( S \) is an M-by-N diagonal matrix, and \( V \) is an N-by-N orthogonal matrix. In the event that \( V \) is complex valued, \( V^H \) is computed instead of \( V^T \) + CswapSwaps the contents of two arrays + CtraceComputes the trace of a matrix (the sum of the main diagonal elements) + Ctri_mtx_multComputes the triangular matrix operation: \( B = \alpha A^T A + \beta B \), or \( B = \alpha A A^T + \beta B \), where A is a triangular matrix diff --git a/doc/html/navtreeindex0.js b/doc/html/navtreeindex0.js index 69609c75..4837cc85 100644 --- a/doc/html/navtreeindex0.js +++ b/doc/html/navtreeindex0.js @@ -11,131 +11,147 @@ var NAVTREEINDEX0 = "index.html#intro_sec":[0], "interfacelinalg_1_1cholesky__factor.html":[1,0,0,0], "interfacelinalg_1_1cholesky__factor.html":[2,0,0,0], -"interfacelinalg_1_1cholesky__rank1__downdate.html":[1,0,0,1], "interfacelinalg_1_1cholesky__rank1__downdate.html":[2,0,0,1], -"interfacelinalg_1_1cholesky__rank1__update.html":[1,0,0,2], +"interfacelinalg_1_1cholesky__rank1__downdate.html":[1,0,0,1], "interfacelinalg_1_1cholesky__rank1__update.html":[2,0,0,2], +"interfacelinalg_1_1cholesky__rank1__update.html":[1,0,0,2], "interfacelinalg_1_1det.html":[2,0,0,3], "interfacelinalg_1_1det.html":[1,0,0,3], -"interfacelinalg_1_1diag__mtx__mult.html":[2,0,0,4], "interfacelinalg_1_1diag__mtx__mult.html":[1,0,0,4], -"interfacelinalg_1_1eigen.html":[2,0,0,5], +"interfacelinalg_1_1diag__mtx__mult.html":[2,0,0,4], "interfacelinalg_1_1eigen.html":[1,0,0,5], -"interfacelinalg_1_1form__lu.html":[1,0,0,6], -"interfacelinalg_1_1form__lu.html":[2,0,0,6], -"interfacelinalg_1_1form__qr.html":[1,0,0,7], -"interfacelinalg_1_1form__qr.html":[2,0,0,7], -"interfacelinalg_1_1lu__factor.html":[1,0,0,8], -"interfacelinalg_1_1lu__factor.html":[2,0,0,8], -"interfacelinalg_1_1mtx__inverse.html":[1,0,0,9], -"interfacelinalg_1_1mtx__inverse.html":[2,0,0,9], -"interfacelinalg_1_1mtx__mult.html":[1,0,0,10], -"interfacelinalg_1_1mtx__mult.html":[2,0,0,10], -"interfacelinalg_1_1mtx__pinverse.html":[2,0,0,11], -"interfacelinalg_1_1mtx__pinverse.html":[1,0,0,11], -"interfacelinalg_1_1mtx__rank.html":[2,0,0,12], -"interfacelinalg_1_1mtx__rank.html":[1,0,0,12], -"interfacelinalg_1_1mult__qr.html":[1,0,0,13], -"interfacelinalg_1_1mult__qr.html":[2,0,0,13], -"interfacelinalg_1_1mult__rz.html":[2,0,0,14], -"interfacelinalg_1_1mult__rz.html":[1,0,0,14], -"interfacelinalg_1_1qr__factor.html":[2,0,0,15], -"interfacelinalg_1_1qr__factor.html":[1,0,0,15], -"interfacelinalg_1_1qr__rank1__update.html":[2,0,0,16], -"interfacelinalg_1_1qr__rank1__update.html":[1,0,0,16], -"interfacelinalg_1_1rank1__update.html":[2,0,0,17], -"interfacelinalg_1_1rank1__update.html":[1,0,0,17], -"interfacelinalg_1_1recip__mult__array.html":[2,0,0,18], -"interfacelinalg_1_1recip__mult__array.html":[1,0,0,18], -"interfacelinalg_1_1rz__factor.html":[2,0,0,19], -"interfacelinalg_1_1rz__factor.html":[1,0,0,19], -"interfacelinalg_1_1solve__cholesky.html":[1,0,0,20], -"interfacelinalg_1_1solve__cholesky.html":[2,0,0,20], -"interfacelinalg_1_1solve__least__squares.html":[1,0,0,21], -"interfacelinalg_1_1solve__least__squares.html":[2,0,0,21], -"interfacelinalg_1_1solve__least__squares__full.html":[1,0,0,22], -"interfacelinalg_1_1solve__least__squares__full.html":[2,0,0,22], -"interfacelinalg_1_1solve__least__squares__svd.html":[1,0,0,23], -"interfacelinalg_1_1solve__least__squares__svd.html":[2,0,0,23], -"interfacelinalg_1_1solve__lu.html":[1,0,0,24], -"interfacelinalg_1_1solve__lu.html":[2,0,0,24], -"interfacelinalg_1_1solve__qr.html":[1,0,0,25], -"interfacelinalg_1_1solve__qr.html":[2,0,0,25], -"interfacelinalg_1_1solve__triangular__system.html":[1,0,0,26], -"interfacelinalg_1_1solve__triangular__system.html":[2,0,0,26], -"interfacelinalg_1_1sort.html":[2,0,0,27], -"interfacelinalg_1_1sort.html":[1,0,0,27], -"interfacelinalg_1_1svd.html":[2,0,0,28], -"interfacelinalg_1_1svd.html":[1,0,0,28], -"interfacelinalg_1_1swap.html":[1,0,0,29], -"interfacelinalg_1_1swap.html":[2,0,0,29], -"interfacelinalg_1_1trace.html":[1,0,0,30], -"interfacelinalg_1_1trace.html":[2,0,0,30], -"interfacelinalg_1_1tri__mtx__mult.html":[1,0,0,31], -"interfacelinalg_1_1tri__mtx__mult.html":[2,0,0,31], +"interfacelinalg_1_1eigen.html":[2,0,0,5], +"interfacelinalg_1_1form__lq.html":[1,0,0,6], +"interfacelinalg_1_1form__lq.html":[2,0,0,6], +"interfacelinalg_1_1form__lu.html":[1,0,0,7], +"interfacelinalg_1_1form__lu.html":[2,0,0,7], +"interfacelinalg_1_1form__qr.html":[2,0,0,8], +"interfacelinalg_1_1form__qr.html":[1,0,0,8], +"interfacelinalg_1_1lq__factor.html":[1,0,0,9], +"interfacelinalg_1_1lq__factor.html":[2,0,0,9], +"interfacelinalg_1_1lu__factor.html":[2,0,0,10], +"interfacelinalg_1_1lu__factor.html":[1,0,0,10], +"interfacelinalg_1_1mtx__inverse.html":[1,0,0,11], +"interfacelinalg_1_1mtx__inverse.html":[2,0,0,11], +"interfacelinalg_1_1mtx__mult.html":[1,0,0,12], +"interfacelinalg_1_1mtx__mult.html":[2,0,0,12], +"interfacelinalg_1_1mtx__pinverse.html":[1,0,0,13], +"interfacelinalg_1_1mtx__pinverse.html":[2,0,0,13], +"interfacelinalg_1_1mtx__rank.html":[1,0,0,14], +"interfacelinalg_1_1mtx__rank.html":[2,0,0,14], +"interfacelinalg_1_1mult__lq.html":[1,0,0,15], +"interfacelinalg_1_1mult__lq.html":[2,0,0,15], +"interfacelinalg_1_1mult__qr.html":[1,0,0,16], +"interfacelinalg_1_1mult__qr.html":[2,0,0,16], +"interfacelinalg_1_1mult__rz.html":[1,0,0,17], +"interfacelinalg_1_1mult__rz.html":[2,0,0,17], +"interfacelinalg_1_1qr__factor.html":[1,0,0,18], +"interfacelinalg_1_1qr__factor.html":[2,0,0,18], +"interfacelinalg_1_1qr__rank1__update.html":[2,0,0,19], +"interfacelinalg_1_1qr__rank1__update.html":[1,0,0,19], +"interfacelinalg_1_1rank1__update.html":[2,0,0,20], +"interfacelinalg_1_1rank1__update.html":[1,0,0,20], +"interfacelinalg_1_1recip__mult__array.html":[2,0,0,21], +"interfacelinalg_1_1recip__mult__array.html":[1,0,0,21], +"interfacelinalg_1_1rz__factor.html":[2,0,0,22], +"interfacelinalg_1_1rz__factor.html":[1,0,0,22], +"interfacelinalg_1_1solve__cholesky.html":[2,0,0,23], +"interfacelinalg_1_1solve__cholesky.html":[1,0,0,23], +"interfacelinalg_1_1solve__least__squares.html":[1,0,0,24], +"interfacelinalg_1_1solve__least__squares.html":[2,0,0,24], +"interfacelinalg_1_1solve__least__squares__full.html":[1,0,0,25], +"interfacelinalg_1_1solve__least__squares__full.html":[2,0,0,25], +"interfacelinalg_1_1solve__least__squares__svd.html":[1,0,0,26], +"interfacelinalg_1_1solve__least__squares__svd.html":[2,0,0,26], +"interfacelinalg_1_1solve__lq.html":[1,0,0,27], +"interfacelinalg_1_1solve__lq.html":[2,0,0,27], +"interfacelinalg_1_1solve__lu.html":[1,0,0,28], +"interfacelinalg_1_1solve__lu.html":[2,0,0,28], +"interfacelinalg_1_1solve__qr.html":[1,0,0,29], +"interfacelinalg_1_1solve__qr.html":[2,0,0,29], +"interfacelinalg_1_1solve__triangular__system.html":[1,0,0,30], +"interfacelinalg_1_1solve__triangular__system.html":[2,0,0,30], +"interfacelinalg_1_1sort.html":[1,0,0,31], +"interfacelinalg_1_1sort.html":[2,0,0,31], +"interfacelinalg_1_1svd.html":[2,0,0,32], +"interfacelinalg_1_1svd.html":[1,0,0,32], +"interfacelinalg_1_1swap.html":[1,0,0,33], +"interfacelinalg_1_1swap.html":[2,0,0,33], +"interfacelinalg_1_1trace.html":[1,0,0,34], +"interfacelinalg_1_1trace.html":[2,0,0,34], +"interfacelinalg_1_1tri__mtx__mult.html":[1,0,0,35], +"interfacelinalg_1_1tri__mtx__mult.html":[2,0,0,35], "linalg_8f90_source.html":[3,0,1,0], "linalg_8h.html":[3,0,0,0], "linalg_8h.html#a00c15ec713541d15eae1fd0b01897689":[3,0,0,0,3], -"linalg_8h.html#a021fbb7fdccf557ec407a86bace43d85":[3,0,0,0,58], -"linalg_8h.html#a02c464a9dd95298c91f431ae4d0773e9":[3,0,0,0,60], -"linalg_8h.html#a02eb049983dd41f2307bb52594fb210e":[3,0,0,0,43], -"linalg_8h.html#a0338870fe1142f88c96db63495fec615":[3,0,0,0,18], -"linalg_8h.html#a089690d293303e30c6eef0bb1e982191":[3,0,0,0,37], -"linalg_8h.html#a090178a5f99a4b400da80481aad77757":[3,0,0,0,54], -"linalg_8h.html#a0dc578507a0cb6ada776142476383590":[3,0,0,0,41], -"linalg_8h.html#a0ff5f2519eb1d2af94e3b4a26dfb10fe":[3,0,0,0,48], -"linalg_8h.html#a15774f6323c34d307c99b32ac4f188a7":[3,0,0,0,15], +"linalg_8h.html#a021fbb7fdccf557ec407a86bace43d85":[3,0,0,0,66], +"linalg_8h.html#a02c464a9dd95298c91f431ae4d0773e9":[3,0,0,0,68], +"linalg_8h.html#a02eb049983dd41f2307bb52594fb210e":[3,0,0,0,49], +"linalg_8h.html#a0338870fe1142f88c96db63495fec615":[3,0,0,0,20], +"linalg_8h.html#a089690d293303e30c6eef0bb1e982191":[3,0,0,0,43], +"linalg_8h.html#a090178a5f99a4b400da80481aad77757":[3,0,0,0,62], +"linalg_8h.html#a0dc578507a0cb6ada776142476383590":[3,0,0,0,47], +"linalg_8h.html#a0ff5f2519eb1d2af94e3b4a26dfb10fe":[3,0,0,0,56], +"linalg_8h.html#a15774f6323c34d307c99b32ac4f188a7":[3,0,0,0,17], "linalg_8h.html#a1734acc61ef569dfff9c83bcad566f67":[3,0,0,0,1], -"linalg_8h.html#a248142a5f0826cddac5daf1c74f234a6":[3,0,0,0,23], +"linalg_8h.html#a248142a5f0826cddac5daf1c74f234a6":[3,0,0,0,27], "linalg_8h.html#a292e54c48a8e7f0203bf11f02844691f":[3,0,0,0,2], +"linalg_8h.html#a2c485d619c24435be713cf4356285e9a":[3,0,0,0,51], "linalg_8h.html#a3967bc139cba341a513d1353bea62ac9":[3,0,0,0,0], -"linalg_8h.html#a3c958fe274f8d1663dd0188455a5fe15":[3,0,0,0,39], -"linalg_8h.html#a4a3f6dafe185c2985fc76aab3d0abb97":[3,0,0,0,33], +"linalg_8h.html#a3c958fe274f8d1663dd0188455a5fe15":[3,0,0,0,45], +"linalg_8h.html#a4a3f6dafe185c2985fc76aab3d0abb97":[3,0,0,0,39], "linalg_8h.html#a4b74177a8914b109e1bf3aa56c9d9cb7":[3,0,0,0,8], -"linalg_8h.html#a4bc671dad87b42ff285a4241322a3764":[3,0,0,0,34], +"linalg_8h.html#a4bc671dad87b42ff285a4241322a3764":[3,0,0,0,40], "linalg_8h.html#a4d5bad18dcc8a52d9594cc21954c572d":[3,0,0,0,10], -"linalg_8h.html#a56c0cea99a066e74c8fff9682d5ca92d":[3,0,0,0,55], -"linalg_8h.html#a62f97b4319f5574aef5e52bbacff14bb":[3,0,0,0,50], +"linalg_8h.html#a54ee9d9ab89b88b0ca682f70bc6c3c54":[3,0,0,0,52], +"linalg_8h.html#a56c0cea99a066e74c8fff9682d5ca92d":[3,0,0,0,63], +"linalg_8h.html#a5e6786c40f8f91e5f16f06e92be71ffa":[3,0,0,0,26], +"linalg_8h.html#a62f97b4319f5574aef5e52bbacff14bb":[3,0,0,0,58], "linalg_8h.html#a63bec2daa56fdc4bbf3f45b67ea14f65":[3,0,0,0,9], -"linalg_8h.html#a719ffdff56c8fa0875409c4f4e5e95cf":[3,0,0,0,42], -"linalg_8h.html#a71ba1a09caca9d59a9d24b95c7ea749b":[3,0,0,0,30], -"linalg_8h.html#a73bea3ca338925cfa4a58bcaea726a14":[3,0,0,0,16], -"linalg_8h.html#a791d5221eb8ad4fcd106cb218590dfc9":[3,0,0,0,31], -"linalg_8h.html#a7a821b41c61670f5710214a4d9178998":[3,0,0,0,22], -"linalg_8h.html#a7f611f8f3de7d56120c78e70671c7112":[3,0,0,0,57], +"linalg_8h.html#a719ffdff56c8fa0875409c4f4e5e95cf":[3,0,0,0,48], +"linalg_8h.html#a71ba1a09caca9d59a9d24b95c7ea749b":[3,0,0,0,36], +"linalg_8h.html#a73bea3ca338925cfa4a58bcaea726a14":[3,0,0,0,18], +"linalg_8h.html#a791d5221eb8ad4fcd106cb218590dfc9":[3,0,0,0,37], +"linalg_8h.html#a7a821b41c61670f5710214a4d9178998":[3,0,0,0,24], +"linalg_8h.html#a7b2048bb219e58f455175041558ac44f":[3,0,0,0,25], +"linalg_8h.html#a7f611f8f3de7d56120c78e70671c7112":[3,0,0,0,65], "linalg_8h.html#a9491626ab4b3664771e1282b61eeaa74":[3,0,0,0,11], -"linalg_8h.html#a95d6ed56844c62d553b940091837014b":[3,0,0,0,21], -"linalg_8h.html#a95f921847131eaedd62a439490d2a801":[3,0,0,0,27], -"linalg_8h.html#a968b10545320af7bbe1030867ae88e8c":[3,0,0,0,25], -"linalg_8h.html#a9b0639faf9ac0af9bbdb348b92746d5f":[3,0,0,0,35], -"linalg_8h.html#aa067ac0d3f58e28371d413ab7419da74":[3,0,0,0,46], -"linalg_8h.html#aace787c5b11959a457b936ace4995033":[3,0,0,0,20], -"linalg_8h.html#aae725d3247301d1163c58f89edff3d4b":[3,0,0,0,45], -"linalg_8h.html#ab346fed23fd61f02d65e09c795c26d74":[3,0,0,0,38], +"linalg_8h.html#a95d6ed56844c62d553b940091837014b":[3,0,0,0,23], +"linalg_8h.html#a95f921847131eaedd62a439490d2a801":[3,0,0,0,33], +"linalg_8h.html#a968b10545320af7bbe1030867ae88e8c":[3,0,0,0,29], +"linalg_8h.html#a9b0639faf9ac0af9bbdb348b92746d5f":[3,0,0,0,41], +"linalg_8h.html#aa067ac0d3f58e28371d413ab7419da74":[3,0,0,0,54], +"linalg_8h.html#aa54b8d224976dca7ef384eed74f50bed":[3,0,0,0,16], +"linalg_8h.html#aace787c5b11959a457b936ace4995033":[3,0,0,0,22], +"linalg_8h.html#aae725d3247301d1163c58f89edff3d4b":[3,0,0,0,53], +"linalg_8h.html#ab346fed23fd61f02d65e09c795c26d74":[3,0,0,0,44], "linalg_8h.html#abeb7ee58d4151498be96aa91432f296f":[3,0,0,0,4], -"linalg_8h.html#abf5918abab8f97fc2ac5887e051ff493":[3,0,0,0,53], +"linalg_8h.html#abf5918abab8f97fc2ac5887e051ff493":[3,0,0,0,61], "linalg_8h.html#ac208d5e6849972a77ef261f2e368868c":[3,0,0,0,14], -"linalg_8h.html#ac3bb7b959d8cc7400e9b13290a895b64":[3,0,0,0,44], +"linalg_8h.html#ac3bb7b959d8cc7400e9b13290a895b64":[3,0,0,0,50], +"linalg_8h.html#ac54763802ad5c3966f8e14cdf93fdc96":[3,0,0,0,15], +"linalg_8h.html#ac575e10e20e9c2d8d40ed8df47179773":[3,0,0,0,31], "linalg_8h.html#ac7b4894cd929a106e02a8e37a4d52913":[3,0,0,0,6], -"linalg_8h.html#acc25c0daa53c10ace21a61d78b2e79f3":[3,0,0,0,28], -"linalg_8h.html#ace554b62c12a5d9a2434c8171c756c47":[3,0,0,0,24], +"linalg_8h.html#acc25c0daa53c10ace21a61d78b2e79f3":[3,0,0,0,34], +"linalg_8h.html#ace554b62c12a5d9a2434c8171c756c47":[3,0,0,0,28], "linalg_8h.html#ace9edf6a878ee4dd0b220b75b7db6431":[3,0,0,0,7], -"linalg_8h.html#acfbd42393c8b1931ff11bc4c7e858aef":[3,0,0,0,36], -"linalg_8h.html#ad0ee4a9c71de62911a71a342790f5070":[3,0,0,0,49], -"linalg_8h.html#ad76e25c5eb98075e83cc9df493be5b38":[3,0,0,0,19], +"linalg_8h.html#acfbd42393c8b1931ff11bc4c7e858aef":[3,0,0,0,42], +"linalg_8h.html#ad0ee4a9c71de62911a71a342790f5070":[3,0,0,0,57], +"linalg_8h.html#ad76e25c5eb98075e83cc9df493be5b38":[3,0,0,0,21], +"linalg_8h.html#adcb07293cf47d090dfb89c20837ca7b5":[3,0,0,0,32], "linalg_8h.html#ae5a16375c14c924836c33bafa747a1cf":[3,0,0,0,12], -"linalg_8h.html#ae5ffa6e8d9c850bd41f43f7564bf6896":[3,0,0,0,32], -"linalg_8h.html#ae7d70f1ef2a2824772e1bf0f726c257e":[3,0,0,0,59], -"linalg_8h.html#aed7b29bbff1472ebe805054eb9d8c6d4":[3,0,0,0,51], -"linalg_8h.html#aefdc2e6758482d02a3aa7978f7d5efe0":[3,0,0,0,47], -"linalg_8h.html#aefefe80e13f74470d5afaf44b3a45e76":[3,0,0,0,26], +"linalg_8h.html#ae5ffa6e8d9c850bd41f43f7564bf6896":[3,0,0,0,38], +"linalg_8h.html#ae7d70f1ef2a2824772e1bf0f726c257e":[3,0,0,0,67], +"linalg_8h.html#aed7b29bbff1472ebe805054eb9d8c6d4":[3,0,0,0,59], +"linalg_8h.html#aefdc2e6758482d02a3aa7978f7d5efe0":[3,0,0,0,55], +"linalg_8h.html#aefefe80e13f74470d5afaf44b3a45e76":[3,0,0,0,30], "linalg_8h.html#af19ebf41be31ee92f657131a8fbf55a3":[3,0,0,0,5], "linalg_8h.html#af3c6f1a45aee2f275d4b109c9bb660d2":[3,0,0,0,13], -"linalg_8h.html#af7f8185c0f25ad3fb0b89cc98d77b3d6":[3,0,0,0,29], -"linalg_8h.html#af87823d73fb5a319e4262594d147e38c":[3,0,0,0,52], -"linalg_8h.html#afbffa0856d75c607a03d3dc7b5b1076e":[3,0,0,0,56], -"linalg_8h.html#afdc9b7e6ffab89915a082c00ceac7258":[3,0,0,0,40], -"linalg_8h.html#afe39765d805c1d9ae93e9aa2f20d8548":[3,0,0,0,17], +"linalg_8h.html#af7f8185c0f25ad3fb0b89cc98d77b3d6":[3,0,0,0,35], +"linalg_8h.html#af87823d73fb5a319e4262594d147e38c":[3,0,0,0,60], +"linalg_8h.html#afbffa0856d75c607a03d3dc7b5b1076e":[3,0,0,0,64], +"linalg_8h.html#afdc9b7e6ffab89915a082c00ceac7258":[3,0,0,0,46], +"linalg_8h.html#afe39765d805c1d9ae93e9aa2f20d8548":[3,0,0,0,19], "linalg_8h_source.html":[3,0,0,0], "linalg__basic_8f90_source.html":[3,0,1,1], "linalg__eigen_8f90_source.html":[3,0,1,2], @@ -143,17 +159,17 @@ var NAVTREEINDEX0 = "linalg__solve_8f90_source.html":[3,0,1,4], "linalg__sorting_8f90_source.html":[3,0,1,5], "namespacelinalg.html":[1,0,0], -"namespacelinalg.html#a0e420096028b759a87f2f4f4306d202a":[1,0,0,34], -"namespacelinalg.html#a2b842a1fb17710d7ec2f117f5fdb2a59":[1,0,0,42], -"namespacelinalg.html#a4f47021e96cd813b568422a2eb3821bc":[1,0,0,36], -"namespacelinalg.html#a665d131453840e869510e9e8d2f7f151":[1,0,0,39], -"namespacelinalg.html#a7974856c0c0c76e6f1f2098a1eb7eac9":[1,0,0,32], -"namespacelinalg.html#abfb78ba61c0c2751f1c771c984469006":[1,0,0,40], -"namespacelinalg.html#ac691dea40873ac2a70c8b44c933774a7":[1,0,0,33], -"namespacelinalg.html#ace738355659bce2e9591473f0d543ef7":[1,0,0,35], -"namespacelinalg.html#ad89b9d502b7c484df53f9b10b9545776":[1,0,0,37], -"namespacelinalg.html#aefdfc0979567e89aa3b8c599d3f766f4":[1,0,0,38], -"namespacelinalg.html#af5dc9d60151bb81436b442525871c8c9":[1,0,0,41], +"namespacelinalg.html#a0e420096028b759a87f2f4f4306d202a":[1,0,0,38], +"namespacelinalg.html#a2b842a1fb17710d7ec2f117f5fdb2a59":[1,0,0,46], +"namespacelinalg.html#a4f47021e96cd813b568422a2eb3821bc":[1,0,0,40], +"namespacelinalg.html#a665d131453840e869510e9e8d2f7f151":[1,0,0,43], +"namespacelinalg.html#a7974856c0c0c76e6f1f2098a1eb7eac9":[1,0,0,36], +"namespacelinalg.html#abfb78ba61c0c2751f1c771c984469006":[1,0,0,44], +"namespacelinalg.html#ac691dea40873ac2a70c8b44c933774a7":[1,0,0,37], +"namespacelinalg.html#ace738355659bce2e9591473f0d543ef7":[1,0,0,39], +"namespacelinalg.html#ad89b9d502b7c484df53f9b10b9545776":[1,0,0,41], +"namespacelinalg.html#aefdfc0979567e89aa3b8c599d3f766f4":[1,0,0,42], +"namespacelinalg.html#af5dc9d60151bb81436b442525871c8c9":[1,0,0,45], "namespacemembers.html":[1,1,0], "namespacemembers_vars.html":[1,1,1], "namespaces.html":[1,0], diff --git a/doc/html/search/all_3.js b/doc/html/search/all_3.js index d6925134..6ac0a6ce 100644 --- a/doc/html/search/all_3.js +++ b/doc/html/search/all_3.js @@ -1,5 +1,6 @@ var searchData= [ - ['form_5flu_0',['form_lu',['../interfacelinalg_1_1form__lu.html',1,'linalg']]], - ['form_5fqr_1',['form_qr',['../interfacelinalg_1_1form__qr.html',1,'linalg']]] + ['form_5flq_0',['form_lq',['../interfacelinalg_1_1form__lq.html',1,'linalg']]], + ['form_5flu_1',['form_lu',['../interfacelinalg_1_1form__lu.html',1,'linalg']]], + ['form_5fqr_2',['form_qr',['../interfacelinalg_1_1form__qr.html',1,'linalg']]] ]; diff --git a/doc/html/search/all_4.js b/doc/html/search/all_4.js index 8609fff0..35ef54c2 100644 --- a/doc/html/search/all_4.js +++ b/doc/html/search/all_4.js @@ -17,62 +17,71 @@ var searchData= ['la_5feigen_5fcmplx_14',['la_eigen_cmplx',['../linalg_8h.html#ae5a16375c14c924836c33bafa747a1cf',1,'linalg.h']]], ['la_5feigen_5fgen_15',['la_eigen_gen',['../linalg_8h.html#af3c6f1a45aee2f275d4b109c9bb660d2',1,'linalg.h']]], ['la_5feigen_5fsymm_16',['la_eigen_symm',['../linalg_8h.html#ac208d5e6849972a77ef261f2e368868c',1,'linalg.h']]], - ['la_5fform_5flu_17',['la_form_lu',['../linalg_8h.html#a15774f6323c34d307c99b32ac4f188a7',1,'linalg.h']]], - ['la_5fform_5flu_5fcmplx_18',['la_form_lu_cmplx',['../linalg_8h.html#a73bea3ca338925cfa4a58bcaea726a14',1,'linalg.h']]], - ['la_5fform_5fqr_19',['la_form_qr',['../linalg_8h.html#afe39765d805c1d9ae93e9aa2f20d8548',1,'linalg.h']]], - ['la_5fform_5fqr_5fcmplx_20',['la_form_qr_cmplx',['../linalg_8h.html#a0338870fe1142f88c96db63495fec615',1,'linalg.h']]], - ['la_5fform_5fqr_5fcmplx_5fpvt_21',['la_form_qr_cmplx_pvt',['../linalg_8h.html#ad76e25c5eb98075e83cc9df493be5b38',1,'linalg.h']]], - ['la_5fform_5fqr_5fpvt_22',['la_form_qr_pvt',['../linalg_8h.html#aace787c5b11959a457b936ace4995033',1,'linalg.h']]], - ['la_5fhermitian_5ftranspose_23',['la_hermitian_transpose',['../namespacelinalg.html#a0e420096028b759a87f2f4f4306d202a',1,'linalg']]], - ['la_5finvalid_5finput_5ferror_24',['la_invalid_input_error',['../namespacelinalg.html#ace738355659bce2e9591473f0d543ef7',1,'linalg']]], - ['la_5finvalid_5foperation_5ferror_25',['la_invalid_operation_error',['../namespacelinalg.html#a4f47021e96cd813b568422a2eb3821bc',1,'linalg']]], - ['la_5finverse_26',['la_inverse',['../linalg_8h.html#a95d6ed56844c62d553b940091837014b',1,'linalg.h']]], - ['la_5finverse_5fcmplx_27',['la_inverse_cmplx',['../linalg_8h.html#a7a821b41c61670f5710214a4d9178998',1,'linalg.h']]], - ['la_5flu_5ffactor_28',['la_lu_factor',['../linalg_8h.html#a248142a5f0826cddac5daf1c74f234a6',1,'linalg.h']]], - ['la_5flu_5ffactor_5fcmplx_29',['la_lu_factor_cmplx',['../linalg_8h.html#ace554b62c12a5d9a2434c8171c756c47',1,'linalg.h']]], - ['la_5fmatrix_5fformat_5ferror_30',['la_matrix_format_error',['../namespacelinalg.html#ad89b9d502b7c484df53f9b10b9545776',1,'linalg']]], - ['la_5fmtx_5fmult_31',['la_mtx_mult',['../linalg_8h.html#a968b10545320af7bbe1030867ae88e8c',1,'linalg.h']]], - ['la_5fmtx_5fmult_5fcmplx_32',['la_mtx_mult_cmplx',['../linalg_8h.html#aefefe80e13f74470d5afaf44b3a45e76',1,'linalg.h']]], - ['la_5fmult_5fqr_33',['la_mult_qr',['../linalg_8h.html#a95f921847131eaedd62a439490d2a801',1,'linalg.h']]], - ['la_5fmult_5fqr_5fcmplx_34',['la_mult_qr_cmplx',['../linalg_8h.html#acc25c0daa53c10ace21a61d78b2e79f3',1,'linalg.h']]], - ['la_5fno_5ferror_35',['la_no_error',['../namespacelinalg.html#aefdfc0979567e89aa3b8c599d3f766f4',1,'linalg']]], - ['la_5fno_5foperation_36',['la_no_operation',['../namespacelinalg.html#a665d131453840e869510e9e8d2f7f151',1,'linalg']]], - ['la_5fout_5fof_5fmemory_5ferror_37',['la_out_of_memory_error',['../namespacelinalg.html#abfb78ba61c0c2751f1c771c984469006',1,'linalg']]], - ['la_5fpinverse_38',['la_pinverse',['../linalg_8h.html#af7f8185c0f25ad3fb0b89cc98d77b3d6',1,'linalg.h']]], - ['la_5fpinverse_5fcmplx_39',['la_pinverse_cmplx',['../linalg_8h.html#a71ba1a09caca9d59a9d24b95c7ea749b',1,'linalg.h']]], - ['la_5fqr_5ffactor_40',['la_qr_factor',['../linalg_8h.html#a791d5221eb8ad4fcd106cb218590dfc9',1,'linalg.h']]], - ['la_5fqr_5ffactor_5fcmplx_41',['la_qr_factor_cmplx',['../linalg_8h.html#ae5ffa6e8d9c850bd41f43f7564bf6896',1,'linalg.h']]], - ['la_5fqr_5ffactor_5fcmplx_5fpvt_42',['la_qr_factor_cmplx_pvt',['../linalg_8h.html#a4a3f6dafe185c2985fc76aab3d0abb97',1,'linalg.h']]], - ['la_5fqr_5ffactor_5fpvt_43',['la_qr_factor_pvt',['../linalg_8h.html#a4bc671dad87b42ff285a4241322a3764',1,'linalg.h']]], - ['la_5fqr_5frank1_5fupdate_44',['la_qr_rank1_update',['../linalg_8h.html#a9b0639faf9ac0af9bbdb348b92746d5f',1,'linalg.h']]], - ['la_5fqr_5frank1_5fupdate_5fcmplx_45',['la_qr_rank1_update_cmplx',['../linalg_8h.html#acfbd42393c8b1931ff11bc4c7e858aef',1,'linalg.h']]], - ['la_5frank_46',['la_rank',['../linalg_8h.html#a089690d293303e30c6eef0bb1e982191',1,'linalg.h']]], - ['la_5frank1_5fupdate_47',['la_rank1_update',['../linalg_8h.html#ab346fed23fd61f02d65e09c795c26d74',1,'linalg.h']]], - ['la_5frank1_5fupdate_5fcmplx_48',['la_rank1_update_cmplx',['../linalg_8h.html#a3c958fe274f8d1663dd0188455a5fe15',1,'linalg.h']]], - ['la_5frank_5fcmplx_49',['la_rank_cmplx',['../linalg_8h.html#afdc9b7e6ffab89915a082c00ceac7258',1,'linalg.h']]], - ['la_5fsingular_5fmatrix_5ferror_50',['la_singular_matrix_error',['../namespacelinalg.html#af5dc9d60151bb81436b442525871c8c9',1,'linalg']]], - ['la_5fsolve_5fcholesky_51',['la_solve_cholesky',['../linalg_8h.html#a0dc578507a0cb6ada776142476383590',1,'linalg.h']]], - ['la_5fsolve_5fcholesky_5fcmplx_52',['la_solve_cholesky_cmplx',['../linalg_8h.html#a719ffdff56c8fa0875409c4f4e5e95cf',1,'linalg.h']]], - ['la_5fsolve_5fleast_5fsquares_53',['la_solve_least_squares',['../linalg_8h.html#a02eb049983dd41f2307bb52594fb210e',1,'linalg.h']]], - ['la_5fsolve_5fleast_5fsquares_5fcmplx_54',['la_solve_least_squares_cmplx',['../linalg_8h.html#ac3bb7b959d8cc7400e9b13290a895b64',1,'linalg.h']]], - ['la_5fsolve_5flu_55',['la_solve_lu',['../linalg_8h.html#aae725d3247301d1163c58f89edff3d4b',1,'linalg.h']]], - ['la_5fsolve_5flu_5fcmplx_56',['la_solve_lu_cmplx',['../linalg_8h.html#aa067ac0d3f58e28371d413ab7419da74',1,'linalg.h']]], - ['la_5fsolve_5fqr_57',['la_solve_qr',['../linalg_8h.html#aefdc2e6758482d02a3aa7978f7d5efe0',1,'linalg.h']]], - ['la_5fsolve_5fqr_5fcmplx_58',['la_solve_qr_cmplx',['../linalg_8h.html#a0ff5f2519eb1d2af94e3b4a26dfb10fe',1,'linalg.h']]], - ['la_5fsolve_5fqr_5fcmplx_5fpvt_59',['la_solve_qr_cmplx_pvt',['../linalg_8h.html#ad0ee4a9c71de62911a71a342790f5070',1,'linalg.h']]], - ['la_5fsolve_5fqr_5fpvt_60',['la_solve_qr_pvt',['../linalg_8h.html#a62f97b4319f5574aef5e52bbacff14bb',1,'linalg.h']]], - ['la_5fsolve_5ftri_5fmtx_61',['la_solve_tri_mtx',['../linalg_8h.html#aed7b29bbff1472ebe805054eb9d8c6d4',1,'linalg.h']]], - ['la_5fsolve_5ftri_5fmtx_5fcmplx_62',['la_solve_tri_mtx_cmplx',['../linalg_8h.html#af87823d73fb5a319e4262594d147e38c',1,'linalg.h']]], - ['la_5fsort_5feigen_63',['la_sort_eigen',['../linalg_8h.html#abf5918abab8f97fc2ac5887e051ff493',1,'linalg.h']]], - ['la_5fsort_5feigen_5fcmplx_64',['la_sort_eigen_cmplx',['../linalg_8h.html#a090178a5f99a4b400da80481aad77757',1,'linalg.h']]], - ['la_5fsvd_65',['la_svd',['../linalg_8h.html#a56c0cea99a066e74c8fff9682d5ca92d',1,'linalg.h']]], - ['la_5fsvd_5fcmplx_66',['la_svd_cmplx',['../linalg_8h.html#afbffa0856d75c607a03d3dc7b5b1076e',1,'linalg.h']]], - ['la_5ftrace_67',['la_trace',['../linalg_8h.html#a7f611f8f3de7d56120c78e70671c7112',1,'linalg.h']]], - ['la_5ftrace_5fcmplx_68',['la_trace_cmplx',['../linalg_8h.html#a021fbb7fdccf557ec407a86bace43d85',1,'linalg.h']]], - ['la_5ftranspose_69',['la_transpose',['../namespacelinalg.html#a2b842a1fb17710d7ec2f117f5fdb2a59',1,'linalg']]], - ['la_5ftri_5fmtx_5fmult_70',['la_tri_mtx_mult',['../linalg_8h.html#ae7d70f1ef2a2824772e1bf0f726c257e',1,'linalg.h']]], - ['la_5ftri_5fmtx_5fmult_5fcmplx_71',['la_tri_mtx_mult_cmplx',['../linalg_8h.html#a02c464a9dd95298c91f431ae4d0773e9',1,'linalg.h']]], - ['linalg_72',['linalg',['../index.html',1,'(Global Namespace)'],['../namespacelinalg.html',1,'linalg']]], - ['linalg_2eh_73',['linalg.h',['../linalg_8h.html',1,'']]], - ['lu_5ffactor_74',['lu_factor',['../interfacelinalg_1_1lu__factor.html',1,'linalg']]] + ['la_5fform_5flq_17',['la_form_lq',['../linalg_8h.html#ac54763802ad5c3966f8e14cdf93fdc96',1,'linalg.h']]], + ['la_5fform_5flq_5fcmplx_18',['la_form_lq_cmplx',['../linalg_8h.html#aa54b8d224976dca7ef384eed74f50bed',1,'linalg.h']]], + ['la_5fform_5flu_19',['la_form_lu',['../linalg_8h.html#a15774f6323c34d307c99b32ac4f188a7',1,'linalg.h']]], + ['la_5fform_5flu_5fcmplx_20',['la_form_lu_cmplx',['../linalg_8h.html#a73bea3ca338925cfa4a58bcaea726a14',1,'linalg.h']]], + ['la_5fform_5fqr_21',['la_form_qr',['../linalg_8h.html#afe39765d805c1d9ae93e9aa2f20d8548',1,'linalg.h']]], + ['la_5fform_5fqr_5fcmplx_22',['la_form_qr_cmplx',['../linalg_8h.html#a0338870fe1142f88c96db63495fec615',1,'linalg.h']]], + ['la_5fform_5fqr_5fcmplx_5fpvt_23',['la_form_qr_cmplx_pvt',['../linalg_8h.html#ad76e25c5eb98075e83cc9df493be5b38',1,'linalg.h']]], + ['la_5fform_5fqr_5fpvt_24',['la_form_qr_pvt',['../linalg_8h.html#aace787c5b11959a457b936ace4995033',1,'linalg.h']]], + ['la_5fhermitian_5ftranspose_25',['la_hermitian_transpose',['../namespacelinalg.html#a0e420096028b759a87f2f4f4306d202a',1,'linalg']]], + ['la_5finvalid_5finput_5ferror_26',['la_invalid_input_error',['../namespacelinalg.html#ace738355659bce2e9591473f0d543ef7',1,'linalg']]], + ['la_5finvalid_5foperation_5ferror_27',['la_invalid_operation_error',['../namespacelinalg.html#a4f47021e96cd813b568422a2eb3821bc',1,'linalg']]], + ['la_5finverse_28',['la_inverse',['../linalg_8h.html#a95d6ed56844c62d553b940091837014b',1,'linalg.h']]], + ['la_5finverse_5fcmplx_29',['la_inverse_cmplx',['../linalg_8h.html#a7a821b41c61670f5710214a4d9178998',1,'linalg.h']]], + ['la_5flq_5ffactor_30',['la_lq_factor',['../linalg_8h.html#a7b2048bb219e58f455175041558ac44f',1,'linalg.h']]], + ['la_5flq_5ffactor_5fcmplx_31',['la_lq_factor_cmplx',['../linalg_8h.html#a5e6786c40f8f91e5f16f06e92be71ffa',1,'linalg.h']]], + ['la_5flu_5ffactor_32',['la_lu_factor',['../linalg_8h.html#a248142a5f0826cddac5daf1c74f234a6',1,'linalg.h']]], + ['la_5flu_5ffactor_5fcmplx_33',['la_lu_factor_cmplx',['../linalg_8h.html#ace554b62c12a5d9a2434c8171c756c47',1,'linalg.h']]], + ['la_5fmatrix_5fformat_5ferror_34',['la_matrix_format_error',['../namespacelinalg.html#ad89b9d502b7c484df53f9b10b9545776',1,'linalg']]], + ['la_5fmtx_5fmult_35',['la_mtx_mult',['../linalg_8h.html#a968b10545320af7bbe1030867ae88e8c',1,'linalg.h']]], + ['la_5fmtx_5fmult_5fcmplx_36',['la_mtx_mult_cmplx',['../linalg_8h.html#aefefe80e13f74470d5afaf44b3a45e76',1,'linalg.h']]], + ['la_5fmult_5flq_37',['la_mult_lq',['../linalg_8h.html#ac575e10e20e9c2d8d40ed8df47179773',1,'linalg.h']]], + ['la_5fmult_5flq_5fcmplx_38',['la_mult_lq_cmplx',['../linalg_8h.html#adcb07293cf47d090dfb89c20837ca7b5',1,'linalg.h']]], + ['la_5fmult_5fqr_39',['la_mult_qr',['../linalg_8h.html#a95f921847131eaedd62a439490d2a801',1,'linalg.h']]], + ['la_5fmult_5fqr_5fcmplx_40',['la_mult_qr_cmplx',['../linalg_8h.html#acc25c0daa53c10ace21a61d78b2e79f3',1,'linalg.h']]], + ['la_5fno_5ferror_41',['la_no_error',['../namespacelinalg.html#aefdfc0979567e89aa3b8c599d3f766f4',1,'linalg']]], + ['la_5fno_5foperation_42',['la_no_operation',['../namespacelinalg.html#a665d131453840e869510e9e8d2f7f151',1,'linalg']]], + ['la_5fout_5fof_5fmemory_5ferror_43',['la_out_of_memory_error',['../namespacelinalg.html#abfb78ba61c0c2751f1c771c984469006',1,'linalg']]], + ['la_5fpinverse_44',['la_pinverse',['../linalg_8h.html#af7f8185c0f25ad3fb0b89cc98d77b3d6',1,'linalg.h']]], + ['la_5fpinverse_5fcmplx_45',['la_pinverse_cmplx',['../linalg_8h.html#a71ba1a09caca9d59a9d24b95c7ea749b',1,'linalg.h']]], + ['la_5fqr_5ffactor_46',['la_qr_factor',['../linalg_8h.html#a791d5221eb8ad4fcd106cb218590dfc9',1,'linalg.h']]], + ['la_5fqr_5ffactor_5fcmplx_47',['la_qr_factor_cmplx',['../linalg_8h.html#ae5ffa6e8d9c850bd41f43f7564bf6896',1,'linalg.h']]], + ['la_5fqr_5ffactor_5fcmplx_5fpvt_48',['la_qr_factor_cmplx_pvt',['../linalg_8h.html#a4a3f6dafe185c2985fc76aab3d0abb97',1,'linalg.h']]], + ['la_5fqr_5ffactor_5fpvt_49',['la_qr_factor_pvt',['../linalg_8h.html#a4bc671dad87b42ff285a4241322a3764',1,'linalg.h']]], + ['la_5fqr_5frank1_5fupdate_50',['la_qr_rank1_update',['../linalg_8h.html#a9b0639faf9ac0af9bbdb348b92746d5f',1,'linalg.h']]], + ['la_5fqr_5frank1_5fupdate_5fcmplx_51',['la_qr_rank1_update_cmplx',['../linalg_8h.html#acfbd42393c8b1931ff11bc4c7e858aef',1,'linalg.h']]], + ['la_5frank_52',['la_rank',['../linalg_8h.html#a089690d293303e30c6eef0bb1e982191',1,'linalg.h']]], + ['la_5frank1_5fupdate_53',['la_rank1_update',['../linalg_8h.html#ab346fed23fd61f02d65e09c795c26d74',1,'linalg.h']]], + ['la_5frank1_5fupdate_5fcmplx_54',['la_rank1_update_cmplx',['../linalg_8h.html#a3c958fe274f8d1663dd0188455a5fe15',1,'linalg.h']]], + ['la_5frank_5fcmplx_55',['la_rank_cmplx',['../linalg_8h.html#afdc9b7e6ffab89915a082c00ceac7258',1,'linalg.h']]], + ['la_5fsingular_5fmatrix_5ferror_56',['la_singular_matrix_error',['../namespacelinalg.html#af5dc9d60151bb81436b442525871c8c9',1,'linalg']]], + ['la_5fsolve_5fcholesky_57',['la_solve_cholesky',['../linalg_8h.html#a0dc578507a0cb6ada776142476383590',1,'linalg.h']]], + ['la_5fsolve_5fcholesky_5fcmplx_58',['la_solve_cholesky_cmplx',['../linalg_8h.html#a719ffdff56c8fa0875409c4f4e5e95cf',1,'linalg.h']]], + ['la_5fsolve_5fleast_5fsquares_59',['la_solve_least_squares',['../linalg_8h.html#a02eb049983dd41f2307bb52594fb210e',1,'linalg.h']]], + ['la_5fsolve_5fleast_5fsquares_5fcmplx_60',['la_solve_least_squares_cmplx',['../linalg_8h.html#ac3bb7b959d8cc7400e9b13290a895b64',1,'linalg.h']]], + ['la_5fsolve_5flq_61',['la_solve_lq',['../linalg_8h.html#a2c485d619c24435be713cf4356285e9a',1,'linalg.h']]], + ['la_5fsolve_5flq_5fcmplx_62',['la_solve_lq_cmplx',['../linalg_8h.html#a54ee9d9ab89b88b0ca682f70bc6c3c54',1,'linalg.h']]], + ['la_5fsolve_5flu_63',['la_solve_lu',['../linalg_8h.html#aae725d3247301d1163c58f89edff3d4b',1,'linalg.h']]], + ['la_5fsolve_5flu_5fcmplx_64',['la_solve_lu_cmplx',['../linalg_8h.html#aa067ac0d3f58e28371d413ab7419da74',1,'linalg.h']]], + ['la_5fsolve_5fqr_65',['la_solve_qr',['../linalg_8h.html#aefdc2e6758482d02a3aa7978f7d5efe0',1,'linalg.h']]], + ['la_5fsolve_5fqr_5fcmplx_66',['la_solve_qr_cmplx',['../linalg_8h.html#a0ff5f2519eb1d2af94e3b4a26dfb10fe',1,'linalg.h']]], + ['la_5fsolve_5fqr_5fcmplx_5fpvt_67',['la_solve_qr_cmplx_pvt',['../linalg_8h.html#ad0ee4a9c71de62911a71a342790f5070',1,'linalg.h']]], + ['la_5fsolve_5fqr_5fpvt_68',['la_solve_qr_pvt',['../linalg_8h.html#a62f97b4319f5574aef5e52bbacff14bb',1,'linalg.h']]], + ['la_5fsolve_5ftri_5fmtx_69',['la_solve_tri_mtx',['../linalg_8h.html#aed7b29bbff1472ebe805054eb9d8c6d4',1,'linalg.h']]], + ['la_5fsolve_5ftri_5fmtx_5fcmplx_70',['la_solve_tri_mtx_cmplx',['../linalg_8h.html#af87823d73fb5a319e4262594d147e38c',1,'linalg.h']]], + ['la_5fsort_5feigen_71',['la_sort_eigen',['../linalg_8h.html#abf5918abab8f97fc2ac5887e051ff493',1,'linalg.h']]], + ['la_5fsort_5feigen_5fcmplx_72',['la_sort_eigen_cmplx',['../linalg_8h.html#a090178a5f99a4b400da80481aad77757',1,'linalg.h']]], + ['la_5fsvd_73',['la_svd',['../linalg_8h.html#a56c0cea99a066e74c8fff9682d5ca92d',1,'linalg.h']]], + ['la_5fsvd_5fcmplx_74',['la_svd_cmplx',['../linalg_8h.html#afbffa0856d75c607a03d3dc7b5b1076e',1,'linalg.h']]], + ['la_5ftrace_75',['la_trace',['../linalg_8h.html#a7f611f8f3de7d56120c78e70671c7112',1,'linalg.h']]], + ['la_5ftrace_5fcmplx_76',['la_trace_cmplx',['../linalg_8h.html#a021fbb7fdccf557ec407a86bace43d85',1,'linalg.h']]], + ['la_5ftranspose_77',['la_transpose',['../namespacelinalg.html#a2b842a1fb17710d7ec2f117f5fdb2a59',1,'linalg']]], + ['la_5ftri_5fmtx_5fmult_78',['la_tri_mtx_mult',['../linalg_8h.html#ae7d70f1ef2a2824772e1bf0f726c257e',1,'linalg.h']]], + ['la_5ftri_5fmtx_5fmult_5fcmplx_79',['la_tri_mtx_mult_cmplx',['../linalg_8h.html#a02c464a9dd95298c91f431ae4d0773e9',1,'linalg.h']]], + ['linalg_80',['linalg',['../index.html',1,'(Global Namespace)'],['../namespacelinalg.html',1,'linalg']]], + ['linalg_2eh_81',['linalg.h',['../linalg_8h.html',1,'']]], + ['lq_5ffactor_82',['lq_factor',['../interfacelinalg_1_1lq__factor.html',1,'linalg']]], + ['lu_5ffactor_83',['lu_factor',['../interfacelinalg_1_1lu__factor.html',1,'linalg']]] ]; diff --git a/doc/html/search/all_5.js b/doc/html/search/all_5.js index 9dc478d5..abc272a4 100644 --- a/doc/html/search/all_5.js +++ b/doc/html/search/all_5.js @@ -4,6 +4,7 @@ var searchData= ['mtx_5fmult_1',['mtx_mult',['../interfacelinalg_1_1mtx__mult.html',1,'linalg']]], ['mtx_5fpinverse_2',['mtx_pinverse',['../interfacelinalg_1_1mtx__pinverse.html',1,'linalg']]], ['mtx_5frank_3',['mtx_rank',['../interfacelinalg_1_1mtx__rank.html',1,'linalg']]], - ['mult_5fqr_4',['mult_qr',['../interfacelinalg_1_1mult__qr.html',1,'linalg']]], - ['mult_5frz_5',['mult_rz',['../interfacelinalg_1_1mult__rz.html',1,'linalg']]] + ['mult_5flq_4',['mult_lq',['../interfacelinalg_1_1mult__lq.html',1,'linalg']]], + ['mult_5fqr_5',['mult_qr',['../interfacelinalg_1_1mult__qr.html',1,'linalg']]], + ['mult_5frz_6',['mult_rz',['../interfacelinalg_1_1mult__rz.html',1,'linalg']]] ]; diff --git a/doc/html/search/all_8.js b/doc/html/search/all_8.js index 9de17823..5136c9f3 100644 --- a/doc/html/search/all_8.js +++ b/doc/html/search/all_8.js @@ -4,10 +4,11 @@ var searchData= ['solve_5fleast_5fsquares_1',['solve_least_squares',['../interfacelinalg_1_1solve__least__squares.html',1,'linalg']]], ['solve_5fleast_5fsquares_5ffull_2',['solve_least_squares_full',['../interfacelinalg_1_1solve__least__squares__full.html',1,'linalg']]], ['solve_5fleast_5fsquares_5fsvd_3',['solve_least_squares_svd',['../interfacelinalg_1_1solve__least__squares__svd.html',1,'linalg']]], - ['solve_5flu_4',['solve_lu',['../interfacelinalg_1_1solve__lu.html',1,'linalg']]], - ['solve_5fqr_5',['solve_qr',['../interfacelinalg_1_1solve__qr.html',1,'linalg']]], - ['solve_5ftriangular_5fsystem_6',['solve_triangular_system',['../interfacelinalg_1_1solve__triangular__system.html',1,'linalg']]], - ['sort_7',['sort',['../interfacelinalg_1_1sort.html',1,'linalg']]], - ['svd_8',['svd',['../interfacelinalg_1_1svd.html',1,'linalg']]], - ['swap_9',['swap',['../interfacelinalg_1_1swap.html',1,'linalg']]] + ['solve_5flq_4',['solve_lq',['../interfacelinalg_1_1solve__lq.html',1,'linalg']]], + ['solve_5flu_5',['solve_lu',['../interfacelinalg_1_1solve__lu.html',1,'linalg']]], + ['solve_5fqr_6',['solve_qr',['../interfacelinalg_1_1solve__qr.html',1,'linalg']]], + ['solve_5ftriangular_5fsystem_7',['solve_triangular_system',['../interfacelinalg_1_1solve__triangular__system.html',1,'linalg']]], + ['sort_8',['sort',['../interfacelinalg_1_1sort.html',1,'linalg']]], + ['svd_9',['svd',['../interfacelinalg_1_1svd.html',1,'linalg']]], + ['swap_10',['swap',['../interfacelinalg_1_1swap.html',1,'linalg']]] ]; diff --git a/doc/html/search/classes_3.js b/doc/html/search/classes_3.js index d6925134..6ac0a6ce 100644 --- a/doc/html/search/classes_3.js +++ b/doc/html/search/classes_3.js @@ -1,5 +1,6 @@ var searchData= [ - ['form_5flu_0',['form_lu',['../interfacelinalg_1_1form__lu.html',1,'linalg']]], - ['form_5fqr_1',['form_qr',['../interfacelinalg_1_1form__qr.html',1,'linalg']]] + ['form_5flq_0',['form_lq',['../interfacelinalg_1_1form__lq.html',1,'linalg']]], + ['form_5flu_1',['form_lu',['../interfacelinalg_1_1form__lu.html',1,'linalg']]], + ['form_5fqr_2',['form_qr',['../interfacelinalg_1_1form__qr.html',1,'linalg']]] ]; diff --git a/doc/html/search/classes_4.js b/doc/html/search/classes_4.js index cd2d1a10..d81989f4 100644 --- a/doc/html/search/classes_4.js +++ b/doc/html/search/classes_4.js @@ -1,4 +1,5 @@ var searchData= [ - ['lu_5ffactor_0',['lu_factor',['../interfacelinalg_1_1lu__factor.html',1,'linalg']]] + ['lq_5ffactor_0',['lq_factor',['../interfacelinalg_1_1lq__factor.html',1,'linalg']]], + ['lu_5ffactor_1',['lu_factor',['../interfacelinalg_1_1lu__factor.html',1,'linalg']]] ]; diff --git a/doc/html/search/classes_5.js b/doc/html/search/classes_5.js index 9dc478d5..abc272a4 100644 --- a/doc/html/search/classes_5.js +++ b/doc/html/search/classes_5.js @@ -4,6 +4,7 @@ var searchData= ['mtx_5fmult_1',['mtx_mult',['../interfacelinalg_1_1mtx__mult.html',1,'linalg']]], ['mtx_5fpinverse_2',['mtx_pinverse',['../interfacelinalg_1_1mtx__pinverse.html',1,'linalg']]], ['mtx_5frank_3',['mtx_rank',['../interfacelinalg_1_1mtx__rank.html',1,'linalg']]], - ['mult_5fqr_4',['mult_qr',['../interfacelinalg_1_1mult__qr.html',1,'linalg']]], - ['mult_5frz_5',['mult_rz',['../interfacelinalg_1_1mult__rz.html',1,'linalg']]] + ['mult_5flq_4',['mult_lq',['../interfacelinalg_1_1mult__lq.html',1,'linalg']]], + ['mult_5fqr_5',['mult_qr',['../interfacelinalg_1_1mult__qr.html',1,'linalg']]], + ['mult_5frz_6',['mult_rz',['../interfacelinalg_1_1mult__rz.html',1,'linalg']]] ]; diff --git a/doc/html/search/classes_8.js b/doc/html/search/classes_8.js index 9de17823..5136c9f3 100644 --- a/doc/html/search/classes_8.js +++ b/doc/html/search/classes_8.js @@ -4,10 +4,11 @@ var searchData= ['solve_5fleast_5fsquares_1',['solve_least_squares',['../interfacelinalg_1_1solve__least__squares.html',1,'linalg']]], ['solve_5fleast_5fsquares_5ffull_2',['solve_least_squares_full',['../interfacelinalg_1_1solve__least__squares__full.html',1,'linalg']]], ['solve_5fleast_5fsquares_5fsvd_3',['solve_least_squares_svd',['../interfacelinalg_1_1solve__least__squares__svd.html',1,'linalg']]], - ['solve_5flu_4',['solve_lu',['../interfacelinalg_1_1solve__lu.html',1,'linalg']]], - ['solve_5fqr_5',['solve_qr',['../interfacelinalg_1_1solve__qr.html',1,'linalg']]], - ['solve_5ftriangular_5fsystem_6',['solve_triangular_system',['../interfacelinalg_1_1solve__triangular__system.html',1,'linalg']]], - ['sort_7',['sort',['../interfacelinalg_1_1sort.html',1,'linalg']]], - ['svd_8',['svd',['../interfacelinalg_1_1svd.html',1,'linalg']]], - ['swap_9',['swap',['../interfacelinalg_1_1swap.html',1,'linalg']]] + ['solve_5flq_4',['solve_lq',['../interfacelinalg_1_1solve__lq.html',1,'linalg']]], + ['solve_5flu_5',['solve_lu',['../interfacelinalg_1_1solve__lu.html',1,'linalg']]], + ['solve_5fqr_6',['solve_qr',['../interfacelinalg_1_1solve__qr.html',1,'linalg']]], + ['solve_5ftriangular_5fsystem_7',['solve_triangular_system',['../interfacelinalg_1_1solve__triangular__system.html',1,'linalg']]], + ['sort_8',['sort',['../interfacelinalg_1_1sort.html',1,'linalg']]], + ['svd_9',['svd',['../interfacelinalg_1_1svd.html',1,'linalg']]], + ['swap_10',['swap',['../interfacelinalg_1_1swap.html',1,'linalg']]] ]; diff --git a/doc/html/search/functions_0.js b/doc/html/search/functions_0.js index 50c950b0..b5fc3cd0 100644 --- a/doc/html/search/functions_0.js +++ b/doc/html/search/functions_0.js @@ -15,50 +15,58 @@ var searchData= ['la_5feigen_5fcmplx_12',['la_eigen_cmplx',['../linalg_8h.html#ae5a16375c14c924836c33bafa747a1cf',1,'linalg.h']]], ['la_5feigen_5fgen_13',['la_eigen_gen',['../linalg_8h.html#af3c6f1a45aee2f275d4b109c9bb660d2',1,'linalg.h']]], ['la_5feigen_5fsymm_14',['la_eigen_symm',['../linalg_8h.html#ac208d5e6849972a77ef261f2e368868c',1,'linalg.h']]], - ['la_5fform_5flu_15',['la_form_lu',['../linalg_8h.html#a15774f6323c34d307c99b32ac4f188a7',1,'linalg.h']]], - ['la_5fform_5flu_5fcmplx_16',['la_form_lu_cmplx',['../linalg_8h.html#a73bea3ca338925cfa4a58bcaea726a14',1,'linalg.h']]], - ['la_5fform_5fqr_17',['la_form_qr',['../linalg_8h.html#afe39765d805c1d9ae93e9aa2f20d8548',1,'linalg.h']]], - ['la_5fform_5fqr_5fcmplx_18',['la_form_qr_cmplx',['../linalg_8h.html#a0338870fe1142f88c96db63495fec615',1,'linalg.h']]], - ['la_5fform_5fqr_5fcmplx_5fpvt_19',['la_form_qr_cmplx_pvt',['../linalg_8h.html#ad76e25c5eb98075e83cc9df493be5b38',1,'linalg.h']]], - ['la_5fform_5fqr_5fpvt_20',['la_form_qr_pvt',['../linalg_8h.html#aace787c5b11959a457b936ace4995033',1,'linalg.h']]], - ['la_5finverse_21',['la_inverse',['../linalg_8h.html#a95d6ed56844c62d553b940091837014b',1,'linalg.h']]], - ['la_5finverse_5fcmplx_22',['la_inverse_cmplx',['../linalg_8h.html#a7a821b41c61670f5710214a4d9178998',1,'linalg.h']]], - ['la_5flu_5ffactor_23',['la_lu_factor',['../linalg_8h.html#a248142a5f0826cddac5daf1c74f234a6',1,'linalg.h']]], - ['la_5flu_5ffactor_5fcmplx_24',['la_lu_factor_cmplx',['../linalg_8h.html#ace554b62c12a5d9a2434c8171c756c47',1,'linalg.h']]], - ['la_5fmtx_5fmult_25',['la_mtx_mult',['../linalg_8h.html#a968b10545320af7bbe1030867ae88e8c',1,'linalg.h']]], - ['la_5fmtx_5fmult_5fcmplx_26',['la_mtx_mult_cmplx',['../linalg_8h.html#aefefe80e13f74470d5afaf44b3a45e76',1,'linalg.h']]], - ['la_5fmult_5fqr_27',['la_mult_qr',['../linalg_8h.html#a95f921847131eaedd62a439490d2a801',1,'linalg.h']]], - ['la_5fmult_5fqr_5fcmplx_28',['la_mult_qr_cmplx',['../linalg_8h.html#acc25c0daa53c10ace21a61d78b2e79f3',1,'linalg.h']]], - ['la_5fpinverse_29',['la_pinverse',['../linalg_8h.html#af7f8185c0f25ad3fb0b89cc98d77b3d6',1,'linalg.h']]], - ['la_5fpinverse_5fcmplx_30',['la_pinverse_cmplx',['../linalg_8h.html#a71ba1a09caca9d59a9d24b95c7ea749b',1,'linalg.h']]], - ['la_5fqr_5ffactor_31',['la_qr_factor',['../linalg_8h.html#a791d5221eb8ad4fcd106cb218590dfc9',1,'linalg.h']]], - ['la_5fqr_5ffactor_5fcmplx_32',['la_qr_factor_cmplx',['../linalg_8h.html#ae5ffa6e8d9c850bd41f43f7564bf6896',1,'linalg.h']]], - ['la_5fqr_5ffactor_5fcmplx_5fpvt_33',['la_qr_factor_cmplx_pvt',['../linalg_8h.html#a4a3f6dafe185c2985fc76aab3d0abb97',1,'linalg.h']]], - ['la_5fqr_5ffactor_5fpvt_34',['la_qr_factor_pvt',['../linalg_8h.html#a4bc671dad87b42ff285a4241322a3764',1,'linalg.h']]], - ['la_5fqr_5frank1_5fupdate_35',['la_qr_rank1_update',['../linalg_8h.html#a9b0639faf9ac0af9bbdb348b92746d5f',1,'linalg.h']]], - ['la_5fqr_5frank1_5fupdate_5fcmplx_36',['la_qr_rank1_update_cmplx',['../linalg_8h.html#acfbd42393c8b1931ff11bc4c7e858aef',1,'linalg.h']]], - ['la_5frank_37',['la_rank',['../linalg_8h.html#a089690d293303e30c6eef0bb1e982191',1,'linalg.h']]], - ['la_5frank1_5fupdate_38',['la_rank1_update',['../linalg_8h.html#ab346fed23fd61f02d65e09c795c26d74',1,'linalg.h']]], - ['la_5frank1_5fupdate_5fcmplx_39',['la_rank1_update_cmplx',['../linalg_8h.html#a3c958fe274f8d1663dd0188455a5fe15',1,'linalg.h']]], - ['la_5frank_5fcmplx_40',['la_rank_cmplx',['../linalg_8h.html#afdc9b7e6ffab89915a082c00ceac7258',1,'linalg.h']]], - ['la_5fsolve_5fcholesky_41',['la_solve_cholesky',['../linalg_8h.html#a0dc578507a0cb6ada776142476383590',1,'linalg.h']]], - ['la_5fsolve_5fcholesky_5fcmplx_42',['la_solve_cholesky_cmplx',['../linalg_8h.html#a719ffdff56c8fa0875409c4f4e5e95cf',1,'linalg.h']]], - ['la_5fsolve_5fleast_5fsquares_43',['la_solve_least_squares',['../linalg_8h.html#a02eb049983dd41f2307bb52594fb210e',1,'linalg.h']]], - ['la_5fsolve_5fleast_5fsquares_5fcmplx_44',['la_solve_least_squares_cmplx',['../linalg_8h.html#ac3bb7b959d8cc7400e9b13290a895b64',1,'linalg.h']]], - ['la_5fsolve_5flu_45',['la_solve_lu',['../linalg_8h.html#aae725d3247301d1163c58f89edff3d4b',1,'linalg.h']]], - ['la_5fsolve_5flu_5fcmplx_46',['la_solve_lu_cmplx',['../linalg_8h.html#aa067ac0d3f58e28371d413ab7419da74',1,'linalg.h']]], - ['la_5fsolve_5fqr_47',['la_solve_qr',['../linalg_8h.html#aefdc2e6758482d02a3aa7978f7d5efe0',1,'linalg.h']]], - ['la_5fsolve_5fqr_5fcmplx_48',['la_solve_qr_cmplx',['../linalg_8h.html#a0ff5f2519eb1d2af94e3b4a26dfb10fe',1,'linalg.h']]], - ['la_5fsolve_5fqr_5fcmplx_5fpvt_49',['la_solve_qr_cmplx_pvt',['../linalg_8h.html#ad0ee4a9c71de62911a71a342790f5070',1,'linalg.h']]], - ['la_5fsolve_5fqr_5fpvt_50',['la_solve_qr_pvt',['../linalg_8h.html#a62f97b4319f5574aef5e52bbacff14bb',1,'linalg.h']]], - ['la_5fsolve_5ftri_5fmtx_51',['la_solve_tri_mtx',['../linalg_8h.html#aed7b29bbff1472ebe805054eb9d8c6d4',1,'linalg.h']]], - ['la_5fsolve_5ftri_5fmtx_5fcmplx_52',['la_solve_tri_mtx_cmplx',['../linalg_8h.html#af87823d73fb5a319e4262594d147e38c',1,'linalg.h']]], - ['la_5fsort_5feigen_53',['la_sort_eigen',['../linalg_8h.html#abf5918abab8f97fc2ac5887e051ff493',1,'linalg.h']]], - ['la_5fsort_5feigen_5fcmplx_54',['la_sort_eigen_cmplx',['../linalg_8h.html#a090178a5f99a4b400da80481aad77757',1,'linalg.h']]], - ['la_5fsvd_55',['la_svd',['../linalg_8h.html#a56c0cea99a066e74c8fff9682d5ca92d',1,'linalg.h']]], - ['la_5fsvd_5fcmplx_56',['la_svd_cmplx',['../linalg_8h.html#afbffa0856d75c607a03d3dc7b5b1076e',1,'linalg.h']]], - ['la_5ftrace_57',['la_trace',['../linalg_8h.html#a7f611f8f3de7d56120c78e70671c7112',1,'linalg.h']]], - ['la_5ftrace_5fcmplx_58',['la_trace_cmplx',['../linalg_8h.html#a021fbb7fdccf557ec407a86bace43d85',1,'linalg.h']]], - ['la_5ftri_5fmtx_5fmult_59',['la_tri_mtx_mult',['../linalg_8h.html#ae7d70f1ef2a2824772e1bf0f726c257e',1,'linalg.h']]], - ['la_5ftri_5fmtx_5fmult_5fcmplx_60',['la_tri_mtx_mult_cmplx',['../linalg_8h.html#a02c464a9dd95298c91f431ae4d0773e9',1,'linalg.h']]] + ['la_5fform_5flq_15',['la_form_lq',['../linalg_8h.html#ac54763802ad5c3966f8e14cdf93fdc96',1,'linalg.h']]], + ['la_5fform_5flq_5fcmplx_16',['la_form_lq_cmplx',['../linalg_8h.html#aa54b8d224976dca7ef384eed74f50bed',1,'linalg.h']]], + ['la_5fform_5flu_17',['la_form_lu',['../linalg_8h.html#a15774f6323c34d307c99b32ac4f188a7',1,'linalg.h']]], + ['la_5fform_5flu_5fcmplx_18',['la_form_lu_cmplx',['../linalg_8h.html#a73bea3ca338925cfa4a58bcaea726a14',1,'linalg.h']]], + ['la_5fform_5fqr_19',['la_form_qr',['../linalg_8h.html#afe39765d805c1d9ae93e9aa2f20d8548',1,'linalg.h']]], + ['la_5fform_5fqr_5fcmplx_20',['la_form_qr_cmplx',['../linalg_8h.html#a0338870fe1142f88c96db63495fec615',1,'linalg.h']]], + ['la_5fform_5fqr_5fcmplx_5fpvt_21',['la_form_qr_cmplx_pvt',['../linalg_8h.html#ad76e25c5eb98075e83cc9df493be5b38',1,'linalg.h']]], + ['la_5fform_5fqr_5fpvt_22',['la_form_qr_pvt',['../linalg_8h.html#aace787c5b11959a457b936ace4995033',1,'linalg.h']]], + ['la_5finverse_23',['la_inverse',['../linalg_8h.html#a95d6ed56844c62d553b940091837014b',1,'linalg.h']]], + ['la_5finverse_5fcmplx_24',['la_inverse_cmplx',['../linalg_8h.html#a7a821b41c61670f5710214a4d9178998',1,'linalg.h']]], + ['la_5flq_5ffactor_25',['la_lq_factor',['../linalg_8h.html#a7b2048bb219e58f455175041558ac44f',1,'linalg.h']]], + ['la_5flq_5ffactor_5fcmplx_26',['la_lq_factor_cmplx',['../linalg_8h.html#a5e6786c40f8f91e5f16f06e92be71ffa',1,'linalg.h']]], + ['la_5flu_5ffactor_27',['la_lu_factor',['../linalg_8h.html#a248142a5f0826cddac5daf1c74f234a6',1,'linalg.h']]], + ['la_5flu_5ffactor_5fcmplx_28',['la_lu_factor_cmplx',['../linalg_8h.html#ace554b62c12a5d9a2434c8171c756c47',1,'linalg.h']]], + ['la_5fmtx_5fmult_29',['la_mtx_mult',['../linalg_8h.html#a968b10545320af7bbe1030867ae88e8c',1,'linalg.h']]], + ['la_5fmtx_5fmult_5fcmplx_30',['la_mtx_mult_cmplx',['../linalg_8h.html#aefefe80e13f74470d5afaf44b3a45e76',1,'linalg.h']]], + ['la_5fmult_5flq_31',['la_mult_lq',['../linalg_8h.html#ac575e10e20e9c2d8d40ed8df47179773',1,'linalg.h']]], + ['la_5fmult_5flq_5fcmplx_32',['la_mult_lq_cmplx',['../linalg_8h.html#adcb07293cf47d090dfb89c20837ca7b5',1,'linalg.h']]], + ['la_5fmult_5fqr_33',['la_mult_qr',['../linalg_8h.html#a95f921847131eaedd62a439490d2a801',1,'linalg.h']]], + ['la_5fmult_5fqr_5fcmplx_34',['la_mult_qr_cmplx',['../linalg_8h.html#acc25c0daa53c10ace21a61d78b2e79f3',1,'linalg.h']]], + ['la_5fpinverse_35',['la_pinverse',['../linalg_8h.html#af7f8185c0f25ad3fb0b89cc98d77b3d6',1,'linalg.h']]], + ['la_5fpinverse_5fcmplx_36',['la_pinverse_cmplx',['../linalg_8h.html#a71ba1a09caca9d59a9d24b95c7ea749b',1,'linalg.h']]], + ['la_5fqr_5ffactor_37',['la_qr_factor',['../linalg_8h.html#a791d5221eb8ad4fcd106cb218590dfc9',1,'linalg.h']]], + ['la_5fqr_5ffactor_5fcmplx_38',['la_qr_factor_cmplx',['../linalg_8h.html#ae5ffa6e8d9c850bd41f43f7564bf6896',1,'linalg.h']]], + ['la_5fqr_5ffactor_5fcmplx_5fpvt_39',['la_qr_factor_cmplx_pvt',['../linalg_8h.html#a4a3f6dafe185c2985fc76aab3d0abb97',1,'linalg.h']]], + ['la_5fqr_5ffactor_5fpvt_40',['la_qr_factor_pvt',['../linalg_8h.html#a4bc671dad87b42ff285a4241322a3764',1,'linalg.h']]], + ['la_5fqr_5frank1_5fupdate_41',['la_qr_rank1_update',['../linalg_8h.html#a9b0639faf9ac0af9bbdb348b92746d5f',1,'linalg.h']]], + ['la_5fqr_5frank1_5fupdate_5fcmplx_42',['la_qr_rank1_update_cmplx',['../linalg_8h.html#acfbd42393c8b1931ff11bc4c7e858aef',1,'linalg.h']]], + ['la_5frank_43',['la_rank',['../linalg_8h.html#a089690d293303e30c6eef0bb1e982191',1,'linalg.h']]], + ['la_5frank1_5fupdate_44',['la_rank1_update',['../linalg_8h.html#ab346fed23fd61f02d65e09c795c26d74',1,'linalg.h']]], + ['la_5frank1_5fupdate_5fcmplx_45',['la_rank1_update_cmplx',['../linalg_8h.html#a3c958fe274f8d1663dd0188455a5fe15',1,'linalg.h']]], + ['la_5frank_5fcmplx_46',['la_rank_cmplx',['../linalg_8h.html#afdc9b7e6ffab89915a082c00ceac7258',1,'linalg.h']]], + ['la_5fsolve_5fcholesky_47',['la_solve_cholesky',['../linalg_8h.html#a0dc578507a0cb6ada776142476383590',1,'linalg.h']]], + ['la_5fsolve_5fcholesky_5fcmplx_48',['la_solve_cholesky_cmplx',['../linalg_8h.html#a719ffdff56c8fa0875409c4f4e5e95cf',1,'linalg.h']]], + ['la_5fsolve_5fleast_5fsquares_49',['la_solve_least_squares',['../linalg_8h.html#a02eb049983dd41f2307bb52594fb210e',1,'linalg.h']]], + ['la_5fsolve_5fleast_5fsquares_5fcmplx_50',['la_solve_least_squares_cmplx',['../linalg_8h.html#ac3bb7b959d8cc7400e9b13290a895b64',1,'linalg.h']]], + ['la_5fsolve_5flq_51',['la_solve_lq',['../linalg_8h.html#a2c485d619c24435be713cf4356285e9a',1,'linalg.h']]], + ['la_5fsolve_5flq_5fcmplx_52',['la_solve_lq_cmplx',['../linalg_8h.html#a54ee9d9ab89b88b0ca682f70bc6c3c54',1,'linalg.h']]], + ['la_5fsolve_5flu_53',['la_solve_lu',['../linalg_8h.html#aae725d3247301d1163c58f89edff3d4b',1,'linalg.h']]], + ['la_5fsolve_5flu_5fcmplx_54',['la_solve_lu_cmplx',['../linalg_8h.html#aa067ac0d3f58e28371d413ab7419da74',1,'linalg.h']]], + ['la_5fsolve_5fqr_55',['la_solve_qr',['../linalg_8h.html#aefdc2e6758482d02a3aa7978f7d5efe0',1,'linalg.h']]], + ['la_5fsolve_5fqr_5fcmplx_56',['la_solve_qr_cmplx',['../linalg_8h.html#a0ff5f2519eb1d2af94e3b4a26dfb10fe',1,'linalg.h']]], + ['la_5fsolve_5fqr_5fcmplx_5fpvt_57',['la_solve_qr_cmplx_pvt',['../linalg_8h.html#ad0ee4a9c71de62911a71a342790f5070',1,'linalg.h']]], + ['la_5fsolve_5fqr_5fpvt_58',['la_solve_qr_pvt',['../linalg_8h.html#a62f97b4319f5574aef5e52bbacff14bb',1,'linalg.h']]], + ['la_5fsolve_5ftri_5fmtx_59',['la_solve_tri_mtx',['../linalg_8h.html#aed7b29bbff1472ebe805054eb9d8c6d4',1,'linalg.h']]], + ['la_5fsolve_5ftri_5fmtx_5fcmplx_60',['la_solve_tri_mtx_cmplx',['../linalg_8h.html#af87823d73fb5a319e4262594d147e38c',1,'linalg.h']]], + ['la_5fsort_5feigen_61',['la_sort_eigen',['../linalg_8h.html#abf5918abab8f97fc2ac5887e051ff493',1,'linalg.h']]], + ['la_5fsort_5feigen_5fcmplx_62',['la_sort_eigen_cmplx',['../linalg_8h.html#a090178a5f99a4b400da80481aad77757',1,'linalg.h']]], + ['la_5fsvd_63',['la_svd',['../linalg_8h.html#a56c0cea99a066e74c8fff9682d5ca92d',1,'linalg.h']]], + ['la_5fsvd_5fcmplx_64',['la_svd_cmplx',['../linalg_8h.html#afbffa0856d75c607a03d3dc7b5b1076e',1,'linalg.h']]], + ['la_5ftrace_65',['la_trace',['../linalg_8h.html#a7f611f8f3de7d56120c78e70671c7112',1,'linalg.h']]], + ['la_5ftrace_5fcmplx_66',['la_trace_cmplx',['../linalg_8h.html#a021fbb7fdccf557ec407a86bace43d85',1,'linalg.h']]], + ['la_5ftri_5fmtx_5fmult_67',['la_tri_mtx_mult',['../linalg_8h.html#ae7d70f1ef2a2824772e1bf0f726c257e',1,'linalg.h']]], + ['la_5ftri_5fmtx_5fmult_5fcmplx_68',['la_tri_mtx_mult_cmplx',['../linalg_8h.html#a02c464a9dd95298c91f431ae4d0773e9',1,'linalg.h']]] ]; From a0509268aeb4e02e978cf9ddf7a0fa7c587fcf61 Mon Sep 17 00:00:00 2001 From: jchristopherson Date: Tue, 20 Dec 2022 07:22:47 -0600 Subject: [PATCH 52/65] Bug fix --- src/linalg_factor.f90 | 23 +++++++++++------------ 1 file changed, 11 insertions(+), 12 deletions(-) diff --git a/src/linalg_factor.f90 b/src/linalg_factor.f90 index 6f8ff53a..2f7698f0 100644 --- a/src/linalg_factor.f90 +++ b/src/linalg_factor.f90 @@ -3028,7 +3028,6 @@ module subroutine form_lq_no_pivot(l, tau, q, work, olwork, err) m = size(l, 1) n = size(l, 2) mn = min(m, n) - qcol = size(q, 2) if (present(err)) then errmgr => err else @@ -3041,7 +3040,7 @@ module subroutine form_lq_no_pivot(l, tau, q, work, olwork, err) flag = 1 else if (size(tau) /= mn) then flag = 2 - else if (size(q, 1) /= m .or. size(q, 2) /= n) then + else if (size(q, 1) /= n .or. size(q, 2) /= n) then flag = 3 end if if (flag /= 0) then @@ -3054,7 +3053,7 @@ module subroutine form_lq_no_pivot(l, tau, q, work, olwork, err) end if ! Workspace Query - call DORGLQ(m, n, mn, q, m, tau, temp, -1, flag) + call DORGLQ(n, n, mn, q, n, tau, temp, -1, flag) lwork = int(temp(1), int32) if (present(olwork)) then olwork = lwork @@ -3091,7 +3090,7 @@ module subroutine form_lq_no_pivot(l, tau, q, work, olwork, err) end do ! Build Q - call DORGLQ(m, n, mn, q, m, tau, wptr, lwork, flag) + call DORGLQ(n, n, mn, q, n, tau, wptr, lwork, flag) ! Formatting 100 format(A, I0, A) @@ -3149,7 +3148,7 @@ module subroutine form_lq_no_pivot_cmplx(l, tau, q, work, olwork, err) end if ! Workspace Query - call ZUNGLQ(m, n, mn, q, m, tau, temp, -1, flag) + call ZUNGLQ(n, n, mn, q, n, tau, temp, -1, flag) lwork = int(temp(1), int32) if (present(olwork)) then olwork = lwork @@ -3186,7 +3185,7 @@ module subroutine form_lq_no_pivot_cmplx(l, tau, q, work, olwork, err) end do ! Build Q - call ZUNGLQ(m, n, mn, q, m, tau, wptr, lwork, flag) + call ZUNGLQ(n, n, mn, q, n, tau, wptr, lwork, flag) ! Formatting 100 format(A, I0, A) @@ -3419,7 +3418,7 @@ module subroutine mult_lq_vec(trans, a, tau, c, work, olwork, err) ! Input Check flag = 0 - if (size(a, 1) /= m .or. size(a, 2) /= m) then + if (size(a, 1) /= k .or. size(a, 2) /= m) then flag = 3 end if if (flag /= 0) then @@ -3432,7 +3431,7 @@ module subroutine mult_lq_vec(trans, a, tau, c, work, olwork, err) end if ! Workspace Query - call DORMLQ(side, t, m, n, k, a, m, tau, c, m, temp, -1, flag) + call DORMLQ(side, t, m, n, k, a, k, tau, c, m, temp, -1, flag) lwork = int(temp(1), int32) if (present(olwork)) then olwork = lwork @@ -3462,7 +3461,7 @@ module subroutine mult_lq_vec(trans, a, tau, c, work, olwork, err) end if ! Call DORMLQ - call DORMLQ(side, t, m, n, k, a, m, tau, c, m, wptr, lwork, flag) + call DORMLQ(side, t, m, n, k, a, k, tau, c, m, wptr, lwork, flag) ! Formatting 100 format(A, I0, A) @@ -3507,7 +3506,7 @@ module subroutine mult_lq_vec_cmplx(trans, a, tau, c, work, olwork, err) ! Input Check flag = 0 - if (size(a, 1) /= m .or. size(a, 2) /= m) then + if (size(a, 1) /= k .or. size(a, 2) /= m) then flag = 3 end if if (flag /= 0) then @@ -3520,7 +3519,7 @@ module subroutine mult_lq_vec_cmplx(trans, a, tau, c, work, olwork, err) end if ! Workspace Query - call ZUNMLQ(side, t, m, n, k, a, m, tau, c, m, temp, -1, flag) + call ZUNMLQ(side, t, m, n, k, a, k, tau, c, m, temp, -1, flag) lwork = int(temp(1), int32) if (present(olwork)) then olwork = lwork @@ -3550,7 +3549,7 @@ module subroutine mult_lq_vec_cmplx(trans, a, tau, c, work, olwork, err) end if ! Call ZUNMLQ - call ZUNMLQ(side, t, m, n, k, a, m, tau, c, m, wptr, lwork, flag) + call ZUNMLQ(side, t, m, n, k, a, k, tau, c, m, wptr, lwork, flag) ! Formatting 100 format(A, I0, A) From bb0fa11d523b7b534b44d1a3df594752bc8eb99f Mon Sep 17 00:00:00 2001 From: jchristopherson Date: Tue, 20 Dec 2022 07:22:51 -0600 Subject: [PATCH 53/65] Update tests --- tests/test_lq.f90 | 36 ++++++++++++++++++------------------ 1 file changed, 18 insertions(+), 18 deletions(-) diff --git a/tests/test_lq.f90 b/tests/test_lq.f90 index e4633dd1..f91cb5c4 100644 --- a/tests/test_lq.f90 +++ b/tests/test_lq.f90 @@ -17,7 +17,7 @@ function test_lq_factor() result(rst) real(real64), parameter :: tol = 1.0d-8 ! Local Variables - real(real64) :: a(m, n), aref(m, n), tau(m), q(m, n) + real(real64) :: a(m, n), aref(m, n), tau(m), q(n, n) logical :: rst ! Initialization @@ -46,7 +46,7 @@ function test_lq_factor_ud() result(rst) real(real64), parameter :: tol = 1.0d-8 ! Local Variables - real(real64) :: a(m, n), aref(m, n), tau(m), q(m, n), temp(m, n) + real(real64) :: a(m, n), aref(m, n), tau(m), q(n, n), temp(m, n) logical :: rst ! Initialization @@ -61,7 +61,7 @@ function test_lq_factor_ud() result(rst) call form_lq(a, tau, q) ! Perform the check - if (.not.is_mtx_equal(matmul(a(:,1:m), q), aref, tol)) then + if (.not.is_mtx_equal(matmul(a, q), aref, tol)) then rst = .false. print '(A)', "Test Failed: Underdetermined LQ Factorization Test 1" end if @@ -76,7 +76,7 @@ function test_lq_factor_cmplx() result(rst) ! Local Variables real(real64) :: ar(m, n), ai(m, n) - complex(real64) :: a(m, n), aref(m, n), tau(m), q(m, n) + complex(real64) :: a(m, n), aref(m, n), tau(m), q(n, n) logical :: rst ! Initialization @@ -108,7 +108,7 @@ function test_lq_factor_cmplx_ud() result(rst) ! Local Variables real(real64) :: ar(m, n), ai(m, n) - complex(real64) :: a(m, n), aref(m, n), tau(m), q(m, n) + complex(real64) :: a(m, n), aref(m, n), tau(m), q(n, n) logical :: rst ! Initialization @@ -125,7 +125,7 @@ function test_lq_factor_cmplx_ud() result(rst) call form_lq(a, tau, q) ! Perform the check - if (.not.is_mtx_equal(matmul(a(:,1:m), q), aref, tol)) then + if (.not.is_mtx_equal(matmul(a, q), aref, tol)) then rst = .false. print '(A)', "Test Failed: Underdetermined Complex LQ Factorization Test 1" end if @@ -141,8 +141,8 @@ function test_lq_mult() result(rst) real(real64), parameter :: tol = 1.0d-8 ! Local Variables - real(real64) :: a(m, n), l(m, n), tau(m), q(m, n), c1(m, n), c2(m, n), & - ans(m, n), c3(m), c4(m), ans2(m) + real(real64) :: a(m, n), l(m, n), tau(m), q(n, n), c1(n, n), c2(n, n), & + ans(n, n), c3(n), c4(n), ans2(n) logical :: rst ! Initialization @@ -157,7 +157,7 @@ function test_lq_mult() result(rst) call lq_factor(a, tau) l = a - ! Extract L and Q and check that L * Q = A + ! Extract L and Q call form_lq(l, tau, q) ! Compute C = Q * C @@ -193,8 +193,8 @@ function test_lq_mult_ud() result(rst) real(real64), parameter :: tol = 1.0d-8 ! Local Variables - real(real64) :: a(m, n), l(m, n), tau(m), q(m, n), c1(m, n), c2(m, n), & - ans(m, n), c3(m), c4(m), ans2(m) + real(real64) :: a(m, n), l(m, n), tau(m), q(n, n), c1(n, n), c2(n, n), & + ans(n, n), c3(n), c4(n), ans2(n) logical :: rst ! Initialization @@ -209,31 +209,31 @@ function test_lq_mult_ud() result(rst) call lq_factor(a, tau) l = a - ! Extract L and Q and check that L * Q = A + ! Extract L and Q call form_lq(l, tau, q) ! Compute C = Q * C - call mult_lq(.true., .false., a(:,1:m), tau, c1) + call mult_lq(.true., .false., a, tau, c1) ! Compute the answer - ans = matmul(q(:,1:m), c2) + ans = matmul(q, c2) ! Test if (.not.is_mtx_equal(c1, ans, tol)) then rst = .false. - print '(A)', "Test Failed: LQ Multiplication Test 1" + print '(A)', "Test Failed: Underdetermined LQ Multiplication Test 1" end if ! Vector RHS - call mult_lq(.false., a(:,1:m), tau, c3) + call mult_lq(.false., a, tau, c3) ! Compute the answer - ans2 = matmul(q(:,1:m), c4) + ans2 = matmul(q, c4) ! Test if (.not.is_mtx_equal(c3, ans2, tol)) then rst = .false. - print '(A)', "Test Failed: LQ Multiplication Test 2" + print '(A)', "Test Failed: Underdetermined LQ Multiplication Test 2" end if end function From fc341e512696d2c286aab4e7c8a3e2cdf5294264 Mon Sep 17 00:00:00 2001 From: jchristopherson Date: Tue, 20 Dec 2022 07:28:26 -0600 Subject: [PATCH 54/65] Update comments --- include/linalg.h | 12 ++++-------- src/linalg.f90 | 18 ++++++++---------- 2 files changed, 12 insertions(+), 18 deletions(-) diff --git a/include/linalg.h b/include/linalg.h index 701484e3..97c20844 100644 --- a/include/linalg.h +++ b/include/linalg.h @@ -1846,11 +1846,9 @@ int la_form_lq_cmplx(int m, int n, double complex *l, int ldl, * @param n The number of columns in matrix C. * @param k The number of elementary reflectors whose product defines * the matrix Q. - * @param a On input, an LDA-by-K matrix containing the elementary + * @param a On input, an K-by-P matrix containing the elementary * reflectors output from the LQ factorization. If @p lside is set to - * true, LDA = M, and M >= K >= 0; else, if @p lside is set to false, - * LDA = N, and N >= K >= 0. Notice, the contents of this matrix are - * restored on exit. + * true, P = M; else, if @p lside is set to false, P = N. * @param lda The leading dimension of matrix A. * @param tau A K-element array containing the scalar factors of each * elementary reflector defined in @p a. @@ -1878,11 +1876,9 @@ int la_mult_lq(bool lside, bool trans, int m, int n, int k, const double *a, * @param n The number of columns in matrix C. * @param k The number of elementary reflectors whose product defines * the matrix Q. - * @param a On input, an LDA-by-K matrix containing the elementary + * @param a On input, an K-by-P matrix containing the elementary * reflectors output from the LQ factorization. If @p lside is set to - * true, LDA = M, and M >= K >= 0; else, if @p lside is set to false, - * LDA = N, and N >= K >= 0. Notice, the contents of this matrix are - * restored on exit. + * true, P = M; else, if @p lside is set to false, P = N. * @param lda The leading dimension of matrix A. * @param tau A K-element array containing the scalar factors of each * elementary reflector defined in @p a. diff --git a/src/linalg.f90 b/src/linalg.f90 index d03bdc7f..f72a3b19 100644 --- a/src/linalg.f90 +++ b/src/linalg.f90 @@ -3436,8 +3436,8 @@ module linalg module procedure :: lq_factor_no_pivot_cmplx end interface -!> @brief Forms the matrix Q with orthonormal rows from the elementary -!! reflectors returned by the LQ factorization algorithm. +!> @brief Forms the orthogonal matrix Q from the elementary reflectors returned +!! by the LQ factorization algorithm. !! !! @par Syntax !! @code{.f90} @@ -3454,7 +3454,7 @@ module linalg !! Notice, M must be less than or equal to N for this routine. !! @param[in] tau A MIN(M, N)-element array containing the scalar factors of !! each elementary reflector defined in @p l. -!! @param[out] q An M-by-N matrix where the matrix Q with orhtonormal rows will +!! @param[out] q An N-by-N matrix where the orthogonal matrix Q will !! be written. !! @param[out] work An optional input, that if provided, prevents any local !! memory allocation. If not provided, the memory required is allocated @@ -3566,11 +3566,9 @@ module linalg !! @param[in] trans Set to true to apply \f$ Q^T \f$; else, set to false. In !! the event \f$ Q \f$ is complex-valued, \f$ Q^H \f$ is computed instead of !! \f$ Q^T \f$. -!! @param[in] a On input, an LDA-by-K matrix containing the elementary -!! reflectors output from the QR factorization. If @p lside is set to -!! true, LDA = M, and M >= K >= 0; else, if @p lside is set to false, -!! LDA = N, and N >= K >= 0. Notice, the contents of this matrix are -!! restored on exit. +!! @param[in] a On input, an K-by-P matrix containing the elementary +!! reflectors output from the LQ factorization. If @p lside is set to +!! true, P = M; else, if @p lside is set to false, P = N. !! @param[in] tau A K-element array containing the scalar factors of each !! elementary reflector defined in @p a. !! @param[in,out] c On input, the M-by-N matrix C. On output, the product @@ -3603,8 +3601,8 @@ module linalg !! @param[in] trans Set to true to apply \f$ Q^T \f$; else, set to false. In !! the event \f$ Q \f$ is complex-valued, \f$ Q^H \f$ is computed instead of !! \f$ Q^T \f$. -!! @param[in] a On input, an M-by-K matrix containing the elementary -!! reflectors output from the QR factorization. Notice, the contents of +!! @param[in] a On input, an K-by-M matrix containing the elementary +!! reflectors output from the LQ factorization. Notice, the contents of !! this matrix are restored on exit. !! @param[in] tau A K-element array containing the scalar factors of each !! elementary reflector defined in @p a. From 50046278d05d4caf4e1e8b7a65ae84fe2dae3de1 Mon Sep 17 00:00:00 2001 From: jchristopherson Date: Tue, 20 Dec 2022 07:28:57 -0600 Subject: [PATCH 55/65] Update documentation --- doc/C/html/globals.html | 8 + doc/C/html/globals_func.html | 8 + doc/C/html/linalg_8h.html | 798 +++++++- doc/C/html/linalg_8h.js | 8 + doc/C/html/linalg_8h_source.html | 40 +- doc/C/html/navtreeindex0.js | 100 +- doc/C/html/search/all_0.js | 104 +- doc/C/html/search/functions_0.js | 100 +- doc/html/annotated.html | 2 +- doc/html/interfacelinalg_1_1form__lq.html | 8 +- doc/html/interfacelinalg_1_1lq__factor.html | 2 +- doc/html/interfacelinalg_1_1mult__lq.html | 8 +- doc/html/interfacelinalg_1_1solve__lq.html | 4 +- doc/html/linalg_8f90_source.html | 2022 +++++++++---------- doc/html/linalg_8h.html | 4 +- doc/html/linalg_8h_source.html | 34 +- doc/html/linalg__factor_8f90_source.html | 1059 +++++----- doc/html/namespacelinalg.html | 2 +- doc/html/namespaces.html | 2 +- 19 files changed, 2526 insertions(+), 1787 deletions(-) diff --git a/doc/C/html/globals.html b/doc/C/html/globals.html index f8b45e82..0ffa3f4a 100644 --- a/doc/C/html/globals.html +++ b/doc/C/html/globals.html @@ -115,6 +115,8 @@

    - l -

    • la_eigen_cmplx() : linalg.h
    • la_eigen_gen() : linalg.h
    • la_eigen_symm() : linalg.h
    • +
    • la_form_lq() : linalg.h
    • +
    • la_form_lq_cmplx() : linalg.h
    • la_form_lu() : linalg.h
    • la_form_lu_cmplx() : linalg.h
    • la_form_qr() : linalg.h
    • @@ -123,10 +125,14 @@

      - l -

      • la_form_qr_pvt() : linalg.h
      • la_inverse() : linalg.h
      • la_inverse_cmplx() : linalg.h
      • +
      • la_lq_factor() : linalg.h
      • +
      • la_lq_factor_cmplx() : linalg.h
      • la_lu_factor() : linalg.h
      • la_lu_factor_cmplx() : linalg.h
      • la_mtx_mult() : linalg.h
      • la_mtx_mult_cmplx() : linalg.h
      • +
      • la_mult_lq() : linalg.h
      • +
      • la_mult_lq_cmplx() : linalg.h
      • la_mult_qr() : linalg.h
      • la_mult_qr_cmplx() : linalg.h
      • la_pinverse() : linalg.h
      • @@ -145,6 +151,8 @@

        - l -

        • la_solve_cholesky_cmplx() : linalg.h
        • la_solve_least_squares() : linalg.h
        • la_solve_least_squares_cmplx() : linalg.h
        • +
        • la_solve_lq() : linalg.h
        • +
        • la_solve_lq_cmplx() : linalg.h
        • la_solve_lu() : linalg.h
        • la_solve_lu_cmplx() : linalg.h
        • la_solve_qr() : linalg.h
        • diff --git a/doc/C/html/globals_func.html b/doc/C/html/globals_func.html index 7aa03a1d..85652ded 100644 --- a/doc/C/html/globals_func.html +++ b/doc/C/html/globals_func.html @@ -115,6 +115,8 @@

          - l -

          • la_eigen_cmplx() : linalg.h
          • la_eigen_gen() : linalg.h
          • la_eigen_symm() : linalg.h
          • +
          • la_form_lq() : linalg.h
          • +
          • la_form_lq_cmplx() : linalg.h
          • la_form_lu() : linalg.h
          • la_form_lu_cmplx() : linalg.h
          • la_form_qr() : linalg.h
          • @@ -123,10 +125,14 @@

            - l -

            • la_form_qr_pvt() : linalg.h
            • la_inverse() : linalg.h
            • la_inverse_cmplx() : linalg.h
            • +
            • la_lq_factor() : linalg.h
            • +
            • la_lq_factor_cmplx() : linalg.h
            • la_lu_factor() : linalg.h
            • la_lu_factor_cmplx() : linalg.h
            • la_mtx_mult() : linalg.h
            • la_mtx_mult_cmplx() : linalg.h
            • +
            • la_mult_lq() : linalg.h
            • +
            • la_mult_lq_cmplx() : linalg.h
            • la_mult_qr() : linalg.h
            • la_mult_qr_cmplx() : linalg.h
            • la_pinverse() : linalg.h
            • @@ -145,6 +151,8 @@

              - l -

              • la_solve_cholesky_cmplx() : linalg.h
              • la_solve_least_squares() : linalg.h
              • la_solve_least_squares_cmplx() : linalg.h
              • +
              • la_solve_lq() : linalg.h
              • +
              • la_solve_lq_cmplx() : linalg.h
              • la_solve_lu() : linalg.h
              • la_solve_lu_cmplx() : linalg.h
              • la_solve_qr() : linalg.h
              • diff --git a/doc/C/html/linalg_8h.html b/doc/C/html/linalg_8h.html index c0933092..802fc1f4 100644 --- a/doc/C/html/linalg_8h.html +++ b/doc/C/html/linalg_8h.html @@ -268,6 +268,22 @@   int la_sort_eigen_cmplx (bool ascend, int n, double complex *vals, double complex *vecs, int ldv)   +int la_lq_factor (int m, int n, double *a, int lda, double *tau) +  +int la_lq_factor_cmplx (int m, int n, double complex *a, int lda, double complex *tau) +  +int la_form_lq (int m, int n, double *l, int ldl, const double *tau, double *q, int ldq) +  +int la_form_lq_cmplx (int m, int n, double complex *l, int ldl, const double complex *tau, double complex *q, int ldq) +  +int la_mult_lq (bool lside, bool trans, int m, int n, int k, const double *a, int lda, const double *tau, double *c, int ldc) +  +int la_mult_lq_cmplx (bool lside, bool trans, int m, int n, int k, const double complex *a, int lda, const double complex *tau, double complex *c, int ldc) +  +int la_solve_lq (int m, int n, int k, const double *a, int lda, const double *tau, double *b, int ldb) +  +int la_solve_lq_cmplx (int m, int n, int k, const double complex *a, int lda, const double complex *tau, double complex *b, int ldb) + 

                Function Documentation

                @@ -1388,6 +1404,160 @@

                +

                ◆ la_form_lq()

                + +
                +
                + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
                int la_form_lq (int m,
                int n,
                double * l,
                int ldl,
                const double * tau,
                double * q,
                int ldq 
                )
                +
                +

                Forms the matrix Q with orthonormal rows from the elementary reflectors returned by the base QR factorization algorithm.

                +
                Parameters
                + + + + + + + + +
                mThe number of rows in R.
                nThe number of columns in R.
                lOn input, the M-by-N factored matrix as returned by the LQ factorization routine. On output, the lower triangular matrix L.
                ldlThe leading dimension of matrix L.
                tauA MIN(M, N)-element array containing the scalar factors of each elementary reflector defined in r.
                qAn M-by-N matrix where the Q matrix will be written.
                ldqThe leading dimension of matrix Q.
                +
                +
                +
                Returns
                An error code. The following codes are possible.
                  +
                • LA_NO_ERROR: No error occurred. Successful operation.
                • +
                • LA_INVALID_INPUT_ERROR: Occurs if ldl or ldq are not correct.
                • +
                • LA_OUT_OF_MEMORY_ERROR: Occurs if there is insufficient memory available.
                • +
                +
                + +
                +
                + +

                ◆ la_form_lq_cmplx()

                + +
                +
                + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
                int la_form_lq_cmplx (int m,
                int n,
                double complex * l,
                int ldl,
                const double complex * tau,
                double complex * q,
                int ldq 
                )
                +
                +

                Forms the matrix Q with orthonormal rows from the elementary reflectors returned by the base QR factorization algorithm.

                +
                Parameters
                + + + + + + + + +
                mThe number of rows in R.
                nThe number of columns in R.
                lOn input, the M-by-N factored matrix as returned by the LQ factorization routine. On output, the lower triangular matrix L.
                ldlThe leading dimension of matrix L.
                tauA MIN(M, N)-element array containing the scalar factors of each elementary reflector defined in r.
                qAn M-by-N matrix where the Q matrix will be written.
                ldqThe leading dimension of matrix Q.
                +
                +
                +
                Returns
                An error code. The following codes are possible.
                  +
                • LA_NO_ERROR: No error occurred. Successful operation.
                • +
                • LA_INVALID_INPUT_ERROR: Occurs if ldl or ldq are not correct.
                • +
                • LA_OUT_OF_MEMORY_ERROR: Occurs if there is insufficient memory available.
                • +
                +
                +
                @@ -1633,7 +1803,7 @@

                Returns
                An error code. The following codes are possible.
                • LA_NO_ERROR: No error occurred. Successful operation.
                • -
                • LA_INVALID_INPUT_ERROR: Occurs if lda is not correct.
                • +
                • LA_INVALID_INPUT_ERROR: Occurs if ldr or ldq are not correct.
                • LA_OUT_OF_MEMORY_ERROR: Occurs if there is insufficient memory available.
                @@ -1717,7 +1887,7 @@

                Returns
                An error code. The following codes are possible.
                • LA_NO_ERROR: No error occurred. Successful operation.
                • -
                • LA_INVALID_INPUT_ERROR: Occurs if lda is not correct.
                • +
                • LA_INVALID_INPUT_ERROR: Occurs if ldr or ldq are not correct.
                • LA_OUT_OF_MEMORY_ERROR: Occurs if there is insufficient memory available.
                @@ -2030,6 +2200,132 @@

                +

                ◆ la_lq_factor()

                + +
                +
                + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
                int la_lq_factor (int m,
                int n,
                double * a,
                int lda,
                double * tau 
                )
                +
                +

                Computes the LQ factorization of an M-by-N matrix without pivoting.

                +
                Parameters
                + + + + + + +
                mThe number of rows in the matrix.
                nThe number of columns in the matrix.
                aOn input, the M-by-N matrix to factor. On output, the elements on and above the diagonal contain the MIN(M, N)-by-N upper trapezoidal matrix R (R is upper triangular if M >= N). The elements below the diagonal, along with the array tau, represent the orthogonal matrix Q as a product of elementary reflectors.
                ldaThe leading dimension of matrix A.
                tauA MIN(M, N)-element array used to store the scalar factors of the elementary reflectors.
                +
                +
                +
                Returns
                An error code. The following codes are possible.
                  +
                • LA_NO_ERROR: No error occurred. Successful operation.
                • +
                • LA_INVALID_INPUT_ERROR: Occurs if lda is not correct.
                • +
                • LA_OUT_OF_MEMORY_ERROR: Occurs if there is insufficient memory available.
                • +
                +
                + +
                +
                + +

                ◆ la_lq_factor_cmplx()

                + +
                +
                + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
                int la_lq_factor_cmplx (int m,
                int n,
                double complex * a,
                int lda,
                double complex * tau 
                )
                +
                +

                Computes the LQ factorization of an M-by-N matrix without pivoting.

                +
                Parameters
                + + + + + + +
                mThe number of rows in the matrix.
                nThe number of columns in the matrix.
                aOn input, the M-by-N matrix to factor. On output, the elements on and above the diagonal contain the MIN(M, N)-by-N upper trapezoidal matrix R (R is upper triangular if M >= N). The elements below the diagonal, along with the array tau, represent the orthogonal matrix Q as a product of elementary reflectors.
                ldaThe leading dimension of matrix A.
                tauA MIN(M, N)-element array used to store the scalar factors of the elementary reflectors.
                +
                +
                +
                Returns
                An error code. The following codes are possible.
                  +
                • LA_NO_ERROR: No error occurred. Successful operation.
                • +
                • LA_INVALID_INPUT_ERROR: Occurs if lda is not correct.
                • +
                • LA_OUT_OF_MEMORY_ERROR: Occurs if there is insufficient memory available.
                • +
                +
                +
                @@ -2203,32 +2499,250 @@

                - const double *  - a, + const double *  + a, + + + + + int  + lda, + + + + + const double *  + b, + + + + + int  + ldb, + + + + + double  + beta, + + + + + double *  + c, + + + + + int  + ldc  + + + + ) + + + +
                +

                Computes the matrix operation \( C = \alpha op(A) op(B) + \beta C \).

                +
                Parameters
                + + + + + + + + + + + + + + +
                transaSet to true to compute op(A) as the transpose of A; else, set to false to compute op(A) as A.
                transbSet to true to compute op(B) as the transpose of B; else, set to false to compute op(B) as B.
                mThe number of rows in c.
                nThe number of columns in c.
                kThe interior dimension of the product a and b.
                alphaA scalar multiplier.
                aIf transa is true, this matrix must be k by m; else, if transa is false, this matrix must be m by k.
                ldaThe leading dimension of matrix a.
                bIf transb is true, this matrix must be n by k; else, if transb is false, this matrix must be k by n.
                ldbThe leading dimension of matrix b.
                betaA scalar multiplier.
                cThe m by n matrix C.
                ldcThe leading dimension of matrix c.
                +
                +
                +
                Returns
                An error code. The following codes are possible.
                  +
                • LA_NO_ERROR: No error occurred. Successful operation.
                • +
                • LA_INVALID_INPUT_ERROR: Occurs if lda, ldb, or ldc are not correct.
                • +
                +
                + +
                + +
                +

                ◆ la_mtx_mult_cmplx()

                + +
                +
                + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
                int la_mtx_mult_cmplx (int opa,
                int opb,
                int m,
                int n,
                int k,
                double complex alpha,
                const double complex * a,
                int lda,
                const double complex * b,
                int ldb,
                double complex beta,
                double complex * c,
                int ldc 
                )
                +
                +

                Computes the matrix operation \( C = \alpha op(A) op(B) + \beta C \).

                +
                Parameters
                + + + + + + + + + + + + + + +
                opaSet to LA_TRANSPOSE to compute op(A) as a direct transpose of A, set to LA_HERMITIAN_TRANSPOSE to compute op(A) as the Hermitian transpose of A, otherwise, set to LA_NO_OPERATION to compute op(A) as A.
                opbSet to TLA_RANSPOSE to compute op(B) as a direct transpose of B, set to LA_HERMITIAN_TRANSPOSE to compute op(B) as the Hermitian transpose of B, otherwise, set to LA_NO_OPERATION to compute op(B) as B.
                mThenumber of rows in c.
                nThe number of columns in c.
                kThe interior dimension of the product a and b.
                alphaA scalar multiplier.
                aIf opa is LA_TRANSPOSE or LA_HERMITIAN_TRANSPOSE, this matrix must be k by m; else, this matrix must be m by k.
                ldaThe leading dimension of matrix a.
                bIf opb is LA_TRANSPOSE or LA_HERMITIAN_TRANSPOSE, this matrix must be n by k; else, this matrix must be k by n.
                ldbThe leading dimension of matrix b.
                betaA scalar multiplier.
                cThe m by n matrix C.
                ldcThe leading dimension of matrix c.
                +
                +
                +
                Returns
                An error code. The following codes are possible.
                  +
                • LA_NO_ERROR: No error occurred. Successful operation.
                • +
                • LA_INVALID_INPUT_ERROR: Occurs if lda, ldb, or ldc are not correct.
                • +
                +
                + +
                +
                + +

                ◆ la_mult_lq()

                + +
                +
                + + + + + + + + + + + + + + + + + + + + + + + + - + - + - + - - + + @@ -2249,50 +2763,48 @@

                -

                Computes the matrix operation \( C = \alpha op(A) op(B) + \beta C \).

                +

                Multiplies a general matrix by the orthogonal matrix Q from a LQ factorization such that: \( C = op(Q) C \), or \( C = C op(Q) \).

                Parameters

                int la_mult_lq (bool lside,
                bool trans,
                int m,
                int n,
                int lda, k,
                const double * b, a,
                int ldb, lda,
                double beta, const double * tau,
                - - - - - - - - - - - - - + + + + + + + + + +
                transaSet to true to compute op(A) as the transpose of A; else, set to false to compute op(A) as A.
                transbSet to true to compute op(B) as the transpose of B; else, set to false to compute op(B) as B.
                mThe number of rows in c.
                nThe number of columns in c.
                kThe interior dimension of the product a and b.
                alphaA scalar multiplier.
                aIf transa is true, this matrix must be k by m; else, if transa is false, this matrix must be m by k.
                ldaThe leading dimension of matrix a.
                bIf transb is true, this matrix must be n by k; else, if transb is false, this matrix must be k by n.
                ldbThe leading dimension of matrix b.
                betaA scalar multiplier.
                cThe m by n matrix C.
                ldcThe leading dimension of matrix c.
                lsideSet to true to apply \( Q \) or \( Q^T \) from the left; else, set to false to apply \( Q \) or \( Q^T \) from the right.
                transSet to true to apply \( Q^T \); else, set to false.
                mThe number of rows in matrix C.
                nThe number of columns in matrix C.
                kThe number of elementary reflectors whose product defines the matrix Q.
                aOn input, an K-by-P matrix containing the elementary reflectors output from the LQ factorization. If lside is set to true, P = M; else, if lside is set to false, P = N.
                ldaThe leading dimension of matrix A.
                tauA K-element array containing the scalar factors of each elementary reflector defined in a.
                cOn input, the M-by-N matrix C. On output, the product of the orthogonal matrix Q and the original matrix C.
                ldcThe leading dimension of matrix C.
                Returns
                An error code. The following codes are possible.
                • LA_NO_ERROR: No error occurred. Successful operation.
                • -
                • LA_INVALID_INPUT_ERROR: Occurs if lda, ldb, or ldc are not correct.
                • +
                • LA_INVALID_INPUT_ERROR: Occurs if lda or ldc are not correct.
                • +
                • LA_OUT_OF_MEMORY_ERROR: Occurs if there is insufficient memory available.
                - -

                ◆ la_mtx_mult_cmplx()

                + +

                ◆ la_mult_lq_cmplx()

                - + - - + + - - + + @@ -2312,12 +2824,6 @@

                int 

                - - - - - - @@ -2334,19 +2840,7 @@

                - - - - - - - - - - - - - + @@ -2367,28 +2861,26 @@

                -

                Computes the matrix operation \( C = \alpha op(A) op(B) + \beta C \).

                +

                Multiplies a general matrix by the orthogonal matrix Q from a LQ factorization such that: \( C = op(Q) C \), or \( C = C op(Q) \).

                Parameters

                int la_mtx_mult_cmplx int la_mult_lq_cmplx (int opa, bool lside,
                int opb, bool trans,
                k,
                double complex alpha,
                const double complex * b,
                int ldb,
                double complex beta, tau,
                - - - - - - - - - - - - - + + + + + + + + + +
                opaSet to LA_TRANSPOSE to compute op(A) as a direct transpose of A, set to LA_HERMITIAN_TRANSPOSE to compute op(A) as the Hermitian transpose of A, otherwise, set to LA_NO_OPERATION to compute op(A) as A.
                opbSet to TLA_RANSPOSE to compute op(B) as a direct transpose of B, set to LA_HERMITIAN_TRANSPOSE to compute op(B) as the Hermitian transpose of B, otherwise, set to LA_NO_OPERATION to compute op(B) as B.
                mThenumber of rows in c.
                nThe number of columns in c.
                kThe interior dimension of the product a and b.
                alphaA scalar multiplier.
                aIf opa is LA_TRANSPOSE or LA_HERMITIAN_TRANSPOSE, this matrix must be k by m; else, this matrix must be m by k.
                ldaThe leading dimension of matrix a.
                bIf opb is LA_TRANSPOSE or LA_HERMITIAN_TRANSPOSE, this matrix must be n by k; else, this matrix must be k by n.
                ldbThe leading dimension of matrix b.
                betaA scalar multiplier.
                cThe m by n matrix C.
                ldcThe leading dimension of matrix c.
                lsideSet to true to apply \( Q \) or \( Q^H \) from the left; else, set to false to apply \( Q \) or \( Q^H \) from the right.
                transSet to true to apply \( Q^H \); else, set to false.
                mThe number of rows in matrix C.
                nThe number of columns in matrix C.
                kThe number of elementary reflectors whose product defines the matrix Q.
                aOn input, an K-by-P matrix containing the elementary reflectors output from the LQ factorization. If lside is set to true, P = M; else, if lside is set to false, P = N.
                ldaThe leading dimension of matrix A.
                tauA K-element array containing the scalar factors of each elementary reflector defined in a.
                cOn input, the M-by-N matrix C. On output, the product of the orthogonal matrix Q and the original matrix C.
                ldcThe leading dimension of matrix C.
                Returns
                An error code. The following codes are possible.
                • LA_NO_ERROR: No error occurred. Successful operation.
                • -
                • LA_INVALID_INPUT_ERROR: Occurs if lda, ldb, or ldc are not correct.
                • +
                • LA_INVALID_INPUT_ERROR: Occurs if lda or ldc are not correct.
                • +
                • LA_OUT_OF_MEMORY_ERROR: Occurs if there is insufficient memory available.
                @@ -2479,13 +2971,13 @@

                ldaThe leading dimension of matrix A. tauA K-element array containing the scalar factors of each elementary reflector defined in a. cOn input, the M-by-N matrix C. On output, the product of the orthogonal matrix Q and the original matrix C. - ldcTHe leading dimension of matrix C. + ldcThe leading dimension of matrix C.
                Returns
                An error code. The following codes are possible.
                • LA_NO_ERROR: No error occurred. Successful operation.
                • -
                • LA_INVALID_INPUT_ERROR: Occurs if lda is not correct.
                • +
                • LA_INVALID_INPUT_ERROR: Occurs if lda or ldc are not correct.
                • LA_OUT_OF_MEMORY_ERROR: Occurs if there is insufficient memory available.
                @@ -2577,13 +3069,13 @@

                ldaThe leading dimension of matrix A. tauA K-element array containing the scalar factors of each elementary reflector defined in a. cOn input, the M-by-N matrix C. On output, the product of the orthogonal matrix Q and the original matrix C. - ldcTHe leading dimension of matrix C. + ldcThe leading dimension of matrix C.
                Returns
                An error code. The following codes are possible.
                • LA_NO_ERROR: No error occurred. Successful operation.
                • -
                • LA_INVALID_INPUT_ERROR: Occurs if lda is not correct.
                • +
                • LA_INVALID_INPUT_ERROR: Occurs if lda or ldc are not correct.
                • LA_OUT_OF_MEMORY_ERROR: Occurs if there is insufficient memory available.
                @@ -3746,6 +4238,174 @@

                +

                ◆ la_solve_lq()

                + +
                +
                + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
                int la_solve_lq (int m,
                int n,
                int k,
                const double * a,
                int lda,
                const double * tau,
                double * b,
                int ldb 
                )
                +
                +

                Solves a system of M QR-factored equations of N unknowns where N >= M.

                +
                Parameters
                + + + + + + + + + +
                mThe number of equations (rows in matrix A).
                nThe number of unknowns (columns in matrix A).
                kThe number of columns in the right-hand-side matrix.
                aOn input, the M-by-N QR factored matrix as returned by lq_factor.
                ldaThe leading dimension of matrix A.
                tauA MIN(M, N)-element array containing the scalar factors of the elementary reflectors as returned by lq_factor.
                bOn input, an N-by-K matrix containing the first M rows of the right-hand-side matrix. On output, the solution matrix X.
                ldbThe leading dimension of matrix B.
                +
                +
                +
                Returns
                An error code. The following codes are possible.
                  +
                • LA_NO_ERROR: No error occurred. Successful operation.
                • +
                • LA_INVALID_INPUT_ERROR: Occurs if lda, or ldb is not correct, or if m is less than n.
                • +
                • LA_OUT_OF_MEMORY_ERROR: Occurs if local memory must be allocated, and there is insufficient memory available.
                • +
                +
                + +
                +
                + +

                ◆ la_solve_lq_cmplx()

                + +
                +
                + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
                int la_solve_lq_cmplx (int m,
                int n,
                int k,
                const double complex * a,
                int lda,
                const double complex * tau,
                double complex * b,
                int ldb 
                )
                +
                +

                Solves a system of M QR-factored equations of N unknowns where N >= M.

                +
                Parameters
                + + + + + + + + + +
                mThe number of equations (rows in matrix A).
                nThe number of unknowns (columns in matrix A).
                kThe number of columns in the right-hand-side matrix.
                aOn input, the M-by-N QR factored matrix as returned by lq_factor.
                ldaThe leading dimension of matrix A.
                tauA MIN(M, N)-element array containing the scalar factors of the elementary reflectors as returned by lq_factor.
                bOn input, an N-by-K matrix containing the first M rows of the right-hand-side matrix. On output, the solution matrix X.
                ldbThe leading dimension of matrix B.
                +
                +
                +
                Returns
                An error code. The following codes are possible.
                  +
                • LA_NO_ERROR: No error occurred. Successful operation.
                • +
                • LA_INVALID_INPUT_ERROR: Occurs if lda, or ldb is not correct, or if m is less than n.
                • +
                • LA_OUT_OF_MEMORY_ERROR: Occurs if local memory must be allocated, and there is insufficient memory available.
                • +
                +
                +
                diff --git a/doc/C/html/linalg_8h.js b/doc/C/html/linalg_8h.js index 32aee583..d3bd2485 100644 --- a/doc/C/html/linalg_8h.js +++ b/doc/C/html/linalg_8h.js @@ -15,6 +15,8 @@ var linalg_8h = [ "la_eigen_cmplx", "linalg_8h.html#ae5a16375c14c924836c33bafa747a1cf", null ], [ "la_eigen_gen", "linalg_8h.html#af3c6f1a45aee2f275d4b109c9bb660d2", null ], [ "la_eigen_symm", "linalg_8h.html#ac208d5e6849972a77ef261f2e368868c", null ], + [ "la_form_lq", "linalg_8h.html#ac54763802ad5c3966f8e14cdf93fdc96", null ], + [ "la_form_lq_cmplx", "linalg_8h.html#aa54b8d224976dca7ef384eed74f50bed", null ], [ "la_form_lu", "linalg_8h.html#a15774f6323c34d307c99b32ac4f188a7", null ], [ "la_form_lu_cmplx", "linalg_8h.html#a73bea3ca338925cfa4a58bcaea726a14", null ], [ "la_form_qr", "linalg_8h.html#afe39765d805c1d9ae93e9aa2f20d8548", null ], @@ -23,10 +25,14 @@ var linalg_8h = [ "la_form_qr_pvt", "linalg_8h.html#aace787c5b11959a457b936ace4995033", null ], [ "la_inverse", "linalg_8h.html#a95d6ed56844c62d553b940091837014b", null ], [ "la_inverse_cmplx", "linalg_8h.html#a7a821b41c61670f5710214a4d9178998", null ], + [ "la_lq_factor", "linalg_8h.html#a7b2048bb219e58f455175041558ac44f", null ], + [ "la_lq_factor_cmplx", "linalg_8h.html#a5e6786c40f8f91e5f16f06e92be71ffa", null ], [ "la_lu_factor", "linalg_8h.html#a248142a5f0826cddac5daf1c74f234a6", null ], [ "la_lu_factor_cmplx", "linalg_8h.html#ace554b62c12a5d9a2434c8171c756c47", null ], [ "la_mtx_mult", "linalg_8h.html#a968b10545320af7bbe1030867ae88e8c", null ], [ "la_mtx_mult_cmplx", "linalg_8h.html#aefefe80e13f74470d5afaf44b3a45e76", null ], + [ "la_mult_lq", "linalg_8h.html#ac575e10e20e9c2d8d40ed8df47179773", null ], + [ "la_mult_lq_cmplx", "linalg_8h.html#adcb07293cf47d090dfb89c20837ca7b5", null ], [ "la_mult_qr", "linalg_8h.html#a95f921847131eaedd62a439490d2a801", null ], [ "la_mult_qr_cmplx", "linalg_8h.html#acc25c0daa53c10ace21a61d78b2e79f3", null ], [ "la_pinverse", "linalg_8h.html#af7f8185c0f25ad3fb0b89cc98d77b3d6", null ], @@ -45,6 +51,8 @@ var linalg_8h = [ "la_solve_cholesky_cmplx", "linalg_8h.html#a719ffdff56c8fa0875409c4f4e5e95cf", null ], [ "la_solve_least_squares", "linalg_8h.html#a02eb049983dd41f2307bb52594fb210e", null ], [ "la_solve_least_squares_cmplx", "linalg_8h.html#ac3bb7b959d8cc7400e9b13290a895b64", null ], + [ "la_solve_lq", "linalg_8h.html#a2c485d619c24435be713cf4356285e9a", null ], + [ "la_solve_lq_cmplx", "linalg_8h.html#a54ee9d9ab89b88b0ca682f70bc6c3c54", null ], [ "la_solve_lu", "linalg_8h.html#aae725d3247301d1163c58f89edff3d4b", null ], [ "la_solve_lu_cmplx", "linalg_8h.html#aa067ac0d3f58e28371d413ab7419da74", null ], [ "la_solve_qr", "linalg_8h.html#aefdc2e6758482d02a3aa7978f7d5efe0", null ], diff --git a/doc/C/html/linalg_8h_source.html b/doc/C/html/linalg_8h_source.html index d4f7dc00..b914016e 100644 --- a/doc/C/html/linalg_8h_source.html +++ b/doc/C/html/linalg_8h_source.html @@ -299,10 +299,34 @@
                1742int la_sort_eigen_cmplx(bool ascend, int n, double complex *vals,
                1743 double complex *vecs, int ldv);
                1744
                -
                1745#ifdef __cplusplus
                -
                1746}
                -
                1747#endif // __cplusplus
                -
                1748#endif // LINALG_H_DEFINED
                +
                1766int la_lq_factor(int m, int n, double *a, int lda, double *tau);
                +
                1767
                +
                1789int la_lq_factor_cmplx(int m, int n, double complex *a, int lda,
                +
                1790 double complex *tau);
                +
                1791
                +
                1812int la_form_lq(int m, int n, double *l, int ldl, const double *tau, double *q,
                +
                1813 int ldq);
                +
                1814
                +
                1835int la_form_lq_cmplx(int m, int n, double complex *l, int ldl,
                +
                1836 const double complex *tau, double complex *q, int ldq);
                +
                1837
                +
                1865int la_mult_lq(bool lside, bool trans, int m, int n, int k, const double *a,
                +
                1866 int lda, const double *tau, double *c, int ldc);
                +
                1867
                +
                1895int la_mult_lq_cmplx(bool lside, bool trans, int m, int n, int k,
                +
                1896 const double complex *a, int lda, const double complex *tau,
                +
                1897 double complex *c, int ldc);
                +
                1898
                +
                1922int la_solve_lq(int m, int n, int k, const double *a, int lda,
                +
                1923 const double *tau, double *b, int ldb);
                +
                1924
                +
                1948int la_solve_lq_cmplx(int m, int n, int k, const double complex *a, int lda,
                +
                1949 const double complex *tau, double complex *b, int ldb);
                +
                1950
                +
                1951#ifdef __cplusplus
                +
                1952}
                +
                1953#endif // __cplusplus
                +
                1954#endif // LINALG_H_DEFINED
                int la_cholesky_rank1_downdate_cmplx(int n, double complex *r, int ldr, double complex *u)
                int la_trace_cmplx(int m, int n, const double complex *a, int lda, double complex *rst)
                int la_tri_mtx_mult_cmplx(bool upper, double complex alpha, int n, const double complex *a, int lda, double complex beta, double complex *b, int ldb)
                @@ -316,13 +340,16 @@
                int la_cholesky_factor_cmplx(bool upper, int n, double complex *a, int lda)
                int la_lu_factor(int m, int n, double *a, int lda, int *ipvt)
                int la_cholesky_rank1_downdate(int n, double *r, int ldr, double *u)
                +
                int la_solve_lq(int m, int n, int k, const double *a, int lda, const double *tau, double *b, int ldb)
                int la_cholesky_factor(bool upper, int n, double *a, int lda)
                int la_rank1_update_cmplx(int m, int n, double complex alpha, const double complex *x, const double complex *y, double complex *a, int lda)
                int la_qr_factor_cmplx_pvt(int m, int n, double complex *a, int lda, double complex *tau, int *jpvt)
                int la_diag_mtx_mult(bool lside, bool transb, int m, int n, int k, double alpha, const double *a, const double *b, int ldb, double beta, double *c, int ldc)
                int la_qr_factor_pvt(int m, int n, double *a, int lda, double *tau, int *jpvt)
                int la_diag_mtx_mult_mixed(bool lside, int opb, int m, int n, int k, double complex alpha, const double *a, const double complex *b, int ldb, double complex beta, double complex *c, int ldc)
                +
                int la_solve_lq_cmplx(int m, int n, int k, const double complex *a, int lda, const double complex *tau, double complex *b, int ldb)
                int la_svd(int m, int n, double *a, int lda, double *s, double *u, int ldu, double *vt, int ldv)
                +
                int la_lq_factor_cmplx(int m, int n, double complex *a, int lda, double complex *tau)
                int la_solve_qr_pvt(int m, int n, int k, double *a, int lda, const double *tau, const int *jpvt, double *b, int ldb)
                int la_diag_mtx_mult_cmplx(bool lside, int opb, int m, int n, int k, double complex alpha, const double complex *a, const double complex *b, int ldb, double complex beta, double complex *c, int ldc)
                int la_solve_cholesky_cmplx(bool upper, int m, int n, const double complex *a, int lda, double complex *b, int ldb)
                @@ -330,6 +357,7 @@
                int la_form_lu_cmplx(int n, double complex *a, int lda, int *ipvt, double complex *u, int ldu, double *p, int ldp)
                int la_qr_factor(int m, int n, double *a, int lda, double *tau)
                int la_inverse_cmplx(int n, double complex *a, int lda)
                +
                int la_lq_factor(int m, int n, double *a, int lda, double *tau)
                int la_trace(int m, int n, const double *a, int lda, double *rst)
                int la_eigen_asymm(bool vecs, int n, double *a, int lda, double complex *vals, double complex *v, int ldv)
                int la_inverse(int n, double *a, int lda)
                @@ -337,6 +365,7 @@
                int la_mtx_mult(bool transa, bool transb, int m, int n, int k, double alpha, const double *a, int lda, const double *b, int ldb, double beta, double *c, int ldc)
                int la_qr_rank1_update(int m, int n, double *q, int ldq, double *r, int ldr, double *u, double *v)
                int la_solve_lu_cmplx(int m, int n, const double complex *a, int lda, const int *ipvt, double complex *b, int ldb)
                +
                int la_form_lq_cmplx(int m, int n, double complex *l, int ldl, const double complex *tau, double complex *q, int ldq)
                int la_form_qr_pvt(bool fullq, int m, int n, double *r, int ldr, const double *tau, const int *pvt, double *q, int ldq, double *p, int ldp)
                int la_solve_lu(int m, int n, const double *a, int lda, const int *ipvt, double *b, int ldb)
                int la_rank1_update(int m, int n, double alpha, const double *x, const double *y, double *a, int lda)
                @@ -344,6 +373,8 @@
                int la_sort_eigen(bool ascend, int n, double *vals, double *vecs, int ldv)
                int la_eigen_symm(bool vecs, int n, double *a, int lda, double *vals)
                int la_solve_least_squares_cmplx(int m, int n, int k, double complex *a, int lda, double complex *b, int ldb)
                +
                int la_form_lq(int m, int n, double *l, int ldl, const double *tau, double *q, int ldq)
                +
                int la_mult_lq(bool lside, bool trans, int m, int n, int k, const double *a, int lda, const double *tau, double *c, int ldc)
                int la_det(int n, double *a, int lda, double *d)
                int la_mult_qr_cmplx(bool lside, bool trans, int m, int n, int k, double complex *a, int lda, const double complex *tau, double complex *c, int ldc)
                int la_lu_factor_cmplx(int m, int n, double complex *a, int lda, int *ipvt)
                @@ -351,6 +382,7 @@
                int la_qr_rank1_update_cmplx(int m, int n, double complex *q, int ldq, double complex *r, int ldr, double complex *u, double complex *v)
                int la_solve_qr_cmplx_pvt(int m, int n, int k, double complex *a, int lda, const double complex *tau, const int *jpvt, double complex *b, int ldb)
                int la_form_qr_cmplx_pvt(bool fullq, int m, int n, double complex *r, int ldr, const double complex *tau, const int *pvt, double complex *q, int ldq, double complex *p, int ldp)
                +
                int la_mult_lq_cmplx(bool lside, bool trans, int m, int n, int k, const double complex *a, int lda, const double complex *tau, double complex *c, int ldc)
                int la_eigen_cmplx(bool vecs, int n, double complex *a, int lda, double complex *vals, double complex *v, int ldv)
                int la_qr_factor_cmplx(int m, int n, double complex *a, int lda, double complex *tau)
                int la_tri_mtx_mult(bool upper, double alpha, int n, const double *a, int lda, double beta, double *b, int ldb)
                diff --git a/doc/C/html/navtreeindex0.js b/doc/C/html/navtreeindex0.js index e831859e..69571ad3 100644 --- a/doc/C/html/navtreeindex0.js +++ b/doc/C/html/navtreeindex0.js @@ -8,66 +8,74 @@ var NAVTREEINDEX0 = "index.html#intro_sec":[0], "linalg_8h.html":[1,0,0,0], "linalg_8h.html#a00c15ec713541d15eae1fd0b01897689":[1,0,0,0,3], -"linalg_8h.html#a021fbb7fdccf557ec407a86bace43d85":[1,0,0,0,58], -"linalg_8h.html#a02c464a9dd95298c91f431ae4d0773e9":[1,0,0,0,60], -"linalg_8h.html#a02eb049983dd41f2307bb52594fb210e":[1,0,0,0,43], -"linalg_8h.html#a0338870fe1142f88c96db63495fec615":[1,0,0,0,18], -"linalg_8h.html#a089690d293303e30c6eef0bb1e982191":[1,0,0,0,37], -"linalg_8h.html#a090178a5f99a4b400da80481aad77757":[1,0,0,0,54], -"linalg_8h.html#a0dc578507a0cb6ada776142476383590":[1,0,0,0,41], -"linalg_8h.html#a0ff5f2519eb1d2af94e3b4a26dfb10fe":[1,0,0,0,48], -"linalg_8h.html#a15774f6323c34d307c99b32ac4f188a7":[1,0,0,0,15], +"linalg_8h.html#a021fbb7fdccf557ec407a86bace43d85":[1,0,0,0,66], +"linalg_8h.html#a02c464a9dd95298c91f431ae4d0773e9":[1,0,0,0,68], +"linalg_8h.html#a02eb049983dd41f2307bb52594fb210e":[1,0,0,0,49], +"linalg_8h.html#a0338870fe1142f88c96db63495fec615":[1,0,0,0,20], +"linalg_8h.html#a089690d293303e30c6eef0bb1e982191":[1,0,0,0,43], +"linalg_8h.html#a090178a5f99a4b400da80481aad77757":[1,0,0,0,62], +"linalg_8h.html#a0dc578507a0cb6ada776142476383590":[1,0,0,0,47], +"linalg_8h.html#a0ff5f2519eb1d2af94e3b4a26dfb10fe":[1,0,0,0,56], +"linalg_8h.html#a15774f6323c34d307c99b32ac4f188a7":[1,0,0,0,17], "linalg_8h.html#a1734acc61ef569dfff9c83bcad566f67":[1,0,0,0,1], -"linalg_8h.html#a248142a5f0826cddac5daf1c74f234a6":[1,0,0,0,23], +"linalg_8h.html#a248142a5f0826cddac5daf1c74f234a6":[1,0,0,0,27], "linalg_8h.html#a292e54c48a8e7f0203bf11f02844691f":[1,0,0,0,2], +"linalg_8h.html#a2c485d619c24435be713cf4356285e9a":[1,0,0,0,51], "linalg_8h.html#a3967bc139cba341a513d1353bea62ac9":[1,0,0,0,0], -"linalg_8h.html#a3c958fe274f8d1663dd0188455a5fe15":[1,0,0,0,39], -"linalg_8h.html#a4a3f6dafe185c2985fc76aab3d0abb97":[1,0,0,0,33], +"linalg_8h.html#a3c958fe274f8d1663dd0188455a5fe15":[1,0,0,0,45], +"linalg_8h.html#a4a3f6dafe185c2985fc76aab3d0abb97":[1,0,0,0,39], "linalg_8h.html#a4b74177a8914b109e1bf3aa56c9d9cb7":[1,0,0,0,8], -"linalg_8h.html#a4bc671dad87b42ff285a4241322a3764":[1,0,0,0,34], +"linalg_8h.html#a4bc671dad87b42ff285a4241322a3764":[1,0,0,0,40], "linalg_8h.html#a4d5bad18dcc8a52d9594cc21954c572d":[1,0,0,0,10], -"linalg_8h.html#a56c0cea99a066e74c8fff9682d5ca92d":[1,0,0,0,55], -"linalg_8h.html#a62f97b4319f5574aef5e52bbacff14bb":[1,0,0,0,50], +"linalg_8h.html#a54ee9d9ab89b88b0ca682f70bc6c3c54":[1,0,0,0,52], +"linalg_8h.html#a56c0cea99a066e74c8fff9682d5ca92d":[1,0,0,0,63], +"linalg_8h.html#a5e6786c40f8f91e5f16f06e92be71ffa":[1,0,0,0,26], +"linalg_8h.html#a62f97b4319f5574aef5e52bbacff14bb":[1,0,0,0,58], "linalg_8h.html#a63bec2daa56fdc4bbf3f45b67ea14f65":[1,0,0,0,9], -"linalg_8h.html#a719ffdff56c8fa0875409c4f4e5e95cf":[1,0,0,0,42], -"linalg_8h.html#a71ba1a09caca9d59a9d24b95c7ea749b":[1,0,0,0,30], -"linalg_8h.html#a73bea3ca338925cfa4a58bcaea726a14":[1,0,0,0,16], -"linalg_8h.html#a791d5221eb8ad4fcd106cb218590dfc9":[1,0,0,0,31], -"linalg_8h.html#a7a821b41c61670f5710214a4d9178998":[1,0,0,0,22], -"linalg_8h.html#a7f611f8f3de7d56120c78e70671c7112":[1,0,0,0,57], +"linalg_8h.html#a719ffdff56c8fa0875409c4f4e5e95cf":[1,0,0,0,48], +"linalg_8h.html#a71ba1a09caca9d59a9d24b95c7ea749b":[1,0,0,0,36], +"linalg_8h.html#a73bea3ca338925cfa4a58bcaea726a14":[1,0,0,0,18], +"linalg_8h.html#a791d5221eb8ad4fcd106cb218590dfc9":[1,0,0,0,37], +"linalg_8h.html#a7a821b41c61670f5710214a4d9178998":[1,0,0,0,24], +"linalg_8h.html#a7b2048bb219e58f455175041558ac44f":[1,0,0,0,25], +"linalg_8h.html#a7f611f8f3de7d56120c78e70671c7112":[1,0,0,0,65], "linalg_8h.html#a9491626ab4b3664771e1282b61eeaa74":[1,0,0,0,11], -"linalg_8h.html#a95d6ed56844c62d553b940091837014b":[1,0,0,0,21], -"linalg_8h.html#a95f921847131eaedd62a439490d2a801":[1,0,0,0,27], -"linalg_8h.html#a968b10545320af7bbe1030867ae88e8c":[1,0,0,0,25], -"linalg_8h.html#a9b0639faf9ac0af9bbdb348b92746d5f":[1,0,0,0,35], -"linalg_8h.html#aa067ac0d3f58e28371d413ab7419da74":[1,0,0,0,46], -"linalg_8h.html#aace787c5b11959a457b936ace4995033":[1,0,0,0,20], -"linalg_8h.html#aae725d3247301d1163c58f89edff3d4b":[1,0,0,0,45], -"linalg_8h.html#ab346fed23fd61f02d65e09c795c26d74":[1,0,0,0,38], +"linalg_8h.html#a95d6ed56844c62d553b940091837014b":[1,0,0,0,23], +"linalg_8h.html#a95f921847131eaedd62a439490d2a801":[1,0,0,0,33], +"linalg_8h.html#a968b10545320af7bbe1030867ae88e8c":[1,0,0,0,29], +"linalg_8h.html#a9b0639faf9ac0af9bbdb348b92746d5f":[1,0,0,0,41], +"linalg_8h.html#aa067ac0d3f58e28371d413ab7419da74":[1,0,0,0,54], +"linalg_8h.html#aa54b8d224976dca7ef384eed74f50bed":[1,0,0,0,16], +"linalg_8h.html#aace787c5b11959a457b936ace4995033":[1,0,0,0,22], +"linalg_8h.html#aae725d3247301d1163c58f89edff3d4b":[1,0,0,0,53], +"linalg_8h.html#ab346fed23fd61f02d65e09c795c26d74":[1,0,0,0,44], "linalg_8h.html#abeb7ee58d4151498be96aa91432f296f":[1,0,0,0,4], -"linalg_8h.html#abf5918abab8f97fc2ac5887e051ff493":[1,0,0,0,53], +"linalg_8h.html#abf5918abab8f97fc2ac5887e051ff493":[1,0,0,0,61], "linalg_8h.html#ac208d5e6849972a77ef261f2e368868c":[1,0,0,0,14], -"linalg_8h.html#ac3bb7b959d8cc7400e9b13290a895b64":[1,0,0,0,44], +"linalg_8h.html#ac3bb7b959d8cc7400e9b13290a895b64":[1,0,0,0,50], +"linalg_8h.html#ac54763802ad5c3966f8e14cdf93fdc96":[1,0,0,0,15], +"linalg_8h.html#ac575e10e20e9c2d8d40ed8df47179773":[1,0,0,0,31], "linalg_8h.html#ac7b4894cd929a106e02a8e37a4d52913":[1,0,0,0,6], -"linalg_8h.html#acc25c0daa53c10ace21a61d78b2e79f3":[1,0,0,0,28], -"linalg_8h.html#ace554b62c12a5d9a2434c8171c756c47":[1,0,0,0,24], +"linalg_8h.html#acc25c0daa53c10ace21a61d78b2e79f3":[1,0,0,0,34], +"linalg_8h.html#ace554b62c12a5d9a2434c8171c756c47":[1,0,0,0,28], "linalg_8h.html#ace9edf6a878ee4dd0b220b75b7db6431":[1,0,0,0,7], -"linalg_8h.html#acfbd42393c8b1931ff11bc4c7e858aef":[1,0,0,0,36], -"linalg_8h.html#ad0ee4a9c71de62911a71a342790f5070":[1,0,0,0,49], -"linalg_8h.html#ad76e25c5eb98075e83cc9df493be5b38":[1,0,0,0,19], +"linalg_8h.html#acfbd42393c8b1931ff11bc4c7e858aef":[1,0,0,0,42], +"linalg_8h.html#ad0ee4a9c71de62911a71a342790f5070":[1,0,0,0,57], +"linalg_8h.html#ad76e25c5eb98075e83cc9df493be5b38":[1,0,0,0,21], +"linalg_8h.html#adcb07293cf47d090dfb89c20837ca7b5":[1,0,0,0,32], "linalg_8h.html#ae5a16375c14c924836c33bafa747a1cf":[1,0,0,0,12], -"linalg_8h.html#ae5ffa6e8d9c850bd41f43f7564bf6896":[1,0,0,0,32], -"linalg_8h.html#ae7d70f1ef2a2824772e1bf0f726c257e":[1,0,0,0,59], -"linalg_8h.html#aed7b29bbff1472ebe805054eb9d8c6d4":[1,0,0,0,51], -"linalg_8h.html#aefdc2e6758482d02a3aa7978f7d5efe0":[1,0,0,0,47], -"linalg_8h.html#aefefe80e13f74470d5afaf44b3a45e76":[1,0,0,0,26], +"linalg_8h.html#ae5ffa6e8d9c850bd41f43f7564bf6896":[1,0,0,0,38], +"linalg_8h.html#ae7d70f1ef2a2824772e1bf0f726c257e":[1,0,0,0,67], +"linalg_8h.html#aed7b29bbff1472ebe805054eb9d8c6d4":[1,0,0,0,59], +"linalg_8h.html#aefdc2e6758482d02a3aa7978f7d5efe0":[1,0,0,0,55], +"linalg_8h.html#aefefe80e13f74470d5afaf44b3a45e76":[1,0,0,0,30], "linalg_8h.html#af19ebf41be31ee92f657131a8fbf55a3":[1,0,0,0,5], "linalg_8h.html#af3c6f1a45aee2f275d4b109c9bb660d2":[1,0,0,0,13], -"linalg_8h.html#af7f8185c0f25ad3fb0b89cc98d77b3d6":[1,0,0,0,29], -"linalg_8h.html#af87823d73fb5a319e4262594d147e38c":[1,0,0,0,52], -"linalg_8h.html#afbffa0856d75c607a03d3dc7b5b1076e":[1,0,0,0,56], -"linalg_8h.html#afdc9b7e6ffab89915a082c00ceac7258":[1,0,0,0,40], -"linalg_8h.html#afe39765d805c1d9ae93e9aa2f20d8548":[1,0,0,0,17], +"linalg_8h.html#af7f8185c0f25ad3fb0b89cc98d77b3d6":[1,0,0,0,35], +"linalg_8h.html#af87823d73fb5a319e4262594d147e38c":[1,0,0,0,60], +"linalg_8h.html#afbffa0856d75c607a03d3dc7b5b1076e":[1,0,0,0,64], +"linalg_8h.html#afdc9b7e6ffab89915a082c00ceac7258":[1,0,0,0,46], +"linalg_8h.html#afe39765d805c1d9ae93e9aa2f20d8548":[1,0,0,0,19], "linalg_8h_source.html":[1,0,0,0], "pages.html":[] }; diff --git a/doc/C/html/search/all_0.js b/doc/C/html/search/all_0.js index 54295e52..2a629ebc 100644 --- a/doc/C/html/search/all_0.js +++ b/doc/C/html/search/all_0.js @@ -15,52 +15,60 @@ var searchData= ['la_5feigen_5fcmplx_12',['la_eigen_cmplx',['../linalg_8h.html#ae5a16375c14c924836c33bafa747a1cf',1,'linalg.h']]], ['la_5feigen_5fgen_13',['la_eigen_gen',['../linalg_8h.html#af3c6f1a45aee2f275d4b109c9bb660d2',1,'linalg.h']]], ['la_5feigen_5fsymm_14',['la_eigen_symm',['../linalg_8h.html#ac208d5e6849972a77ef261f2e368868c',1,'linalg.h']]], - ['la_5fform_5flu_15',['la_form_lu',['../linalg_8h.html#a15774f6323c34d307c99b32ac4f188a7',1,'linalg.h']]], - ['la_5fform_5flu_5fcmplx_16',['la_form_lu_cmplx',['../linalg_8h.html#a73bea3ca338925cfa4a58bcaea726a14',1,'linalg.h']]], - ['la_5fform_5fqr_17',['la_form_qr',['../linalg_8h.html#afe39765d805c1d9ae93e9aa2f20d8548',1,'linalg.h']]], - ['la_5fform_5fqr_5fcmplx_18',['la_form_qr_cmplx',['../linalg_8h.html#a0338870fe1142f88c96db63495fec615',1,'linalg.h']]], - ['la_5fform_5fqr_5fcmplx_5fpvt_19',['la_form_qr_cmplx_pvt',['../linalg_8h.html#ad76e25c5eb98075e83cc9df493be5b38',1,'linalg.h']]], - ['la_5fform_5fqr_5fpvt_20',['la_form_qr_pvt',['../linalg_8h.html#aace787c5b11959a457b936ace4995033',1,'linalg.h']]], - ['la_5finverse_21',['la_inverse',['../linalg_8h.html#a95d6ed56844c62d553b940091837014b',1,'linalg.h']]], - ['la_5finverse_5fcmplx_22',['la_inverse_cmplx',['../linalg_8h.html#a7a821b41c61670f5710214a4d9178998',1,'linalg.h']]], - ['la_5flu_5ffactor_23',['la_lu_factor',['../linalg_8h.html#a248142a5f0826cddac5daf1c74f234a6',1,'linalg.h']]], - ['la_5flu_5ffactor_5fcmplx_24',['la_lu_factor_cmplx',['../linalg_8h.html#ace554b62c12a5d9a2434c8171c756c47',1,'linalg.h']]], - ['la_5fmtx_5fmult_25',['la_mtx_mult',['../linalg_8h.html#a968b10545320af7bbe1030867ae88e8c',1,'linalg.h']]], - ['la_5fmtx_5fmult_5fcmplx_26',['la_mtx_mult_cmplx',['../linalg_8h.html#aefefe80e13f74470d5afaf44b3a45e76',1,'linalg.h']]], - ['la_5fmult_5fqr_27',['la_mult_qr',['../linalg_8h.html#a95f921847131eaedd62a439490d2a801',1,'linalg.h']]], - ['la_5fmult_5fqr_5fcmplx_28',['la_mult_qr_cmplx',['../linalg_8h.html#acc25c0daa53c10ace21a61d78b2e79f3',1,'linalg.h']]], - ['la_5fpinverse_29',['la_pinverse',['../linalg_8h.html#af7f8185c0f25ad3fb0b89cc98d77b3d6',1,'linalg.h']]], - ['la_5fpinverse_5fcmplx_30',['la_pinverse_cmplx',['../linalg_8h.html#a71ba1a09caca9d59a9d24b95c7ea749b',1,'linalg.h']]], - ['la_5fqr_5ffactor_31',['la_qr_factor',['../linalg_8h.html#a791d5221eb8ad4fcd106cb218590dfc9',1,'linalg.h']]], - ['la_5fqr_5ffactor_5fcmplx_32',['la_qr_factor_cmplx',['../linalg_8h.html#ae5ffa6e8d9c850bd41f43f7564bf6896',1,'linalg.h']]], - ['la_5fqr_5ffactor_5fcmplx_5fpvt_33',['la_qr_factor_cmplx_pvt',['../linalg_8h.html#a4a3f6dafe185c2985fc76aab3d0abb97',1,'linalg.h']]], - ['la_5fqr_5ffactor_5fpvt_34',['la_qr_factor_pvt',['../linalg_8h.html#a4bc671dad87b42ff285a4241322a3764',1,'linalg.h']]], - ['la_5fqr_5frank1_5fupdate_35',['la_qr_rank1_update',['../linalg_8h.html#a9b0639faf9ac0af9bbdb348b92746d5f',1,'linalg.h']]], - ['la_5fqr_5frank1_5fupdate_5fcmplx_36',['la_qr_rank1_update_cmplx',['../linalg_8h.html#acfbd42393c8b1931ff11bc4c7e858aef',1,'linalg.h']]], - ['la_5frank_37',['la_rank',['../linalg_8h.html#a089690d293303e30c6eef0bb1e982191',1,'linalg.h']]], - ['la_5frank1_5fupdate_38',['la_rank1_update',['../linalg_8h.html#ab346fed23fd61f02d65e09c795c26d74',1,'linalg.h']]], - ['la_5frank1_5fupdate_5fcmplx_39',['la_rank1_update_cmplx',['../linalg_8h.html#a3c958fe274f8d1663dd0188455a5fe15',1,'linalg.h']]], - ['la_5frank_5fcmplx_40',['la_rank_cmplx',['../linalg_8h.html#afdc9b7e6ffab89915a082c00ceac7258',1,'linalg.h']]], - ['la_5fsolve_5fcholesky_41',['la_solve_cholesky',['../linalg_8h.html#a0dc578507a0cb6ada776142476383590',1,'linalg.h']]], - ['la_5fsolve_5fcholesky_5fcmplx_42',['la_solve_cholesky_cmplx',['../linalg_8h.html#a719ffdff56c8fa0875409c4f4e5e95cf',1,'linalg.h']]], - ['la_5fsolve_5fleast_5fsquares_43',['la_solve_least_squares',['../linalg_8h.html#a02eb049983dd41f2307bb52594fb210e',1,'linalg.h']]], - ['la_5fsolve_5fleast_5fsquares_5fcmplx_44',['la_solve_least_squares_cmplx',['../linalg_8h.html#ac3bb7b959d8cc7400e9b13290a895b64',1,'linalg.h']]], - ['la_5fsolve_5flu_45',['la_solve_lu',['../linalg_8h.html#aae725d3247301d1163c58f89edff3d4b',1,'linalg.h']]], - ['la_5fsolve_5flu_5fcmplx_46',['la_solve_lu_cmplx',['../linalg_8h.html#aa067ac0d3f58e28371d413ab7419da74',1,'linalg.h']]], - ['la_5fsolve_5fqr_47',['la_solve_qr',['../linalg_8h.html#aefdc2e6758482d02a3aa7978f7d5efe0',1,'linalg.h']]], - ['la_5fsolve_5fqr_5fcmplx_48',['la_solve_qr_cmplx',['../linalg_8h.html#a0ff5f2519eb1d2af94e3b4a26dfb10fe',1,'linalg.h']]], - ['la_5fsolve_5fqr_5fcmplx_5fpvt_49',['la_solve_qr_cmplx_pvt',['../linalg_8h.html#ad0ee4a9c71de62911a71a342790f5070',1,'linalg.h']]], - ['la_5fsolve_5fqr_5fpvt_50',['la_solve_qr_pvt',['../linalg_8h.html#a62f97b4319f5574aef5e52bbacff14bb',1,'linalg.h']]], - ['la_5fsolve_5ftri_5fmtx_51',['la_solve_tri_mtx',['../linalg_8h.html#aed7b29bbff1472ebe805054eb9d8c6d4',1,'linalg.h']]], - ['la_5fsolve_5ftri_5fmtx_5fcmplx_52',['la_solve_tri_mtx_cmplx',['../linalg_8h.html#af87823d73fb5a319e4262594d147e38c',1,'linalg.h']]], - ['la_5fsort_5feigen_53',['la_sort_eigen',['../linalg_8h.html#abf5918abab8f97fc2ac5887e051ff493',1,'linalg.h']]], - ['la_5fsort_5feigen_5fcmplx_54',['la_sort_eigen_cmplx',['../linalg_8h.html#a090178a5f99a4b400da80481aad77757',1,'linalg.h']]], - ['la_5fsvd_55',['la_svd',['../linalg_8h.html#a56c0cea99a066e74c8fff9682d5ca92d',1,'linalg.h']]], - ['la_5fsvd_5fcmplx_56',['la_svd_cmplx',['../linalg_8h.html#afbffa0856d75c607a03d3dc7b5b1076e',1,'linalg.h']]], - ['la_5ftrace_57',['la_trace',['../linalg_8h.html#a7f611f8f3de7d56120c78e70671c7112',1,'linalg.h']]], - ['la_5ftrace_5fcmplx_58',['la_trace_cmplx',['../linalg_8h.html#a021fbb7fdccf557ec407a86bace43d85',1,'linalg.h']]], - ['la_5ftri_5fmtx_5fmult_59',['la_tri_mtx_mult',['../linalg_8h.html#ae7d70f1ef2a2824772e1bf0f726c257e',1,'linalg.h']]], - ['la_5ftri_5fmtx_5fmult_5fcmplx_60',['la_tri_mtx_mult_cmplx',['../linalg_8h.html#a02c464a9dd95298c91f431ae4d0773e9',1,'linalg.h']]], - ['linalg_61',['linalg',['../index.html',1,'']]], - ['linalg_2eh_62',['linalg.h',['../linalg_8h.html',1,'']]] + ['la_5fform_5flq_15',['la_form_lq',['../linalg_8h.html#ac54763802ad5c3966f8e14cdf93fdc96',1,'linalg.h']]], + ['la_5fform_5flq_5fcmplx_16',['la_form_lq_cmplx',['../linalg_8h.html#aa54b8d224976dca7ef384eed74f50bed',1,'linalg.h']]], + ['la_5fform_5flu_17',['la_form_lu',['../linalg_8h.html#a15774f6323c34d307c99b32ac4f188a7',1,'linalg.h']]], + ['la_5fform_5flu_5fcmplx_18',['la_form_lu_cmplx',['../linalg_8h.html#a73bea3ca338925cfa4a58bcaea726a14',1,'linalg.h']]], + ['la_5fform_5fqr_19',['la_form_qr',['../linalg_8h.html#afe39765d805c1d9ae93e9aa2f20d8548',1,'linalg.h']]], + ['la_5fform_5fqr_5fcmplx_20',['la_form_qr_cmplx',['../linalg_8h.html#a0338870fe1142f88c96db63495fec615',1,'linalg.h']]], + ['la_5fform_5fqr_5fcmplx_5fpvt_21',['la_form_qr_cmplx_pvt',['../linalg_8h.html#ad76e25c5eb98075e83cc9df493be5b38',1,'linalg.h']]], + ['la_5fform_5fqr_5fpvt_22',['la_form_qr_pvt',['../linalg_8h.html#aace787c5b11959a457b936ace4995033',1,'linalg.h']]], + ['la_5finverse_23',['la_inverse',['../linalg_8h.html#a95d6ed56844c62d553b940091837014b',1,'linalg.h']]], + ['la_5finverse_5fcmplx_24',['la_inverse_cmplx',['../linalg_8h.html#a7a821b41c61670f5710214a4d9178998',1,'linalg.h']]], + ['la_5flq_5ffactor_25',['la_lq_factor',['../linalg_8h.html#a7b2048bb219e58f455175041558ac44f',1,'linalg.h']]], + ['la_5flq_5ffactor_5fcmplx_26',['la_lq_factor_cmplx',['../linalg_8h.html#a5e6786c40f8f91e5f16f06e92be71ffa',1,'linalg.h']]], + ['la_5flu_5ffactor_27',['la_lu_factor',['../linalg_8h.html#a248142a5f0826cddac5daf1c74f234a6',1,'linalg.h']]], + ['la_5flu_5ffactor_5fcmplx_28',['la_lu_factor_cmplx',['../linalg_8h.html#ace554b62c12a5d9a2434c8171c756c47',1,'linalg.h']]], + ['la_5fmtx_5fmult_29',['la_mtx_mult',['../linalg_8h.html#a968b10545320af7bbe1030867ae88e8c',1,'linalg.h']]], + ['la_5fmtx_5fmult_5fcmplx_30',['la_mtx_mult_cmplx',['../linalg_8h.html#aefefe80e13f74470d5afaf44b3a45e76',1,'linalg.h']]], + ['la_5fmult_5flq_31',['la_mult_lq',['../linalg_8h.html#ac575e10e20e9c2d8d40ed8df47179773',1,'linalg.h']]], + ['la_5fmult_5flq_5fcmplx_32',['la_mult_lq_cmplx',['../linalg_8h.html#adcb07293cf47d090dfb89c20837ca7b5',1,'linalg.h']]], + ['la_5fmult_5fqr_33',['la_mult_qr',['../linalg_8h.html#a95f921847131eaedd62a439490d2a801',1,'linalg.h']]], + ['la_5fmult_5fqr_5fcmplx_34',['la_mult_qr_cmplx',['../linalg_8h.html#acc25c0daa53c10ace21a61d78b2e79f3',1,'linalg.h']]], + ['la_5fpinverse_35',['la_pinverse',['../linalg_8h.html#af7f8185c0f25ad3fb0b89cc98d77b3d6',1,'linalg.h']]], + ['la_5fpinverse_5fcmplx_36',['la_pinverse_cmplx',['../linalg_8h.html#a71ba1a09caca9d59a9d24b95c7ea749b',1,'linalg.h']]], + ['la_5fqr_5ffactor_37',['la_qr_factor',['../linalg_8h.html#a791d5221eb8ad4fcd106cb218590dfc9',1,'linalg.h']]], + ['la_5fqr_5ffactor_5fcmplx_38',['la_qr_factor_cmplx',['../linalg_8h.html#ae5ffa6e8d9c850bd41f43f7564bf6896',1,'linalg.h']]], + ['la_5fqr_5ffactor_5fcmplx_5fpvt_39',['la_qr_factor_cmplx_pvt',['../linalg_8h.html#a4a3f6dafe185c2985fc76aab3d0abb97',1,'linalg.h']]], + ['la_5fqr_5ffactor_5fpvt_40',['la_qr_factor_pvt',['../linalg_8h.html#a4bc671dad87b42ff285a4241322a3764',1,'linalg.h']]], + ['la_5fqr_5frank1_5fupdate_41',['la_qr_rank1_update',['../linalg_8h.html#a9b0639faf9ac0af9bbdb348b92746d5f',1,'linalg.h']]], + ['la_5fqr_5frank1_5fupdate_5fcmplx_42',['la_qr_rank1_update_cmplx',['../linalg_8h.html#acfbd42393c8b1931ff11bc4c7e858aef',1,'linalg.h']]], + ['la_5frank_43',['la_rank',['../linalg_8h.html#a089690d293303e30c6eef0bb1e982191',1,'linalg.h']]], + ['la_5frank1_5fupdate_44',['la_rank1_update',['../linalg_8h.html#ab346fed23fd61f02d65e09c795c26d74',1,'linalg.h']]], + ['la_5frank1_5fupdate_5fcmplx_45',['la_rank1_update_cmplx',['../linalg_8h.html#a3c958fe274f8d1663dd0188455a5fe15',1,'linalg.h']]], + ['la_5frank_5fcmplx_46',['la_rank_cmplx',['../linalg_8h.html#afdc9b7e6ffab89915a082c00ceac7258',1,'linalg.h']]], + ['la_5fsolve_5fcholesky_47',['la_solve_cholesky',['../linalg_8h.html#a0dc578507a0cb6ada776142476383590',1,'linalg.h']]], + ['la_5fsolve_5fcholesky_5fcmplx_48',['la_solve_cholesky_cmplx',['../linalg_8h.html#a719ffdff56c8fa0875409c4f4e5e95cf',1,'linalg.h']]], + ['la_5fsolve_5fleast_5fsquares_49',['la_solve_least_squares',['../linalg_8h.html#a02eb049983dd41f2307bb52594fb210e',1,'linalg.h']]], + ['la_5fsolve_5fleast_5fsquares_5fcmplx_50',['la_solve_least_squares_cmplx',['../linalg_8h.html#ac3bb7b959d8cc7400e9b13290a895b64',1,'linalg.h']]], + ['la_5fsolve_5flq_51',['la_solve_lq',['../linalg_8h.html#a2c485d619c24435be713cf4356285e9a',1,'linalg.h']]], + ['la_5fsolve_5flq_5fcmplx_52',['la_solve_lq_cmplx',['../linalg_8h.html#a54ee9d9ab89b88b0ca682f70bc6c3c54',1,'linalg.h']]], + ['la_5fsolve_5flu_53',['la_solve_lu',['../linalg_8h.html#aae725d3247301d1163c58f89edff3d4b',1,'linalg.h']]], + ['la_5fsolve_5flu_5fcmplx_54',['la_solve_lu_cmplx',['../linalg_8h.html#aa067ac0d3f58e28371d413ab7419da74',1,'linalg.h']]], + ['la_5fsolve_5fqr_55',['la_solve_qr',['../linalg_8h.html#aefdc2e6758482d02a3aa7978f7d5efe0',1,'linalg.h']]], + ['la_5fsolve_5fqr_5fcmplx_56',['la_solve_qr_cmplx',['../linalg_8h.html#a0ff5f2519eb1d2af94e3b4a26dfb10fe',1,'linalg.h']]], + ['la_5fsolve_5fqr_5fcmplx_5fpvt_57',['la_solve_qr_cmplx_pvt',['../linalg_8h.html#ad0ee4a9c71de62911a71a342790f5070',1,'linalg.h']]], + ['la_5fsolve_5fqr_5fpvt_58',['la_solve_qr_pvt',['../linalg_8h.html#a62f97b4319f5574aef5e52bbacff14bb',1,'linalg.h']]], + ['la_5fsolve_5ftri_5fmtx_59',['la_solve_tri_mtx',['../linalg_8h.html#aed7b29bbff1472ebe805054eb9d8c6d4',1,'linalg.h']]], + ['la_5fsolve_5ftri_5fmtx_5fcmplx_60',['la_solve_tri_mtx_cmplx',['../linalg_8h.html#af87823d73fb5a319e4262594d147e38c',1,'linalg.h']]], + ['la_5fsort_5feigen_61',['la_sort_eigen',['../linalg_8h.html#abf5918abab8f97fc2ac5887e051ff493',1,'linalg.h']]], + ['la_5fsort_5feigen_5fcmplx_62',['la_sort_eigen_cmplx',['../linalg_8h.html#a090178a5f99a4b400da80481aad77757',1,'linalg.h']]], + ['la_5fsvd_63',['la_svd',['../linalg_8h.html#a56c0cea99a066e74c8fff9682d5ca92d',1,'linalg.h']]], + ['la_5fsvd_5fcmplx_64',['la_svd_cmplx',['../linalg_8h.html#afbffa0856d75c607a03d3dc7b5b1076e',1,'linalg.h']]], + ['la_5ftrace_65',['la_trace',['../linalg_8h.html#a7f611f8f3de7d56120c78e70671c7112',1,'linalg.h']]], + ['la_5ftrace_5fcmplx_66',['la_trace_cmplx',['../linalg_8h.html#a021fbb7fdccf557ec407a86bace43d85',1,'linalg.h']]], + ['la_5ftri_5fmtx_5fmult_67',['la_tri_mtx_mult',['../linalg_8h.html#ae7d70f1ef2a2824772e1bf0f726c257e',1,'linalg.h']]], + ['la_5ftri_5fmtx_5fmult_5fcmplx_68',['la_tri_mtx_mult_cmplx',['../linalg_8h.html#a02c464a9dd95298c91f431ae4d0773e9',1,'linalg.h']]], + ['linalg_69',['linalg',['../index.html',1,'']]], + ['linalg_2eh_70',['linalg.h',['../linalg_8h.html',1,'']]] ]; diff --git a/doc/C/html/search/functions_0.js b/doc/C/html/search/functions_0.js index 50c950b0..b5fc3cd0 100644 --- a/doc/C/html/search/functions_0.js +++ b/doc/C/html/search/functions_0.js @@ -15,50 +15,58 @@ var searchData= ['la_5feigen_5fcmplx_12',['la_eigen_cmplx',['../linalg_8h.html#ae5a16375c14c924836c33bafa747a1cf',1,'linalg.h']]], ['la_5feigen_5fgen_13',['la_eigen_gen',['../linalg_8h.html#af3c6f1a45aee2f275d4b109c9bb660d2',1,'linalg.h']]], ['la_5feigen_5fsymm_14',['la_eigen_symm',['../linalg_8h.html#ac208d5e6849972a77ef261f2e368868c',1,'linalg.h']]], - ['la_5fform_5flu_15',['la_form_lu',['../linalg_8h.html#a15774f6323c34d307c99b32ac4f188a7',1,'linalg.h']]], - ['la_5fform_5flu_5fcmplx_16',['la_form_lu_cmplx',['../linalg_8h.html#a73bea3ca338925cfa4a58bcaea726a14',1,'linalg.h']]], - ['la_5fform_5fqr_17',['la_form_qr',['../linalg_8h.html#afe39765d805c1d9ae93e9aa2f20d8548',1,'linalg.h']]], - ['la_5fform_5fqr_5fcmplx_18',['la_form_qr_cmplx',['../linalg_8h.html#a0338870fe1142f88c96db63495fec615',1,'linalg.h']]], - ['la_5fform_5fqr_5fcmplx_5fpvt_19',['la_form_qr_cmplx_pvt',['../linalg_8h.html#ad76e25c5eb98075e83cc9df493be5b38',1,'linalg.h']]], - ['la_5fform_5fqr_5fpvt_20',['la_form_qr_pvt',['../linalg_8h.html#aace787c5b11959a457b936ace4995033',1,'linalg.h']]], - ['la_5finverse_21',['la_inverse',['../linalg_8h.html#a95d6ed56844c62d553b940091837014b',1,'linalg.h']]], - ['la_5finverse_5fcmplx_22',['la_inverse_cmplx',['../linalg_8h.html#a7a821b41c61670f5710214a4d9178998',1,'linalg.h']]], - ['la_5flu_5ffactor_23',['la_lu_factor',['../linalg_8h.html#a248142a5f0826cddac5daf1c74f234a6',1,'linalg.h']]], - ['la_5flu_5ffactor_5fcmplx_24',['la_lu_factor_cmplx',['../linalg_8h.html#ace554b62c12a5d9a2434c8171c756c47',1,'linalg.h']]], - ['la_5fmtx_5fmult_25',['la_mtx_mult',['../linalg_8h.html#a968b10545320af7bbe1030867ae88e8c',1,'linalg.h']]], - ['la_5fmtx_5fmult_5fcmplx_26',['la_mtx_mult_cmplx',['../linalg_8h.html#aefefe80e13f74470d5afaf44b3a45e76',1,'linalg.h']]], - ['la_5fmult_5fqr_27',['la_mult_qr',['../linalg_8h.html#a95f921847131eaedd62a439490d2a801',1,'linalg.h']]], - ['la_5fmult_5fqr_5fcmplx_28',['la_mult_qr_cmplx',['../linalg_8h.html#acc25c0daa53c10ace21a61d78b2e79f3',1,'linalg.h']]], - ['la_5fpinverse_29',['la_pinverse',['../linalg_8h.html#af7f8185c0f25ad3fb0b89cc98d77b3d6',1,'linalg.h']]], - ['la_5fpinverse_5fcmplx_30',['la_pinverse_cmplx',['../linalg_8h.html#a71ba1a09caca9d59a9d24b95c7ea749b',1,'linalg.h']]], - ['la_5fqr_5ffactor_31',['la_qr_factor',['../linalg_8h.html#a791d5221eb8ad4fcd106cb218590dfc9',1,'linalg.h']]], - ['la_5fqr_5ffactor_5fcmplx_32',['la_qr_factor_cmplx',['../linalg_8h.html#ae5ffa6e8d9c850bd41f43f7564bf6896',1,'linalg.h']]], - ['la_5fqr_5ffactor_5fcmplx_5fpvt_33',['la_qr_factor_cmplx_pvt',['../linalg_8h.html#a4a3f6dafe185c2985fc76aab3d0abb97',1,'linalg.h']]], - ['la_5fqr_5ffactor_5fpvt_34',['la_qr_factor_pvt',['../linalg_8h.html#a4bc671dad87b42ff285a4241322a3764',1,'linalg.h']]], - ['la_5fqr_5frank1_5fupdate_35',['la_qr_rank1_update',['../linalg_8h.html#a9b0639faf9ac0af9bbdb348b92746d5f',1,'linalg.h']]], - ['la_5fqr_5frank1_5fupdate_5fcmplx_36',['la_qr_rank1_update_cmplx',['../linalg_8h.html#acfbd42393c8b1931ff11bc4c7e858aef',1,'linalg.h']]], - ['la_5frank_37',['la_rank',['../linalg_8h.html#a089690d293303e30c6eef0bb1e982191',1,'linalg.h']]], - ['la_5frank1_5fupdate_38',['la_rank1_update',['../linalg_8h.html#ab346fed23fd61f02d65e09c795c26d74',1,'linalg.h']]], - ['la_5frank1_5fupdate_5fcmplx_39',['la_rank1_update_cmplx',['../linalg_8h.html#a3c958fe274f8d1663dd0188455a5fe15',1,'linalg.h']]], - ['la_5frank_5fcmplx_40',['la_rank_cmplx',['../linalg_8h.html#afdc9b7e6ffab89915a082c00ceac7258',1,'linalg.h']]], - ['la_5fsolve_5fcholesky_41',['la_solve_cholesky',['../linalg_8h.html#a0dc578507a0cb6ada776142476383590',1,'linalg.h']]], - ['la_5fsolve_5fcholesky_5fcmplx_42',['la_solve_cholesky_cmplx',['../linalg_8h.html#a719ffdff56c8fa0875409c4f4e5e95cf',1,'linalg.h']]], - ['la_5fsolve_5fleast_5fsquares_43',['la_solve_least_squares',['../linalg_8h.html#a02eb049983dd41f2307bb52594fb210e',1,'linalg.h']]], - ['la_5fsolve_5fleast_5fsquares_5fcmplx_44',['la_solve_least_squares_cmplx',['../linalg_8h.html#ac3bb7b959d8cc7400e9b13290a895b64',1,'linalg.h']]], - ['la_5fsolve_5flu_45',['la_solve_lu',['../linalg_8h.html#aae725d3247301d1163c58f89edff3d4b',1,'linalg.h']]], - ['la_5fsolve_5flu_5fcmplx_46',['la_solve_lu_cmplx',['../linalg_8h.html#aa067ac0d3f58e28371d413ab7419da74',1,'linalg.h']]], - ['la_5fsolve_5fqr_47',['la_solve_qr',['../linalg_8h.html#aefdc2e6758482d02a3aa7978f7d5efe0',1,'linalg.h']]], - ['la_5fsolve_5fqr_5fcmplx_48',['la_solve_qr_cmplx',['../linalg_8h.html#a0ff5f2519eb1d2af94e3b4a26dfb10fe',1,'linalg.h']]], - ['la_5fsolve_5fqr_5fcmplx_5fpvt_49',['la_solve_qr_cmplx_pvt',['../linalg_8h.html#ad0ee4a9c71de62911a71a342790f5070',1,'linalg.h']]], - ['la_5fsolve_5fqr_5fpvt_50',['la_solve_qr_pvt',['../linalg_8h.html#a62f97b4319f5574aef5e52bbacff14bb',1,'linalg.h']]], - ['la_5fsolve_5ftri_5fmtx_51',['la_solve_tri_mtx',['../linalg_8h.html#aed7b29bbff1472ebe805054eb9d8c6d4',1,'linalg.h']]], - ['la_5fsolve_5ftri_5fmtx_5fcmplx_52',['la_solve_tri_mtx_cmplx',['../linalg_8h.html#af87823d73fb5a319e4262594d147e38c',1,'linalg.h']]], - ['la_5fsort_5feigen_53',['la_sort_eigen',['../linalg_8h.html#abf5918abab8f97fc2ac5887e051ff493',1,'linalg.h']]], - ['la_5fsort_5feigen_5fcmplx_54',['la_sort_eigen_cmplx',['../linalg_8h.html#a090178a5f99a4b400da80481aad77757',1,'linalg.h']]], - ['la_5fsvd_55',['la_svd',['../linalg_8h.html#a56c0cea99a066e74c8fff9682d5ca92d',1,'linalg.h']]], - ['la_5fsvd_5fcmplx_56',['la_svd_cmplx',['../linalg_8h.html#afbffa0856d75c607a03d3dc7b5b1076e',1,'linalg.h']]], - ['la_5ftrace_57',['la_trace',['../linalg_8h.html#a7f611f8f3de7d56120c78e70671c7112',1,'linalg.h']]], - ['la_5ftrace_5fcmplx_58',['la_trace_cmplx',['../linalg_8h.html#a021fbb7fdccf557ec407a86bace43d85',1,'linalg.h']]], - ['la_5ftri_5fmtx_5fmult_59',['la_tri_mtx_mult',['../linalg_8h.html#ae7d70f1ef2a2824772e1bf0f726c257e',1,'linalg.h']]], - ['la_5ftri_5fmtx_5fmult_5fcmplx_60',['la_tri_mtx_mult_cmplx',['../linalg_8h.html#a02c464a9dd95298c91f431ae4d0773e9',1,'linalg.h']]] + ['la_5fform_5flq_15',['la_form_lq',['../linalg_8h.html#ac54763802ad5c3966f8e14cdf93fdc96',1,'linalg.h']]], + ['la_5fform_5flq_5fcmplx_16',['la_form_lq_cmplx',['../linalg_8h.html#aa54b8d224976dca7ef384eed74f50bed',1,'linalg.h']]], + ['la_5fform_5flu_17',['la_form_lu',['../linalg_8h.html#a15774f6323c34d307c99b32ac4f188a7',1,'linalg.h']]], + ['la_5fform_5flu_5fcmplx_18',['la_form_lu_cmplx',['../linalg_8h.html#a73bea3ca338925cfa4a58bcaea726a14',1,'linalg.h']]], + ['la_5fform_5fqr_19',['la_form_qr',['../linalg_8h.html#afe39765d805c1d9ae93e9aa2f20d8548',1,'linalg.h']]], + ['la_5fform_5fqr_5fcmplx_20',['la_form_qr_cmplx',['../linalg_8h.html#a0338870fe1142f88c96db63495fec615',1,'linalg.h']]], + ['la_5fform_5fqr_5fcmplx_5fpvt_21',['la_form_qr_cmplx_pvt',['../linalg_8h.html#ad76e25c5eb98075e83cc9df493be5b38',1,'linalg.h']]], + ['la_5fform_5fqr_5fpvt_22',['la_form_qr_pvt',['../linalg_8h.html#aace787c5b11959a457b936ace4995033',1,'linalg.h']]], + ['la_5finverse_23',['la_inverse',['../linalg_8h.html#a95d6ed56844c62d553b940091837014b',1,'linalg.h']]], + ['la_5finverse_5fcmplx_24',['la_inverse_cmplx',['../linalg_8h.html#a7a821b41c61670f5710214a4d9178998',1,'linalg.h']]], + ['la_5flq_5ffactor_25',['la_lq_factor',['../linalg_8h.html#a7b2048bb219e58f455175041558ac44f',1,'linalg.h']]], + ['la_5flq_5ffactor_5fcmplx_26',['la_lq_factor_cmplx',['../linalg_8h.html#a5e6786c40f8f91e5f16f06e92be71ffa',1,'linalg.h']]], + ['la_5flu_5ffactor_27',['la_lu_factor',['../linalg_8h.html#a248142a5f0826cddac5daf1c74f234a6',1,'linalg.h']]], + ['la_5flu_5ffactor_5fcmplx_28',['la_lu_factor_cmplx',['../linalg_8h.html#ace554b62c12a5d9a2434c8171c756c47',1,'linalg.h']]], + ['la_5fmtx_5fmult_29',['la_mtx_mult',['../linalg_8h.html#a968b10545320af7bbe1030867ae88e8c',1,'linalg.h']]], + ['la_5fmtx_5fmult_5fcmplx_30',['la_mtx_mult_cmplx',['../linalg_8h.html#aefefe80e13f74470d5afaf44b3a45e76',1,'linalg.h']]], + ['la_5fmult_5flq_31',['la_mult_lq',['../linalg_8h.html#ac575e10e20e9c2d8d40ed8df47179773',1,'linalg.h']]], + ['la_5fmult_5flq_5fcmplx_32',['la_mult_lq_cmplx',['../linalg_8h.html#adcb07293cf47d090dfb89c20837ca7b5',1,'linalg.h']]], + ['la_5fmult_5fqr_33',['la_mult_qr',['../linalg_8h.html#a95f921847131eaedd62a439490d2a801',1,'linalg.h']]], + ['la_5fmult_5fqr_5fcmplx_34',['la_mult_qr_cmplx',['../linalg_8h.html#acc25c0daa53c10ace21a61d78b2e79f3',1,'linalg.h']]], + ['la_5fpinverse_35',['la_pinverse',['../linalg_8h.html#af7f8185c0f25ad3fb0b89cc98d77b3d6',1,'linalg.h']]], + ['la_5fpinverse_5fcmplx_36',['la_pinverse_cmplx',['../linalg_8h.html#a71ba1a09caca9d59a9d24b95c7ea749b',1,'linalg.h']]], + ['la_5fqr_5ffactor_37',['la_qr_factor',['../linalg_8h.html#a791d5221eb8ad4fcd106cb218590dfc9',1,'linalg.h']]], + ['la_5fqr_5ffactor_5fcmplx_38',['la_qr_factor_cmplx',['../linalg_8h.html#ae5ffa6e8d9c850bd41f43f7564bf6896',1,'linalg.h']]], + ['la_5fqr_5ffactor_5fcmplx_5fpvt_39',['la_qr_factor_cmplx_pvt',['../linalg_8h.html#a4a3f6dafe185c2985fc76aab3d0abb97',1,'linalg.h']]], + ['la_5fqr_5ffactor_5fpvt_40',['la_qr_factor_pvt',['../linalg_8h.html#a4bc671dad87b42ff285a4241322a3764',1,'linalg.h']]], + ['la_5fqr_5frank1_5fupdate_41',['la_qr_rank1_update',['../linalg_8h.html#a9b0639faf9ac0af9bbdb348b92746d5f',1,'linalg.h']]], + ['la_5fqr_5frank1_5fupdate_5fcmplx_42',['la_qr_rank1_update_cmplx',['../linalg_8h.html#acfbd42393c8b1931ff11bc4c7e858aef',1,'linalg.h']]], + ['la_5frank_43',['la_rank',['../linalg_8h.html#a089690d293303e30c6eef0bb1e982191',1,'linalg.h']]], + ['la_5frank1_5fupdate_44',['la_rank1_update',['../linalg_8h.html#ab346fed23fd61f02d65e09c795c26d74',1,'linalg.h']]], + ['la_5frank1_5fupdate_5fcmplx_45',['la_rank1_update_cmplx',['../linalg_8h.html#a3c958fe274f8d1663dd0188455a5fe15',1,'linalg.h']]], + ['la_5frank_5fcmplx_46',['la_rank_cmplx',['../linalg_8h.html#afdc9b7e6ffab89915a082c00ceac7258',1,'linalg.h']]], + ['la_5fsolve_5fcholesky_47',['la_solve_cholesky',['../linalg_8h.html#a0dc578507a0cb6ada776142476383590',1,'linalg.h']]], + ['la_5fsolve_5fcholesky_5fcmplx_48',['la_solve_cholesky_cmplx',['../linalg_8h.html#a719ffdff56c8fa0875409c4f4e5e95cf',1,'linalg.h']]], + ['la_5fsolve_5fleast_5fsquares_49',['la_solve_least_squares',['../linalg_8h.html#a02eb049983dd41f2307bb52594fb210e',1,'linalg.h']]], + ['la_5fsolve_5fleast_5fsquares_5fcmplx_50',['la_solve_least_squares_cmplx',['../linalg_8h.html#ac3bb7b959d8cc7400e9b13290a895b64',1,'linalg.h']]], + ['la_5fsolve_5flq_51',['la_solve_lq',['../linalg_8h.html#a2c485d619c24435be713cf4356285e9a',1,'linalg.h']]], + ['la_5fsolve_5flq_5fcmplx_52',['la_solve_lq_cmplx',['../linalg_8h.html#a54ee9d9ab89b88b0ca682f70bc6c3c54',1,'linalg.h']]], + ['la_5fsolve_5flu_53',['la_solve_lu',['../linalg_8h.html#aae725d3247301d1163c58f89edff3d4b',1,'linalg.h']]], + ['la_5fsolve_5flu_5fcmplx_54',['la_solve_lu_cmplx',['../linalg_8h.html#aa067ac0d3f58e28371d413ab7419da74',1,'linalg.h']]], + ['la_5fsolve_5fqr_55',['la_solve_qr',['../linalg_8h.html#aefdc2e6758482d02a3aa7978f7d5efe0',1,'linalg.h']]], + ['la_5fsolve_5fqr_5fcmplx_56',['la_solve_qr_cmplx',['../linalg_8h.html#a0ff5f2519eb1d2af94e3b4a26dfb10fe',1,'linalg.h']]], + ['la_5fsolve_5fqr_5fcmplx_5fpvt_57',['la_solve_qr_cmplx_pvt',['../linalg_8h.html#ad0ee4a9c71de62911a71a342790f5070',1,'linalg.h']]], + ['la_5fsolve_5fqr_5fpvt_58',['la_solve_qr_pvt',['../linalg_8h.html#a62f97b4319f5574aef5e52bbacff14bb',1,'linalg.h']]], + ['la_5fsolve_5ftri_5fmtx_59',['la_solve_tri_mtx',['../linalg_8h.html#aed7b29bbff1472ebe805054eb9d8c6d4',1,'linalg.h']]], + ['la_5fsolve_5ftri_5fmtx_5fcmplx_60',['la_solve_tri_mtx_cmplx',['../linalg_8h.html#af87823d73fb5a319e4262594d147e38c',1,'linalg.h']]], + ['la_5fsort_5feigen_61',['la_sort_eigen',['../linalg_8h.html#abf5918abab8f97fc2ac5887e051ff493',1,'linalg.h']]], + ['la_5fsort_5feigen_5fcmplx_62',['la_sort_eigen_cmplx',['../linalg_8h.html#a090178a5f99a4b400da80481aad77757',1,'linalg.h']]], + ['la_5fsvd_63',['la_svd',['../linalg_8h.html#a56c0cea99a066e74c8fff9682d5ca92d',1,'linalg.h']]], + ['la_5fsvd_5fcmplx_64',['la_svd_cmplx',['../linalg_8h.html#afbffa0856d75c607a03d3dc7b5b1076e',1,'linalg.h']]], + ['la_5ftrace_65',['la_trace',['../linalg_8h.html#a7f611f8f3de7d56120c78e70671c7112',1,'linalg.h']]], + ['la_5ftrace_5fcmplx_66',['la_trace_cmplx',['../linalg_8h.html#a021fbb7fdccf557ec407a86bace43d85',1,'linalg.h']]], + ['la_5ftri_5fmtx_5fmult_67',['la_tri_mtx_mult',['../linalg_8h.html#ae7d70f1ef2a2824772e1bf0f726c257e',1,'linalg.h']]], + ['la_5ftri_5fmtx_5fmult_5fcmplx_68',['la_tri_mtx_mult_cmplx',['../linalg_8h.html#a02c464a9dd95298c91f431ae4d0773e9',1,'linalg.h']]] ]; diff --git a/doc/html/annotated.html b/doc/html/annotated.html index 554d05ce..5a4e0de2 100644 --- a/doc/html/annotated.html +++ b/doc/html/annotated.html @@ -109,7 +109,7 @@  CdetComputes the determinant of a square matrix  Cdiag_mtx_multMultiplies a diagonal matrix with another matrix or array  CeigenComputes the eigenvalues, and optionally the eigenvectors, of a matrix - Cform_lqForms the matrix Q with orthonormal rows from the elementary reflectors returned by the LQ factorization algorithm + Cform_lqForms the orthogonal matrix Q from the elementary reflectors returned by the LQ factorization algorithm  Cform_luExtracts the L and U matrices from the condensed [L\U] storage format used by the lu_factor  Cform_qrForms the full M-by-M orthogonal matrix Q from the elementary reflectors returned by the base QR factorization algorithm  Clq_factorComputes the LQ factorization of an M-by-N matrix diff --git a/doc/html/interfacelinalg_1_1form__lq.html b/doc/html/interfacelinalg_1_1form__lq.html index 790df832..dc45d0c8 100644 --- a/doc/html/interfacelinalg_1_1form__lq.html +++ b/doc/html/interfacelinalg_1_1form__lq.html @@ -103,10 +103,10 @@

                -

                Forms the matrix Q with orthonormal rows from the elementary reflectors returned by the LQ factorization algorithm. +

                Forms the orthogonal matrix Q from the elementary reflectors returned by the LQ factorization algorithm. More...

                Detailed Description

                -

                Forms the matrix Q with orthonormal rows from the elementary reflectors returned by the LQ factorization algorithm.

                +

                Forms the orthogonal matrix Q from the elementary reflectors returned by the LQ factorization algorithm.

                Syntax
                subroutine form_lq(real(real64) l(:,:), real(real64) tau(:), real(real64) q(:,:), optional real(real64) work(:), optional integer(int32) olwork, optional class(errors) err)
                subroutine form_lq(complex(real64) l(:,:), complex(real64) tau(:), complex(real64) q(:,:), optional complex(real64) work(:), optional integer(int32) olwork, optional class(errors) err)
                @@ -114,7 +114,7 @@ - + - +
                [in,out]lOn input, an M-by-N matrix where the elements above the diagonal contain the elementary reflectors generated from the LQ factorization performed by lq_factor. On and below the diagonal the matrix contains the matrix L. On output, the elements above the diagonal are zeroed sucht hat the remaining matrix is the M-by-N lower trapezoidal matrix L where only the M-by-M submatrix is the lower triangular matrix L. Notice, M must be less than or equal to N for this routine.
                [in]tauA MIN(M, N)-element array containing the scalar factors of each elementary reflector defined in l.
                [out]qAn M-by-N matrix where the matrix Q with orhtonormal rows will be written.
                [out]qAn N-by-N matrix where the orthogonal matrix Q will be written.
                [out]workAn optional input, that if provided, prevents any local memory allocation. If not provided, the memory required is allocated within. If provided, the length of the array must be at least olwork.
                [out]olworkAn optional output used to determine workspace size. If supplied, the routine determines the optimal size for work, and returns without performing any actual calculations.
                [in,out]errAn optional errors-based object that if provided can be used to retrieve information relating to any errors encountered during execution. If not provided, a default implementation of the errors class is used internally to provide error handling. Possible errors and warning messages that may be encountered are as follows.
                  @@ -180,7 +180,7 @@
                  print '(A)', "LQ Solution: X = "
                  print '(F8.4)', (x(i), i = 1, size(x))
                  end program
                  -
                  Forms the matrix Q with orthonormal rows from the elementary reflectors returned by the LQ factorizat...
                  Definition: linalg.f90:3548
                  +
                  Forms the orthogonal matrix Q from the elementary reflectors returned by the LQ factorization algorit...
                  Definition: linalg.f90:3548
                  Computes the LQ factorization of an M-by-N matrix.
                  Definition: linalg.f90:3434
                  Performs the matrix operation: .
                  Definition: linalg.f90:293
                  Solves a triangular system of equations.
                  Definition: linalg.f90:2200
                  diff --git a/doc/html/interfacelinalg_1_1lq__factor.html b/doc/html/interfacelinalg_1_1lq__factor.html index 69080558..f8905f7a 100644 --- a/doc/html/interfacelinalg_1_1lq__factor.html +++ b/doc/html/interfacelinalg_1_1lq__factor.html @@ -179,7 +179,7 @@
                  print '(A)', "LQ Solution: X = "
                  print '(F8.4)', (x(i), i = 1, size(x))
                  end program
                  -
                  Forms the matrix Q with orthonormal rows from the elementary reflectors returned by the LQ factorizat...
                  Definition: linalg.f90:3548
                  +
                  Forms the orthogonal matrix Q from the elementary reflectors returned by the LQ factorization algorit...
                  Definition: linalg.f90:3548
                  Computes the LQ factorization of an M-by-N matrix.
                  Definition: linalg.f90:3434
                  Performs the matrix operation: .
                  Definition: linalg.f90:293
                  Solves a triangular system of equations.
                  Definition: linalg.f90:2200
                  diff --git a/doc/html/interfacelinalg_1_1mult__lq.html b/doc/html/interfacelinalg_1_1mult__lq.html index 1195dce2..ffc2193a 100644 --- a/doc/html/interfacelinalg_1_1mult__lq.html +++ b/doc/html/interfacelinalg_1_1mult__lq.html @@ -114,7 +114,7 @@ - + @@ -133,7 +133,7 @@
                  Parameters
                  [in]lsideSet to true to apply \( Q \) or \( Q^T \) from the left; else, set to false to apply \( Q \) or \( Q^T \) from the right.
                  [in]transSet to true to apply \( Q^T \); else, set to false. In the event \( Q \) is complex-valued, \( Q^H \) is computed instead of \( Q^T \).
                  [in]aOn input, an LDA-by-K matrix containing the elementary reflectors output from the QR factorization. If lside is set to true, LDA = M, and M >= K >= 0; else, if lside is set to false, LDA = N, and N >= K >= 0. Notice, the contents of this matrix are restored on exit.
                  [in]aOn input, an K-by-P matrix containing the elementary reflectors output from the LQ factorization. If lside is set to true, P = M; else, if lside is set to false, P = N.
                  [in]tauA K-element array containing the scalar factors of each elementary reflector defined in a.
                  [in,out]cOn input, the M-by-N matrix C. On output, the product of the orthogonal matrix Q and the original matrix C.
                  [out]workAn optional input, that if provided, prevents any local memory allocation. If not provided, the memory required is allocated within. If provided, the length of the array must be at least olwork.
                  - + @@ -199,7 +199,7 @@
                  print '(F8.4)', (b(i), i = 1, size(b))
                  end program
                  Computes the LQ factorization of an M-by-N matrix.
                  Definition: linalg.f90:3434
                  -
                  Multiplies a general matrix by the orthogonal matrix Q from a LQ factorization.
                  Definition: linalg.f90:3699
                  +
                  Multiplies a general matrix by the orthogonal matrix Q from a LQ factorization.
                  Definition: linalg.f90:3697
                  Solves a triangular system of equations.
                  Definition: linalg.f90:2200
                  Provides a set of common linear algebra routines.
                  Definition: linalg.f90:145
                  The above program produces the following output.
                  LQ Solution: X =
                  @@ -212,7 +212,7 @@ -

                  Definition at line 3699 of file linalg.f90.

                  +

                  Definition at line 3697 of file linalg.f90.


                  The documentation for this interface was generated from the following file: diff --git a/doc/html/interfacelinalg_1_1solve__lq.html b/doc/html/interfacelinalg_1_1solve__lq.html index 03c95ca2..7cc930ed 100644 --- a/doc/html/interfacelinalg_1_1solve__lq.html +++ b/doc/html/interfacelinalg_1_1solve__lq.html @@ -166,7 +166,7 @@
                  print '(F8.4)', (b(i), i = 1, size(b))
                  end program
                  Computes the LQ factorization of an M-by-N matrix.
                  Definition: linalg.f90:3434
                  -
                  Solves a system of M LQ-factored equations of N unknowns. N must be greater than or equal to M.
                  Definition: linalg.f90:3794
                  +
                  Solves a system of M LQ-factored equations of N unknowns. N must be greater than or equal to M.
                  Definition: linalg.f90:3792
                  Provides a set of common linear algebra routines.
                  Definition: linalg.f90:145
                  The above program produces the following output.
                  QR Solution: X =
                  0.3333
                  @@ -178,7 +178,7 @@ -

                  Definition at line 3794 of file linalg.f90.

                  +

                  Definition at line 3792 of file linalg.f90.


                  The documentation for this interface was generated from the following file: diff --git a/doc/html/linalg_8f90_source.html b/doc/html/linalg_8f90_source.html index f4be569e..7f965ea2 100644 --- a/doc/html/linalg_8f90_source.html +++ b/doc/html/linalg_8f90_source.html @@ -419,1023 +419,1023 @@
                  3550 module procedure :: form_lq_no_pivot_cmplx
                  3551end interface
                  3552
                  -
                  3699interface mult_lq
                  -
                  3700 module procedure :: mult_lq_mtx
                  -
                  3701 module procedure :: mult_lq_mtx_cmplx
                  -
                  3702 module procedure :: mult_lq_vec
                  -
                  3703 module procedure :: mult_lq_vec_cmplx
                  -
                  3704end interface
                  -
                  3705
                  -
                  3794interface solve_lq
                  -
                  3795 module procedure :: solve_lq_mtx
                  -
                  3796 module procedure :: solve_lq_mtx_cmplx
                  -
                  3797 module procedure :: solve_lq_vec
                  -
                  3798 module procedure :: solve_lq_vec_cmplx
                  -
                  3799end interface
                  -
                  3800
                  -
                  3801! ******************************************************************************
                  -
                  3802! LINALG_BASIC.F90
                  -
                  3803! ------------------------------------------------------------------------------
                  -
                  3804interface
                  -
                  3805 module subroutine mtx_mult_mtx(transa, transb, alpha, a, b, beta, c, err)
                  -
                  3806 logical, intent(in) :: transa, transb
                  -
                  3807 real(real64), intent(in) :: alpha, beta
                  -
                  3808 real(real64), intent(in), dimension(:,:) :: a, b
                  -
                  3809 real(real64), intent(inout), dimension(:,:) :: c
                  -
                  3810 class(errors), intent(inout), optional, target :: err
                  -
                  3811 end subroutine
                  -
                  3812
                  -
                  3813 module subroutine mtx_mult_vec(trans, alpha, a, b, beta, c, err)
                  -
                  3814 logical, intent(in) :: trans
                  -
                  3815 real(real64), intent(in) :: alpha, beta
                  -
                  3816 real(real64), intent(in), dimension(:,:) :: a
                  -
                  3817 real(real64), intent(in), dimension(:) :: b
                  -
                  3818 real(real64), intent(inout), dimension(:) :: c
                  -
                  3819 class(errors), intent(inout), optional, target :: err
                  -
                  3820 end subroutine
                  -
                  3821
                  -
                  3822 module subroutine cmtx_mult_mtx(opa, opb, alpha, a, b, beta, c, err)
                  -
                  3823 integer(int32), intent(in) :: opa, opb
                  -
                  3824 complex(real64), intent(in) :: alpha, beta
                  -
                  3825 complex(real64), intent(in), dimension(:,:) :: a, b
                  -
                  3826 complex(real64), intent(inout), dimension(:,:) :: c
                  -
                  3827 class(errors), intent(inout), optional, target :: err
                  -
                  3828 end subroutine
                  -
                  3829
                  -
                  3830 module subroutine cmtx_mult_vec(opa, alpha, a, b, beta, c, err)
                  -
                  3831 integer(int32), intent(in) :: opa
                  -
                  3832 complex(real64), intent(in) :: alpha, beta
                  -
                  3833 complex(real64), intent(in), dimension(:,:) :: a
                  -
                  3834 complex(real64), intent(in), dimension(:) :: b
                  -
                  3835 complex(real64), intent(inout), dimension(:) :: c
                  -
                  3836 class(errors), intent(inout), optional, target :: err
                  -
                  3837 end subroutine
                  -
                  3838
                  -
                  3839 module subroutine rank1_update_dbl(alpha, x, y, a, err)
                  -
                  3840 real(real64), intent(in) :: alpha
                  -
                  3841 real(real64), intent(in), dimension(:) :: x, y
                  -
                  3842 real(real64), intent(inout), dimension(:,:) :: a
                  -
                  3843 class(errors), intent(inout), optional, target :: err
                  -
                  3844 end subroutine
                  -
                  3845
                  -
                  3846 module subroutine rank1_update_cmplx(alpha, x, y, a, err)
                  -
                  3847 complex(real64), intent(in) :: alpha
                  -
                  3848 complex(real64), intent(in), dimension(:) :: x, y
                  -
                  3849 complex(real64), intent(inout), dimension(:,:) :: a
                  -
                  3850 class(errors), intent(inout), optional, target :: err
                  -
                  3851 end subroutine
                  -
                  3852
                  -
                  3853 module subroutine diag_mtx_mult_mtx(lside, trans, alpha, a, b, beta, c, err)
                  -
                  3854 logical, intent(in) :: lside, trans
                  -
                  3855 real(real64) :: alpha, beta
                  -
                  3856 real(real64), intent(in), dimension(:) :: a
                  -
                  3857 real(real64), intent(in), dimension(:,:) :: b
                  -
                  3858 real(real64), intent(inout), dimension(:,:) :: c
                  -
                  3859 class(errors), intent(inout), optional, target :: err
                  -
                  3860 end subroutine
                  -
                  3861
                  -
                  3862 module subroutine diag_mtx_mult_mtx2(lside, alpha, a, b, err)
                  -
                  3863 logical, intent(in) :: lside
                  -
                  3864 real(real64), intent(in) :: alpha
                  -
                  3865 real(real64), intent(in), dimension(:) :: a
                  -
                  3866 real(real64), intent(inout), dimension(:,:) :: b
                  -
                  3867 class(errors), intent(inout), optional, target :: err
                  -
                  3868 end subroutine
                  -
                  3869
                  -
                  3870 module subroutine diag_mtx_mult_mtx3(lside, trans, alpha, a, b, beta, c, err)
                  -
                  3871 logical, intent(in) :: lside, trans
                  -
                  3872 real(real64) :: alpha, beta
                  -
                  3873 complex(real64), intent(in), dimension(:) :: a
                  -
                  3874 real(real64), intent(in), dimension(:,:) :: b
                  -
                  3875 complex(real64), intent(inout), dimension(:,:) :: c
                  -
                  3876 class(errors), intent(inout), optional, target :: err
                  -
                  3877 end subroutine
                  -
                  3878
                  -
                  3879 module subroutine diag_mtx_mult_mtx4(lside, opb, alpha, a, b, beta, c, err)
                  -
                  3880 logical, intent(in) :: lside
                  -
                  3881 integer(int32), intent(in) :: opb
                  -
                  3882 real(real64) :: alpha, beta
                  -
                  3883 complex(real64), intent(in), dimension(:) :: a
                  -
                  3884 complex(real64), intent(in), dimension(:,:) :: b
                  -
                  3885 complex(real64), intent(inout), dimension(:,:) :: c
                  -
                  3886 class(errors), intent(inout), optional, target :: err
                  -
                  3887 end subroutine
                  -
                  3888
                  -
                  3889 module subroutine diag_mtx_mult_mtx_cmplx(lside, opb, alpha, a, b, beta, c, err)
                  -
                  3890 logical, intent(in) :: lside
                  -
                  3891 integer(int32), intent(in) :: opb
                  -
                  3892 complex(real64) :: alpha, beta
                  -
                  3893 complex(real64), intent(in), dimension(:) :: a
                  -
                  3894 complex(real64), intent(in), dimension(:,:) :: b
                  -
                  3895 complex(real64), intent(inout), dimension(:,:) :: c
                  -
                  3896 class(errors), intent(inout), optional, target :: err
                  -
                  3897 end subroutine
                  -
                  3898
                  -
                  3899 module subroutine diag_mtx_mult_mtx2_cmplx(lside, alpha, a, b, err)
                  -
                  3900 logical, intent(in) :: lside
                  -
                  3901 complex(real64), intent(in) :: alpha
                  -
                  3902 complex(real64), intent(in), dimension(:) :: a
                  -
                  3903 complex(real64), intent(inout), dimension(:,:) :: b
                  -
                  3904 class(errors), intent(inout), optional, target :: err
                  -
                  3905 end subroutine
                  -
                  3906
                  -
                  3907 module subroutine diag_mtx_mult_mtx_mix(lside, opb, alpha, a, b, beta, c, err)
                  -
                  3908 logical, intent(in) :: lside
                  -
                  3909 integer(int32), intent(in) :: opb
                  -
                  3910 complex(real64) :: alpha, beta
                  -
                  3911 real(real64), intent(in), dimension(:) :: a
                  -
                  3912 complex(real64), intent(in), dimension(:,:) :: b
                  -
                  3913 complex(real64), intent(inout), dimension(:,:) :: c
                  -
                  3914 class(errors), intent(inout), optional, target :: err
                  -
                  3915 end subroutine
                  -
                  3916
                  -
                  3917 module subroutine diag_mtx_mult_mtx2_mix(lside, alpha, a, b, err)
                  -
                  3918 logical, intent(in) :: lside
                  -
                  3919 complex(real64), intent(in) :: alpha
                  -
                  3920 real(real64), intent(in), dimension(:) :: a
                  -
                  3921 complex(real64), intent(inout), dimension(:,:) :: b
                  -
                  3922 class(errors), intent(inout), optional, target :: err
                  -
                  3923 end subroutine
                  -
                  3924
                  -
                  3925 pure module function trace_dbl(x) result(y)
                  -
                  3926 real(real64), intent(in), dimension(:,:) :: x
                  -
                  3927 real(real64) :: y
                  -
                  3928 end function
                  -
                  3929
                  -
                  3930 pure module function trace_cmplx(x) result(y)
                  -
                  3931 complex(real64), intent(in), dimension(:,:) :: x
                  -
                  3932 complex(real64) :: y
                  -
                  3933 end function
                  -
                  3934
                  -
                  3935 module function mtx_rank_dbl(a, tol, work, olwork, err) result(rnk)
                  -
                  3936 real(real64), intent(inout), dimension(:,:) :: a
                  -
                  3937 real(real64), intent(in), optional :: tol
                  -
                  3938 real(real64), intent(out), target, optional, dimension(:) :: work
                  -
                  3939 integer(int32), intent(out), optional :: olwork
                  -
                  3940 class(errors), intent(inout), optional, target :: err
                  -
                  3941 integer(int32) :: rnk
                  -
                  3942 end function
                  -
                  3943
                  -
                  3944 module function mtx_rank_cmplx(a, tol, work, olwork, rwork, err) result(rnk)
                  -
                  3945 complex(real64), intent(inout), dimension(:,:) :: a
                  -
                  3946 real(real64), intent(in), optional :: tol
                  -
                  3947 complex(real64), intent(out), target, optional, dimension(:) :: work
                  -
                  3948 integer(int32), intent(out), optional :: olwork
                  -
                  3949 real(real64), intent(out), target, optional, dimension(:) :: rwork
                  -
                  3950 class(errors), intent(inout), optional, target :: err
                  -
                  3951 integer(int32) :: rnk
                  -
                  3952 end function
                  -
                  3953
                  -
                  3954 module function det_dbl(a, iwork, err) result(x)
                  -
                  3955 real(real64), intent(inout), dimension(:,:) :: a
                  -
                  3956 integer(int32), intent(out), target, optional, dimension(:) :: iwork
                  -
                  3957 class(errors), intent(inout), optional, target :: err
                  -
                  3958 real(real64) :: x
                  -
                  3959 end function
                  -
                  3960
                  -
                  3961 module function det_cmplx(a, iwork, err) result(x)
                  -
                  3962 complex(real64), intent(inout), dimension(:,:) :: a
                  -
                  3963 integer(int32), intent(out), target, optional, dimension(:) :: iwork
                  -
                  3964 class(errors), intent(inout), optional, target :: err
                  -
                  3965 complex(real64) :: x
                  -
                  3966 end function
                  -
                  3967
                  -
                  3968 module subroutine swap_dbl(x, y, err)
                  -
                  3969 real(real64), intent(inout), dimension(:) :: x, y
                  -
                  3970 class(errors), intent(inout), optional, target :: err
                  -
                  3971 end subroutine
                  -
                  3972
                  -
                  3973 module subroutine swap_cmplx(x, y, err)
                  -
                  3974 complex(real64), intent(inout), dimension(:) :: x, y
                  -
                  3975 class(errors), intent(inout), optional, target :: err
                  -
                  3976 end subroutine
                  -
                  3977
                  -
                  3978 module subroutine recip_mult_array_dbl(a, x)
                  -
                  3979 real(real64), intent(in) :: a
                  -
                  3980 real(real64), intent(inout), dimension(:) :: x
                  -
                  3981 end subroutine
                  -
                  3982
                  -
                  3983 module subroutine tri_mtx_mult_dbl(upper, alpha, a, beta, b, err)
                  -
                  3984 logical, intent(in) :: upper
                  -
                  3985 real(real64), intent(in) :: alpha, beta
                  -
                  3986 real(real64), intent(in), dimension(:,:) :: a
                  -
                  3987 real(real64), intent(inout), dimension(:,:) :: b
                  -
                  3988 class(errors), intent(inout), optional, target :: err
                  -
                  3989 end subroutine
                  -
                  3990
                  -
                  3991 module subroutine tri_mtx_mult_cmplx(upper, alpha, a, beta, b, err)
                  -
                  3992 logical, intent(in) :: upper
                  -
                  3993 complex(real64), intent(in) :: alpha, beta
                  -
                  3994 complex(real64), intent(in), dimension(:,:) :: a
                  -
                  3995 complex(real64), intent(inout), dimension(:,:) :: b
                  -
                  3996 class(errors), intent(inout), optional, target :: err
                  -
                  3997 end subroutine
                  +
                  3697interface mult_lq
                  +
                  3698 module procedure :: mult_lq_mtx
                  +
                  3699 module procedure :: mult_lq_mtx_cmplx
                  +
                  3700 module procedure :: mult_lq_vec
                  +
                  3701 module procedure :: mult_lq_vec_cmplx
                  +
                  3702end interface
                  +
                  3703
                  +
                  3792interface solve_lq
                  +
                  3793 module procedure :: solve_lq_mtx
                  +
                  3794 module procedure :: solve_lq_mtx_cmplx
                  +
                  3795 module procedure :: solve_lq_vec
                  +
                  3796 module procedure :: solve_lq_vec_cmplx
                  +
                  3797end interface
                  +
                  3798
                  +
                  3799! ******************************************************************************
                  +
                  3800! LINALG_BASIC.F90
                  +
                  3801! ------------------------------------------------------------------------------
                  +
                  3802interface
                  +
                  3803 module subroutine mtx_mult_mtx(transa, transb, alpha, a, b, beta, c, err)
                  +
                  3804 logical, intent(in) :: transa, transb
                  +
                  3805 real(real64), intent(in) :: alpha, beta
                  +
                  3806 real(real64), intent(in), dimension(:,:) :: a, b
                  +
                  3807 real(real64), intent(inout), dimension(:,:) :: c
                  +
                  3808 class(errors), intent(inout), optional, target :: err
                  +
                  3809 end subroutine
                  +
                  3810
                  +
                  3811 module subroutine mtx_mult_vec(trans, alpha, a, b, beta, c, err)
                  +
                  3812 logical, intent(in) :: trans
                  +
                  3813 real(real64), intent(in) :: alpha, beta
                  +
                  3814 real(real64), intent(in), dimension(:,:) :: a
                  +
                  3815 real(real64), intent(in), dimension(:) :: b
                  +
                  3816 real(real64), intent(inout), dimension(:) :: c
                  +
                  3817 class(errors), intent(inout), optional, target :: err
                  +
                  3818 end subroutine
                  +
                  3819
                  +
                  3820 module subroutine cmtx_mult_mtx(opa, opb, alpha, a, b, beta, c, err)
                  +
                  3821 integer(int32), intent(in) :: opa, opb
                  +
                  3822 complex(real64), intent(in) :: alpha, beta
                  +
                  3823 complex(real64), intent(in), dimension(:,:) :: a, b
                  +
                  3824 complex(real64), intent(inout), dimension(:,:) :: c
                  +
                  3825 class(errors), intent(inout), optional, target :: err
                  +
                  3826 end subroutine
                  +
                  3827
                  +
                  3828 module subroutine cmtx_mult_vec(opa, alpha, a, b, beta, c, err)
                  +
                  3829 integer(int32), intent(in) :: opa
                  +
                  3830 complex(real64), intent(in) :: alpha, beta
                  +
                  3831 complex(real64), intent(in), dimension(:,:) :: a
                  +
                  3832 complex(real64), intent(in), dimension(:) :: b
                  +
                  3833 complex(real64), intent(inout), dimension(:) :: c
                  +
                  3834 class(errors), intent(inout), optional, target :: err
                  +
                  3835 end subroutine
                  +
                  3836
                  +
                  3837 module subroutine rank1_update_dbl(alpha, x, y, a, err)
                  +
                  3838 real(real64), intent(in) :: alpha
                  +
                  3839 real(real64), intent(in), dimension(:) :: x, y
                  +
                  3840 real(real64), intent(inout), dimension(:,:) :: a
                  +
                  3841 class(errors), intent(inout), optional, target :: err
                  +
                  3842 end subroutine
                  +
                  3843
                  +
                  3844 module subroutine rank1_update_cmplx(alpha, x, y, a, err)
                  +
                  3845 complex(real64), intent(in) :: alpha
                  +
                  3846 complex(real64), intent(in), dimension(:) :: x, y
                  +
                  3847 complex(real64), intent(inout), dimension(:,:) :: a
                  +
                  3848 class(errors), intent(inout), optional, target :: err
                  +
                  3849 end subroutine
                  +
                  3850
                  +
                  3851 module subroutine diag_mtx_mult_mtx(lside, trans, alpha, a, b, beta, c, err)
                  +
                  3852 logical, intent(in) :: lside, trans
                  +
                  3853 real(real64) :: alpha, beta
                  +
                  3854 real(real64), intent(in), dimension(:) :: a
                  +
                  3855 real(real64), intent(in), dimension(:,:) :: b
                  +
                  3856 real(real64), intent(inout), dimension(:,:) :: c
                  +
                  3857 class(errors), intent(inout), optional, target :: err
                  +
                  3858 end subroutine
                  +
                  3859
                  +
                  3860 module subroutine diag_mtx_mult_mtx2(lside, alpha, a, b, err)
                  +
                  3861 logical, intent(in) :: lside
                  +
                  3862 real(real64), intent(in) :: alpha
                  +
                  3863 real(real64), intent(in), dimension(:) :: a
                  +
                  3864 real(real64), intent(inout), dimension(:,:) :: b
                  +
                  3865 class(errors), intent(inout), optional, target :: err
                  +
                  3866 end subroutine
                  +
                  3867
                  +
                  3868 module subroutine diag_mtx_mult_mtx3(lside, trans, alpha, a, b, beta, c, err)
                  +
                  3869 logical, intent(in) :: lside, trans
                  +
                  3870 real(real64) :: alpha, beta
                  +
                  3871 complex(real64), intent(in), dimension(:) :: a
                  +
                  3872 real(real64), intent(in), dimension(:,:) :: b
                  +
                  3873 complex(real64), intent(inout), dimension(:,:) :: c
                  +
                  3874 class(errors), intent(inout), optional, target :: err
                  +
                  3875 end subroutine
                  +
                  3876
                  +
                  3877 module subroutine diag_mtx_mult_mtx4(lside, opb, alpha, a, b, beta, c, err)
                  +
                  3878 logical, intent(in) :: lside
                  +
                  3879 integer(int32), intent(in) :: opb
                  +
                  3880 real(real64) :: alpha, beta
                  +
                  3881 complex(real64), intent(in), dimension(:) :: a
                  +
                  3882 complex(real64), intent(in), dimension(:,:) :: b
                  +
                  3883 complex(real64), intent(inout), dimension(:,:) :: c
                  +
                  3884 class(errors), intent(inout), optional, target :: err
                  +
                  3885 end subroutine
                  +
                  3886
                  +
                  3887 module subroutine diag_mtx_mult_mtx_cmplx(lside, opb, alpha, a, b, beta, c, err)
                  +
                  3888 logical, intent(in) :: lside
                  +
                  3889 integer(int32), intent(in) :: opb
                  +
                  3890 complex(real64) :: alpha, beta
                  +
                  3891 complex(real64), intent(in), dimension(:) :: a
                  +
                  3892 complex(real64), intent(in), dimension(:,:) :: b
                  +
                  3893 complex(real64), intent(inout), dimension(:,:) :: c
                  +
                  3894 class(errors), intent(inout), optional, target :: err
                  +
                  3895 end subroutine
                  +
                  3896
                  +
                  3897 module subroutine diag_mtx_mult_mtx2_cmplx(lside, alpha, a, b, err)
                  +
                  3898 logical, intent(in) :: lside
                  +
                  3899 complex(real64), intent(in) :: alpha
                  +
                  3900 complex(real64), intent(in), dimension(:) :: a
                  +
                  3901 complex(real64), intent(inout), dimension(:,:) :: b
                  +
                  3902 class(errors), intent(inout), optional, target :: err
                  +
                  3903 end subroutine
                  +
                  3904
                  +
                  3905 module subroutine diag_mtx_mult_mtx_mix(lside, opb, alpha, a, b, beta, c, err)
                  +
                  3906 logical, intent(in) :: lside
                  +
                  3907 integer(int32), intent(in) :: opb
                  +
                  3908 complex(real64) :: alpha, beta
                  +
                  3909 real(real64), intent(in), dimension(:) :: a
                  +
                  3910 complex(real64), intent(in), dimension(:,:) :: b
                  +
                  3911 complex(real64), intent(inout), dimension(:,:) :: c
                  +
                  3912 class(errors), intent(inout), optional, target :: err
                  +
                  3913 end subroutine
                  +
                  3914
                  +
                  3915 module subroutine diag_mtx_mult_mtx2_mix(lside, alpha, a, b, err)
                  +
                  3916 logical, intent(in) :: lside
                  +
                  3917 complex(real64), intent(in) :: alpha
                  +
                  3918 real(real64), intent(in), dimension(:) :: a
                  +
                  3919 complex(real64), intent(inout), dimension(:,:) :: b
                  +
                  3920 class(errors), intent(inout), optional, target :: err
                  +
                  3921 end subroutine
                  +
                  3922
                  +
                  3923 pure module function trace_dbl(x) result(y)
                  +
                  3924 real(real64), intent(in), dimension(:,:) :: x
                  +
                  3925 real(real64) :: y
                  +
                  3926 end function
                  +
                  3927
                  +
                  3928 pure module function trace_cmplx(x) result(y)
                  +
                  3929 complex(real64), intent(in), dimension(:,:) :: x
                  +
                  3930 complex(real64) :: y
                  +
                  3931 end function
                  +
                  3932
                  +
                  3933 module function mtx_rank_dbl(a, tol, work, olwork, err) result(rnk)
                  +
                  3934 real(real64), intent(inout), dimension(:,:) :: a
                  +
                  3935 real(real64), intent(in), optional :: tol
                  +
                  3936 real(real64), intent(out), target, optional, dimension(:) :: work
                  +
                  3937 integer(int32), intent(out), optional :: olwork
                  +
                  3938 class(errors), intent(inout), optional, target :: err
                  +
                  3939 integer(int32) :: rnk
                  +
                  3940 end function
                  +
                  3941
                  +
                  3942 module function mtx_rank_cmplx(a, tol, work, olwork, rwork, err) result(rnk)
                  +
                  3943 complex(real64), intent(inout), dimension(:,:) :: a
                  +
                  3944 real(real64), intent(in), optional :: tol
                  +
                  3945 complex(real64), intent(out), target, optional, dimension(:) :: work
                  +
                  3946 integer(int32), intent(out), optional :: olwork
                  +
                  3947 real(real64), intent(out), target, optional, dimension(:) :: rwork
                  +
                  3948 class(errors), intent(inout), optional, target :: err
                  +
                  3949 integer(int32) :: rnk
                  +
                  3950 end function
                  +
                  3951
                  +
                  3952 module function det_dbl(a, iwork, err) result(x)
                  +
                  3953 real(real64), intent(inout), dimension(:,:) :: a
                  +
                  3954 integer(int32), intent(out), target, optional, dimension(:) :: iwork
                  +
                  3955 class(errors), intent(inout), optional, target :: err
                  +
                  3956 real(real64) :: x
                  +
                  3957 end function
                  +
                  3958
                  +
                  3959 module function det_cmplx(a, iwork, err) result(x)
                  +
                  3960 complex(real64), intent(inout), dimension(:,:) :: a
                  +
                  3961 integer(int32), intent(out), target, optional, dimension(:) :: iwork
                  +
                  3962 class(errors), intent(inout), optional, target :: err
                  +
                  3963 complex(real64) :: x
                  +
                  3964 end function
                  +
                  3965
                  +
                  3966 module subroutine swap_dbl(x, y, err)
                  +
                  3967 real(real64), intent(inout), dimension(:) :: x, y
                  +
                  3968 class(errors), intent(inout), optional, target :: err
                  +
                  3969 end subroutine
                  +
                  3970
                  +
                  3971 module subroutine swap_cmplx(x, y, err)
                  +
                  3972 complex(real64), intent(inout), dimension(:) :: x, y
                  +
                  3973 class(errors), intent(inout), optional, target :: err
                  +
                  3974 end subroutine
                  +
                  3975
                  +
                  3976 module subroutine recip_mult_array_dbl(a, x)
                  +
                  3977 real(real64), intent(in) :: a
                  +
                  3978 real(real64), intent(inout), dimension(:) :: x
                  +
                  3979 end subroutine
                  +
                  3980
                  +
                  3981 module subroutine tri_mtx_mult_dbl(upper, alpha, a, beta, b, err)
                  +
                  3982 logical, intent(in) :: upper
                  +
                  3983 real(real64), intent(in) :: alpha, beta
                  +
                  3984 real(real64), intent(in), dimension(:,:) :: a
                  +
                  3985 real(real64), intent(inout), dimension(:,:) :: b
                  +
                  3986 class(errors), intent(inout), optional, target :: err
                  +
                  3987 end subroutine
                  +
                  3988
                  +
                  3989 module subroutine tri_mtx_mult_cmplx(upper, alpha, a, beta, b, err)
                  +
                  3990 logical, intent(in) :: upper
                  +
                  3991 complex(real64), intent(in) :: alpha, beta
                  +
                  3992 complex(real64), intent(in), dimension(:,:) :: a
                  +
                  3993 complex(real64), intent(inout), dimension(:,:) :: b
                  +
                  3994 class(errors), intent(inout), optional, target :: err
                  +
                  3995 end subroutine
                  +
                  3996
                  +
                  3997end interface
                  3998
                  -
                  3999end interface
                  -
                  4000
                  -
                  4001! ******************************************************************************
                  -
                  4002! LINALG_FACTOR.F90
                  -
                  4003! ------------------------------------------------------------------------------
                  -
                  4004interface
                  -
                  4005 module subroutine lu_factor_dbl(a, ipvt, err)
                  -
                  4006 real(real64), intent(inout), dimension(:,:) :: a
                  -
                  4007 integer(int32), intent(out), dimension(:) :: ipvt
                  -
                  4008 class(errors), intent(inout), optional, target :: err
                  -
                  4009 end subroutine
                  -
                  4010
                  -
                  4011 module subroutine lu_factor_cmplx(a, ipvt, err)
                  -
                  4012 complex(real64), intent(inout), dimension(:,:) :: a
                  -
                  4013 integer(int32), intent(out), dimension(:) :: ipvt
                  -
                  4014 class(errors), intent(inout), optional, target :: err
                  -
                  4015 end subroutine
                  -
                  4016
                  -
                  4017 module subroutine form_lu_all(lu, ipvt, u, p, err)
                  -
                  4018 real(real64), intent(inout), dimension(:,:) :: lu
                  -
                  4019 integer(int32), intent(in), dimension(:) :: ipvt
                  -
                  4020 real(real64), intent(out), dimension(:,:) :: u, p
                  -
                  4021 class(errors), intent(inout), optional, target :: err
                  -
                  4022 end subroutine
                  -
                  4023
                  -
                  4024 module subroutine form_lu_all_cmplx(lu, ipvt, u, p, err)
                  -
                  4025 complex(real64), intent(inout), dimension(:,:) :: lu
                  -
                  4026 integer(int32), intent(in), dimension(:) :: ipvt
                  -
                  4027 complex(real64), intent(out), dimension(:,:) :: u
                  -
                  4028 real(real64), intent(out), dimension(:,:) :: p
                  -
                  4029 class(errors), intent(inout), optional, target :: err
                  -
                  4030 end subroutine
                  -
                  4031
                  -
                  4032 module subroutine form_lu_only(lu, u, err)
                  -
                  4033 real(real64), intent(inout), dimension(:,:) :: lu
                  -
                  4034 real(real64), intent(out), dimension(:,:) :: u
                  -
                  4035 class(errors), intent(inout), optional, target :: err
                  -
                  4036 end subroutine
                  -
                  4037
                  -
                  4038 module subroutine form_lu_only_cmplx(lu, u, err)
                  -
                  4039 complex(real64), intent(inout), dimension(:,:) :: lu
                  -
                  4040 complex(real64), intent(out), dimension(:,:) :: u
                  -
                  4041 class(errors), intent(inout), optional, target :: err
                  -
                  4042 end subroutine
                  -
                  4043
                  -
                  4044 module subroutine qr_factor_no_pivot(a, tau, work, olwork, err)
                  -
                  4045 real(real64), intent(inout), dimension(:,:) :: a
                  -
                  4046 real(real64), intent(out), dimension(:) :: tau
                  -
                  4047 real(real64), intent(out), target, dimension(:), optional :: work
                  -
                  4048 integer(int32), intent(out), optional :: olwork
                  -
                  4049 class(errors), intent(inout), optional, target :: err
                  -
                  4050 end subroutine
                  -
                  4051
                  -
                  4052 module subroutine qr_factor_no_pivot_cmplx(a, tau, work, olwork, err)
                  -
                  4053 complex(real64), intent(inout), dimension(:,:) :: a
                  -
                  4054 complex(real64), intent(out), dimension(:) :: tau
                  -
                  4055 complex(real64), intent(out), target, dimension(:), optional :: work
                  -
                  4056 integer(int32), intent(out), optional :: olwork
                  -
                  4057 class(errors), intent(inout), optional, target :: err
                  -
                  4058 end subroutine
                  -
                  4059
                  -
                  4060 module subroutine qr_factor_pivot(a, tau, jpvt, work, olwork, err)
                  -
                  4061 real(real64), intent(inout), dimension(:,:) :: a
                  -
                  4062 real(real64), intent(out), dimension(:) :: tau
                  -
                  4063 integer(int32), intent(inout), dimension(:) :: jpvt
                  -
                  4064 real(real64), intent(out), target, dimension(:), optional :: work
                  -
                  4065 integer(int32), intent(out), optional :: olwork
                  -
                  4066 class(errors), intent(inout), optional, target :: err
                  -
                  4067 end subroutine
                  -
                  4068
                  -
                  4069 module subroutine qr_factor_pivot_cmplx(a, tau, jpvt, work, olwork, rwork, &
                  -
                  4070 err)
                  -
                  4071 complex(real64), intent(inout), dimension(:,:) :: a
                  -
                  4072 complex(real64), intent(out), dimension(:) :: tau
                  -
                  4073 integer(int32), intent(inout), dimension(:) :: jpvt
                  -
                  4074 complex(real64), intent(out), target, dimension(:), optional :: work
                  -
                  4075 integer(int32), intent(out), optional :: olwork
                  -
                  4076 real(real64), intent(out), target, dimension(:), optional :: rwork
                  -
                  4077 class(errors), intent(inout), optional, target :: err
                  -
                  4078 end subroutine
                  -
                  4079
                  -
                  4080 module subroutine form_qr_no_pivot(r, tau, q, work, olwork, err)
                  -
                  4081 real(real64), intent(inout), dimension(:,:) :: r
                  -
                  4082 real(real64), intent(in), dimension(:) :: tau
                  -
                  4083 real(real64), intent(out), dimension(:,:) :: q
                  -
                  4084 real(real64), intent(out), target, dimension(:), optional :: work
                  -
                  4085 integer(int32), intent(out), optional :: olwork
                  -
                  4086 class(errors), intent(inout), optional, target :: err
                  -
                  4087 end subroutine
                  -
                  4088
                  -
                  4089 module subroutine form_qr_no_pivot_cmplx(r, tau, q, work, olwork, err)
                  -
                  4090 complex(real64), intent(inout), dimension(:,:) :: r
                  -
                  4091 complex(real64), intent(in), dimension(:) :: tau
                  -
                  4092 complex(real64), intent(out), dimension(:,:) :: q
                  -
                  4093 complex(real64), intent(out), target, dimension(:), optional :: work
                  -
                  4094 integer(int32), intent(out), optional :: olwork
                  -
                  4095 class(errors), intent(inout), optional, target :: err
                  -
                  4096 end subroutine
                  -
                  4097
                  -
                  4098 module subroutine form_qr_pivot(r, tau, pvt, q, p, work, olwork, err)
                  -
                  4099 real(real64), intent(inout), dimension(:,:) :: r
                  -
                  4100 real(real64), intent(in), dimension(:) :: tau
                  -
                  4101 integer(int32), intent(in), dimension(:) :: pvt
                  -
                  4102 real(real64), intent(out), dimension(:,:) :: q, p
                  -
                  4103 real(real64), intent(out), target, dimension(:), optional :: work
                  -
                  4104 integer(int32), intent(out), optional :: olwork
                  -
                  4105 class(errors), intent(inout), optional, target :: err
                  -
                  4106 end subroutine
                  -
                  4107
                  -
                  4108 module subroutine form_qr_pivot_cmplx(r, tau, pvt, q, p, work, olwork, err)
                  -
                  4109 complex(real64), intent(inout), dimension(:,:) :: r
                  -
                  4110 complex(real64), intent(in), dimension(:) :: tau
                  -
                  4111 integer(int32), intent(in), dimension(:) :: pvt
                  -
                  4112 complex(real64), intent(out), dimension(:,:) :: q, p
                  -
                  4113 complex(real64), intent(out), target, dimension(:), optional :: work
                  -
                  4114 integer(int32), intent(out), optional :: olwork
                  -
                  4115 class(errors), intent(inout), optional, target :: err
                  -
                  4116 end subroutine
                  -
                  4117
                  -
                  4118 module subroutine mult_qr_mtx(lside, trans, a, tau, c, work, olwork, err)
                  -
                  4119 logical, intent(in) :: lside, trans
                  -
                  4120 real(real64), intent(in), dimension(:) :: tau
                  -
                  4121 real(real64), intent(inout), dimension(:,:) :: a, c
                  -
                  4122 real(real64), intent(out), target, dimension(:), optional :: work
                  -
                  4123 integer(int32), intent(out), optional :: olwork
                  -
                  4124 class(errors), intent(inout), optional, target :: err
                  -
                  4125 end subroutine
                  -
                  4126
                  -
                  4127 module subroutine mult_qr_mtx_cmplx(lside, trans, a, tau, c, work, olwork, err)
                  -
                  4128 logical, intent(in) :: lside, trans
                  -
                  4129 complex(real64), intent(in), dimension(:) :: tau
                  -
                  4130 complex(real64), intent(inout), dimension(:,:) :: a, c
                  -
                  4131 complex(real64), intent(out), target, dimension(:), optional :: work
                  -
                  4132 integer(int32), intent(out), optional :: olwork
                  -
                  4133 class(errors), intent(inout), optional, target :: err
                  -
                  4134 end subroutine
                  -
                  4135
                  -
                  4136 module subroutine mult_qr_vec(trans, a, tau, c, work, olwork, err)
                  -
                  4137 logical, intent(in) :: trans
                  -
                  4138 real(real64), intent(inout), dimension(:,:) :: a
                  -
                  4139 real(real64), intent(in), dimension(:) :: tau
                  -
                  4140 real(real64), intent(inout), dimension(:) :: c
                  -
                  4141 real(real64), intent(out), target, dimension(:), optional :: work
                  -
                  4142 integer(int32), intent(out), optional :: olwork
                  -
                  4143 class(errors), intent(inout), optional, target :: err
                  -
                  4144 end subroutine
                  -
                  4145
                  -
                  4146 module subroutine mult_qr_vec_cmplx(trans, a, tau, c, work, olwork, err)
                  -
                  4147 logical, intent(in) :: trans
                  -
                  4148 complex(real64), intent(inout), dimension(:,:) :: a
                  -
                  4149 complex(real64), intent(in), dimension(:) :: tau
                  -
                  4150 complex(real64), intent(inout), dimension(:) :: c
                  -
                  4151 complex(real64), intent(out), target, dimension(:), optional :: work
                  -
                  4152 integer(int32), intent(out), optional :: olwork
                  -
                  4153 class(errors), intent(inout), optional, target :: err
                  -
                  4154 end subroutine
                  -
                  4155
                  -
                  4156 module subroutine qr_rank1_update_dbl(q, r, u, v, work, err)
                  -
                  4157 real(real64), intent(inout), dimension(:,:) :: q, r
                  -
                  4158 real(real64), intent(inout), dimension(:) :: u, v
                  -
                  4159 real(real64), intent(out), target, optional, dimension(:) :: work
                  -
                  4160 class(errors), intent(inout), optional, target :: err
                  -
                  4161 end subroutine
                  -
                  4162
                  -
                  4163 module subroutine qr_rank1_update_cmplx(q, r, u, v, work, rwork, err)
                  -
                  4164 complex(real64), intent(inout), dimension(:,:) :: q, r
                  -
                  4165 complex(real64), intent(inout), dimension(:) :: u, v
                  -
                  4166 complex(real64), intent(out), target, optional, dimension(:) :: work
                  -
                  4167 real(real64), intent(out), target, optional, dimension(:) :: rwork
                  -
                  4168 class(errors), intent(inout), optional, target :: err
                  -
                  4169 end subroutine
                  -
                  4170
                  -
                  4171 module subroutine cholesky_factor_dbl(a, upper, err)
                  -
                  4172 real(real64), intent(inout), dimension(:,:) :: a
                  -
                  4173 logical, intent(in), optional :: upper
                  -
                  4174 class(errors), intent(inout), optional, target :: err
                  -
                  4175 end subroutine
                  -
                  4176
                  -
                  4177 module subroutine cholesky_factor_cmplx(a, upper, err)
                  -
                  4178 complex(real64), intent(inout), dimension(:,:) :: a
                  -
                  4179 logical, intent(in), optional :: upper
                  -
                  4180 class(errors), intent(inout), optional, target :: err
                  -
                  4181 end subroutine
                  -
                  4182
                  -
                  4183 module subroutine cholesky_rank1_update_dbl(r, u, work, err)
                  -
                  4184 real(real64), intent(inout), dimension(:,:) :: r
                  -
                  4185 real(real64), intent(inout), dimension(:) :: u
                  -
                  4186 real(real64), intent(out), target, optional, dimension(:) :: work
                  -
                  4187 class(errors), intent(inout), optional, target :: err
                  -
                  4188 end subroutine
                  -
                  4189
                  -
                  4190 module subroutine cholesky_rank1_update_cmplx(r, u, work, err)
                  -
                  4191 complex(real64), intent(inout), dimension(:,:) :: r
                  -
                  4192 complex(real64), intent(inout), dimension(:) :: u
                  -
                  4193 real(real64), intent(out), target, optional, dimension(:) :: work
                  -
                  4194 class(errors), intent(inout), optional, target :: err
                  -
                  4195 end subroutine
                  -
                  4196
                  -
                  4197 module subroutine cholesky_rank1_downdate_dbl(r, u, work, err)
                  -
                  4198 real(real64), intent(inout), dimension(:,:) :: r
                  -
                  4199 real(real64), intent(inout), dimension(:) :: u
                  -
                  4200 real(real64), intent(out), target, optional, dimension(:) :: work
                  -
                  4201 class(errors), intent(inout), optional, target :: err
                  -
                  4202 end subroutine
                  -
                  4203
                  -
                  4204 module subroutine cholesky_rank1_downdate_cmplx(r, u, work, err)
                  -
                  4205 complex(real64), intent(inout), dimension(:,:) :: r
                  -
                  4206 complex(real64), intent(inout), dimension(:) :: u
                  -
                  4207 real(real64), intent(out), target, optional, dimension(:) :: work
                  -
                  4208 class(errors), intent(inout), optional, target :: err
                  -
                  4209 end subroutine
                  -
                  4210
                  -
                  4211 module subroutine rz_factor_dbl(a, tau, work, olwork, err)
                  -
                  4212 real(real64), intent(inout), dimension(:,:) :: a
                  -
                  4213 real(real64), intent(out), dimension(:) :: tau
                  -
                  4214 real(real64), intent(out), target, optional, dimension(:) :: work
                  -
                  4215 integer(int32), intent(out), optional :: olwork
                  -
                  4216 class(errors), intent(inout), optional, target :: err
                  -
                  4217 end subroutine
                  -
                  4218
                  -
                  4219 module subroutine rz_factor_cmplx(a, tau, work, olwork, err)
                  -
                  4220 complex(real64), intent(inout), dimension(:,:) :: a
                  -
                  4221 complex(real64), intent(out), dimension(:) :: tau
                  -
                  4222 complex(real64), intent(out), target, optional, dimension(:) :: work
                  -
                  4223 integer(int32), intent(out), optional :: olwork
                  -
                  4224 class(errors), intent(inout), optional, target :: err
                  -
                  4225 end subroutine
                  -
                  4226
                  -
                  4227 module subroutine mult_rz_mtx(lside, trans, l, a, tau, c, work, olwork, err)
                  -
                  4228 logical, intent(in) :: lside, trans
                  -
                  4229 integer(int32), intent(in) :: l
                  -
                  4230 real(real64), intent(inout), dimension(:,:) :: a, c
                  -
                  4231 real(real64), intent(in), dimension(:) :: tau
                  -
                  4232 real(real64), intent(out), target, optional, dimension(:) :: work
                  -
                  4233 integer(int32), intent(out), optional :: olwork
                  -
                  4234 class(errors), intent(inout), optional, target :: err
                  -
                  4235 end subroutine
                  -
                  4236
                  -
                  4237 module subroutine mult_rz_mtx_cmplx(lside, trans, l, a, tau, c, work, olwork, err)
                  -
                  4238 logical, intent(in) :: lside, trans
                  -
                  4239 integer(int32), intent(in) :: l
                  -
                  4240 complex(real64), intent(inout), dimension(:,:) :: a, c
                  -
                  4241 complex(real64), intent(in), dimension(:) :: tau
                  -
                  4242 complex(real64), intent(out), target, optional, dimension(:) :: work
                  -
                  4243 integer(int32), intent(out), optional :: olwork
                  -
                  4244 class(errors), intent(inout), optional, target :: err
                  -
                  4245 end subroutine
                  -
                  4246
                  -
                  4247 module subroutine mult_rz_vec(trans, l, a, tau, c, work, olwork, err)
                  -
                  4248 logical, intent(in) :: trans
                  -
                  4249 integer(int32), intent(in) :: l
                  -
                  4250 real(real64), intent(inout), dimension(:,:) :: a
                  -
                  4251 real(real64), intent(in), dimension(:) :: tau
                  -
                  4252 real(real64), intent(inout), dimension(:) :: c
                  -
                  4253 real(real64), intent(out), target, optional, dimension(:) :: work
                  -
                  4254 integer(int32), intent(out), optional :: olwork
                  -
                  4255 class(errors), intent(inout), optional, target :: err
                  -
                  4256 end subroutine
                  -
                  4257
                  -
                  4258 module subroutine mult_rz_vec_cmplx(trans, l, a, tau, c, work, olwork, err)
                  -
                  4259 logical, intent(in) :: trans
                  -
                  4260 integer(int32), intent(in) :: l
                  -
                  4261 complex(real64), intent(inout), dimension(:,:) :: a
                  -
                  4262 complex(real64), intent(in), dimension(:) :: tau
                  -
                  4263 complex(real64), intent(inout), dimension(:) :: c
                  -
                  4264 complex(real64), intent(out), target, optional, dimension(:) :: work
                  -
                  4265 integer(int32), intent(out), optional :: olwork
                  -
                  4266 class(errors), intent(inout), optional, target :: err
                  -
                  4267 end subroutine
                  -
                  4268
                  -
                  4269 module subroutine svd_dbl(a, s, u, vt, work, olwork, err)
                  -
                  4270 real(real64), intent(inout), dimension(:,:) :: a
                  -
                  4271 real(real64), intent(out), dimension(:) :: s
                  -
                  4272 real(real64), intent(out), optional, dimension(:,:) :: u, vt
                  -
                  4273 real(real64), intent(out), target, optional, dimension(:) :: work
                  -
                  4274 integer(int32), intent(out), optional :: olwork
                  -
                  4275 class(errors), intent(inout), optional, target :: err
                  -
                  4276 end subroutine
                  -
                  4277
                  -
                  4278 module subroutine svd_cmplx(a, s, u, vt, work, olwork, rwork, err)
                  -
                  4279 complex(real64), intent(inout), dimension(:,:) :: a
                  -
                  4280 real(real64), intent(out), dimension(:) :: s
                  -
                  4281 complex(real64), intent(out), optional, dimension(:,:) :: u, vt
                  -
                  4282 complex(real64), intent(out), target, optional, dimension(:) :: work
                  -
                  4283 integer(int32), intent(out), optional :: olwork
                  -
                  4284 real(real64), intent(out), target, optional, dimension(:) :: rwork
                  -
                  4285 class(errors), intent(inout), optional, target :: err
                  -
                  4286 end subroutine
                  -
                  4287
                  -
                  4288 module subroutine lq_factor_no_pivot(a, tau, work, olwork, err)
                  -
                  4289 real(real64), intent(inout), dimension(:,:) :: a
                  -
                  4290 real(real64), intent(out), dimension(:) :: tau
                  -
                  4291 real(real64), intent(out), target, dimension(:), optional :: work
                  -
                  4292 integer(int32), intent(out), optional :: olwork
                  -
                  4293 class(errors), intent(inout), optional, target :: err
                  -
                  4294 end subroutine
                  -
                  4295
                  -
                  4296 module subroutine lq_factor_no_pivot_cmplx(a, tau, work, olwork, err)
                  -
                  4297 complex(real64), intent(inout), dimension(:,:) :: a
                  -
                  4298 complex(real64), intent(out), dimension(:) :: tau
                  -
                  4299 complex(real64), intent(out), target, dimension(:), optional :: work
                  -
                  4300 integer(int32), intent(out), optional :: olwork
                  -
                  4301 class(errors), intent(inout), optional, target :: err
                  -
                  4302 end subroutine
                  -
                  4303
                  -
                  4304 module subroutine form_lq_no_pivot(l, tau, q, work, olwork, err)
                  -
                  4305 real(real64), intent(inout), dimension(:,:) :: l
                  -
                  4306 real(real64), intent(in), dimension(:) :: tau
                  -
                  4307 real(real64), intent(out), dimension(:,:) :: q
                  -
                  4308 real(real64), intent(out), target, dimension(:), optional :: work
                  -
                  4309 integer(int32), intent(out), optional :: olwork
                  -
                  4310 class(errors), intent(inout), optional, target :: err
                  -
                  4311 end subroutine
                  -
                  4312
                  -
                  4313 module subroutine form_lq_no_pivot_cmplx(l, tau, q, work, olwork, err)
                  -
                  4314 complex(real64), intent(inout), dimension(:,:) :: l
                  -
                  4315 complex(real64), intent(in), dimension(:) :: tau
                  -
                  4316 complex(real64), intent(out), dimension(:,:) :: q
                  -
                  4317 complex(real64), intent(out), target, dimension(:), optional :: work
                  -
                  4318 integer(int32), intent(out), optional :: olwork
                  -
                  4319 class(errors), intent(inout), optional, target :: err
                  -
                  4320 end subroutine
                  -
                  4321
                  -
                  4322 module subroutine mult_lq_mtx(lside, trans, a, tau, c, work, olwork, err)
                  -
                  4323 logical, intent(in) :: lside, trans
                  -
                  4324 real(real64), intent(in), dimension(:,:) :: a
                  -
                  4325 real(real64), intent(in), dimension(:) :: tau
                  -
                  4326 real(real64), intent(inout), dimension(:,:) :: c
                  -
                  4327 real(real64), intent(out), target, dimension(:), optional :: work
                  -
                  4328 integer(int32), intent(out), optional :: olwork
                  -
                  4329 class(errors), intent(inout), optional, target :: err
                  -
                  4330 end subroutine
                  -
                  4331
                  -
                  4332 module subroutine mult_lq_mtx_cmplx(lside, trans, a, tau, c, work, olwork, err)
                  -
                  4333 logical, intent(in) :: lside, trans
                  -
                  4334 complex(real64), intent(in), dimension(:,:) :: a
                  -
                  4335 complex(real64), intent(in), dimension(:) :: tau
                  -
                  4336 complex(real64), intent(inout), dimension(:,:) :: c
                  -
                  4337 complex(real64), intent(out), target, dimension(:), optional :: work
                  -
                  4338 integer(int32), intent(out), optional :: olwork
                  -
                  4339 class(errors), intent(inout), optional, target :: err
                  -
                  4340 end subroutine
                  -
                  4341
                  -
                  4342 module subroutine mult_lq_vec(trans, a, tau, c, work, olwork, err)
                  -
                  4343 logical, intent(in) :: trans
                  -
                  4344 real(real64), intent(in), dimension(:,:) :: a
                  -
                  4345 real(real64), intent(in), dimension(:) :: tau
                  -
                  4346 real(real64), intent(inout), dimension(:) :: c
                  -
                  4347 real(real64), intent(out), target, dimension(:), optional :: work
                  -
                  4348 integer(int32), intent(out), optional :: olwork
                  -
                  4349 class(errors), intent(inout), optional, target :: err
                  -
                  4350 end subroutine
                  -
                  4351
                  -
                  4352 module subroutine mult_lq_vec_cmplx(trans, a, tau, c, work, olwork, err)
                  -
                  4353 logical, intent(in) :: trans
                  -
                  4354 complex(real64), intent(in), dimension(:,:) :: a
                  -
                  4355 complex(real64), intent(in), dimension(:) :: tau
                  -
                  4356 complex(real64), intent(inout), dimension(:) :: c
                  -
                  4357 complex(real64), intent(out), target, dimension(:), optional :: work
                  -
                  4358 integer(int32), intent(out), optional :: olwork
                  -
                  4359 class(errors), intent(inout), optional, target :: err
                  -
                  4360 end subroutine
                  -
                  4361end interface
                  -
                  4362
                  -
                  4363! ******************************************************************************
                  -
                  4364! LINALG_SOLVE.F90
                  -
                  4365! ------------------------------------------------------------------------------
                  -
                  4366interface
                  -
                  4367 module subroutine solve_tri_mtx(lside, upper, trans, nounit, alpha, a, b, err)
                  -
                  4368 logical, intent(in) :: lside, upper, trans, nounit
                  -
                  4369 real(real64), intent(in) :: alpha
                  -
                  4370 real(real64), intent(in), dimension(:,:) :: a
                  -
                  4371 real(real64), intent(inout), dimension(:,:) :: b
                  -
                  4372 class(errors), intent(inout), optional, target :: err
                  -
                  4373 end subroutine
                  -
                  4374
                  -
                  4375 module subroutine solve_tri_mtx_cmplx(lside, upper, trans, nounit, alpha, a, b, err)
                  -
                  4376 logical, intent(in) :: lside, upper, trans, nounit
                  -
                  4377 complex(real64), intent(in) :: alpha
                  -
                  4378 complex(real64), intent(in), dimension(:,:) :: a
                  -
                  4379 complex(real64), intent(inout), dimension(:,:) :: b
                  -
                  4380 class(errors), intent(inout), optional, target :: err
                  -
                  4381 end subroutine
                  -
                  4382
                  -
                  4383 module subroutine solve_tri_vec(upper, trans, nounit, a, x, err)
                  -
                  4384 logical, intent(in) :: upper, trans, nounit
                  -
                  4385 real(real64), intent(in), dimension(:,:) :: a
                  -
                  4386 real(real64), intent(inout), dimension(:) :: x
                  -
                  4387 class(errors), intent(inout), optional, target :: err
                  -
                  4388 end subroutine
                  -
                  4389
                  -
                  4390 module subroutine solve_tri_vec_cmplx(upper, trans, nounit, a, x, err)
                  -
                  4391 logical, intent(in) :: upper, trans, nounit
                  -
                  4392 complex(real64), intent(in), dimension(:,:) :: a
                  -
                  4393 complex(real64), intent(inout), dimension(:) :: x
                  -
                  4394 class(errors), intent(inout), optional, target :: err
                  -
                  4395 end subroutine
                  -
                  4396
                  -
                  4397 module subroutine solve_lu_mtx(a, ipvt, b, err)
                  -
                  4398 real(real64), intent(in), dimension(:,:) :: a
                  -
                  4399 integer(int32), intent(in), dimension(:) :: ipvt
                  -
                  4400 real(real64), intent(inout), dimension(:,:) :: b
                  -
                  4401 class(errors), intent(inout), optional, target :: err
                  -
                  4402 end subroutine
                  -
                  4403
                  -
                  4404 module subroutine solve_lu_mtx_cmplx(a, ipvt, b, err)
                  -
                  4405 complex(real64), intent(in), dimension(:,:) :: a
                  -
                  4406 integer(int32), intent(in), dimension(:) :: ipvt
                  -
                  4407 complex(real64), intent(inout), dimension(:,:) :: b
                  -
                  4408 class(errors), intent(inout), optional, target :: err
                  -
                  4409 end subroutine
                  -
                  4410
                  -
                  4411 module subroutine solve_lu_vec(a, ipvt, b, err)
                  -
                  4412 real(real64), intent(in), dimension(:,:) :: a
                  -
                  4413 integer(int32), intent(in), dimension(:) :: ipvt
                  -
                  4414 real(real64), intent(inout), dimension(:) :: b
                  -
                  4415 class(errors), intent(inout), optional, target :: err
                  -
                  4416 end subroutine
                  -
                  4417
                  -
                  4418 module subroutine solve_lu_vec_cmplx(a, ipvt, b, err)
                  -
                  4419 complex(real64), intent(in), dimension(:,:) :: a
                  -
                  4420 integer(int32), intent(in), dimension(:) :: ipvt
                  -
                  4421 complex(real64), intent(inout), dimension(:) :: b
                  -
                  4422 class(errors), intent(inout), optional, target :: err
                  -
                  4423 end subroutine
                  -
                  4424
                  -
                  4425 module subroutine solve_qr_no_pivot_mtx(a, tau, b, work, olwork, err)
                  -
                  4426 real(real64), intent(inout), dimension(:,:) :: a, b
                  -
                  4427 real(real64), intent(in), dimension(:) :: tau
                  -
                  4428 real(real64), intent(out), target, optional, dimension(:) :: work
                  -
                  4429 integer(int32), intent(out), optional :: olwork
                  -
                  4430 class(errors), intent(inout), optional, target :: err
                  -
                  4431 end subroutine
                  -
                  4432
                  -
                  4433 module subroutine solve_qr_no_pivot_mtx_cmplx(a, tau, b, work, olwork, err)
                  -
                  4434 complex(real64), intent(inout), dimension(:,:) :: a, b
                  -
                  4435 complex(real64), intent(in), dimension(:) :: tau
                  -
                  4436 complex(real64), intent(out), target, optional, dimension(:) :: work
                  -
                  4437 integer(int32), intent(out), optional :: olwork
                  -
                  4438 class(errors), intent(inout), optional, target :: err
                  -
                  4439 end subroutine
                  -
                  4440
                  -
                  4441 module subroutine solve_qr_no_pivot_vec(a, tau, b, work, olwork, err)
                  -
                  4442 real(real64), intent(inout), dimension(:,:) :: a
                  -
                  4443 real(real64), intent(in), dimension(:) :: tau
                  -
                  4444 real(real64), intent(inout), dimension(:) :: b
                  -
                  4445 real(real64), intent(out), target, optional, dimension(:) :: work
                  -
                  4446 integer(int32), intent(out), optional :: olwork
                  -
                  4447 class(errors), intent(inout), optional, target :: err
                  -
                  4448 end subroutine
                  -
                  4449
                  -
                  4450 module subroutine solve_qr_no_pivot_vec_cmplx(a, tau, b, work, olwork, err)
                  -
                  4451 complex(real64), intent(inout), dimension(:,:) :: a
                  -
                  4452 complex(real64), intent(in), dimension(:) :: tau
                  -
                  4453 complex(real64), intent(inout), dimension(:) :: b
                  -
                  4454 complex(real64), intent(out), target, optional, dimension(:) :: work
                  -
                  4455 integer(int32), intent(out), optional :: olwork
                  -
                  4456 class(errors), intent(inout), optional, target :: err
                  -
                  4457 end subroutine
                  -
                  4458
                  -
                  4459 module subroutine solve_qr_pivot_mtx(a, tau, jpvt, b, work, olwork, err)
                  -
                  4460 real(real64), intent(inout), dimension(:,:) :: a
                  -
                  4461 real(real64), intent(in), dimension(:) :: tau
                  -
                  4462 integer(int32), intent(in), dimension(:) :: jpvt
                  -
                  4463 real(real64), intent(inout), dimension(:,:) :: b
                  -
                  4464 real(real64), intent(out), target, optional, dimension(:) :: work
                  -
                  4465 integer(int32), intent(out), optional :: olwork
                  -
                  4466 class(errors), intent(inout), optional, target :: err
                  -
                  4467 end subroutine
                  -
                  4468
                  -
                  4469 module subroutine solve_qr_pivot_mtx_cmplx(a, tau, jpvt, b, work, olwork, err)
                  -
                  4470 complex(real64), intent(inout), dimension(:,:) :: a
                  -
                  4471 complex(real64), intent(in), dimension(:) :: tau
                  -
                  4472 integer(int32), intent(in), dimension(:) :: jpvt
                  -
                  4473 complex(real64), intent(inout), dimension(:,:) :: b
                  -
                  4474 complex(real64), intent(out), target, optional, dimension(:) :: work
                  -
                  4475 integer(int32), intent(out), optional :: olwork
                  -
                  4476 class(errors), intent(inout), optional, target :: err
                  -
                  4477 end subroutine
                  -
                  4478
                  -
                  4479 module subroutine solve_qr_pivot_vec(a, tau, jpvt, b, work, olwork, err)
                  -
                  4480 real(real64), intent(inout), dimension(:,:) :: a
                  -
                  4481 real(real64), intent(in), dimension(:) :: tau
                  -
                  4482 integer(int32), intent(in), dimension(:) :: jpvt
                  -
                  4483 real(real64), intent(inout), dimension(:) :: b
                  -
                  4484 real(real64), intent(out), target, optional, dimension(:) :: work
                  -
                  4485 integer(int32), intent(out), optional :: olwork
                  -
                  4486 class(errors), intent(inout), optional, target :: err
                  -
                  4487 end subroutine
                  -
                  4488
                  -
                  4489 module subroutine solve_qr_pivot_vec_cmplx(a, tau, jpvt, b, work, olwork, err)
                  -
                  4490 complex(real64), intent(inout), dimension(:,:) :: a
                  -
                  4491 complex(real64), intent(in), dimension(:) :: tau
                  -
                  4492 integer(int32), intent(in), dimension(:) :: jpvt
                  -
                  4493 complex(real64), intent(inout), dimension(:) :: b
                  -
                  4494 complex(real64), intent(out), target, optional, dimension(:) :: work
                  -
                  4495 integer(int32), intent(out), optional :: olwork
                  -
                  4496 class(errors), intent(inout), optional, target :: err
                  -
                  4497 end subroutine
                  -
                  4498
                  -
                  4499 module subroutine solve_cholesky_mtx(upper, a, b, err)
                  -
                  4500 logical, intent(in) :: upper
                  -
                  4501 real(real64), intent(in), dimension(:,:) :: a
                  -
                  4502 real(real64), intent(inout), dimension(:,:) :: b
                  -
                  4503 class(errors), intent(inout), optional, target :: err
                  -
                  4504 end subroutine
                  -
                  4505
                  -
                  4506 module subroutine solve_cholesky_mtx_cmplx(upper, a, b, err)
                  -
                  4507 logical, intent(in) :: upper
                  -
                  4508 complex(real64), intent(in), dimension(:,:) :: a
                  -
                  4509 complex(real64), intent(inout), dimension(:,:) :: b
                  -
                  4510 class(errors), intent(inout), optional, target :: err
                  -
                  4511 end subroutine
                  -
                  4512
                  -
                  4513 module subroutine solve_cholesky_vec(upper, a, b, err)
                  -
                  4514 logical, intent(in) :: upper
                  -
                  4515 real(real64), intent(in), dimension(:,:) :: a
                  -
                  4516 real(real64), intent(inout), dimension(:) :: b
                  -
                  4517 class(errors), intent(inout), optional, target :: err
                  -
                  4518 end subroutine
                  -
                  4519
                  -
                  4520 module subroutine solve_cholesky_vec_cmplx(upper, a, b, err)
                  -
                  4521 logical, intent(in) :: upper
                  -
                  4522 complex(real64), intent(in), dimension(:,:) :: a
                  -
                  4523 complex(real64), intent(inout), dimension(:) :: b
                  -
                  4524 class(errors), intent(inout), optional, target :: err
                  -
                  4525 end subroutine
                  -
                  4526
                  -
                  4527 module subroutine solve_least_squares_mtx(a, b, work, olwork, err)
                  -
                  4528 real(real64), intent(inout), dimension(:,:) :: a, b
                  -
                  4529 real(real64), intent(out), target, optional, dimension(:) :: work
                  -
                  4530 integer(int32), intent(out), optional :: olwork
                  -
                  4531 class(errors), intent(inout), optional, target :: err
                  -
                  4532 end subroutine
                  -
                  4533
                  -
                  4534 module subroutine solve_least_squares_mtx_cmplx(a, b, work, olwork, err)
                  -
                  4535 complex(real64), intent(inout), dimension(:,:) :: a, b
                  -
                  4536 complex(real64), intent(out), target, optional, dimension(:) :: work
                  -
                  4537 integer(int32), intent(out), optional :: olwork
                  -
                  4538 class(errors), intent(inout), optional, target :: err
                  -
                  4539 end subroutine
                  -
                  4540
                  -
                  4541 module subroutine solve_least_squares_vec(a, b, work, olwork, err)
                  -
                  4542 real(real64), intent(inout), dimension(:,:) :: a
                  -
                  4543 real(real64), intent(inout), dimension(:) :: b
                  -
                  4544 real(real64), intent(out), target, optional, dimension(:) :: work
                  -
                  4545 integer(int32), intent(out), optional :: olwork
                  -
                  4546 class(errors), intent(inout), optional, target :: err
                  -
                  4547 end subroutine
                  -
                  4548
                  -
                  4549 module subroutine solve_least_squares_vec_cmplx(a, b, work, olwork, err)
                  -
                  4550 complex(real64), intent(inout), dimension(:,:) :: a
                  -
                  4551 complex(real64), intent(inout), dimension(:) :: b
                  -
                  4552 complex(real64), intent(out), target, optional, dimension(:) :: work
                  -
                  4553 integer(int32), intent(out), optional :: olwork
                  -
                  4554 class(errors), intent(inout), optional, target :: err
                  -
                  4555 end subroutine
                  -
                  4556
                  -
                  4557 module subroutine solve_least_squares_mtx_pvt(a, b, ipvt, arnk, work, olwork, err)
                  -
                  4558 real(real64), intent(inout), dimension(:,:) :: a, b
                  -
                  4559 integer(int32), intent(inout), target, optional, dimension(:) :: ipvt
                  -
                  4560 integer(int32), intent(out), optional :: arnk
                  -
                  4561 real(real64), intent(out), target, optional, dimension(:) :: work
                  -
                  4562 integer(int32), intent(out), optional :: olwork
                  -
                  4563 class(errors), intent(inout), optional, target :: err
                  -
                  4564 end subroutine
                  -
                  4565
                  -
                  4566 module subroutine solve_least_squares_mtx_pvt_cmplx(a, b, ipvt, arnk, &
                  -
                  4567 work, olwork, rwork, err)
                  -
                  4568 complex(real64), intent(inout), dimension(:,:) :: a, b
                  -
                  4569 integer(int32), intent(inout), target, optional, dimension(:) :: ipvt
                  -
                  4570 integer(int32), intent(out), optional :: arnk
                  -
                  4571 complex(real64), intent(out), target, optional, dimension(:) :: work
                  -
                  4572 integer(int32), intent(out), optional :: olwork
                  -
                  4573 real(real64), intent(out), target, optional, dimension(:) :: rwork
                  -
                  4574 class(errors), intent(inout), optional, target :: err
                  -
                  4575 end subroutine
                  -
                  4576
                  -
                  4577 module subroutine solve_least_squares_vec_pvt(a, b, ipvt, arnk, work, olwork, err)
                  -
                  4578 real(real64), intent(inout), dimension(:,:) :: a
                  -
                  4579 real(real64), intent(inout), dimension(:) :: b
                  -
                  4580 integer(int32), intent(inout), target, optional, dimension(:) :: ipvt
                  -
                  4581 integer(int32), intent(out), optional :: arnk
                  -
                  4582 real(real64), intent(out), target, optional, dimension(:) :: work
                  -
                  4583 integer(int32), intent(out), optional :: olwork
                  -
                  4584 class(errors), intent(inout), optional, target :: err
                  -
                  4585 end subroutine
                  -
                  4586
                  -
                  4587 module subroutine solve_least_squares_vec_pvt_cmplx(a, b, ipvt, arnk, &
                  -
                  4588 work, olwork, rwork, err)
                  -
                  4589 complex(real64), intent(inout), dimension(:,:) :: a
                  -
                  4590 complex(real64), intent(inout), dimension(:) :: b
                  -
                  4591 integer(int32), intent(inout), target, optional, dimension(:) :: ipvt
                  -
                  4592 integer(int32), intent(out), optional :: arnk
                  -
                  4593 complex(real64), intent(out), target, optional, dimension(:) :: work
                  -
                  4594 integer(int32), intent(out), optional :: olwork
                  -
                  4595 real(real64), intent(out), target, optional, dimension(:) :: rwork
                  -
                  4596 class(errors), intent(inout), optional, target :: err
                  -
                  4597 end subroutine
                  -
                  4598
                  -
                  4599 module subroutine solve_least_squares_mtx_svd(a, b, s, arnk, work, olwork, err)
                  -
                  4600 real(real64), intent(inout), dimension(:,:) :: a, b
                  -
                  4601 integer(int32), intent(out), optional :: arnk
                  -
                  4602 real(real64), intent(out), target, optional, dimension(:) :: work, s
                  -
                  4603 integer(int32), intent(out), optional :: olwork
                  -
                  4604 class(errors), intent(inout), optional, target :: err
                  -
                  4605 end subroutine
                  -
                  4606
                  -
                  4607 module subroutine solve_least_squares_mtx_svd_cmplx(a, b, s, arnk, work, &
                  -
                  4608 olwork, rwork, err)
                  -
                  4609 complex(real64), intent(inout), dimension(:,:) :: a, b
                  -
                  4610 integer(int32), intent(out), optional :: arnk
                  -
                  4611 complex(real64), intent(out), target, optional, dimension(:) :: work
                  -
                  4612 real(real64), intent(out), target, optional, dimension(:) :: rwork, s
                  -
                  4613 integer(int32), intent(out), optional :: olwork
                  -
                  4614 class(errors), intent(inout), optional, target :: err
                  -
                  4615 end subroutine
                  -
                  4616
                  -
                  4617 module subroutine solve_least_squares_vec_svd(a, b, s, arnk, work, olwork, err)
                  -
                  4618 real(real64), intent(inout), dimension(:,:) :: a
                  -
                  4619 real(real64), intent(inout), dimension(:) :: b
                  -
                  4620 integer(int32), intent(out), optional :: arnk
                  -
                  4621 real(real64), intent(out), target, optional, dimension(:) :: work, s
                  -
                  4622 integer(int32), intent(out), optional :: olwork
                  -
                  4623 class(errors), intent(inout), optional, target :: err
                  -
                  4624 end subroutine
                  -
                  4625
                  -
                  4626 module subroutine solve_least_squares_vec_svd_cmplx(a, b, s, arnk, work, &
                  -
                  4627 olwork, rwork, err)
                  -
                  4628 complex(real64), intent(inout), dimension(:,:) :: a
                  -
                  4629 complex(real64), intent(inout), dimension(:) :: b
                  -
                  4630 integer(int32), intent(out), optional :: arnk
                  -
                  4631 complex(real64), intent(out), target, optional, dimension(:) :: work
                  -
                  4632 real(real64), intent(out), target, optional, dimension(:) :: rwork, s
                  -
                  4633 integer(int32), intent(out), optional :: olwork
                  -
                  4634 class(errors), intent(inout), optional, target :: err
                  -
                  4635 end subroutine
                  -
                  4636
                  -
                  4637 module subroutine mtx_inverse_dbl(a, iwork, work, olwork, err)
                  -
                  4638 real(real64), intent(inout), dimension(:,:) :: a
                  -
                  4639 integer(int32), intent(out), target, optional, dimension(:) :: iwork
                  -
                  4640 real(real64), intent(out), target, optional, dimension(:) :: work
                  -
                  4641 integer(int32), intent(out), optional :: olwork
                  -
                  4642 class(errors), intent(inout), optional, target :: err
                  -
                  4643 end subroutine
                  -
                  4644
                  -
                  4645 module subroutine mtx_inverse_cmplx(a, iwork, work, olwork, err)
                  -
                  4646 complex(real64), intent(inout), dimension(:,:) :: a
                  -
                  4647 integer(int32), intent(out), target, optional, dimension(:) :: iwork
                  -
                  4648 complex(real64), intent(out), target, optional, dimension(:) :: work
                  -
                  4649 integer(int32), intent(out), optional :: olwork
                  -
                  4650 class(errors), intent(inout), optional, target :: err
                  -
                  4651 end subroutine
                  -
                  4652
                  -
                  4653 module subroutine mtx_pinverse_dbl(a, ainv, tol, work, olwork, err)
                  -
                  4654 real(real64), intent(inout), dimension(:,:) :: a
                  -
                  4655 real(real64), intent(out), dimension(:,:) :: ainv
                  -
                  4656 real(real64), intent(in), optional :: tol
                  -
                  4657 real(real64), intent(out), target, dimension(:), optional :: work
                  -
                  4658 integer(int32), intent(out), optional :: olwork
                  -
                  4659 class(errors), intent(inout), optional, target :: err
                  -
                  4660 end subroutine
                  -
                  4661
                  -
                  4662 module subroutine mtx_pinverse_cmplx(a, ainv, tol, work, olwork, rwork, err)
                  -
                  4663 complex(real64), intent(inout), dimension(:,:) :: a
                  -
                  4664 complex(real64), intent(out), dimension(:,:) :: ainv
                  -
                  4665 real(real64), intent(in), optional :: tol
                  -
                  4666 complex(real64), intent(out), target, dimension(:), optional :: work
                  -
                  4667 integer(int32), intent(out), optional :: olwork
                  -
                  4668 real(real64), intent(out), target, dimension(:), optional :: rwork
                  -
                  4669 class(errors), intent(inout), optional, target :: err
                  -
                  4670 end subroutine
                  -
                  4671
                  -
                  4672 module subroutine solve_lq_mtx(a, tau, b, work, olwork, err)
                  -
                  4673 real(real64), intent(in), dimension(:,:) :: a
                  -
                  4674 real(real64), intent(in), dimension(:) :: tau
                  -
                  4675 real(real64), intent(inout), dimension(:,:) :: b
                  -
                  4676 real(real64), intent(out), target, optional, dimension(:) :: work
                  -
                  4677 integer(int32), intent(out), optional :: olwork
                  -
                  4678 class(errors), intent(inout), optional, target :: err
                  -
                  4679 end subroutine
                  -
                  4680
                  -
                  4681 module subroutine solve_lq_mtx_cmplx(a, tau, b, work, olwork, err)
                  -
                  4682 complex(real64), intent(in), dimension(:,:) :: a
                  -
                  4683 complex(real64), intent(in), dimension(:) :: tau
                  -
                  4684 complex(real64), intent(inout), dimension(:,:) :: b
                  -
                  4685 complex(real64), intent(out), target, optional, dimension(:) :: work
                  -
                  4686 integer(int32), intent(out), optional :: olwork
                  -
                  4687 class(errors), intent(inout), optional, target :: err
                  -
                  4688 end subroutine
                  -
                  4689
                  -
                  4690 module subroutine solve_lq_vec(a, tau, b, work, olwork, err)
                  -
                  4691 real(real64), intent(in), dimension(:,:) :: a
                  -
                  4692 real(real64), intent(in), dimension(:) :: tau
                  -
                  4693 real(real64), intent(inout), dimension(:) :: b
                  -
                  4694 real(real64), intent(out), target, optional, dimension(:) :: work
                  -
                  4695 integer(int32), intent(out), optional :: olwork
                  -
                  4696 class(errors), intent(inout), optional, target :: err
                  -
                  4697 end subroutine
                  -
                  4698
                  -
                  4699 module subroutine solve_lq_vec_cmplx(a, tau, b, work, olwork, err)
                  -
                  4700 complex(real64), intent(in), dimension(:,:) :: a
                  -
                  4701 complex(real64), intent(in), dimension(:) :: tau
                  -
                  4702 complex(real64), intent(inout), dimension(:) :: b
                  -
                  4703 complex(real64), intent(out), target, optional, dimension(:) :: work
                  -
                  4704 integer(int32), intent(out), optional :: olwork
                  -
                  4705 class(errors), intent(inout), optional, target :: err
                  -
                  4706 end subroutine
                  -
                  4707end interface
                  -
                  4708
                  -
                  4709! ******************************************************************************
                  -
                  4710! LINALG_EIGEN.F90
                  -
                  4711! ------------------------------------------------------------------------------
                  -
                  4712interface
                  -
                  4713 module subroutine eigen_symm(vecs, a, vals, work, olwork, err)
                  -
                  4714 logical, intent(in) :: vecs
                  -
                  4715 real(real64), intent(inout), dimension(:,:) :: a
                  -
                  4716 real(real64), intent(out), dimension(:) :: vals
                  -
                  4717 real(real64), intent(out), pointer, optional, dimension(:) :: work
                  -
                  4718 integer(int32), intent(out), optional :: olwork
                  -
                  4719 class(errors), intent(inout), optional, target :: err
                  -
                  4720 end subroutine
                  -
                  4721
                  -
                  4722 module subroutine eigen_asymm(a, vals, vecs, work, olwork, err)
                  -
                  4723 real(real64), intent(inout), dimension(:,:) :: a
                  -
                  4724 complex(real64), intent(out), dimension(:) :: vals
                  -
                  4725 complex(real64), intent(out), optional, dimension(:,:) :: vecs
                  -
                  4726 real(real64), intent(out), pointer, optional, dimension(:) :: work
                  -
                  4727 integer(int32), intent(out), optional :: olwork
                  -
                  4728 class(errors), intent(inout), optional, target :: err
                  -
                  4729 end subroutine
                  -
                  4730
                  -
                  4731 module subroutine eigen_gen(a, b, alpha, beta, vecs, work, olwork, err)
                  -
                  4732 real(real64), intent(inout), dimension(:,:) :: a, b
                  -
                  4733 complex(real64), intent(out), dimension(:) :: alpha
                  -
                  4734 real(real64), intent(out), optional, dimension(:) :: beta
                  -
                  4735 complex(real64), intent(out), optional, dimension(:,:) :: vecs
                  -
                  4736 real(real64), intent(out), optional, pointer, dimension(:) :: work
                  -
                  4737 integer(int32), intent(out), optional :: olwork
                  -
                  4738 class(errors), intent(inout), optional, target :: err
                  -
                  4739 end subroutine
                  -
                  4740
                  -
                  4741 module subroutine eigen_cmplx(a, vals, vecs, work, olwork, rwork, err)
                  -
                  4742 complex(real64), intent(inout), dimension(:,:) :: a
                  -
                  4743 complex(real64), intent(out), dimension(:) :: vals
                  -
                  4744 complex(real64), intent(out), optional, dimension(:,:) :: vecs
                  -
                  4745 complex(real64), intent(out), target, optional, dimension(:) :: work
                  -
                  4746 real(real64), intent(out), target, optional, dimension(:) :: rwork
                  -
                  4747 integer(int32), intent(out), optional :: olwork
                  -
                  4748 class(errors), intent(inout), optional, target :: err
                  -
                  4749 end subroutine
                  -
                  4750end interface
                  -
                  4751
                  -
                  4752! ******************************************************************************
                  -
                  4753! LINALG_SORTING.F90
                  -
                  4754! ------------------------------------------------------------------------------
                  -
                  4755interface
                  -
                  4756 module subroutine sort_dbl_array(x, ascend)
                  -
                  4757 real(real64), intent(inout), dimension(:) :: x
                  -
                  4758 logical, intent(in), optional :: ascend
                  -
                  4759 end subroutine
                  -
                  4760
                  -
                  4761 module subroutine sort_dbl_array_ind(x, ind, ascend, err)
                  -
                  4762 real(real64), intent(inout), dimension(:) :: x
                  -
                  4763 integer(int32), intent(inout), dimension(:) :: ind
                  -
                  4764 logical, intent(in), optional :: ascend
                  -
                  4765 class(errors), intent(inout), optional, target :: err
                  -
                  4766 end subroutine
                  -
                  4767
                  -
                  4768 module subroutine sort_cmplx_array(x, ascend)
                  -
                  4769 complex(real64), intent(inout), dimension(:) :: x
                  -
                  4770 logical, intent(in), optional :: ascend
                  -
                  4771 end subroutine
                  -
                  4772
                  -
                  4773 module subroutine sort_cmplx_array_ind(x, ind, ascend, err)
                  -
                  4774 complex(real64), intent(inout), dimension(:) :: x
                  -
                  4775 integer(int32), intent(inout), dimension(:) :: ind
                  -
                  4776 logical, intent(in), optional :: ascend
                  -
                  4777 class(errors), intent(inout), optional, target :: err
                  -
                  4778 end subroutine
                  -
                  4779
                  -
                  4780 module subroutine sort_eigen_cmplx(vals, vecs, ascend, err)
                  -
                  4781 complex(real64), intent(inout), dimension(:) :: vals
                  -
                  4782 complex(real64), intent(inout), dimension(:,:) :: vecs
                  -
                  4783 logical, intent(in), optional :: ascend
                  -
                  4784 class(errors), intent(inout), optional, target :: err
                  -
                  4785 end subroutine
                  -
                  4786
                  -
                  4787 module subroutine sort_eigen_dbl(vals, vecs, ascend, err)
                  -
                  4788 real(real64), intent(inout), dimension(:) :: vals
                  -
                  4789 real(real64), intent(inout), dimension(:,:) :: vecs
                  -
                  4790 logical, intent(in), optional :: ascend
                  -
                  4791 class(errors), intent(inout), optional, target :: err
                  -
                  4792 end subroutine
                  +
                  3999! ******************************************************************************
                  +
                  4000! LINALG_FACTOR.F90
                  +
                  4001! ------------------------------------------------------------------------------
                  +
                  4002interface
                  +
                  4003 module subroutine lu_factor_dbl(a, ipvt, err)
                  +
                  4004 real(real64), intent(inout), dimension(:,:) :: a
                  +
                  4005 integer(int32), intent(out), dimension(:) :: ipvt
                  +
                  4006 class(errors), intent(inout), optional, target :: err
                  +
                  4007 end subroutine
                  +
                  4008
                  +
                  4009 module subroutine lu_factor_cmplx(a, ipvt, err)
                  +
                  4010 complex(real64), intent(inout), dimension(:,:) :: a
                  +
                  4011 integer(int32), intent(out), dimension(:) :: ipvt
                  +
                  4012 class(errors), intent(inout), optional, target :: err
                  +
                  4013 end subroutine
                  +
                  4014
                  +
                  4015 module subroutine form_lu_all(lu, ipvt, u, p, err)
                  +
                  4016 real(real64), intent(inout), dimension(:,:) :: lu
                  +
                  4017 integer(int32), intent(in), dimension(:) :: ipvt
                  +
                  4018 real(real64), intent(out), dimension(:,:) :: u, p
                  +
                  4019 class(errors), intent(inout), optional, target :: err
                  +
                  4020 end subroutine
                  +
                  4021
                  +
                  4022 module subroutine form_lu_all_cmplx(lu, ipvt, u, p, err)
                  +
                  4023 complex(real64), intent(inout), dimension(:,:) :: lu
                  +
                  4024 integer(int32), intent(in), dimension(:) :: ipvt
                  +
                  4025 complex(real64), intent(out), dimension(:,:) :: u
                  +
                  4026 real(real64), intent(out), dimension(:,:) :: p
                  +
                  4027 class(errors), intent(inout), optional, target :: err
                  +
                  4028 end subroutine
                  +
                  4029
                  +
                  4030 module subroutine form_lu_only(lu, u, err)
                  +
                  4031 real(real64), intent(inout), dimension(:,:) :: lu
                  +
                  4032 real(real64), intent(out), dimension(:,:) :: u
                  +
                  4033 class(errors), intent(inout), optional, target :: err
                  +
                  4034 end subroutine
                  +
                  4035
                  +
                  4036 module subroutine form_lu_only_cmplx(lu, u, err)
                  +
                  4037 complex(real64), intent(inout), dimension(:,:) :: lu
                  +
                  4038 complex(real64), intent(out), dimension(:,:) :: u
                  +
                  4039 class(errors), intent(inout), optional, target :: err
                  +
                  4040 end subroutine
                  +
                  4041
                  +
                  4042 module subroutine qr_factor_no_pivot(a, tau, work, olwork, err)
                  +
                  4043 real(real64), intent(inout), dimension(:,:) :: a
                  +
                  4044 real(real64), intent(out), dimension(:) :: tau
                  +
                  4045 real(real64), intent(out), target, dimension(:), optional :: work
                  +
                  4046 integer(int32), intent(out), optional :: olwork
                  +
                  4047 class(errors), intent(inout), optional, target :: err
                  +
                  4048 end subroutine
                  +
                  4049
                  +
                  4050 module subroutine qr_factor_no_pivot_cmplx(a, tau, work, olwork, err)
                  +
                  4051 complex(real64), intent(inout), dimension(:,:) :: a
                  +
                  4052 complex(real64), intent(out), dimension(:) :: tau
                  +
                  4053 complex(real64), intent(out), target, dimension(:), optional :: work
                  +
                  4054 integer(int32), intent(out), optional :: olwork
                  +
                  4055 class(errors), intent(inout), optional, target :: err
                  +
                  4056 end subroutine
                  +
                  4057
                  +
                  4058 module subroutine qr_factor_pivot(a, tau, jpvt, work, olwork, err)
                  +
                  4059 real(real64), intent(inout), dimension(:,:) :: a
                  +
                  4060 real(real64), intent(out), dimension(:) :: tau
                  +
                  4061 integer(int32), intent(inout), dimension(:) :: jpvt
                  +
                  4062 real(real64), intent(out), target, dimension(:), optional :: work
                  +
                  4063 integer(int32), intent(out), optional :: olwork
                  +
                  4064 class(errors), intent(inout), optional, target :: err
                  +
                  4065 end subroutine
                  +
                  4066
                  +
                  4067 module subroutine qr_factor_pivot_cmplx(a, tau, jpvt, work, olwork, rwork, &
                  +
                  4068 err)
                  +
                  4069 complex(real64), intent(inout), dimension(:,:) :: a
                  +
                  4070 complex(real64), intent(out), dimension(:) :: tau
                  +
                  4071 integer(int32), intent(inout), dimension(:) :: jpvt
                  +
                  4072 complex(real64), intent(out), target, dimension(:), optional :: work
                  +
                  4073 integer(int32), intent(out), optional :: olwork
                  +
                  4074 real(real64), intent(out), target, dimension(:), optional :: rwork
                  +
                  4075 class(errors), intent(inout), optional, target :: err
                  +
                  4076 end subroutine
                  +
                  4077
                  +
                  4078 module subroutine form_qr_no_pivot(r, tau, q, work, olwork, err)
                  +
                  4079 real(real64), intent(inout), dimension(:,:) :: r
                  +
                  4080 real(real64), intent(in), dimension(:) :: tau
                  +
                  4081 real(real64), intent(out), dimension(:,:) :: q
                  +
                  4082 real(real64), intent(out), target, dimension(:), optional :: work
                  +
                  4083 integer(int32), intent(out), optional :: olwork
                  +
                  4084 class(errors), intent(inout), optional, target :: err
                  +
                  4085 end subroutine
                  +
                  4086
                  +
                  4087 module subroutine form_qr_no_pivot_cmplx(r, tau, q, work, olwork, err)
                  +
                  4088 complex(real64), intent(inout), dimension(:,:) :: r
                  +
                  4089 complex(real64), intent(in), dimension(:) :: tau
                  +
                  4090 complex(real64), intent(out), dimension(:,:) :: q
                  +
                  4091 complex(real64), intent(out), target, dimension(:), optional :: work
                  +
                  4092 integer(int32), intent(out), optional :: olwork
                  +
                  4093 class(errors), intent(inout), optional, target :: err
                  +
                  4094 end subroutine
                  +
                  4095
                  +
                  4096 module subroutine form_qr_pivot(r, tau, pvt, q, p, work, olwork, err)
                  +
                  4097 real(real64), intent(inout), dimension(:,:) :: r
                  +
                  4098 real(real64), intent(in), dimension(:) :: tau
                  +
                  4099 integer(int32), intent(in), dimension(:) :: pvt
                  +
                  4100 real(real64), intent(out), dimension(:,:) :: q, p
                  +
                  4101 real(real64), intent(out), target, dimension(:), optional :: work
                  +
                  4102 integer(int32), intent(out), optional :: olwork
                  +
                  4103 class(errors), intent(inout), optional, target :: err
                  +
                  4104 end subroutine
                  +
                  4105
                  +
                  4106 module subroutine form_qr_pivot_cmplx(r, tau, pvt, q, p, work, olwork, err)
                  +
                  4107 complex(real64), intent(inout), dimension(:,:) :: r
                  +
                  4108 complex(real64), intent(in), dimension(:) :: tau
                  +
                  4109 integer(int32), intent(in), dimension(:) :: pvt
                  +
                  4110 complex(real64), intent(out), dimension(:,:) :: q, p
                  +
                  4111 complex(real64), intent(out), target, dimension(:), optional :: work
                  +
                  4112 integer(int32), intent(out), optional :: olwork
                  +
                  4113 class(errors), intent(inout), optional, target :: err
                  +
                  4114 end subroutine
                  +
                  4115
                  +
                  4116 module subroutine mult_qr_mtx(lside, trans, a, tau, c, work, olwork, err)
                  +
                  4117 logical, intent(in) :: lside, trans
                  +
                  4118 real(real64), intent(in), dimension(:) :: tau
                  +
                  4119 real(real64), intent(inout), dimension(:,:) :: a, c
                  +
                  4120 real(real64), intent(out), target, dimension(:), optional :: work
                  +
                  4121 integer(int32), intent(out), optional :: olwork
                  +
                  4122 class(errors), intent(inout), optional, target :: err
                  +
                  4123 end subroutine
                  +
                  4124
                  +
                  4125 module subroutine mult_qr_mtx_cmplx(lside, trans, a, tau, c, work, olwork, err)
                  +
                  4126 logical, intent(in) :: lside, trans
                  +
                  4127 complex(real64), intent(in), dimension(:) :: tau
                  +
                  4128 complex(real64), intent(inout), dimension(:,:) :: a, c
                  +
                  4129 complex(real64), intent(out), target, dimension(:), optional :: work
                  +
                  4130 integer(int32), intent(out), optional :: olwork
                  +
                  4131 class(errors), intent(inout), optional, target :: err
                  +
                  4132 end subroutine
                  +
                  4133
                  +
                  4134 module subroutine mult_qr_vec(trans, a, tau, c, work, olwork, err)
                  +
                  4135 logical, intent(in) :: trans
                  +
                  4136 real(real64), intent(inout), dimension(:,:) :: a
                  +
                  4137 real(real64), intent(in), dimension(:) :: tau
                  +
                  4138 real(real64), intent(inout), dimension(:) :: c
                  +
                  4139 real(real64), intent(out), target, dimension(:), optional :: work
                  +
                  4140 integer(int32), intent(out), optional :: olwork
                  +
                  4141 class(errors), intent(inout), optional, target :: err
                  +
                  4142 end subroutine
                  +
                  4143
                  +
                  4144 module subroutine mult_qr_vec_cmplx(trans, a, tau, c, work, olwork, err)
                  +
                  4145 logical, intent(in) :: trans
                  +
                  4146 complex(real64), intent(inout), dimension(:,:) :: a
                  +
                  4147 complex(real64), intent(in), dimension(:) :: tau
                  +
                  4148 complex(real64), intent(inout), dimension(:) :: c
                  +
                  4149 complex(real64), intent(out), target, dimension(:), optional :: work
                  +
                  4150 integer(int32), intent(out), optional :: olwork
                  +
                  4151 class(errors), intent(inout), optional, target :: err
                  +
                  4152 end subroutine
                  +
                  4153
                  +
                  4154 module subroutine qr_rank1_update_dbl(q, r, u, v, work, err)
                  +
                  4155 real(real64), intent(inout), dimension(:,:) :: q, r
                  +
                  4156 real(real64), intent(inout), dimension(:) :: u, v
                  +
                  4157 real(real64), intent(out), target, optional, dimension(:) :: work
                  +
                  4158 class(errors), intent(inout), optional, target :: err
                  +
                  4159 end subroutine
                  +
                  4160
                  +
                  4161 module subroutine qr_rank1_update_cmplx(q, r, u, v, work, rwork, err)
                  +
                  4162 complex(real64), intent(inout), dimension(:,:) :: q, r
                  +
                  4163 complex(real64), intent(inout), dimension(:) :: u, v
                  +
                  4164 complex(real64), intent(out), target, optional, dimension(:) :: work
                  +
                  4165 real(real64), intent(out), target, optional, dimension(:) :: rwork
                  +
                  4166 class(errors), intent(inout), optional, target :: err
                  +
                  4167 end subroutine
                  +
                  4168
                  +
                  4169 module subroutine cholesky_factor_dbl(a, upper, err)
                  +
                  4170 real(real64), intent(inout), dimension(:,:) :: a
                  +
                  4171 logical, intent(in), optional :: upper
                  +
                  4172 class(errors), intent(inout), optional, target :: err
                  +
                  4173 end subroutine
                  +
                  4174
                  +
                  4175 module subroutine cholesky_factor_cmplx(a, upper, err)
                  +
                  4176 complex(real64), intent(inout), dimension(:,:) :: a
                  +
                  4177 logical, intent(in), optional :: upper
                  +
                  4178 class(errors), intent(inout), optional, target :: err
                  +
                  4179 end subroutine
                  +
                  4180
                  +
                  4181 module subroutine cholesky_rank1_update_dbl(r, u, work, err)
                  +
                  4182 real(real64), intent(inout), dimension(:,:) :: r
                  +
                  4183 real(real64), intent(inout), dimension(:) :: u
                  +
                  4184 real(real64), intent(out), target, optional, dimension(:) :: work
                  +
                  4185 class(errors), intent(inout), optional, target :: err
                  +
                  4186 end subroutine
                  +
                  4187
                  +
                  4188 module subroutine cholesky_rank1_update_cmplx(r, u, work, err)
                  +
                  4189 complex(real64), intent(inout), dimension(:,:) :: r
                  +
                  4190 complex(real64), intent(inout), dimension(:) :: u
                  +
                  4191 real(real64), intent(out), target, optional, dimension(:) :: work
                  +
                  4192 class(errors), intent(inout), optional, target :: err
                  +
                  4193 end subroutine
                  +
                  4194
                  +
                  4195 module subroutine cholesky_rank1_downdate_dbl(r, u, work, err)
                  +
                  4196 real(real64), intent(inout), dimension(:,:) :: r
                  +
                  4197 real(real64), intent(inout), dimension(:) :: u
                  +
                  4198 real(real64), intent(out), target, optional, dimension(:) :: work
                  +
                  4199 class(errors), intent(inout), optional, target :: err
                  +
                  4200 end subroutine
                  +
                  4201
                  +
                  4202 module subroutine cholesky_rank1_downdate_cmplx(r, u, work, err)
                  +
                  4203 complex(real64), intent(inout), dimension(:,:) :: r
                  +
                  4204 complex(real64), intent(inout), dimension(:) :: u
                  +
                  4205 real(real64), intent(out), target, optional, dimension(:) :: work
                  +
                  4206 class(errors), intent(inout), optional, target :: err
                  +
                  4207 end subroutine
                  +
                  4208
                  +
                  4209 module subroutine rz_factor_dbl(a, tau, work, olwork, err)
                  +
                  4210 real(real64), intent(inout), dimension(:,:) :: a
                  +
                  4211 real(real64), intent(out), dimension(:) :: tau
                  +
                  4212 real(real64), intent(out), target, optional, dimension(:) :: work
                  +
                  4213 integer(int32), intent(out), optional :: olwork
                  +
                  4214 class(errors), intent(inout), optional, target :: err
                  +
                  4215 end subroutine
                  +
                  4216
                  +
                  4217 module subroutine rz_factor_cmplx(a, tau, work, olwork, err)
                  +
                  4218 complex(real64), intent(inout), dimension(:,:) :: a
                  +
                  4219 complex(real64), intent(out), dimension(:) :: tau
                  +
                  4220 complex(real64), intent(out), target, optional, dimension(:) :: work
                  +
                  4221 integer(int32), intent(out), optional :: olwork
                  +
                  4222 class(errors), intent(inout), optional, target :: err
                  +
                  4223 end subroutine
                  +
                  4224
                  +
                  4225 module subroutine mult_rz_mtx(lside, trans, l, a, tau, c, work, olwork, err)
                  +
                  4226 logical, intent(in) :: lside, trans
                  +
                  4227 integer(int32), intent(in) :: l
                  +
                  4228 real(real64), intent(inout), dimension(:,:) :: a, c
                  +
                  4229 real(real64), intent(in), dimension(:) :: tau
                  +
                  4230 real(real64), intent(out), target, optional, dimension(:) :: work
                  +
                  4231 integer(int32), intent(out), optional :: olwork
                  +
                  4232 class(errors), intent(inout), optional, target :: err
                  +
                  4233 end subroutine
                  +
                  4234
                  +
                  4235 module subroutine mult_rz_mtx_cmplx(lside, trans, l, a, tau, c, work, olwork, err)
                  +
                  4236 logical, intent(in) :: lside, trans
                  +
                  4237 integer(int32), intent(in) :: l
                  +
                  4238 complex(real64), intent(inout), dimension(:,:) :: a, c
                  +
                  4239 complex(real64), intent(in), dimension(:) :: tau
                  +
                  4240 complex(real64), intent(out), target, optional, dimension(:) :: work
                  +
                  4241 integer(int32), intent(out), optional :: olwork
                  +
                  4242 class(errors), intent(inout), optional, target :: err
                  +
                  4243 end subroutine
                  +
                  4244
                  +
                  4245 module subroutine mult_rz_vec(trans, l, a, tau, c, work, olwork, err)
                  +
                  4246 logical, intent(in) :: trans
                  +
                  4247 integer(int32), intent(in) :: l
                  +
                  4248 real(real64), intent(inout), dimension(:,:) :: a
                  +
                  4249 real(real64), intent(in), dimension(:) :: tau
                  +
                  4250 real(real64), intent(inout), dimension(:) :: c
                  +
                  4251 real(real64), intent(out), target, optional, dimension(:) :: work
                  +
                  4252 integer(int32), intent(out), optional :: olwork
                  +
                  4253 class(errors), intent(inout), optional, target :: err
                  +
                  4254 end subroutine
                  +
                  4255
                  +
                  4256 module subroutine mult_rz_vec_cmplx(trans, l, a, tau, c, work, olwork, err)
                  +
                  4257 logical, intent(in) :: trans
                  +
                  4258 integer(int32), intent(in) :: l
                  +
                  4259 complex(real64), intent(inout), dimension(:,:) :: a
                  +
                  4260 complex(real64), intent(in), dimension(:) :: tau
                  +
                  4261 complex(real64), intent(inout), dimension(:) :: c
                  +
                  4262 complex(real64), intent(out), target, optional, dimension(:) :: work
                  +
                  4263 integer(int32), intent(out), optional :: olwork
                  +
                  4264 class(errors), intent(inout), optional, target :: err
                  +
                  4265 end subroutine
                  +
                  4266
                  +
                  4267 module subroutine svd_dbl(a, s, u, vt, work, olwork, err)
                  +
                  4268 real(real64), intent(inout), dimension(:,:) :: a
                  +
                  4269 real(real64), intent(out), dimension(:) :: s
                  +
                  4270 real(real64), intent(out), optional, dimension(:,:) :: u, vt
                  +
                  4271 real(real64), intent(out), target, optional, dimension(:) :: work
                  +
                  4272 integer(int32), intent(out), optional :: olwork
                  +
                  4273 class(errors), intent(inout), optional, target :: err
                  +
                  4274 end subroutine
                  +
                  4275
                  +
                  4276 module subroutine svd_cmplx(a, s, u, vt, work, olwork, rwork, err)
                  +
                  4277 complex(real64), intent(inout), dimension(:,:) :: a
                  +
                  4278 real(real64), intent(out), dimension(:) :: s
                  +
                  4279 complex(real64), intent(out), optional, dimension(:,:) :: u, vt
                  +
                  4280 complex(real64), intent(out), target, optional, dimension(:) :: work
                  +
                  4281 integer(int32), intent(out), optional :: olwork
                  +
                  4282 real(real64), intent(out), target, optional, dimension(:) :: rwork
                  +
                  4283 class(errors), intent(inout), optional, target :: err
                  +
                  4284 end subroutine
                  +
                  4285
                  +
                  4286 module subroutine lq_factor_no_pivot(a, tau, work, olwork, err)
                  +
                  4287 real(real64), intent(inout), dimension(:,:) :: a
                  +
                  4288 real(real64), intent(out), dimension(:) :: tau
                  +
                  4289 real(real64), intent(out), target, dimension(:), optional :: work
                  +
                  4290 integer(int32), intent(out), optional :: olwork
                  +
                  4291 class(errors), intent(inout), optional, target :: err
                  +
                  4292 end subroutine
                  +
                  4293
                  +
                  4294 module subroutine lq_factor_no_pivot_cmplx(a, tau, work, olwork, err)
                  +
                  4295 complex(real64), intent(inout), dimension(:,:) :: a
                  +
                  4296 complex(real64), intent(out), dimension(:) :: tau
                  +
                  4297 complex(real64), intent(out), target, dimension(:), optional :: work
                  +
                  4298 integer(int32), intent(out), optional :: olwork
                  +
                  4299 class(errors), intent(inout), optional, target :: err
                  +
                  4300 end subroutine
                  +
                  4301
                  +
                  4302 module subroutine form_lq_no_pivot(l, tau, q, work, olwork, err)
                  +
                  4303 real(real64), intent(inout), dimension(:,:) :: l
                  +
                  4304 real(real64), intent(in), dimension(:) :: tau
                  +
                  4305 real(real64), intent(out), dimension(:,:) :: q
                  +
                  4306 real(real64), intent(out), target, dimension(:), optional :: work
                  +
                  4307 integer(int32), intent(out), optional :: olwork
                  +
                  4308 class(errors), intent(inout), optional, target :: err
                  +
                  4309 end subroutine
                  +
                  4310
                  +
                  4311 module subroutine form_lq_no_pivot_cmplx(l, tau, q, work, olwork, err)
                  +
                  4312 complex(real64), intent(inout), dimension(:,:) :: l
                  +
                  4313 complex(real64), intent(in), dimension(:) :: tau
                  +
                  4314 complex(real64), intent(out), dimension(:,:) :: q
                  +
                  4315 complex(real64), intent(out), target, dimension(:), optional :: work
                  +
                  4316 integer(int32), intent(out), optional :: olwork
                  +
                  4317 class(errors), intent(inout), optional, target :: err
                  +
                  4318 end subroutine
                  +
                  4319
                  +
                  4320 module subroutine mult_lq_mtx(lside, trans, a, tau, c, work, olwork, err)
                  +
                  4321 logical, intent(in) :: lside, trans
                  +
                  4322 real(real64), intent(in), dimension(:,:) :: a
                  +
                  4323 real(real64), intent(in), dimension(:) :: tau
                  +
                  4324 real(real64), intent(inout), dimension(:,:) :: c
                  +
                  4325 real(real64), intent(out), target, dimension(:), optional :: work
                  +
                  4326 integer(int32), intent(out), optional :: olwork
                  +
                  4327 class(errors), intent(inout), optional, target :: err
                  +
                  4328 end subroutine
                  +
                  4329
                  +
                  4330 module subroutine mult_lq_mtx_cmplx(lside, trans, a, tau, c, work, olwork, err)
                  +
                  4331 logical, intent(in) :: lside, trans
                  +
                  4332 complex(real64), intent(in), dimension(:,:) :: a
                  +
                  4333 complex(real64), intent(in), dimension(:) :: tau
                  +
                  4334 complex(real64), intent(inout), dimension(:,:) :: c
                  +
                  4335 complex(real64), intent(out), target, dimension(:), optional :: work
                  +
                  4336 integer(int32), intent(out), optional :: olwork
                  +
                  4337 class(errors), intent(inout), optional, target :: err
                  +
                  4338 end subroutine
                  +
                  4339
                  +
                  4340 module subroutine mult_lq_vec(trans, a, tau, c, work, olwork, err)
                  +
                  4341 logical, intent(in) :: trans
                  +
                  4342 real(real64), intent(in), dimension(:,:) :: a
                  +
                  4343 real(real64), intent(in), dimension(:) :: tau
                  +
                  4344 real(real64), intent(inout), dimension(:) :: c
                  +
                  4345 real(real64), intent(out), target, dimension(:), optional :: work
                  +
                  4346 integer(int32), intent(out), optional :: olwork
                  +
                  4347 class(errors), intent(inout), optional, target :: err
                  +
                  4348 end subroutine
                  +
                  4349
                  +
                  4350 module subroutine mult_lq_vec_cmplx(trans, a, tau, c, work, olwork, err)
                  +
                  4351 logical, intent(in) :: trans
                  +
                  4352 complex(real64), intent(in), dimension(:,:) :: a
                  +
                  4353 complex(real64), intent(in), dimension(:) :: tau
                  +
                  4354 complex(real64), intent(inout), dimension(:) :: c
                  +
                  4355 complex(real64), intent(out), target, dimension(:), optional :: work
                  +
                  4356 integer(int32), intent(out), optional :: olwork
                  +
                  4357 class(errors), intent(inout), optional, target :: err
                  +
                  4358 end subroutine
                  +
                  4359end interface
                  +
                  4360
                  +
                  4361! ******************************************************************************
                  +
                  4362! LINALG_SOLVE.F90
                  +
                  4363! ------------------------------------------------------------------------------
                  +
                  4364interface
                  +
                  4365 module subroutine solve_tri_mtx(lside, upper, trans, nounit, alpha, a, b, err)
                  +
                  4366 logical, intent(in) :: lside, upper, trans, nounit
                  +
                  4367 real(real64), intent(in) :: alpha
                  +
                  4368 real(real64), intent(in), dimension(:,:) :: a
                  +
                  4369 real(real64), intent(inout), dimension(:,:) :: b
                  +
                  4370 class(errors), intent(inout), optional, target :: err
                  +
                  4371 end subroutine
                  +
                  4372
                  +
                  4373 module subroutine solve_tri_mtx_cmplx(lside, upper, trans, nounit, alpha, a, b, err)
                  +
                  4374 logical, intent(in) :: lside, upper, trans, nounit
                  +
                  4375 complex(real64), intent(in) :: alpha
                  +
                  4376 complex(real64), intent(in), dimension(:,:) :: a
                  +
                  4377 complex(real64), intent(inout), dimension(:,:) :: b
                  +
                  4378 class(errors), intent(inout), optional, target :: err
                  +
                  4379 end subroutine
                  +
                  4380
                  +
                  4381 module subroutine solve_tri_vec(upper, trans, nounit, a, x, err)
                  +
                  4382 logical, intent(in) :: upper, trans, nounit
                  +
                  4383 real(real64), intent(in), dimension(:,:) :: a
                  +
                  4384 real(real64), intent(inout), dimension(:) :: x
                  +
                  4385 class(errors), intent(inout), optional, target :: err
                  +
                  4386 end subroutine
                  +
                  4387
                  +
                  4388 module subroutine solve_tri_vec_cmplx(upper, trans, nounit, a, x, err)
                  +
                  4389 logical, intent(in) :: upper, trans, nounit
                  +
                  4390 complex(real64), intent(in), dimension(:,:) :: a
                  +
                  4391 complex(real64), intent(inout), dimension(:) :: x
                  +
                  4392 class(errors), intent(inout), optional, target :: err
                  +
                  4393 end subroutine
                  +
                  4394
                  +
                  4395 module subroutine solve_lu_mtx(a, ipvt, b, err)
                  +
                  4396 real(real64), intent(in), dimension(:,:) :: a
                  +
                  4397 integer(int32), intent(in), dimension(:) :: ipvt
                  +
                  4398 real(real64), intent(inout), dimension(:,:) :: b
                  +
                  4399 class(errors), intent(inout), optional, target :: err
                  +
                  4400 end subroutine
                  +
                  4401
                  +
                  4402 module subroutine solve_lu_mtx_cmplx(a, ipvt, b, err)
                  +
                  4403 complex(real64), intent(in), dimension(:,:) :: a
                  +
                  4404 integer(int32), intent(in), dimension(:) :: ipvt
                  +
                  4405 complex(real64), intent(inout), dimension(:,:) :: b
                  +
                  4406 class(errors), intent(inout), optional, target :: err
                  +
                  4407 end subroutine
                  +
                  4408
                  +
                  4409 module subroutine solve_lu_vec(a, ipvt, b, err)
                  +
                  4410 real(real64), intent(in), dimension(:,:) :: a
                  +
                  4411 integer(int32), intent(in), dimension(:) :: ipvt
                  +
                  4412 real(real64), intent(inout), dimension(:) :: b
                  +
                  4413 class(errors), intent(inout), optional, target :: err
                  +
                  4414 end subroutine
                  +
                  4415
                  +
                  4416 module subroutine solve_lu_vec_cmplx(a, ipvt, b, err)
                  +
                  4417 complex(real64), intent(in), dimension(:,:) :: a
                  +
                  4418 integer(int32), intent(in), dimension(:) :: ipvt
                  +
                  4419 complex(real64), intent(inout), dimension(:) :: b
                  +
                  4420 class(errors), intent(inout), optional, target :: err
                  +
                  4421 end subroutine
                  +
                  4422
                  +
                  4423 module subroutine solve_qr_no_pivot_mtx(a, tau, b, work, olwork, err)
                  +
                  4424 real(real64), intent(inout), dimension(:,:) :: a, b
                  +
                  4425 real(real64), intent(in), dimension(:) :: tau
                  +
                  4426 real(real64), intent(out), target, optional, dimension(:) :: work
                  +
                  4427 integer(int32), intent(out), optional :: olwork
                  +
                  4428 class(errors), intent(inout), optional, target :: err
                  +
                  4429 end subroutine
                  +
                  4430
                  +
                  4431 module subroutine solve_qr_no_pivot_mtx_cmplx(a, tau, b, work, olwork, err)
                  +
                  4432 complex(real64), intent(inout), dimension(:,:) :: a, b
                  +
                  4433 complex(real64), intent(in), dimension(:) :: tau
                  +
                  4434 complex(real64), intent(out), target, optional, dimension(:) :: work
                  +
                  4435 integer(int32), intent(out), optional :: olwork
                  +
                  4436 class(errors), intent(inout), optional, target :: err
                  +
                  4437 end subroutine
                  +
                  4438
                  +
                  4439 module subroutine solve_qr_no_pivot_vec(a, tau, b, work, olwork, err)
                  +
                  4440 real(real64), intent(inout), dimension(:,:) :: a
                  +
                  4441 real(real64), intent(in), dimension(:) :: tau
                  +
                  4442 real(real64), intent(inout), dimension(:) :: b
                  +
                  4443 real(real64), intent(out), target, optional, dimension(:) :: work
                  +
                  4444 integer(int32), intent(out), optional :: olwork
                  +
                  4445 class(errors), intent(inout), optional, target :: err
                  +
                  4446 end subroutine
                  +
                  4447
                  +
                  4448 module subroutine solve_qr_no_pivot_vec_cmplx(a, tau, b, work, olwork, err)
                  +
                  4449 complex(real64), intent(inout), dimension(:,:) :: a
                  +
                  4450 complex(real64), intent(in), dimension(:) :: tau
                  +
                  4451 complex(real64), intent(inout), dimension(:) :: b
                  +
                  4452 complex(real64), intent(out), target, optional, dimension(:) :: work
                  +
                  4453 integer(int32), intent(out), optional :: olwork
                  +
                  4454 class(errors), intent(inout), optional, target :: err
                  +
                  4455 end subroutine
                  +
                  4456
                  +
                  4457 module subroutine solve_qr_pivot_mtx(a, tau, jpvt, b, work, olwork, err)
                  +
                  4458 real(real64), intent(inout), dimension(:,:) :: a
                  +
                  4459 real(real64), intent(in), dimension(:) :: tau
                  +
                  4460 integer(int32), intent(in), dimension(:) :: jpvt
                  +
                  4461 real(real64), intent(inout), dimension(:,:) :: b
                  +
                  4462 real(real64), intent(out), target, optional, dimension(:) :: work
                  +
                  4463 integer(int32), intent(out), optional :: olwork
                  +
                  4464 class(errors), intent(inout), optional, target :: err
                  +
                  4465 end subroutine
                  +
                  4466
                  +
                  4467 module subroutine solve_qr_pivot_mtx_cmplx(a, tau, jpvt, b, work, olwork, err)
                  +
                  4468 complex(real64), intent(inout), dimension(:,:) :: a
                  +
                  4469 complex(real64), intent(in), dimension(:) :: tau
                  +
                  4470 integer(int32), intent(in), dimension(:) :: jpvt
                  +
                  4471 complex(real64), intent(inout), dimension(:,:) :: b
                  +
                  4472 complex(real64), intent(out), target, optional, dimension(:) :: work
                  +
                  4473 integer(int32), intent(out), optional :: olwork
                  +
                  4474 class(errors), intent(inout), optional, target :: err
                  +
                  4475 end subroutine
                  +
                  4476
                  +
                  4477 module subroutine solve_qr_pivot_vec(a, tau, jpvt, b, work, olwork, err)
                  +
                  4478 real(real64), intent(inout), dimension(:,:) :: a
                  +
                  4479 real(real64), intent(in), dimension(:) :: tau
                  +
                  4480 integer(int32), intent(in), dimension(:) :: jpvt
                  +
                  4481 real(real64), intent(inout), dimension(:) :: b
                  +
                  4482 real(real64), intent(out), target, optional, dimension(:) :: work
                  +
                  4483 integer(int32), intent(out), optional :: olwork
                  +
                  4484 class(errors), intent(inout), optional, target :: err
                  +
                  4485 end subroutine
                  +
                  4486
                  +
                  4487 module subroutine solve_qr_pivot_vec_cmplx(a, tau, jpvt, b, work, olwork, err)
                  +
                  4488 complex(real64), intent(inout), dimension(:,:) :: a
                  +
                  4489 complex(real64), intent(in), dimension(:) :: tau
                  +
                  4490 integer(int32), intent(in), dimension(:) :: jpvt
                  +
                  4491 complex(real64), intent(inout), dimension(:) :: b
                  +
                  4492 complex(real64), intent(out), target, optional, dimension(:) :: work
                  +
                  4493 integer(int32), intent(out), optional :: olwork
                  +
                  4494 class(errors), intent(inout), optional, target :: err
                  +
                  4495 end subroutine
                  +
                  4496
                  +
                  4497 module subroutine solve_cholesky_mtx(upper, a, b, err)
                  +
                  4498 logical, intent(in) :: upper
                  +
                  4499 real(real64), intent(in), dimension(:,:) :: a
                  +
                  4500 real(real64), intent(inout), dimension(:,:) :: b
                  +
                  4501 class(errors), intent(inout), optional, target :: err
                  +
                  4502 end subroutine
                  +
                  4503
                  +
                  4504 module subroutine solve_cholesky_mtx_cmplx(upper, a, b, err)
                  +
                  4505 logical, intent(in) :: upper
                  +
                  4506 complex(real64), intent(in), dimension(:,:) :: a
                  +
                  4507 complex(real64), intent(inout), dimension(:,:) :: b
                  +
                  4508 class(errors), intent(inout), optional, target :: err
                  +
                  4509 end subroutine
                  +
                  4510
                  +
                  4511 module subroutine solve_cholesky_vec(upper, a, b, err)
                  +
                  4512 logical, intent(in) :: upper
                  +
                  4513 real(real64), intent(in), dimension(:,:) :: a
                  +
                  4514 real(real64), intent(inout), dimension(:) :: b
                  +
                  4515 class(errors), intent(inout), optional, target :: err
                  +
                  4516 end subroutine
                  +
                  4517
                  +
                  4518 module subroutine solve_cholesky_vec_cmplx(upper, a, b, err)
                  +
                  4519 logical, intent(in) :: upper
                  +
                  4520 complex(real64), intent(in), dimension(:,:) :: a
                  +
                  4521 complex(real64), intent(inout), dimension(:) :: b
                  +
                  4522 class(errors), intent(inout), optional, target :: err
                  +
                  4523 end subroutine
                  +
                  4524
                  +
                  4525 module subroutine solve_least_squares_mtx(a, b, work, olwork, err)
                  +
                  4526 real(real64), intent(inout), dimension(:,:) :: a, b
                  +
                  4527 real(real64), intent(out), target, optional, dimension(:) :: work
                  +
                  4528 integer(int32), intent(out), optional :: olwork
                  +
                  4529 class(errors), intent(inout), optional, target :: err
                  +
                  4530 end subroutine
                  +
                  4531
                  +
                  4532 module subroutine solve_least_squares_mtx_cmplx(a, b, work, olwork, err)
                  +
                  4533 complex(real64), intent(inout), dimension(:,:) :: a, b
                  +
                  4534 complex(real64), intent(out), target, optional, dimension(:) :: work
                  +
                  4535 integer(int32), intent(out), optional :: olwork
                  +
                  4536 class(errors), intent(inout), optional, target :: err
                  +
                  4537 end subroutine
                  +
                  4538
                  +
                  4539 module subroutine solve_least_squares_vec(a, b, work, olwork, err)
                  +
                  4540 real(real64), intent(inout), dimension(:,:) :: a
                  +
                  4541 real(real64), intent(inout), dimension(:) :: b
                  +
                  4542 real(real64), intent(out), target, optional, dimension(:) :: work
                  +
                  4543 integer(int32), intent(out), optional :: olwork
                  +
                  4544 class(errors), intent(inout), optional, target :: err
                  +
                  4545 end subroutine
                  +
                  4546
                  +
                  4547 module subroutine solve_least_squares_vec_cmplx(a, b, work, olwork, err)
                  +
                  4548 complex(real64), intent(inout), dimension(:,:) :: a
                  +
                  4549 complex(real64), intent(inout), dimension(:) :: b
                  +
                  4550 complex(real64), intent(out), target, optional, dimension(:) :: work
                  +
                  4551 integer(int32), intent(out), optional :: olwork
                  +
                  4552 class(errors), intent(inout), optional, target :: err
                  +
                  4553 end subroutine
                  +
                  4554
                  +
                  4555 module subroutine solve_least_squares_mtx_pvt(a, b, ipvt, arnk, work, olwork, err)
                  +
                  4556 real(real64), intent(inout), dimension(:,:) :: a, b
                  +
                  4557 integer(int32), intent(inout), target, optional, dimension(:) :: ipvt
                  +
                  4558 integer(int32), intent(out), optional :: arnk
                  +
                  4559 real(real64), intent(out), target, optional, dimension(:) :: work
                  +
                  4560 integer(int32), intent(out), optional :: olwork
                  +
                  4561 class(errors), intent(inout), optional, target :: err
                  +
                  4562 end subroutine
                  +
                  4563
                  +
                  4564 module subroutine solve_least_squares_mtx_pvt_cmplx(a, b, ipvt, arnk, &
                  +
                  4565 work, olwork, rwork, err)
                  +
                  4566 complex(real64), intent(inout), dimension(:,:) :: a, b
                  +
                  4567 integer(int32), intent(inout), target, optional, dimension(:) :: ipvt
                  +
                  4568 integer(int32), intent(out), optional :: arnk
                  +
                  4569 complex(real64), intent(out), target, optional, dimension(:) :: work
                  +
                  4570 integer(int32), intent(out), optional :: olwork
                  +
                  4571 real(real64), intent(out), target, optional, dimension(:) :: rwork
                  +
                  4572 class(errors), intent(inout), optional, target :: err
                  +
                  4573 end subroutine
                  +
                  4574
                  +
                  4575 module subroutine solve_least_squares_vec_pvt(a, b, ipvt, arnk, work, olwork, err)
                  +
                  4576 real(real64), intent(inout), dimension(:,:) :: a
                  +
                  4577 real(real64), intent(inout), dimension(:) :: b
                  +
                  4578 integer(int32), intent(inout), target, optional, dimension(:) :: ipvt
                  +
                  4579 integer(int32), intent(out), optional :: arnk
                  +
                  4580 real(real64), intent(out), target, optional, dimension(:) :: work
                  +
                  4581 integer(int32), intent(out), optional :: olwork
                  +
                  4582 class(errors), intent(inout), optional, target :: err
                  +
                  4583 end subroutine
                  +
                  4584
                  +
                  4585 module subroutine solve_least_squares_vec_pvt_cmplx(a, b, ipvt, arnk, &
                  +
                  4586 work, olwork, rwork, err)
                  +
                  4587 complex(real64), intent(inout), dimension(:,:) :: a
                  +
                  4588 complex(real64), intent(inout), dimension(:) :: b
                  +
                  4589 integer(int32), intent(inout), target, optional, dimension(:) :: ipvt
                  +
                  4590 integer(int32), intent(out), optional :: arnk
                  +
                  4591 complex(real64), intent(out), target, optional, dimension(:) :: work
                  +
                  4592 integer(int32), intent(out), optional :: olwork
                  +
                  4593 real(real64), intent(out), target, optional, dimension(:) :: rwork
                  +
                  4594 class(errors), intent(inout), optional, target :: err
                  +
                  4595 end subroutine
                  +
                  4596
                  +
                  4597 module subroutine solve_least_squares_mtx_svd(a, b, s, arnk, work, olwork, err)
                  +
                  4598 real(real64), intent(inout), dimension(:,:) :: a, b
                  +
                  4599 integer(int32), intent(out), optional :: arnk
                  +
                  4600 real(real64), intent(out), target, optional, dimension(:) :: work, s
                  +
                  4601 integer(int32), intent(out), optional :: olwork
                  +
                  4602 class(errors), intent(inout), optional, target :: err
                  +
                  4603 end subroutine
                  +
                  4604
                  +
                  4605 module subroutine solve_least_squares_mtx_svd_cmplx(a, b, s, arnk, work, &
                  +
                  4606 olwork, rwork, err)
                  +
                  4607 complex(real64), intent(inout), dimension(:,:) :: a, b
                  +
                  4608 integer(int32), intent(out), optional :: arnk
                  +
                  4609 complex(real64), intent(out), target, optional, dimension(:) :: work
                  +
                  4610 real(real64), intent(out), target, optional, dimension(:) :: rwork, s
                  +
                  4611 integer(int32), intent(out), optional :: olwork
                  +
                  4612 class(errors), intent(inout), optional, target :: err
                  +
                  4613 end subroutine
                  +
                  4614
                  +
                  4615 module subroutine solve_least_squares_vec_svd(a, b, s, arnk, work, olwork, err)
                  +
                  4616 real(real64), intent(inout), dimension(:,:) :: a
                  +
                  4617 real(real64), intent(inout), dimension(:) :: b
                  +
                  4618 integer(int32), intent(out), optional :: arnk
                  +
                  4619 real(real64), intent(out), target, optional, dimension(:) :: work, s
                  +
                  4620 integer(int32), intent(out), optional :: olwork
                  +
                  4621 class(errors), intent(inout), optional, target :: err
                  +
                  4622 end subroutine
                  +
                  4623
                  +
                  4624 module subroutine solve_least_squares_vec_svd_cmplx(a, b, s, arnk, work, &
                  +
                  4625 olwork, rwork, err)
                  +
                  4626 complex(real64), intent(inout), dimension(:,:) :: a
                  +
                  4627 complex(real64), intent(inout), dimension(:) :: b
                  +
                  4628 integer(int32), intent(out), optional :: arnk
                  +
                  4629 complex(real64), intent(out), target, optional, dimension(:) :: work
                  +
                  4630 real(real64), intent(out), target, optional, dimension(:) :: rwork, s
                  +
                  4631 integer(int32), intent(out), optional :: olwork
                  +
                  4632 class(errors), intent(inout), optional, target :: err
                  +
                  4633 end subroutine
                  +
                  4634
                  +
                  4635 module subroutine mtx_inverse_dbl(a, iwork, work, olwork, err)
                  +
                  4636 real(real64), intent(inout), dimension(:,:) :: a
                  +
                  4637 integer(int32), intent(out), target, optional, dimension(:) :: iwork
                  +
                  4638 real(real64), intent(out), target, optional, dimension(:) :: work
                  +
                  4639 integer(int32), intent(out), optional :: olwork
                  +
                  4640 class(errors), intent(inout), optional, target :: err
                  +
                  4641 end subroutine
                  +
                  4642
                  +
                  4643 module subroutine mtx_inverse_cmplx(a, iwork, work, olwork, err)
                  +
                  4644 complex(real64), intent(inout), dimension(:,:) :: a
                  +
                  4645 integer(int32), intent(out), target, optional, dimension(:) :: iwork
                  +
                  4646 complex(real64), intent(out), target, optional, dimension(:) :: work
                  +
                  4647 integer(int32), intent(out), optional :: olwork
                  +
                  4648 class(errors), intent(inout), optional, target :: err
                  +
                  4649 end subroutine
                  +
                  4650
                  +
                  4651 module subroutine mtx_pinverse_dbl(a, ainv, tol, work, olwork, err)
                  +
                  4652 real(real64), intent(inout), dimension(:,:) :: a
                  +
                  4653 real(real64), intent(out), dimension(:,:) :: ainv
                  +
                  4654 real(real64), intent(in), optional :: tol
                  +
                  4655 real(real64), intent(out), target, dimension(:), optional :: work
                  +
                  4656 integer(int32), intent(out), optional :: olwork
                  +
                  4657 class(errors), intent(inout), optional, target :: err
                  +
                  4658 end subroutine
                  +
                  4659
                  +
                  4660 module subroutine mtx_pinverse_cmplx(a, ainv, tol, work, olwork, rwork, err)
                  +
                  4661 complex(real64), intent(inout), dimension(:,:) :: a
                  +
                  4662 complex(real64), intent(out), dimension(:,:) :: ainv
                  +
                  4663 real(real64), intent(in), optional :: tol
                  +
                  4664 complex(real64), intent(out), target, dimension(:), optional :: work
                  +
                  4665 integer(int32), intent(out), optional :: olwork
                  +
                  4666 real(real64), intent(out), target, dimension(:), optional :: rwork
                  +
                  4667 class(errors), intent(inout), optional, target :: err
                  +
                  4668 end subroutine
                  +
                  4669
                  +
                  4670 module subroutine solve_lq_mtx(a, tau, b, work, olwork, err)
                  +
                  4671 real(real64), intent(in), dimension(:,:) :: a
                  +
                  4672 real(real64), intent(in), dimension(:) :: tau
                  +
                  4673 real(real64), intent(inout), dimension(:,:) :: b
                  +
                  4674 real(real64), intent(out), target, optional, dimension(:) :: work
                  +
                  4675 integer(int32), intent(out), optional :: olwork
                  +
                  4676 class(errors), intent(inout), optional, target :: err
                  +
                  4677 end subroutine
                  +
                  4678
                  +
                  4679 module subroutine solve_lq_mtx_cmplx(a, tau, b, work, olwork, err)
                  +
                  4680 complex(real64), intent(in), dimension(:,:) :: a
                  +
                  4681 complex(real64), intent(in), dimension(:) :: tau
                  +
                  4682 complex(real64), intent(inout), dimension(:,:) :: b
                  +
                  4683 complex(real64), intent(out), target, optional, dimension(:) :: work
                  +
                  4684 integer(int32), intent(out), optional :: olwork
                  +
                  4685 class(errors), intent(inout), optional, target :: err
                  +
                  4686 end subroutine
                  +
                  4687
                  +
                  4688 module subroutine solve_lq_vec(a, tau, b, work, olwork, err)
                  +
                  4689 real(real64), intent(in), dimension(:,:) :: a
                  +
                  4690 real(real64), intent(in), dimension(:) :: tau
                  +
                  4691 real(real64), intent(inout), dimension(:) :: b
                  +
                  4692 real(real64), intent(out), target, optional, dimension(:) :: work
                  +
                  4693 integer(int32), intent(out), optional :: olwork
                  +
                  4694 class(errors), intent(inout), optional, target :: err
                  +
                  4695 end subroutine
                  +
                  4696
                  +
                  4697 module subroutine solve_lq_vec_cmplx(a, tau, b, work, olwork, err)
                  +
                  4698 complex(real64), intent(in), dimension(:,:) :: a
                  +
                  4699 complex(real64), intent(in), dimension(:) :: tau
                  +
                  4700 complex(real64), intent(inout), dimension(:) :: b
                  +
                  4701 complex(real64), intent(out), target, optional, dimension(:) :: work
                  +
                  4702 integer(int32), intent(out), optional :: olwork
                  +
                  4703 class(errors), intent(inout), optional, target :: err
                  +
                  4704 end subroutine
                  +
                  4705end interface
                  +
                  4706
                  +
                  4707! ******************************************************************************
                  +
                  4708! LINALG_EIGEN.F90
                  +
                  4709! ------------------------------------------------------------------------------
                  +
                  4710interface
                  +
                  4711 module subroutine eigen_symm(vecs, a, vals, work, olwork, err)
                  +
                  4712 logical, intent(in) :: vecs
                  +
                  4713 real(real64), intent(inout), dimension(:,:) :: a
                  +
                  4714 real(real64), intent(out), dimension(:) :: vals
                  +
                  4715 real(real64), intent(out), pointer, optional, dimension(:) :: work
                  +
                  4716 integer(int32), intent(out), optional :: olwork
                  +
                  4717 class(errors), intent(inout), optional, target :: err
                  +
                  4718 end subroutine
                  +
                  4719
                  +
                  4720 module subroutine eigen_asymm(a, vals, vecs, work, olwork, err)
                  +
                  4721 real(real64), intent(inout), dimension(:,:) :: a
                  +
                  4722 complex(real64), intent(out), dimension(:) :: vals
                  +
                  4723 complex(real64), intent(out), optional, dimension(:,:) :: vecs
                  +
                  4724 real(real64), intent(out), pointer, optional, dimension(:) :: work
                  +
                  4725 integer(int32), intent(out), optional :: olwork
                  +
                  4726 class(errors), intent(inout), optional, target :: err
                  +
                  4727 end subroutine
                  +
                  4728
                  +
                  4729 module subroutine eigen_gen(a, b, alpha, beta, vecs, work, olwork, err)
                  +
                  4730 real(real64), intent(inout), dimension(:,:) :: a, b
                  +
                  4731 complex(real64), intent(out), dimension(:) :: alpha
                  +
                  4732 real(real64), intent(out), optional, dimension(:) :: beta
                  +
                  4733 complex(real64), intent(out), optional, dimension(:,:) :: vecs
                  +
                  4734 real(real64), intent(out), optional, pointer, dimension(:) :: work
                  +
                  4735 integer(int32), intent(out), optional :: olwork
                  +
                  4736 class(errors), intent(inout), optional, target :: err
                  +
                  4737 end subroutine
                  +
                  4738
                  +
                  4739 module subroutine eigen_cmplx(a, vals, vecs, work, olwork, rwork, err)
                  +
                  4740 complex(real64), intent(inout), dimension(:,:) :: a
                  +
                  4741 complex(real64), intent(out), dimension(:) :: vals
                  +
                  4742 complex(real64), intent(out), optional, dimension(:,:) :: vecs
                  +
                  4743 complex(real64), intent(out), target, optional, dimension(:) :: work
                  +
                  4744 real(real64), intent(out), target, optional, dimension(:) :: rwork
                  +
                  4745 integer(int32), intent(out), optional :: olwork
                  +
                  4746 class(errors), intent(inout), optional, target :: err
                  +
                  4747 end subroutine
                  +
                  4748end interface
                  +
                  4749
                  +
                  4750! ******************************************************************************
                  +
                  4751! LINALG_SORTING.F90
                  +
                  4752! ------------------------------------------------------------------------------
                  +
                  4753interface
                  +
                  4754 module subroutine sort_dbl_array(x, ascend)
                  +
                  4755 real(real64), intent(inout), dimension(:) :: x
                  +
                  4756 logical, intent(in), optional :: ascend
                  +
                  4757 end subroutine
                  +
                  4758
                  +
                  4759 module subroutine sort_dbl_array_ind(x, ind, ascend, err)
                  +
                  4760 real(real64), intent(inout), dimension(:) :: x
                  +
                  4761 integer(int32), intent(inout), dimension(:) :: ind
                  +
                  4762 logical, intent(in), optional :: ascend
                  +
                  4763 class(errors), intent(inout), optional, target :: err
                  +
                  4764 end subroutine
                  +
                  4765
                  +
                  4766 module subroutine sort_cmplx_array(x, ascend)
                  +
                  4767 complex(real64), intent(inout), dimension(:) :: x
                  +
                  4768 logical, intent(in), optional :: ascend
                  +
                  4769 end subroutine
                  +
                  4770
                  +
                  4771 module subroutine sort_cmplx_array_ind(x, ind, ascend, err)
                  +
                  4772 complex(real64), intent(inout), dimension(:) :: x
                  +
                  4773 integer(int32), intent(inout), dimension(:) :: ind
                  +
                  4774 logical, intent(in), optional :: ascend
                  +
                  4775 class(errors), intent(inout), optional, target :: err
                  +
                  4776 end subroutine
                  +
                  4777
                  +
                  4778 module subroutine sort_eigen_cmplx(vals, vecs, ascend, err)
                  +
                  4779 complex(real64), intent(inout), dimension(:) :: vals
                  +
                  4780 complex(real64), intent(inout), dimension(:,:) :: vecs
                  +
                  4781 logical, intent(in), optional :: ascend
                  +
                  4782 class(errors), intent(inout), optional, target :: err
                  +
                  4783 end subroutine
                  +
                  4784
                  +
                  4785 module subroutine sort_eigen_dbl(vals, vecs, ascend, err)
                  +
                  4786 real(real64), intent(inout), dimension(:) :: vals
                  +
                  4787 real(real64), intent(inout), dimension(:,:) :: vecs
                  +
                  4788 logical, intent(in), optional :: ascend
                  +
                  4789 class(errors), intent(inout), optional, target :: err
                  +
                  4790 end subroutine
                  +
                  4791
                  +
                  4792end interface
                  4793
                  -
                  4794end interface
                  -
                  4795
                  -
                  4796end module
                  +
                  4794end module
                  Computes the Cholesky factorization of a symmetric, positive definite matrix.
                  Definition: linalg.f90:1571
                  Computes the rank 1 downdate to a Cholesky factored matrix (upper triangular).
                  Definition: linalg.f90:1777
                  Computes the rank 1 update to a Cholesky factored matrix (upper triangular).
                  Definition: linalg.f90:1670
                  Computes the determinant of a square matrix.
                  Definition: linalg.f90:568
                  Multiplies a diagonal matrix with another matrix or array.
                  Definition: linalg.f90:463
                  Computes the eigenvalues, and optionally the eigenvectors, of a matrix.
                  Definition: linalg.f90:3237
                  -
                  Forms the matrix Q with orthonormal rows from the elementary reflectors returned by the LQ factorizat...
                  Definition: linalg.f90:3548
                  +
                  Forms the orthogonal matrix Q from the elementary reflectors returned by the LQ factorization algorit...
                  Definition: linalg.f90:3548
                  Extracts the L and U matrices from the condensed [L\U] storage format used by the lu_factor.
                  Definition: linalg.f90:851
                  Forms the full M-by-M orthogonal matrix Q from the elementary reflectors returned by the base QR fact...
                  Definition: linalg.f90:1165
                  Computes the LQ factorization of an M-by-N matrix.
                  Definition: linalg.f90:3434
                  @@ -1444,7 +1444,7 @@
                  Performs the matrix operation: .
                  Definition: linalg.f90:293
                  Computes the Moore-Penrose pseudo-inverse of a M-by-N matrix using the singular value decomposition o...
                  Definition: linalg.f90:3023
                  Computes the rank of a matrix.
                  Definition: linalg.f90:535
                  -
                  Multiplies a general matrix by the orthogonal matrix Q from a LQ factorization.
                  Definition: linalg.f90:3699
                  +
                  Multiplies a general matrix by the orthogonal matrix Q from a LQ factorization.
                  Definition: linalg.f90:3697
                  Multiplies a general matrix by the orthogonal matrix Q from a QR factorization.
                  Definition: linalg.f90:1322
                  Multiplies a general matrix by the orthogonal matrix Z from an RZ factorization.
                  Definition: linalg.f90:1941
                  Computes the QR factorization of an M-by-N matrix.
                  Definition: linalg.f90:1005
                  @@ -1456,7 +1456,7 @@
                  Solves the overdetermined or underdetermined system of M equations of N unknowns,...
                  Definition: linalg.f90:2720
                  Solves the overdetermined or underdetermined system of M equations of N unknowns using a singular va...
                  Definition: linalg.f90:2822
                  Solves the overdetermined or underdetermined system of M equations of N unknowns....
                  Definition: linalg.f90:2619
                  -
                  Solves a system of M LQ-factored equations of N unknowns. N must be greater than or equal to M.
                  Definition: linalg.f90:3794
                  +
                  Solves a system of M LQ-factored equations of N unknowns. N must be greater than or equal to M.
                  Definition: linalg.f90:3792
                  Solves a system of LU-factored equations.
                  Definition: linalg.f90:2288
                  Solves a system of M QR-factored equations of N unknowns.
                  Definition: linalg.f90:2423
                  Solves a triangular system of equations.
                  Definition: linalg.f90:2200
                  diff --git a/doc/html/linalg_8h.html b/doc/html/linalg_8h.html index ec5f4df2..6e75bcfd 100644 --- a/doc/html/linalg_8h.html +++ b/doc/html/linalg_8h.html @@ -2942,7 +2942,7 @@

                  m

                  - + @@ -3040,7 +3040,7 @@

                  m

                  - + diff --git a/doc/html/linalg_8h_source.html b/doc/html/linalg_8h_source.html index 8571d88e..79ace52f 100644 --- a/doc/html/linalg_8h_source.html +++ b/doc/html/linalg_8h_source.html @@ -310,23 +310,23 @@
                  1835int la_form_lq_cmplx(int m, int n, double complex *l, int ldl,
                  1836 const double complex *tau, double complex *q, int ldq);
                  1837
                  -
                  1867int la_mult_lq(bool lside, bool trans, int m, int n, int k, const double *a,
                  -
                  1868 int lda, const double *tau, double *c, int ldc);
                  -
                  1869
                  -
                  1899int la_mult_lq_cmplx(bool lside, bool trans, int m, int n, int k,
                  -
                  1900 const double complex *a, int lda, const double complex *tau,
                  -
                  1901 double complex *c, int ldc);
                  -
                  1902
                  -
                  1926int la_solve_lq(int m, int n, int k, const double *a, int lda,
                  -
                  1927 const double *tau, double *b, int ldb);
                  -
                  1928
                  -
                  1952int la_solve_lq_cmplx(int m, int n, int k, const double complex *a, int lda,
                  -
                  1953 const double complex *tau, double complex *b, int ldb);
                  -
                  1954
                  -
                  1955#ifdef __cplusplus
                  -
                  1956}
                  -
                  1957#endif // __cplusplus
                  -
                  1958#endif // LINALG_H_DEFINED
                  +
                  1865int la_mult_lq(bool lside, bool trans, int m, int n, int k, const double *a,
                  +
                  1866 int lda, const double *tau, double *c, int ldc);
                  +
                  1867
                  +
                  1895int la_mult_lq_cmplx(bool lside, bool trans, int m, int n, int k,
                  +
                  1896 const double complex *a, int lda, const double complex *tau,
                  +
                  1897 double complex *c, int ldc);
                  +
                  1898
                  +
                  1922int la_solve_lq(int m, int n, int k, const double *a, int lda,
                  +
                  1923 const double *tau, double *b, int ldb);
                  +
                  1924
                  +
                  1948int la_solve_lq_cmplx(int m, int n, int k, const double complex *a, int lda,
                  +
                  1949 const double complex *tau, double complex *b, int ldb);
                  +
                  1950
                  +
                  1951#ifdef __cplusplus
                  +
                  1952}
                  +
                  1953#endif // __cplusplus
                  +
                  1954#endif // LINALG_H_DEFINED
                  int la_cholesky_rank1_downdate_cmplx(int n, double complex *r, int ldr, double complex *u)
                  int la_trace_cmplx(int m, int n, const double complex *a, int lda, double complex *rst)
                  int la_tri_mtx_mult_cmplx(bool upper, double complex alpha, int n, const double complex *a, int lda, double complex beta, double complex *b, int ldb)
                  diff --git a/doc/html/linalg__factor_8f90_source.html b/doc/html/linalg__factor_8f90_source.html index efc93441..e09321fc 100644 --- a/doc/html/linalg__factor_8f90_source.html +++ b/doc/html/linalg__factor_8f90_source.html @@ -3126,536 +3126,535 @@
                  3028 m = size(l, 1)
                  3029 n = size(l, 2)
                  3030 mn = min(m, n)
                  -
                  3031 qcol = size(q, 2)
                  -
                  3032 if (present(err)) then
                  -
                  3033 errmgr => err
                  -
                  3034 else
                  -
                  3035 errmgr => deferr
                  -
                  3036 end if
                  -
                  3037
                  -
                  3038 ! Input Check
                  -
                  3039 flag = 0
                  -
                  3040 if (m > n) then
                  -
                  3041 flag = 1
                  -
                  3042 else if (size(tau) /= mn) then
                  -
                  3043 flag = 2
                  -
                  3044 else if (size(q, 1) /= m .or. size(q, 2) /= n) then
                  -
                  3045 flag = 3
                  -
                  3046 end if
                  -
                  3047 if (flag /= 0) then
                  -
                  3048 ! ERROR: One of the input arrays is not sized correctly
                  -
                  3049 write(errmsg, 100) "Input number ", flag, &
                  -
                  3050 " is not sized correctly."
                  -
                  3051 call errmgr%report_error("form_lq_no_pivot", trim(errmsg), &
                  -
                  3052 la_array_size_error)
                  -
                  3053 return
                  -
                  3054 end if
                  -
                  3055
                  -
                  3056 ! Workspace Query
                  -
                  3057 call dorglq(m, n, mn, q, m, tau, temp, -1, flag)
                  -
                  3058 lwork = int(temp(1), int32)
                  -
                  3059 if (present(olwork)) then
                  -
                  3060 olwork = lwork
                  -
                  3061 return
                  -
                  3062 end if
                  -
                  3063
                  -
                  3064 ! Local Memory Allocation
                  -
                  3065 if (present(work)) then
                  -
                  3066 if (size(work) < lwork) then
                  -
                  3067 ! ERROR: WORK not sized correctly
                  -
                  3068 call errmgr%report_error("form_lq_no_pivot", &
                  -
                  3069 "Incorrectly sized input array WORK, argument 4.", &
                  -
                  3070 la_array_size_error)
                  -
                  3071 return
                  -
                  3072 end if
                  -
                  3073 wptr => work(1:lwork)
                  -
                  3074 else
                  -
                  3075 allocate(wrk(lwork), stat = istat)
                  -
                  3076 if (istat /= 0) then
                  -
                  3077 ! ERROR: Out of memory
                  -
                  3078 call errmgr%report_error("form_lq_no_pivot", &
                  -
                  3079 "Insufficient memory available.", &
                  -
                  3080 la_out_of_memory_error)
                  -
                  3081 return
                  -
                  3082 end if
                  -
                  3083 wptr => wrk
                  -
                  3084 end if
                  -
                  3085
                  -
                  3086 ! Copy the upper triangular portion of L to Q, and then zero it out in L
                  -
                  3087 do j = 2, n
                  -
                  3088 k = min(j - 1, m)
                  -
                  3089 q(1:j-1,j) = l(1:k,j)
                  -
                  3090 l(1:k,j) = zero
                  -
                  3091 end do
                  -
                  3092
                  -
                  3093 ! Build Q
                  -
                  3094 call dorglq(m, n, mn, q, m, tau, wptr, lwork, flag)
                  -
                  3095
                  -
                  3096 ! Formatting
                  -
                  3097100 format(a, i0, a)
                  -
                  3098 end subroutine
                  -
                  3099
                  -
                  3100! ------------------------------------------------------------------------------
                  -
                  3101 module subroutine form_lq_no_pivot_cmplx(l, tau, q, work, olwork, err)
                  -
                  3102 ! Arguments
                  -
                  3103 complex(real64), intent(inout), dimension(:,:) :: l
                  -
                  3104 complex(real64), intent(in), dimension(:) :: tau
                  -
                  3105 complex(real64), intent(out), dimension(:,:) :: q
                  -
                  3106 complex(real64), intent(out), target, dimension(:), optional :: work
                  -
                  3107 integer(int32), intent(out), optional :: olwork
                  -
                  3108 class(errors), intent(inout), optional, target :: err
                  -
                  3109
                  -
                  3110 ! Parameters
                  -
                  3111 complex(real64), parameter :: zero = (0.0d0, 0.0d0)
                  -
                  3112
                  -
                  3113 ! Local Variables
                  -
                  3114 integer(int32) :: i, m, n, mn, k, istat, flag, lwork
                  -
                  3115 complex(real64), pointer, dimension(:) :: wptr
                  -
                  3116 complex(real64), allocatable, target, dimension(:) :: wrk
                  -
                  3117 complex(real64), dimension(1) :: temp
                  -
                  3118 class(errors), pointer :: errmgr
                  -
                  3119 type(errors), target :: deferr
                  -
                  3120 character(len = 128) :: errmsg
                  -
                  3121
                  -
                  3122 ! Initialization
                  -
                  3123 m = size(l, 1)
                  -
                  3124 n = size(l, 2)
                  -
                  3125 mn = min(m, n)
                  -
                  3126 qcol = size(q, 2)
                  -
                  3127 if (present(err)) then
                  -
                  3128 errmgr => err
                  -
                  3129 else
                  -
                  3130 errmgr => deferr
                  -
                  3131 end if
                  -
                  3132
                  -
                  3133 ! Input Check
                  -
                  3134 flag = 0
                  -
                  3135 if (m > n) then
                  -
                  3136 flag = 1
                  -
                  3137 else if (size(tau) /= mn) then
                  -
                  3138 flag = 2
                  -
                  3139 else if (size(q, 1) /= m .or. size(q, 2) /= n) then
                  -
                  3140 flag = 3
                  -
                  3141 end if
                  -
                  3142 if (flag /= 0) then
                  -
                  3143 ! ERROR: One of the input arrays is not sized correctly
                  -
                  3144 write(errmsg, 100) "Input number ", flag, &
                  -
                  3145 " is not sized correctly."
                  -
                  3146 call errmgr%report_error("form_lq_no_pivot_cmplx", trim(errmsg), &
                  -
                  3147 la_array_size_error)
                  -
                  3148 return
                  -
                  3149 end if
                  -
                  3150
                  -
                  3151 ! Workspace Query
                  -
                  3152 call zunglq(m, n, mn, q, m, tau, temp, -1, flag)
                  -
                  3153 lwork = int(temp(1), int32)
                  -
                  3154 if (present(olwork)) then
                  -
                  3155 olwork = lwork
                  -
                  3156 return
                  -
                  3157 end if
                  -
                  3158
                  -
                  3159 ! Local Memory Allocation
                  -
                  3160 if (present(work)) then
                  -
                  3161 if (size(work) < lwork) then
                  -
                  3162 ! ERROR: WORK not sized correctly
                  -
                  3163 call errmgr%report_error("form_lq_no_pivot_cmplx", &
                  -
                  3164 "Incorrectly sized input array WORK, argument 4.", &
                  -
                  3165 la_array_size_error)
                  -
                  3166 return
                  -
                  3167 end if
                  -
                  3168 wptr => work(1:lwork)
                  -
                  3169 else
                  -
                  3170 allocate(wrk(lwork), stat = istat)
                  -
                  3171 if (istat /= 0) then
                  -
                  3172 ! ERROR: Out of memory
                  -
                  3173 call errmgr%report_error("form_lq_no_pivot_cmplx", &
                  -
                  3174 "Insufficient memory available.", &
                  -
                  3175 la_out_of_memory_error)
                  -
                  3176 return
                  -
                  3177 end if
                  -
                  3178 wptr => wrk
                  -
                  3179 end if
                  -
                  3180
                  -
                  3181 ! Copy the upper triangular portion of L to Q, and then zero it out in L
                  -
                  3182 do j = 2, n
                  -
                  3183 k = min(j - 1, m)
                  -
                  3184 q(1:j-1,j) = l(1:k,j)
                  -
                  3185 l(1:k,j) = zero
                  -
                  3186 end do
                  -
                  3187
                  -
                  3188 ! Build Q
                  -
                  3189 call zunglq(m, n, mn, q, m, tau, wptr, lwork, flag)
                  -
                  3190
                  -
                  3191 ! Formatting
                  -
                  3192100 format(a, i0, a)
                  -
                  3193 end subroutine
                  -
                  3194
                  -
                  3195! ------------------------------------------------------------------------------
                  -
                  3196 module subroutine mult_lq_mtx(lside, trans, a, tau, c, work, olwork, err)
                  -
                  3197 ! Arguments
                  -
                  3198 logical, intent(in) :: lside, trans
                  -
                  3199 real(real64), intent(in), dimension(:,:) :: a
                  -
                  3200 real(real64), intent(in), dimension(:) :: tau
                  -
                  3201 real(real64), intent(inout), dimension(:,:) :: c
                  -
                  3202 real(real64), intent(out), target, dimension(:), optional :: work
                  -
                  3203 integer(int32), intent(out), optional :: olwork
                  -
                  3204 class(errors), intent(inout), optional, target :: err
                  -
                  3205
                  -
                  3206 ! Local Variables
                  -
                  3207 character :: side, t
                  -
                  3208 integer(int32) :: m, n, k, ncola, istat, flag, lwork
                  -
                  3209 real(real64), pointer, dimension(:) :: wptr
                  -
                  3210 real(real64), allocatable, target, dimension(:) :: wrk
                  -
                  3211 real(real64), dimension(1) :: temp
                  -
                  3212 class(errors), pointer :: errmgr
                  -
                  3213 type(errors), target :: deferr
                  -
                  3214 character(len = 128) :: errmsg
                  -
                  3215
                  -
                  3216 ! Initialization
                  -
                  3217 m = size(c, 1)
                  -
                  3218 n = size(c, 2)
                  -
                  3219 k = size(tau)
                  -
                  3220 if (lside) then
                  -
                  3221 side = 'L'
                  -
                  3222 ncola = m
                  -
                  3223 else
                  -
                  3224 side = 'R'
                  -
                  3225 ncola = n
                  -
                  3226 end if
                  -
                  3227 if (trans) then
                  -
                  3228 t = 'T'
                  -
                  3229 else
                  -
                  3230 t = 'N'
                  -
                  3231 end if
                  -
                  3232 if (present(err)) then
                  -
                  3233 errmgr => err
                  -
                  3234 else
                  -
                  3235 errmgr => deferr
                  -
                  3236 end if
                  -
                  3237
                  -
                  3238 ! Input Check
                  -
                  3239 flag = 0
                  -
                  3240 if (size(a, 1) /= k .or. size(a, 2) /= ncola) then
                  -
                  3241 flag = 3
                  -
                  3242 end if
                  -
                  3243 if (flag /= 0) then
                  -
                  3244 ! ERROR: One of the input arrays is not sized correctly
                  -
                  3245 write(errmsg, 100) "Input number ", flag, &
                  -
                  3246 " is not sized correctly."
                  -
                  3247 call errmgr%report_error("mult_lq_mtx", trim(errmsg), &
                  -
                  3248 la_array_size_error)
                  -
                  3249 return
                  -
                  3250 end if
                  -
                  3251
                  -
                  3252 ! Workspace Query
                  -
                  3253 call dormlq(side, t, m, n, k, a, k, tau, c, m, temp, -1, flag)
                  -
                  3254 lwork = int(temp(1), int32)
                  -
                  3255 if (present(olwork)) then
                  -
                  3256 olwork = lwork
                  -
                  3257 return
                  -
                  3258 end if
                  -
                  3259
                  -
                  3260 ! Local Memory Allocation
                  -
                  3261 if (present(work)) then
                  -
                  3262 if (size(work) < lwork) then
                  -
                  3263 ! ERROR: WORK not sized correctly
                  -
                  3264 call errmgr%report_error("mult_lq_mtx", &
                  -
                  3265 "Incorrectly sized input array WORK, argument 6.", &
                  -
                  3266 la_array_size_error)
                  -
                  3267 return
                  -
                  3268 end if
                  -
                  3269 wptr => work(1:lwork)
                  -
                  3270 else
                  -
                  3271 allocate(wrk(lwork), stat = istat)
                  -
                  3272 if (istat /= 0) then
                  -
                  3273 ! ERROR: Out of memory
                  -
                  3274 call errmgr%report_error("mult_lq_mtx", &
                  -
                  3275 "Insufficient memory available.", &
                  -
                  3276 la_out_of_memory_error)
                  -
                  3277 return
                  -
                  3278 end if
                  -
                  3279 wptr => wrk
                  -
                  3280 end if
                  -
                  3281
                  -
                  3282 ! Call DORMLQ
                  -
                  3283 call dormlq(side, t, m, n, k, a, k, tau, c, m, wptr, lwork, flag)
                  -
                  3284
                  -
                  3285 ! Formatting
                  -
                  3286100 format(a, i0, a)
                  -
                  3287 end subroutine
                  -
                  3288
                  -
                  3289! ------------------------------------------------------------------------------
                  -
                  3290 module subroutine mult_lq_mtx_cmplx(lside, trans, a, tau, c, work, olwork, err)
                  -
                  3291 ! Arguments
                  -
                  3292 logical, intent(in) :: lside, trans
                  -
                  3293 complex(real64), intent(in), dimension(:,:) :: a
                  -
                  3294 complex(real64), intent(in), dimension(:) :: tau
                  -
                  3295 complex(real64), intent(inout), dimension(:,:) :: c
                  -
                  3296 complex(real64), intent(out), target, dimension(:), optional :: work
                  -
                  3297 integer(int32), intent(out), optional :: olwork
                  -
                  3298 class(errors), intent(inout), optional, target :: err
                  -
                  3299
                  -
                  3300 ! Local Variables
                  -
                  3301 character :: side, t
                  -
                  3302 integer(int32) :: m, n, k, ncola, istat, flag, lwork
                  -
                  3303 complex(real64), pointer, dimension(:) :: wptr
                  -
                  3304 complex(real64), allocatable, target, dimension(:) :: wrk
                  -
                  3305 complex(real64), dimension(1) :: temp
                  -
                  3306 class(errors), pointer :: errmgr
                  -
                  3307 type(errors), target :: deferr
                  -
                  3308 character(len = 128) :: errmsg
                  -
                  3309
                  -
                  3310 ! Initialization
                  -
                  3311 m = size(c, 1)
                  -
                  3312 n = size(c, 2)
                  -
                  3313 k = size(tau)
                  -
                  3314 if (lside) then
                  -
                  3315 side = 'L'
                  -
                  3316 ncola = m
                  -
                  3317 else
                  -
                  3318 side = 'R'
                  -
                  3319 ncola = n
                  -
                  3320 end if
                  -
                  3321 if (trans) then
                  -
                  3322 t = 'T'
                  -
                  3323 else
                  -
                  3324 t = 'N'
                  -
                  3325 end if
                  -
                  3326 if (present(err)) then
                  -
                  3327 errmgr => err
                  -
                  3328 else
                  -
                  3329 errmgr => deferr
                  -
                  3330 end if
                  -
                  3331
                  -
                  3332 ! Input Check
                  -
                  3333 flag = 0
                  -
                  3334 if (size(a, 1) /= k .or. size(a, 2) /= ncola) then
                  -
                  3335 flag = 3
                  -
                  3336 end if
                  -
                  3337 if (flag /= 0) then
                  -
                  3338 ! ERROR: One of the input arrays is not sized correctly
                  -
                  3339 write(errmsg, 100) "Input number ", flag, &
                  -
                  3340 " is not sized correctly."
                  -
                  3341 call errmgr%report_error("mult_lq_mtx_cmplx", trim(errmsg), &
                  -
                  3342 la_array_size_error)
                  -
                  3343 return
                  -
                  3344 end if
                  -
                  3345
                  -
                  3346 ! Workspace Query
                  -
                  3347 call zunmlq(side, t, m, n, k, a, k, tau, c, m, temp, -1, flag)
                  -
                  3348 lwork = int(temp(1), int32)
                  -
                  3349 if (present(olwork)) then
                  -
                  3350 olwork = lwork
                  -
                  3351 return
                  -
                  3352 end if
                  -
                  3353
                  -
                  3354 ! Local Memory Allocation
                  -
                  3355 if (present(work)) then
                  -
                  3356 if (size(work) < lwork) then
                  -
                  3357 ! ERROR: WORK not sized correctly
                  -
                  3358 call errmgr%report_error("mult_lq_mtx_cmplx", &
                  -
                  3359 "Incorrectly sized input array WORK, argument 6.", &
                  -
                  3360 la_array_size_error)
                  -
                  3361 return
                  -
                  3362 end if
                  -
                  3363 wptr => work(1:lwork)
                  -
                  3364 else
                  -
                  3365 allocate(wrk(lwork), stat = istat)
                  -
                  3366 if (istat /= 0) then
                  -
                  3367 ! ERROR: Out of memory
                  -
                  3368 call errmgr%report_error("mult_lq_mtx_cmplx", &
                  -
                  3369 "Insufficient memory available.", &
                  -
                  3370 la_out_of_memory_error)
                  -
                  3371 return
                  -
                  3372 end if
                  -
                  3373 wptr => wrk
                  -
                  3374 end if
                  -
                  3375
                  -
                  3376 ! Call ZUNMLQ
                  -
                  3377 call zunmlq(side, t, m, n, k, a, k, tau, c, m, wptr, lwork, flag)
                  -
                  3378
                  -
                  3379 ! Formatting
                  -
                  3380100 format(a, i0, a)
                  -
                  3381 end subroutine
                  -
                  3382
                  -
                  3383! ------------------------------------------------------------------------------
                  -
                  3384 module subroutine mult_lq_vec(trans, a, tau, c, work, olwork, err)
                  -
                  3385 ! Arguments
                  -
                  3386 logical, intent(in) :: trans
                  -
                  3387 real(real64), intent(in), dimension(:,:) :: a
                  -
                  3388 real(real64), intent(in), dimension(:) :: tau
                  -
                  3389 real(real64), intent(inout), dimension(:) :: c
                  -
                  3390 real(real64), intent(out), target, dimension(:), optional :: work
                  -
                  3391 integer(int32), intent(out), optional :: olwork
                  -
                  3392 class(errors), intent(inout), optional, target :: err
                  -
                  3393
                  -
                  3394 ! Local Variables
                  -
                  3395 character :: side, t
                  -
                  3396 integer(int32) :: m, n, k, istat, flag, lwork
                  -
                  3397 real(real64), pointer, dimension(:) :: wptr
                  -
                  3398 real(real64), allocatable, target, dimension(:) :: wrk
                  -
                  3399 real(real64), dimension(1) :: temp
                  -
                  3400 class(errors), pointer :: errmgr
                  -
                  3401 type(errors), target :: deferr
                  -
                  3402 character(len = 128) :: errmsg
                  -
                  3403
                  -
                  3404 ! Initialization
                  -
                  3405 m = size(c)
                  -
                  3406 n = 1
                  -
                  3407 k = size(tau)
                  -
                  3408 side = 'L'
                  -
                  3409 if (trans) then
                  -
                  3410 t = 'T'
                  -
                  3411 else
                  -
                  3412 t = 'N'
                  -
                  3413 end if
                  -
                  3414 if (present(err)) then
                  -
                  3415 errmgr => err
                  -
                  3416 else
                  -
                  3417 errmgr => deferr
                  -
                  3418 end if
                  -
                  3419
                  -
                  3420 ! Input Check
                  -
                  3421 flag = 0
                  -
                  3422 if (size(a, 1) /= m .or. size(a, 2) /= m) then
                  -
                  3423 flag = 3
                  -
                  3424 end if
                  -
                  3425 if (flag /= 0) then
                  -
                  3426 ! ERROR: One of the input arrays is not sized correctly
                  -
                  3427 write(errmsg, 100) "Input number ", flag, &
                  -
                  3428 " is not sized correctly."
                  -
                  3429 call errmgr%report_error("mult_lq_vec", trim(errmsg), &
                  -
                  3430 la_array_size_error)
                  -
                  3431 return
                  -
                  3432 end if
                  -
                  3433
                  -
                  3434 ! Workspace Query
                  -
                  3435 call dormlq(side, t, m, n, k, a, m, tau, c, m, temp, -1, flag)
                  -
                  3436 lwork = int(temp(1), int32)
                  -
                  3437 if (present(olwork)) then
                  -
                  3438 olwork = lwork
                  -
                  3439 return
                  -
                  3440 end if
                  -
                  3441
                  -
                  3442 ! Local Memory Allocation
                  -
                  3443 if (present(work)) then
                  -
                  3444 if (size(work) < lwork) then
                  -
                  3445 ! ERROR: WORK not sized correctly
                  -
                  3446 call errmgr%report_error("mult_lq_vec", &
                  -
                  3447 "Incorrectly sized input array WORK, argument 6.", &
                  -
                  3448 la_array_size_error)
                  -
                  3449 return
                  -
                  3450 end if
                  -
                  3451 wptr => work(1:lwork)
                  -
                  3452 else
                  -
                  3453 allocate(wrk(lwork), stat = istat)
                  -
                  3454 if (istat /= 0) then
                  -
                  3455 ! ERROR: Out of memory
                  -
                  3456 call errmgr%report_error("mult_lq_vec", &
                  -
                  3457 "Insufficient memory available.", &
                  -
                  3458 la_out_of_memory_error)
                  -
                  3459 return
                  -
                  3460 end if
                  -
                  3461 wptr => wrk
                  -
                  3462 end if
                  -
                  3463
                  -
                  3464 ! Call DORMLQ
                  -
                  3465 call dormlq(side, t, m, n, k, a, m, tau, c, m, wptr, lwork, flag)
                  -
                  3466
                  -
                  3467 ! Formatting
                  -
                  3468100 format(a, i0, a)
                  -
                  3469 end subroutine
                  -
                  3470
                  -
                  3471! ------------------------------------------------------------------------------
                  -
                  3472 module subroutine mult_lq_vec_cmplx(trans, a, tau, c, work, olwork, err)
                  -
                  3473 ! Arguments
                  -
                  3474 logical, intent(in) :: trans
                  -
                  3475 complex(real64), intent(in), dimension(:,:) :: a
                  -
                  3476 complex(real64), intent(in), dimension(:) :: tau
                  -
                  3477 complex(real64), intent(inout), dimension(:) :: c
                  -
                  3478 complex(real64), intent(out), target, dimension(:), optional :: work
                  -
                  3479 integer(int32), intent(out), optional :: olwork
                  -
                  3480 class(errors), intent(inout), optional, target :: err
                  -
                  3481
                  -
                  3482 ! Local Variables
                  -
                  3483 character :: side, t
                  -
                  3484 integer(int32) :: m, n, k, istat, flag, lwork
                  -
                  3485 complex(real64), pointer, dimension(:) :: wptr
                  -
                  3486 complex(real64), allocatable, target, dimension(:) :: wrk
                  -
                  3487 complex(real64), dimension(1) :: temp
                  -
                  3488 class(errors), pointer :: errmgr
                  -
                  3489 type(errors), target :: deferr
                  -
                  3490 character(len = 128) :: errmsg
                  -
                  3491
                  -
                  3492 ! Initialization
                  -
                  3493 m = size(c)
                  -
                  3494 n = 1
                  -
                  3495 k = size(tau)
                  -
                  3496 side = 'L'
                  -
                  3497 if (trans) then
                  -
                  3498 t = 'T'
                  -
                  3499 else
                  -
                  3500 t = 'N'
                  -
                  3501 end if
                  -
                  3502 if (present(err)) then
                  -
                  3503 errmgr => err
                  -
                  3504 else
                  -
                  3505 errmgr => deferr
                  -
                  3506 end if
                  -
                  3507
                  -
                  3508 ! Input Check
                  -
                  3509 flag = 0
                  -
                  3510 if (size(a, 1) /= m .or. size(a, 2) /= m) then
                  -
                  3511 flag = 3
                  -
                  3512 end if
                  -
                  3513 if (flag /= 0) then
                  -
                  3514 ! ERROR: One of the input arrays is not sized correctly
                  -
                  3515 write(errmsg, 100) "Input number ", flag, &
                  -
                  3516 " is not sized correctly."
                  -
                  3517 call errmgr%report_error("mult_lq_vec_cmplx", trim(errmsg), &
                  -
                  3518 la_array_size_error)
                  -
                  3519 return
                  -
                  3520 end if
                  -
                  3521
                  -
                  3522 ! Workspace Query
                  -
                  3523 call zunmlq(side, t, m, n, k, a, m, tau, c, m, temp, -1, flag)
                  -
                  3524 lwork = int(temp(1), int32)
                  -
                  3525 if (present(olwork)) then
                  -
                  3526 olwork = lwork
                  -
                  3527 return
                  -
                  3528 end if
                  -
                  3529
                  -
                  3530 ! Local Memory Allocation
                  -
                  3531 if (present(work)) then
                  -
                  3532 if (size(work) < lwork) then
                  -
                  3533 ! ERROR: WORK not sized correctly
                  -
                  3534 call errmgr%report_error("mult_lq_vec_cmplx", &
                  -
                  3535 "Incorrectly sized input array WORK, argument 6.", &
                  -
                  3536 la_array_size_error)
                  -
                  3537 return
                  -
                  3538 end if
                  -
                  3539 wptr => work(1:lwork)
                  -
                  3540 else
                  -
                  3541 allocate(wrk(lwork), stat = istat)
                  -
                  3542 if (istat /= 0) then
                  -
                  3543 ! ERROR: Out of memory
                  -
                  3544 call errmgr%report_error("mult_lq_vec_cmplx", &
                  -
                  3545 "Insufficient memory available.", &
                  -
                  3546 la_out_of_memory_error)
                  -
                  3547 return
                  -
                  3548 end if
                  -
                  3549 wptr => wrk
                  -
                  3550 end if
                  -
                  3551
                  -
                  3552 ! Call ZUNMLQ
                  -
                  3553 call zunmlq(side, t, m, n, k, a, m, tau, c, m, wptr, lwork, flag)
                  -
                  3554
                  -
                  3555 ! Formatting
                  -
                  3556100 format(a, i0, a)
                  -
                  3557 end subroutine
                  -
                  3558
                  -
                  3559! ------------------------------------------------------------------------------
                  -
                  3560end submodule
                  +
                  3031 if (present(err)) then
                  +
                  3032 errmgr => err
                  +
                  3033 else
                  +
                  3034 errmgr => deferr
                  +
                  3035 end if
                  +
                  3036
                  +
                  3037 ! Input Check
                  +
                  3038 flag = 0
                  +
                  3039 if (m > n) then
                  +
                  3040 flag = 1
                  +
                  3041 else if (size(tau) /= mn) then
                  +
                  3042 flag = 2
                  +
                  3043 else if (size(q, 1) /= n .or. size(q, 2) /= n) then
                  +
                  3044 flag = 3
                  +
                  3045 end if
                  +
                  3046 if (flag /= 0) then
                  +
                  3047 ! ERROR: One of the input arrays is not sized correctly
                  +
                  3048 write(errmsg, 100) "Input number ", flag, &
                  +
                  3049 " is not sized correctly."
                  +
                  3050 call errmgr%report_error("form_lq_no_pivot", trim(errmsg), &
                  +
                  3051 la_array_size_error)
                  +
                  3052 return
                  +
                  3053 end if
                  +
                  3054
                  +
                  3055 ! Workspace Query
                  +
                  3056 call dorglq(n, n, mn, q, n, tau, temp, -1, flag)
                  +
                  3057 lwork = int(temp(1), int32)
                  +
                  3058 if (present(olwork)) then
                  +
                  3059 olwork = lwork
                  +
                  3060 return
                  +
                  3061 end if
                  +
                  3062
                  +
                  3063 ! Local Memory Allocation
                  +
                  3064 if (present(work)) then
                  +
                  3065 if (size(work) < lwork) then
                  +
                  3066 ! ERROR: WORK not sized correctly
                  +
                  3067 call errmgr%report_error("form_lq_no_pivot", &
                  +
                  3068 "Incorrectly sized input array WORK, argument 4.", &
                  +
                  3069 la_array_size_error)
                  +
                  3070 return
                  +
                  3071 end if
                  +
                  3072 wptr => work(1:lwork)
                  +
                  3073 else
                  +
                  3074 allocate(wrk(lwork), stat = istat)
                  +
                  3075 if (istat /= 0) then
                  +
                  3076 ! ERROR: Out of memory
                  +
                  3077 call errmgr%report_error("form_lq_no_pivot", &
                  +
                  3078 "Insufficient memory available.", &
                  +
                  3079 la_out_of_memory_error)
                  +
                  3080 return
                  +
                  3081 end if
                  +
                  3082 wptr => wrk
                  +
                  3083 end if
                  +
                  3084
                  +
                  3085 ! Copy the upper triangular portion of L to Q, and then zero it out in L
                  +
                  3086 do j = 2, n
                  +
                  3087 k = min(j - 1, m)
                  +
                  3088 q(1:j-1,j) = l(1:k,j)
                  +
                  3089 l(1:k,j) = zero
                  +
                  3090 end do
                  +
                  3091
                  +
                  3092 ! Build Q
                  +
                  3093 call dorglq(n, n, mn, q, n, tau, wptr, lwork, flag)
                  +
                  3094
                  +
                  3095 ! Formatting
                  +
                  3096100 format(a, i0, a)
                  +
                  3097 end subroutine
                  +
                  3098
                  +
                  3099! ------------------------------------------------------------------------------
                  +
                  3100 module subroutine form_lq_no_pivot_cmplx(l, tau, q, work, olwork, err)
                  +
                  3101 ! Arguments
                  +
                  3102 complex(real64), intent(inout), dimension(:,:) :: l
                  +
                  3103 complex(real64), intent(in), dimension(:) :: tau
                  +
                  3104 complex(real64), intent(out), dimension(:,:) :: q
                  +
                  3105 complex(real64), intent(out), target, dimension(:), optional :: work
                  +
                  3106 integer(int32), intent(out), optional :: olwork
                  +
                  3107 class(errors), intent(inout), optional, target :: err
                  +
                  3108
                  +
                  3109 ! Parameters
                  +
                  3110 complex(real64), parameter :: zero = (0.0d0, 0.0d0)
                  +
                  3111
                  +
                  3112 ! Local Variables
                  +
                  3113 integer(int32) :: i, m, n, mn, k, istat, flag, lwork
                  +
                  3114 complex(real64), pointer, dimension(:) :: wptr
                  +
                  3115 complex(real64), allocatable, target, dimension(:) :: wrk
                  +
                  3116 complex(real64), dimension(1) :: temp
                  +
                  3117 class(errors), pointer :: errmgr
                  +
                  3118 type(errors), target :: deferr
                  +
                  3119 character(len = 128) :: errmsg
                  +
                  3120
                  +
                  3121 ! Initialization
                  +
                  3122 m = size(l, 1)
                  +
                  3123 n = size(l, 2)
                  +
                  3124 mn = min(m, n)
                  +
                  3125 qcol = size(q, 2)
                  +
                  3126 if (present(err)) then
                  +
                  3127 errmgr => err
                  +
                  3128 else
                  +
                  3129 errmgr => deferr
                  +
                  3130 end if
                  +
                  3131
                  +
                  3132 ! Input Check
                  +
                  3133 flag = 0
                  +
                  3134 if (m > n) then
                  +
                  3135 flag = 1
                  +
                  3136 else if (size(tau) /= mn) then
                  +
                  3137 flag = 2
                  +
                  3138 else if (size(q, 1) /= m .or. size(q, 2) /= n) then
                  +
                  3139 flag = 3
                  +
                  3140 end if
                  +
                  3141 if (flag /= 0) then
                  +
                  3142 ! ERROR: One of the input arrays is not sized correctly
                  +
                  3143 write(errmsg, 100) "Input number ", flag, &
                  +
                  3144 " is not sized correctly."
                  +
                  3145 call errmgr%report_error("form_lq_no_pivot_cmplx", trim(errmsg), &
                  +
                  3146 la_array_size_error)
                  +
                  3147 return
                  +
                  3148 end if
                  +
                  3149
                  +
                  3150 ! Workspace Query
                  +
                  3151 call zunglq(n, n, mn, q, n, tau, temp, -1, flag)
                  +
                  3152 lwork = int(temp(1), int32)
                  +
                  3153 if (present(olwork)) then
                  +
                  3154 olwork = lwork
                  +
                  3155 return
                  +
                  3156 end if
                  +
                  3157
                  +
                  3158 ! Local Memory Allocation
                  +
                  3159 if (present(work)) then
                  +
                  3160 if (size(work) < lwork) then
                  +
                  3161 ! ERROR: WORK not sized correctly
                  +
                  3162 call errmgr%report_error("form_lq_no_pivot_cmplx", &
                  +
                  3163 "Incorrectly sized input array WORK, argument 4.", &
                  +
                  3164 la_array_size_error)
                  +
                  3165 return
                  +
                  3166 end if
                  +
                  3167 wptr => work(1:lwork)
                  +
                  3168 else
                  +
                  3169 allocate(wrk(lwork), stat = istat)
                  +
                  3170 if (istat /= 0) then
                  +
                  3171 ! ERROR: Out of memory
                  +
                  3172 call errmgr%report_error("form_lq_no_pivot_cmplx", &
                  +
                  3173 "Insufficient memory available.", &
                  +
                  3174 la_out_of_memory_error)
                  +
                  3175 return
                  +
                  3176 end if
                  +
                  3177 wptr => wrk
                  +
                  3178 end if
                  +
                  3179
                  +
                  3180 ! Copy the upper triangular portion of L to Q, and then zero it out in L
                  +
                  3181 do j = 2, n
                  +
                  3182 k = min(j - 1, m)
                  +
                  3183 q(1:j-1,j) = l(1:k,j)
                  +
                  3184 l(1:k,j) = zero
                  +
                  3185 end do
                  +
                  3186
                  +
                  3187 ! Build Q
                  +
                  3188 call zunglq(n, n, mn, q, n, tau, wptr, lwork, flag)
                  +
                  3189
                  +
                  3190 ! Formatting
                  +
                  3191100 format(a, i0, a)
                  +
                  3192 end subroutine
                  +
                  3193
                  +
                  3194! ------------------------------------------------------------------------------
                  +
                  3195 module subroutine mult_lq_mtx(lside, trans, a, tau, c, work, olwork, err)
                  +
                  3196 ! Arguments
                  +
                  3197 logical, intent(in) :: lside, trans
                  +
                  3198 real(real64), intent(in), dimension(:,:) :: a
                  +
                  3199 real(real64), intent(in), dimension(:) :: tau
                  +
                  3200 real(real64), intent(inout), dimension(:,:) :: c
                  +
                  3201 real(real64), intent(out), target, dimension(:), optional :: work
                  +
                  3202 integer(int32), intent(out), optional :: olwork
                  +
                  3203 class(errors), intent(inout), optional, target :: err
                  +
                  3204
                  +
                  3205 ! Local Variables
                  +
                  3206 character :: side, t
                  +
                  3207 integer(int32) :: m, n, k, ncola, istat, flag, lwork
                  +
                  3208 real(real64), pointer, dimension(:) :: wptr
                  +
                  3209 real(real64), allocatable, target, dimension(:) :: wrk
                  +
                  3210 real(real64), dimension(1) :: temp
                  +
                  3211 class(errors), pointer :: errmgr
                  +
                  3212 type(errors), target :: deferr
                  +
                  3213 character(len = 128) :: errmsg
                  +
                  3214
                  +
                  3215 ! Initialization
                  +
                  3216 m = size(c, 1)
                  +
                  3217 n = size(c, 2)
                  +
                  3218 k = size(tau)
                  +
                  3219 if (lside) then
                  +
                  3220 side = 'L'
                  +
                  3221 ncola = m
                  +
                  3222 else
                  +
                  3223 side = 'R'
                  +
                  3224 ncola = n
                  +
                  3225 end if
                  +
                  3226 if (trans) then
                  +
                  3227 t = 'T'
                  +
                  3228 else
                  +
                  3229 t = 'N'
                  +
                  3230 end if
                  +
                  3231 if (present(err)) then
                  +
                  3232 errmgr => err
                  +
                  3233 else
                  +
                  3234 errmgr => deferr
                  +
                  3235 end if
                  +
                  3236
                  +
                  3237 ! Input Check
                  +
                  3238 flag = 0
                  +
                  3239 if (size(a, 1) /= k .or. size(a, 2) /= ncola) then
                  +
                  3240 flag = 3
                  +
                  3241 end if
                  +
                  3242 if (flag /= 0) then
                  +
                  3243 ! ERROR: One of the input arrays is not sized correctly
                  +
                  3244 write(errmsg, 100) "Input number ", flag, &
                  +
                  3245 " is not sized correctly."
                  +
                  3246 call errmgr%report_error("mult_lq_mtx", trim(errmsg), &
                  +
                  3247 la_array_size_error)
                  +
                  3248 return
                  +
                  3249 end if
                  +
                  3250
                  +
                  3251 ! Workspace Query
                  +
                  3252 call dormlq(side, t, m, n, k, a, k, tau, c, m, temp, -1, flag)
                  +
                  3253 lwork = int(temp(1), int32)
                  +
                  3254 if (present(olwork)) then
                  +
                  3255 olwork = lwork
                  +
                  3256 return
                  +
                  3257 end if
                  +
                  3258
                  +
                  3259 ! Local Memory Allocation
                  +
                  3260 if (present(work)) then
                  +
                  3261 if (size(work) < lwork) then
                  +
                  3262 ! ERROR: WORK not sized correctly
                  +
                  3263 call errmgr%report_error("mult_lq_mtx", &
                  +
                  3264 "Incorrectly sized input array WORK, argument 6.", &
                  +
                  3265 la_array_size_error)
                  +
                  3266 return
                  +
                  3267 end if
                  +
                  3268 wptr => work(1:lwork)
                  +
                  3269 else
                  +
                  3270 allocate(wrk(lwork), stat = istat)
                  +
                  3271 if (istat /= 0) then
                  +
                  3272 ! ERROR: Out of memory
                  +
                  3273 call errmgr%report_error("mult_lq_mtx", &
                  +
                  3274 "Insufficient memory available.", &
                  +
                  3275 la_out_of_memory_error)
                  +
                  3276 return
                  +
                  3277 end if
                  +
                  3278 wptr => wrk
                  +
                  3279 end if
                  +
                  3280
                  +
                  3281 ! Call DORMLQ
                  +
                  3282 call dormlq(side, t, m, n, k, a, k, tau, c, m, wptr, lwork, flag)
                  +
                  3283
                  +
                  3284 ! Formatting
                  +
                  3285100 format(a, i0, a)
                  +
                  3286 end subroutine
                  +
                  3287
                  +
                  3288! ------------------------------------------------------------------------------
                  +
                  3289 module subroutine mult_lq_mtx_cmplx(lside, trans, a, tau, c, work, olwork, err)
                  +
                  3290 ! Arguments
                  +
                  3291 logical, intent(in) :: lside, trans
                  +
                  3292 complex(real64), intent(in), dimension(:,:) :: a
                  +
                  3293 complex(real64), intent(in), dimension(:) :: tau
                  +
                  3294 complex(real64), intent(inout), dimension(:,:) :: c
                  +
                  3295 complex(real64), intent(out), target, dimension(:), optional :: work
                  +
                  3296 integer(int32), intent(out), optional :: olwork
                  +
                  3297 class(errors), intent(inout), optional, target :: err
                  +
                  3298
                  +
                  3299 ! Local Variables
                  +
                  3300 character :: side, t
                  +
                  3301 integer(int32) :: m, n, k, ncola, istat, flag, lwork
                  +
                  3302 complex(real64), pointer, dimension(:) :: wptr
                  +
                  3303 complex(real64), allocatable, target, dimension(:) :: wrk
                  +
                  3304 complex(real64), dimension(1) :: temp
                  +
                  3305 class(errors), pointer :: errmgr
                  +
                  3306 type(errors), target :: deferr
                  +
                  3307 character(len = 128) :: errmsg
                  +
                  3308
                  +
                  3309 ! Initialization
                  +
                  3310 m = size(c, 1)
                  +
                  3311 n = size(c, 2)
                  +
                  3312 k = size(tau)
                  +
                  3313 if (lside) then
                  +
                  3314 side = 'L'
                  +
                  3315 ncola = m
                  +
                  3316 else
                  +
                  3317 side = 'R'
                  +
                  3318 ncola = n
                  +
                  3319 end if
                  +
                  3320 if (trans) then
                  +
                  3321 t = 'T'
                  +
                  3322 else
                  +
                  3323 t = 'N'
                  +
                  3324 end if
                  +
                  3325 if (present(err)) then
                  +
                  3326 errmgr => err
                  +
                  3327 else
                  +
                  3328 errmgr => deferr
                  +
                  3329 end if
                  +
                  3330
                  +
                  3331 ! Input Check
                  +
                  3332 flag = 0
                  +
                  3333 if (size(a, 1) /= k .or. size(a, 2) /= ncola) then
                  +
                  3334 flag = 3
                  +
                  3335 end if
                  +
                  3336 if (flag /= 0) then
                  +
                  3337 ! ERROR: One of the input arrays is not sized correctly
                  +
                  3338 write(errmsg, 100) "Input number ", flag, &
                  +
                  3339 " is not sized correctly."
                  +
                  3340 call errmgr%report_error("mult_lq_mtx_cmplx", trim(errmsg), &
                  +
                  3341 la_array_size_error)
                  +
                  3342 return
                  +
                  3343 end if
                  +
                  3344
                  +
                  3345 ! Workspace Query
                  +
                  3346 call zunmlq(side, t, m, n, k, a, k, tau, c, m, temp, -1, flag)
                  +
                  3347 lwork = int(temp(1), int32)
                  +
                  3348 if (present(olwork)) then
                  +
                  3349 olwork = lwork
                  +
                  3350 return
                  +
                  3351 end if
                  +
                  3352
                  +
                  3353 ! Local Memory Allocation
                  +
                  3354 if (present(work)) then
                  +
                  3355 if (size(work) < lwork) then
                  +
                  3356 ! ERROR: WORK not sized correctly
                  +
                  3357 call errmgr%report_error("mult_lq_mtx_cmplx", &
                  +
                  3358 "Incorrectly sized input array WORK, argument 6.", &
                  +
                  3359 la_array_size_error)
                  +
                  3360 return
                  +
                  3361 end if
                  +
                  3362 wptr => work(1:lwork)
                  +
                  3363 else
                  +
                  3364 allocate(wrk(lwork), stat = istat)
                  +
                  3365 if (istat /= 0) then
                  +
                  3366 ! ERROR: Out of memory
                  +
                  3367 call errmgr%report_error("mult_lq_mtx_cmplx", &
                  +
                  3368 "Insufficient memory available.", &
                  +
                  3369 la_out_of_memory_error)
                  +
                  3370 return
                  +
                  3371 end if
                  +
                  3372 wptr => wrk
                  +
                  3373 end if
                  +
                  3374
                  +
                  3375 ! Call ZUNMLQ
                  +
                  3376 call zunmlq(side, t, m, n, k, a, k, tau, c, m, wptr, lwork, flag)
                  +
                  3377
                  +
                  3378 ! Formatting
                  +
                  3379100 format(a, i0, a)
                  +
                  3380 end subroutine
                  +
                  3381
                  +
                  3382! ------------------------------------------------------------------------------
                  +
                  3383 module subroutine mult_lq_vec(trans, a, tau, c, work, olwork, err)
                  +
                  3384 ! Arguments
                  +
                  3385 logical, intent(in) :: trans
                  +
                  3386 real(real64), intent(in), dimension(:,:) :: a
                  +
                  3387 real(real64), intent(in), dimension(:) :: tau
                  +
                  3388 real(real64), intent(inout), dimension(:) :: c
                  +
                  3389 real(real64), intent(out), target, dimension(:), optional :: work
                  +
                  3390 integer(int32), intent(out), optional :: olwork
                  +
                  3391 class(errors), intent(inout), optional, target :: err
                  +
                  3392
                  +
                  3393 ! Local Variables
                  +
                  3394 character :: side, t
                  +
                  3395 integer(int32) :: m, n, k, istat, flag, lwork
                  +
                  3396 real(real64), pointer, dimension(:) :: wptr
                  +
                  3397 real(real64), allocatable, target, dimension(:) :: wrk
                  +
                  3398 real(real64), dimension(1) :: temp
                  +
                  3399 class(errors), pointer :: errmgr
                  +
                  3400 type(errors), target :: deferr
                  +
                  3401 character(len = 128) :: errmsg
                  +
                  3402
                  +
                  3403 ! Initialization
                  +
                  3404 m = size(c)
                  +
                  3405 n = 1
                  +
                  3406 k = size(tau)
                  +
                  3407 side = 'L'
                  +
                  3408 if (trans) then
                  +
                  3409 t = 'T'
                  +
                  3410 else
                  +
                  3411 t = 'N'
                  +
                  3412 end if
                  +
                  3413 if (present(err)) then
                  +
                  3414 errmgr => err
                  +
                  3415 else
                  +
                  3416 errmgr => deferr
                  +
                  3417 end if
                  +
                  3418
                  +
                  3419 ! Input Check
                  +
                  3420 flag = 0
                  +
                  3421 if (size(a, 1) /= k .or. size(a, 2) /= m) then
                  +
                  3422 flag = 3
                  +
                  3423 end if
                  +
                  3424 if (flag /= 0) then
                  +
                  3425 ! ERROR: One of the input arrays is not sized correctly
                  +
                  3426 write(errmsg, 100) "Input number ", flag, &
                  +
                  3427 " is not sized correctly."
                  +
                  3428 call errmgr%report_error("mult_lq_vec", trim(errmsg), &
                  +
                  3429 la_array_size_error)
                  +
                  3430 return
                  +
                  3431 end if
                  +
                  3432
                  +
                  3433 ! Workspace Query
                  +
                  3434 call dormlq(side, t, m, n, k, a, k, tau, c, m, temp, -1, flag)
                  +
                  3435 lwork = int(temp(1), int32)
                  +
                  3436 if (present(olwork)) then
                  +
                  3437 olwork = lwork
                  +
                  3438 return
                  +
                  3439 end if
                  +
                  3440
                  +
                  3441 ! Local Memory Allocation
                  +
                  3442 if (present(work)) then
                  +
                  3443 if (size(work) < lwork) then
                  +
                  3444 ! ERROR: WORK not sized correctly
                  +
                  3445 call errmgr%report_error("mult_lq_vec", &
                  +
                  3446 "Incorrectly sized input array WORK, argument 6.", &
                  +
                  3447 la_array_size_error)
                  +
                  3448 return
                  +
                  3449 end if
                  +
                  3450 wptr => work(1:lwork)
                  +
                  3451 else
                  +
                  3452 allocate(wrk(lwork), stat = istat)
                  +
                  3453 if (istat /= 0) then
                  +
                  3454 ! ERROR: Out of memory
                  +
                  3455 call errmgr%report_error("mult_lq_vec", &
                  +
                  3456 "Insufficient memory available.", &
                  +
                  3457 la_out_of_memory_error)
                  +
                  3458 return
                  +
                  3459 end if
                  +
                  3460 wptr => wrk
                  +
                  3461 end if
                  +
                  3462
                  +
                  3463 ! Call DORMLQ
                  +
                  3464 call dormlq(side, t, m, n, k, a, k, tau, c, m, wptr, lwork, flag)
                  +
                  3465
                  +
                  3466 ! Formatting
                  +
                  3467100 format(a, i0, a)
                  +
                  3468 end subroutine
                  +
                  3469
                  +
                  3470! ------------------------------------------------------------------------------
                  +
                  3471 module subroutine mult_lq_vec_cmplx(trans, a, tau, c, work, olwork, err)
                  +
                  3472 ! Arguments
                  +
                  3473 logical, intent(in) :: trans
                  +
                  3474 complex(real64), intent(in), dimension(:,:) :: a
                  +
                  3475 complex(real64), intent(in), dimension(:) :: tau
                  +
                  3476 complex(real64), intent(inout), dimension(:) :: c
                  +
                  3477 complex(real64), intent(out), target, dimension(:), optional :: work
                  +
                  3478 integer(int32), intent(out), optional :: olwork
                  +
                  3479 class(errors), intent(inout), optional, target :: err
                  +
                  3480
                  +
                  3481 ! Local Variables
                  +
                  3482 character :: side, t
                  +
                  3483 integer(int32) :: m, n, k, istat, flag, lwork
                  +
                  3484 complex(real64), pointer, dimension(:) :: wptr
                  +
                  3485 complex(real64), allocatable, target, dimension(:) :: wrk
                  +
                  3486 complex(real64), dimension(1) :: temp
                  +
                  3487 class(errors), pointer :: errmgr
                  +
                  3488 type(errors), target :: deferr
                  +
                  3489 character(len = 128) :: errmsg
                  +
                  3490
                  +
                  3491 ! Initialization
                  +
                  3492 m = size(c)
                  +
                  3493 n = 1
                  +
                  3494 k = size(tau)
                  +
                  3495 side = 'L'
                  +
                  3496 if (trans) then
                  +
                  3497 t = 'T'
                  +
                  3498 else
                  +
                  3499 t = 'N'
                  +
                  3500 end if
                  +
                  3501 if (present(err)) then
                  +
                  3502 errmgr => err
                  +
                  3503 else
                  +
                  3504 errmgr => deferr
                  +
                  3505 end if
                  +
                  3506
                  +
                  3507 ! Input Check
                  +
                  3508 flag = 0
                  +
                  3509 if (size(a, 1) /= k .or. size(a, 2) /= m) then
                  +
                  3510 flag = 3
                  +
                  3511 end if
                  +
                  3512 if (flag /= 0) then
                  +
                  3513 ! ERROR: One of the input arrays is not sized correctly
                  +
                  3514 write(errmsg, 100) "Input number ", flag, &
                  +
                  3515 " is not sized correctly."
                  +
                  3516 call errmgr%report_error("mult_lq_vec_cmplx", trim(errmsg), &
                  +
                  3517 la_array_size_error)
                  +
                  3518 return
                  +
                  3519 end if
                  +
                  3520
                  +
                  3521 ! Workspace Query
                  +
                  3522 call zunmlq(side, t, m, n, k, a, k, tau, c, m, temp, -1, flag)
                  +
                  3523 lwork = int(temp(1), int32)
                  +
                  3524 if (present(olwork)) then
                  +
                  3525 olwork = lwork
                  +
                  3526 return
                  +
                  3527 end if
                  +
                  3528
                  +
                  3529 ! Local Memory Allocation
                  +
                  3530 if (present(work)) then
                  +
                  3531 if (size(work) < lwork) then
                  +
                  3532 ! ERROR: WORK not sized correctly
                  +
                  3533 call errmgr%report_error("mult_lq_vec_cmplx", &
                  +
                  3534 "Incorrectly sized input array WORK, argument 6.", &
                  +
                  3535 la_array_size_error)
                  +
                  3536 return
                  +
                  3537 end if
                  +
                  3538 wptr => work(1:lwork)
                  +
                  3539 else
                  +
                  3540 allocate(wrk(lwork), stat = istat)
                  +
                  3541 if (istat /= 0) then
                  +
                  3542 ! ERROR: Out of memory
                  +
                  3543 call errmgr%report_error("mult_lq_vec_cmplx", &
                  +
                  3544 "Insufficient memory available.", &
                  +
                  3545 la_out_of_memory_error)
                  +
                  3546 return
                  +
                  3547 end if
                  +
                  3548 wptr => wrk
                  +
                  3549 end if
                  +
                  3550
                  +
                  3551 ! Call ZUNMLQ
                  +
                  3552 call zunmlq(side, t, m, n, k, a, k, tau, c, m, wptr, lwork, flag)
                  +
                  3553
                  +
                  3554 ! Formatting
                  +
                  3555100 format(a, i0, a)
                  +
                  3556 end subroutine
                  +
                  3557
                  +
                  3558! ------------------------------------------------------------------------------
                  +
                  3559end submodule
                  Provides a set of common linear algebra routines.
                  Definition: linalg.f90:145
                  diff --git a/doc/html/namespacelinalg.html b/doc/html/namespacelinalg.html index af93c0cd..d0bdd60c 100644 --- a/doc/html/namespacelinalg.html +++ b/doc/html/namespacelinalg.html @@ -128,7 +128,7 @@ - + diff --git a/doc/html/namespaces.html b/doc/html/namespaces.html index b472dfa2..55194aab 100644 --- a/doc/html/namespaces.html +++ b/doc/html/namespaces.html @@ -109,7 +109,7 @@ - + From 906fb206ad143a26973cfae11d981bd64fdc7923 Mon Sep 17 00:00:00 2001 From: jchristopherson Date: Tue, 20 Dec 2022 13:30:08 -0600 Subject: [PATCH 56/65] Update comments --- include/linalg.h | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/include/linalg.h b/include/linalg.h index 97c20844..808b7ca4 100644 --- a/include/linalg.h +++ b/include/linalg.h @@ -1800,7 +1800,7 @@ int la_lq_factor_cmplx(int m, int n, double complex *a, int lda, * @param ldl The leading dimension of matrix L. * @param tau A MIN(M, N)-element array containing the scalar factors of * each elementary reflector defined in @p r. - * @param q An M-by-N matrix where the Q matrix will be written. + * @param q An N-by-N matrix where the Q matrix will be written. * @param ldq The leading dimension of matrix Q. * * @return An error code. The following codes are possible. @@ -1823,7 +1823,7 @@ int la_form_lq(int m, int n, double *l, int ldl, const double *tau, double *q, * @param ldl The leading dimension of matrix L. * @param tau A MIN(M, N)-element array containing the scalar factors of * each elementary reflector defined in @p r. - * @param q An M-by-N matrix where the Q matrix will be written. + * @param q An N-by-N matrix where the Q matrix will be written. * @param ldq The leading dimension of matrix Q. * * @return An error code. The following codes are possible. From 56bd3a69c6b7f69db5e967e11dd1b902bd8e8868 Mon Sep 17 00:00:00 2001 From: jchristopherson Date: Tue, 20 Dec 2022 13:30:27 -0600 Subject: [PATCH 57/65] Fix LQ issues --- src/linalg_c_api.f90 | 16 +-- src/linalg_factor.f90 | 7 +- tests/linalg_test.f90 | 8 +- tests/test_lq.f90 | 230 ++++++++++++++++++++++++++++++++++++++++++ 4 files changed, 247 insertions(+), 14 deletions(-) diff --git a/src/linalg_c_api.f90 b/src/linalg_c_api.f90 index 9fa13a76..53023d0e 100644 --- a/src/linalg_c_api.f90 +++ b/src/linalg_c_api.f90 @@ -3229,13 +3229,13 @@ function la_form_lq(m, n, l, ldl, tau, q, ldq) & ! Initialization mn = min(m, n) flag = LA_NO_ERROR - if (ldl < m .or. ldq < m) then + if (ldl < m .or. ldq < n) then flag = LA_INVALID_INPUT_ERROR return end if ! Process - call form_lq(l(1:m,1:n), tau(1:mn), q(1:m,1:n), err = err) + call form_lq(l(1:m,1:n), tau(1:mn), q(1:n,1:n), err = err) if (err%has_error_occurred()) then flag = err%get_error_flag() return @@ -3259,13 +3259,13 @@ function la_form_lq_cmplx(m, n, l, ldl, tau, q, ldq) & ! Initialization mn = min(m, n) flag = LA_NO_ERROR - if (ldl < m .or. ldq < m) then + if (ldl < m .or. ldq < n) then flag = LA_INVALID_INPUT_ERROR return end if ! Process - call form_lq(l(1:m,1:n), tau(1:mn), q(1:m,1:n), err = err) + call form_lq(l(1:m,1:n), tau(1:mn), q(1:n,1:n), err = err) if (err%has_error_occurred()) then flag = err%get_error_flag() return @@ -3295,13 +3295,13 @@ function la_mult_lq(lside, trans, m, n, k, a, lda, tau, c, ldc) & else ma = n end if - if (lda < ma .or. ldc < m .or. k < ma) then + if (lda < k .or. ldc < m .or. k < ma) then flag = LA_INVALID_INPUT_ERROR return end if ! Process - call mult_lq(logical(lside), logical(trans), a(1:ma,1:k), tau(1:k), & + call mult_lq(logical(lside), logical(trans), a(1:k,1:ma), tau(1:k), & c(1:m,1:n), err = err) if (err%has_error_occurred()) then flag = err%get_error_flag() @@ -3332,13 +3332,13 @@ function la_mult_lq_cmplx(lside, trans, m, n, k, a, lda, tau, c, ldc) & else ma = n end if - if (lda < ma .or. ldc < m .or. k < ma) then + if (lda < k .or. ldc < m .or. k < ma) then flag = LA_INVALID_INPUT_ERROR return end if ! Process - call mult_lq(logical(lside), logical(trans), a(1:ma,1:k), tau(1:k), & + call mult_lq(logical(lside), logical(trans), a(1:k,1:ma), tau(1:k), & c(1:m,1:n), err = err) if (err%has_error_occurred()) then flag = err%get_error_flag() diff --git a/src/linalg_factor.f90 b/src/linalg_factor.f90 index 2f7698f0..261fd764 100644 --- a/src/linalg_factor.f90 +++ b/src/linalg_factor.f90 @@ -3122,7 +3122,6 @@ module subroutine form_lq_no_pivot_cmplx(l, tau, q, work, olwork, err) m = size(l, 1) n = size(l, 2) mn = min(m, n) - qcol = size(q, 2) if (present(err)) then errmgr => err else @@ -3135,7 +3134,7 @@ module subroutine form_lq_no_pivot_cmplx(l, tau, q, work, olwork, err) flag = 1 else if (size(tau) /= mn) then flag = 2 - else if (size(q, 1) /= m .or. size(q, 2) /= n) then + else if (size(q, 1) /= n .or. size(q, 2) /= n) then flag = 3 end if if (flag /= 0) then @@ -3318,7 +3317,7 @@ module subroutine mult_lq_mtx_cmplx(lside, trans, a, tau, c, work, olwork, err) ncola = n end if if (trans) then - t = 'T' + t = 'C' else t = 'N' end if @@ -3494,7 +3493,7 @@ module subroutine mult_lq_vec_cmplx(trans, a, tau, c, work, olwork, err) k = size(tau) side = 'L' if (trans) then - t = 'T' + t = 'C' else t = 'N' end if diff --git a/tests/linalg_test.f90 b/tests/linalg_test.f90 index cf507b39..6c44065b 100644 --- a/tests/linalg_test.f90 +++ b/tests/linalg_test.f90 @@ -177,12 +177,16 @@ program main rst = test_lq_mult_ud() if (.not.rst) overall = .false. + rst = test_lq_mult_cmplx() + if (.not.rst) overall = .false. + + rst = test_lq_mult_cmplx_ud() + if (.not.rst) overall = .false. + ! End if (overall) then - print '(A)', "LINALG TEST STATUS: PASS" call exit(0) else - print '(A)', "LINALG TEST STATUS: FAILED" call exit(1) end if end program diff --git a/tests/test_lq.f90 b/tests/test_lq.f90 index f91cb5c4..13dca8ea 100644 --- a/tests/test_lq.f90 +++ b/tests/test_lq.f90 @@ -183,6 +183,35 @@ function test_lq_mult() result(rst) rst = .false. print '(A)', "Test Failed: LQ Multiplication Test 2" end if + + ! ---------- + ! Q**T + + ! Compute C = Q**T * C + c1 = c2 + call mult_lq(.true., .true., a, tau, c1) + + ! Compute the answer + call mtx_mult(.true., .false., 1.0d0, q, c2, 0.0d0, ans) + + ! Test + if (.not.is_mtx_equal(c1, ans, tol)) then + rst = .false. + print '(A)', "Test Failed: LQ Multiplication Test 3" + end if + + ! Vector RHS + c3 = c4 + call mult_lq(.true., a, tau, c3) + + ! Compute the answer + call mtx_mult(.true., 1.0d0, q, c4, 0.0d0, ans2) + + ! Test + if (.not.is_mtx_equal(c3, ans2, tol)) then + rst = .false. + print '(A)', "Test Failed: LQ Multiplication Test 4" + end if end function ! ------------------------------------------------------------------------------ @@ -235,11 +264,212 @@ function test_lq_mult_ud() result(rst) rst = .false. print '(A)', "Test Failed: Underdetermined LQ Multiplication Test 2" end if + + ! ---------- + ! Q**T + + ! Compute C = Q**T * C + c1 = c2 + call mult_lq(.true., .true., a, tau, c1) + + ! Compute the answer + ans = matmul(transpose(q), c2) + + ! Test + if (.not.is_mtx_equal(c1, ans, tol)) then + rst = .false. + print '(A)', "Test Failed: LQ Multiplication Test 3" + end if + + ! Vector RHS + c3 = c4 + call mult_lq(.true., a, tau, c3) + + ! Compute the answer + ans2 = matmul(transpose(q), c4) + + ! Test + if (.not.is_mtx_equal(c3, ans2, tol)) then + rst = .false. + print '(A)', "Test Failed: LQ Multiplication Test 4" + end if end function ! ------------------------------------------------------------------------------ + function test_lq_mult_cmplx() result(rst) + ! Parameters + integer(int32), parameter :: m = 50 + integer(int32), parameter :: n = 50 + real(real64), parameter :: tol = 1.0d-8 + complex(real64), parameter :: zero = (0.0d0, 0.0d0) + complex(real64), parameter :: one = (1.0d0, 0.0d0) + + ! Local Variables + complex(real64) :: a(m, n), l(m, n), tau(m), q(n, n), c1(n, n), & + c2(n, n), ans(n, n), c3(n), c4(n), ans2(n) + real(real64) :: ar(m, n), ai(m, n), cr(n, n), ci(n, n) + logical :: rst + + ! Initialization + rst = .true. + call random_number(ar) + call random_number(ai) + a = cmplx(ar, ai, real64) + call random_number(cr) + call random_number(ci) + c1 = cmplx(cr, ci, real64) + c3 = c1(:,1) + c2 = c1 + c4 = c3 + + ! Compute the LQ factorization of A + call lq_factor(a, tau) + l = a + + ! Extract L and Q + call form_lq(l, tau, q) + + ! Compute C = Q * C + call mult_lq(.true., .false., a, tau, c1) + + ! Compute the answer + ans = matmul(q, c2) + + ! Test + if (.not.is_mtx_equal(c1, ans, tol)) then + rst = .false. + print '(A)', "Test Failed: Complex LQ Multiplication Test 1" + end if + + ! Vector RHS + call mult_lq(.false., a, tau, c3) + + ! Compute the answer + ans2 = matmul(q, c4) + + ! Test + if (.not.is_mtx_equal(c3, ans2, tol)) then + rst = .false. + print '(A)', "Test Failed: Complex LQ Multiplication Test 2" + end if + + ! ---------- + ! Q**H + + ! Compute C = Q**H * C + ! c1 = c2 + ! call mult_lq(.true., .true., a, tau, c1) + + ! ! Compute the answer + ! call mtx_mult(LA_HERMITIAN_TRANSPOSE, LA_NO_OPERATION, one, q, c2, zero, ans) + + ! ! Test + ! if (.not.is_mtx_equal(c1, ans, tol)) then + ! rst = .false. + ! print '(A)', "Test Failed: Complex LQ Multiplication Test 3" + ! end if + + ! ! Vector RHS + ! c3 = c4 + ! call mult_lq(.true., a, tau, c3) + + ! ! Compute the answer + ! call mtx_mult(LA_HERMITIAN_TRANSPOSE, one, q, c4, zero, ans2) + + ! ! Test + ! if (.not.is_mtx_equal(c3, ans2, tol)) then + ! rst = .false. + ! print '(A)', "Test Failed: Complex LQ Multiplication Test 4" + ! end if + end function ! ------------------------------------------------------------------------------ + function test_lq_mult_cmplx_ud() result(rst) + ! Parameters + integer(int32), parameter :: m = 50 + integer(int32), parameter :: n = 60 + real(real64), parameter :: tol = 1.0d-8 + complex(real64), parameter :: zero = (0.0d0, 0.0d0) + complex(real64), parameter :: one = (1.0d0, 0.0d0) + + ! Local Variables + complex(real64) :: a(m, n), l(m, n), tau(m), q(n, n), c1(n, n), & + c2(n, n), ans(n, n), c3(n), c4(n), ans2(n) + real(real64) :: ar(m, n), ai(m, n), cr(n, n), ci(n, n) + logical :: rst + + ! Initialization + rst = .true. + call random_number(ar) + call random_number(ai) + a = cmplx(ar, ai, real64) + call random_number(cr) + call random_number(ci) + c1 = cmplx(cr, ci, real64) + c3 = c1(:,1) + c2 = c1 + c4 = c3 + + ! Compute the LQ factorization of A + call lq_factor(a, tau) + l = a + + ! Extract L and Q + call form_lq(l, tau, q) + + ! Compute C = Q * C + call mult_lq(.true., .false., a, tau, c1) + + ! Compute the answer + ans = matmul(q, c2) + + ! Test + if (.not.is_mtx_equal(c1, ans, tol)) then + rst = .false. + print '(A)', "Test Failed: Underdetermined Complex LQ Multiplication Test 1" + end if + + ! Vector RHS + call mult_lq(.false., a, tau, c3) + + ! Compute the answer + ans2 = matmul(q, c4) + + ! Test + if (.not.is_mtx_equal(c3, ans2, tol)) then + rst = .false. + print '(A)', "Test Failed: Underdetermined Complex LQ Multiplication Test 2" + end if + + ! ---------- + ! Q**H + + ! Compute C = Q**H * C + ! c1 = c2 + ! call mult_lq(.true., .true., a, tau, c1) + + ! ! Compute the answer + ! call mtx_mult(LA_HERMITIAN_TRANSPOSE, LA_NO_OPERATION, one, q, c2, zero, ans) + + ! ! Test + ! if (.not.is_mtx_equal(c1, ans, tol)) then + ! rst = .false. + ! print '(A)', "Test Failed: Underdetermined Complex LQ Multiplication Test 3" + ! end if + + ! ! Vector RHS + ! c3 = c4 + ! call mult_lq(.true., a, tau, c3) + + ! ! Compute the answer + ! call mtx_mult(LA_HERMITIAN_TRANSPOSE, one, q, c4, zero, ans2) + + ! ! Test + ! if (.not.is_mtx_equal(c3, ans2, tol)) then + ! rst = .false. + ! print '(A)', "Test Failed: Underdetermined Complex LQ Multiplication Test 4" + ! end if + end function ! ------------------------------------------------------------------------------ From d5beb38515e95ad0e9c87ec3553e88c9818ae279 Mon Sep 17 00:00:00 2001 From: jchristopherson Date: Tue, 20 Dec 2022 13:53:22 -0600 Subject: [PATCH 58/65] Add tests --- tests/linalg_test.f90 | 12 +++ tests/test_lq.f90 | 216 ++++++++++++++++++++++++++++++++++++++++++ 2 files changed, 228 insertions(+) diff --git a/tests/linalg_test.f90 b/tests/linalg_test.f90 index 6c44065b..39b2473a 100644 --- a/tests/linalg_test.f90 +++ b/tests/linalg_test.f90 @@ -183,6 +183,18 @@ program main rst = test_lq_mult_cmplx_ud() if (.not.rst) overall = .false. + rst = test_lq_mult_right() + if (.not.rst) overall = .false. + + rst = test_lq_mult_right_cmplx() + if (.not.rst) overall = .false. + + rst = test_lq_mult_right_ud() + if (.not.rst) overall = .false. + + rst = test_lq_mult_right_cmplx_ud() + if (.not.rst) overall = .false. + ! End if (overall) then call exit(0) diff --git a/tests/test_lq.f90 b/tests/test_lq.f90 index 13dca8ea..f2aa3986 100644 --- a/tests/test_lq.f90 +++ b/tests/test_lq.f90 @@ -472,8 +472,224 @@ function test_lq_mult_cmplx_ud() result(rst) end function ! ------------------------------------------------------------------------------ + function test_lq_mult_right() result(rst) + ! Parameters + integer(int32), parameter :: m = 50 + integer(int32), parameter :: n = 50 + real(real64), parameter :: tol = 1.0d-8 + + ! Local Variables + logical :: rst + real(real64) :: a(m, n), l(m, n), tau(m), q(n, n), c1(m, n), c2(m, n), & + ans(m, n) + + ! Initialization + rst = .true. + call random_number(a) + call random_number(c1) + c2 = c1 + + ! Compute the LQ factorization + call lq_factor(a, tau) + l = a + + ! Extract L & Q + call form_lq(l, tau, q) + + ! Compute C = C * Q + call mult_lq(.false., .false., a, tau, c1) + + ! Compute the answer + ans = matmul(c2, q) + + ! Test + if (.not.is_mtx_equal(c1, ans, tol)) then + rst = .false. + print '(A)', "Test Failed: LQ Right Multiplication Test 1" + end if + + ! Transpose + c1 = c2 + call mult_lq(.false., .true., a, tau, c1) + + ! Compute the answer: C = C * Q**T + call mtx_mult(.false., .true., 1.0d0, c2, q, 0.0d0, ans) + + ! Test + if (.not.is_mtx_equal(c1, ans, tol)) then + rst = .false. + print '(A)', "Test Failed: LQ Right Multiplication Test 2" + end if + end function + +! ------------------------------------------------------------------------------ + function test_lq_mult_right_cmplx() result(rst) + ! Parameters + integer(int32), parameter :: m = 50 + integer(int32), parameter :: n = 50 + real(real64), parameter :: tol = 1.0d-8 + complex(real64), parameter :: zero = (0.0d0, 0.0d0) + complex(real64), parameter :: one = (1.0d0, 0.0d0) + + ! Local Variables + logical :: rst + complex(real64) :: a(m, n), l(m, n), tau(m), q(n, n), c1(m, n), & + c2(m, n), ans(m, n) + real(real64) :: ar(m, n), ai(m, n), cr(m, n), ci(m, n) + + ! Initialization + rst = .true. + call random_number(ar) + call random_number(ai) + call random_number(cr) + call random_number(ci) + a = cmplx(ar, ai, real64) + c1 = cmplx(cr, ci, real64) + c2 = c1 + + ! Compute the LQ factorization + call lq_factor(a, tau) + l = a + + ! Extract L & Q + call form_lq(l, tau, q) + + ! Compute C = C * Q + call mult_lq(.false., .false., a, tau, c1) + + ! Compute the answer + ans = matmul(c2, q) + + ! Test + if (.not.is_mtx_equal(c1, ans, tol)) then + rst = .false. + print '(A)', "Test Failed: Complex LQ Right Multiplication Test 1" + end if + + ! Transpose + ! c1 = c2 + ! call mult_lq(.false., .true., a, tau, c1) + + ! ! Compute the answer: C = C * Q**H + ! call mtx_mult(LA_NO_OPERATION, LA_HERMITIAN_TRANSPOSE, one, c2, q, & + ! zero, ans) + + ! ! Test + ! if (.not.is_mtx_equal(c1, ans, tol)) then + ! rst = .false. + ! print '(A)', "Test Failed: Complex LQ Right Multiplication Test 2" + ! end if + end function ! ------------------------------------------------------------------------------ + function test_lq_mult_right_ud() result(rst) + ! Parameters + integer(int32), parameter :: m = 50 + integer(int32), parameter :: n = 60 + real(real64), parameter :: tol = 1.0d-8 + + ! Local Variables + logical :: rst + real(real64) :: a(m, n), l(m, n), tau(m), q(n, n), c1(m, n), c2(m, n), & + ans(m, n) + + ! Initialization + rst = .true. + call random_number(a) + call random_number(c1) + c2 = c1 + + ! Compute the LQ factorization + call lq_factor(a, tau) + l = a + + ! Extract L & Q + call form_lq(l, tau, q) + + ! Compute C = C * Q + call mult_lq(.false., .false., a, tau, c1) + + ! Compute the answer + ans = matmul(c2, q) + + ! Test + if (.not.is_mtx_equal(c1, ans, tol)) then + rst = .false. + print '(A)', "Test Failed: Underdetermined LQ Right Multiplication Test 1" + end if + + ! Transpose + c1 = c2 + call mult_lq(.false., .true., a, tau, c1) + + ! Compute the answer: C = C * Q**T + call mtx_mult(.false., .true., 1.0d0, c2, q, 0.0d0, ans) + + ! Test + if (.not.is_mtx_equal(c1, ans, tol)) then + rst = .false. + print '(A)', "Test Failed: Underdetermined LQ Right Multiplication Test 2" + end if + end function + +! ------------------------------------------------------------------------------ + function test_lq_mult_right_cmplx_ud() result(rst) + ! Parameters + integer(int32), parameter :: m = 50 + integer(int32), parameter :: n = 60 + real(real64), parameter :: tol = 1.0d-8 + complex(real64), parameter :: zero = (0.0d0, 0.0d0) + complex(real64), parameter :: one = (1.0d0, 0.0d0) + + ! Local Variables + logical :: rst + complex(real64) :: a(m, n), l(m, n), tau(m), q(n, n), c1(m, n), & + c2(m, n), ans(m, n) + real(real64) :: ar(m, n), ai(m, n), cr(m, n), ci(m, n) + + ! Initialization + rst = .true. + call random_number(ar) + call random_number(ai) + call random_number(cr) + call random_number(ci) + a = cmplx(ar, ai, real64) + c1 = cmplx(cr, ci, real64) + c2 = c1 + + ! Compute the LQ factorization + call lq_factor(a, tau) + l = a + + ! Extract L & Q + call form_lq(l, tau, q) + + ! Compute C = C * Q + call mult_lq(.false., .false., a, tau, c1) + + ! Compute the answer + ans = matmul(c2, q) + + ! Test + if (.not.is_mtx_equal(c1, ans, tol)) then + rst = .false. + print '(A)', "Test Failed: Underdetermined Complex LQ Right Multiplication Test 1" + end if + + ! Transpose + ! c1 = c2 + ! call mult_lq(.false., .true., a, tau, c1) + + ! ! Compute the answer: C = C * Q**H + ! call mtx_mult(LA_NO_OPERATION, LA_HERMITIAN_TRANSPOSE, one, c2, q, & + ! zero, ans) + + ! ! Test + ! if (.not.is_mtx_equal(c1, ans, tol)) then + ! rst = .false. + ! print '(A)', "Test Failed: Underdetermined Complex LQ Right Multiplication Test 2" + ! end if + end function ! ------------------------------------------------------------------------------ end module \ No newline at end of file From fae3a94ba4b39fa76afa2864e7cb321eecadb9ff Mon Sep 17 00:00:00 2001 From: jchristopherson Date: Tue, 20 Dec 2022 13:54:47 -0600 Subject: [PATCH 59/65] Update documentation --- doc/C/html/linalg_8h.html | 4 +- doc/html/linalg_8h.html | 4 +- doc/html/linalg__factor_8f90_source.html | 869 +++++++++++------------ 3 files changed, 438 insertions(+), 439 deletions(-) diff --git a/doc/C/html/linalg_8h.html b/doc/C/html/linalg_8h.html index 802fc1f4..91b5d1db 100644 --- a/doc/C/html/linalg_8h.html +++ b/doc/C/html/linalg_8h.html @@ -1469,7 +1469,7 @@

                  l

                  - +
                  [in]transSet to true to apply \( Q^T \); else, set to false. In the event \( Q \) is complex-valued, \( Q^H \) is computed instead of \( Q^T \).
                  [in]aOn input, an M-by-K matrix containing the elementary reflectors output from the QR factorization. Notice, the contents of this matrix are restored on exit.
                  [in]aOn input, an K-by-M matrix containing the elementary reflectors output from the LQ factorization. Notice, the contents of this matrix are restored on exit.
                  [in]tauA K-element array containing the scalar factors of each elementary reflector defined in a.
                  [in,out]cOn input, the M-element vector C. On output, the product of the orthogonal matrix Q and the original vector C.
                  [out]workAn optional input, that if provided, prevents any local memory allocation. If not provided, the memory required is allocated within. If provided, the length of the array must be at least olwork.
                  The number of rows in matrix C.
                  nThe number of columns in matrix C.
                  kThe number of elementary reflectors whose product defines the matrix Q.
                  aOn input, an LDA-by-K matrix containing the elementary reflectors output from the LQ factorization. If lside is set to true, LDA = M, and M >= K >= 0; else, if lside is set to false, LDA = N, and N >= K >= 0. Notice, the contents of this matrix are restored on exit.
                  aOn input, an K-by-P matrix containing the elementary reflectors output from the LQ factorization. If lside is set to true, P = M; else, if lside is set to false, P = N.
                  ldaThe leading dimension of matrix A.
                  tauA K-element array containing the scalar factors of each elementary reflector defined in a.
                  cOn input, the M-by-N matrix C. On output, the product of the orthogonal matrix Q and the original matrix C.
                  The number of rows in matrix C.
                  nThe number of columns in matrix C.
                  kThe number of elementary reflectors whose product defines the matrix Q.
                  aOn input, an LDA-by-K matrix containing the elementary reflectors output from the LQ factorization. If lside is set to true, LDA = M, and M >= K >= 0; else, if lside is set to false, LDA = N, and N >= K >= 0. Notice, the contents of this matrix are restored on exit.
                  aOn input, an K-by-P matrix containing the elementary reflectors output from the LQ factorization. If lside is set to true, P = M; else, if lside is set to false, P = N.
                  ldaThe leading dimension of matrix A.
                  tauA K-element array containing the scalar factors of each elementary reflector defined in a.
                  cOn input, the M-by-N matrix C. On output, the product of the orthogonal matrix Q and the original matrix C.
                   Computes the eigenvalues, and optionally the eigenvectors, of a matrix. More...
                   
                  interface  form_lq
                   Forms the matrix Q with orthonormal rows from the elementary reflectors returned by the LQ factorization algorithm. More...
                   Forms the orthogonal matrix Q from the elementary reflectors returned by the LQ factorization algorithm. More...
                   
                  interface  form_lu
                   Extracts the L and U matrices from the condensed [L\U] storage format used by the lu_factor. More...
                   CdetComputes the determinant of a square matrix
                   Cdiag_mtx_multMultiplies a diagonal matrix with another matrix or array
                   CeigenComputes the eigenvalues, and optionally the eigenvectors, of a matrix
                   Cform_lqForms the matrix Q with orthonormal rows from the elementary reflectors returned by the LQ factorization algorithm
                   Cform_lqForms the orthogonal matrix Q from the elementary reflectors returned by the LQ factorization algorithm
                   Cform_luExtracts the L and U matrices from the condensed [L\U] storage format used by the lu_factor
                   Cform_qrForms the full M-by-M orthogonal matrix Q from the elementary reflectors returned by the base QR factorization algorithm
                   Clq_factorComputes the LQ factorization of an M-by-N matrix
                  On input, the M-by-N factored matrix as returned by the LQ factorization routine. On output, the lower triangular matrix L.
                  ldlThe leading dimension of matrix L.
                  tauA MIN(M, N)-element array containing the scalar factors of each elementary reflector defined in r.
                  qAn M-by-N matrix where the Q matrix will be written.
                  qAn N-by-N matrix where the Q matrix will be written.
                  ldqThe leading dimension of matrix Q.
                  @@ -1546,7 +1546,7 @@

                  l

                On input, the M-by-N factored matrix as returned by the LQ factorization routine. On output, the lower triangular matrix L.
                ldlThe leading dimension of matrix L.
                tauA MIN(M, N)-element array containing the scalar factors of each elementary reflector defined in r.
                qAn M-by-N matrix where the Q matrix will be written.
                qAn N-by-N matrix where the Q matrix will be written.
                ldqThe leading dimension of matrix Q.
                diff --git a/doc/html/linalg_8h.html b/doc/html/linalg_8h.html index 6e75bcfd..345bb6b0 100644 --- a/doc/html/linalg_8h.html +++ b/doc/html/linalg_8h.html @@ -1640,7 +1640,7 @@

                lOn input, the M-by-N factored matrix as returned by the LQ factorization routine. On output, the lower triangular matrix L. ldlThe leading dimension of matrix L. tauA MIN(M, N)-element array containing the scalar factors of each elementary reflector defined in r. - qAn M-by-N matrix where the Q matrix will be written. + qAn N-by-N matrix where the Q matrix will be written. ldqThe leading dimension of matrix Q. @@ -1717,7 +1717,7 @@

                lOn input, the M-by-N factored matrix as returned by the LQ factorization routine. On output, the lower triangular matrix L. ldlThe leading dimension of matrix L. tauA MIN(M, N)-element array containing the scalar factors of each elementary reflector defined in r. - qAn M-by-N matrix where the Q matrix will be written. + qAn N-by-N matrix where the Q matrix will be written. ldqThe leading dimension of matrix Q. diff --git a/doc/html/linalg__factor_8f90_source.html b/doc/html/linalg__factor_8f90_source.html index e09321fc..bf7b8706 100644 --- a/doc/html/linalg__factor_8f90_source.html +++ b/doc/html/linalg__factor_8f90_source.html @@ -3220,441 +3220,440 @@
                3122 m = size(l, 1)
                3123 n = size(l, 2)
                3124 mn = min(m, n)
                -
                3125 qcol = size(q, 2)
                -
                3126 if (present(err)) then
                -
                3127 errmgr => err
                -
                3128 else
                -
                3129 errmgr => deferr
                -
                3130 end if
                -
                3131
                -
                3132 ! Input Check
                -
                3133 flag = 0
                -
                3134 if (m > n) then
                -
                3135 flag = 1
                -
                3136 else if (size(tau) /= mn) then
                -
                3137 flag = 2
                -
                3138 else if (size(q, 1) /= m .or. size(q, 2) /= n) then
                -
                3139 flag = 3
                -
                3140 end if
                -
                3141 if (flag /= 0) then
                -
                3142 ! ERROR: One of the input arrays is not sized correctly
                -
                3143 write(errmsg, 100) "Input number ", flag, &
                -
                3144 " is not sized correctly."
                -
                3145 call errmgr%report_error("form_lq_no_pivot_cmplx", trim(errmsg), &
                -
                3146 la_array_size_error)
                -
                3147 return
                -
                3148 end if
                -
                3149
                -
                3150 ! Workspace Query
                -
                3151 call zunglq(n, n, mn, q, n, tau, temp, -1, flag)
                -
                3152 lwork = int(temp(1), int32)
                -
                3153 if (present(olwork)) then
                -
                3154 olwork = lwork
                -
                3155 return
                -
                3156 end if
                -
                3157
                -
                3158 ! Local Memory Allocation
                -
                3159 if (present(work)) then
                -
                3160 if (size(work) < lwork) then
                -
                3161 ! ERROR: WORK not sized correctly
                -
                3162 call errmgr%report_error("form_lq_no_pivot_cmplx", &
                -
                3163 "Incorrectly sized input array WORK, argument 4.", &
                -
                3164 la_array_size_error)
                -
                3165 return
                -
                3166 end if
                -
                3167 wptr => work(1:lwork)
                -
                3168 else
                -
                3169 allocate(wrk(lwork), stat = istat)
                -
                3170 if (istat /= 0) then
                -
                3171 ! ERROR: Out of memory
                -
                3172 call errmgr%report_error("form_lq_no_pivot_cmplx", &
                -
                3173 "Insufficient memory available.", &
                -
                3174 la_out_of_memory_error)
                -
                3175 return
                -
                3176 end if
                -
                3177 wptr => wrk
                -
                3178 end if
                -
                3179
                -
                3180 ! Copy the upper triangular portion of L to Q, and then zero it out in L
                -
                3181 do j = 2, n
                -
                3182 k = min(j - 1, m)
                -
                3183 q(1:j-1,j) = l(1:k,j)
                -
                3184 l(1:k,j) = zero
                -
                3185 end do
                -
                3186
                -
                3187 ! Build Q
                -
                3188 call zunglq(n, n, mn, q, n, tau, wptr, lwork, flag)
                -
                3189
                -
                3190 ! Formatting
                -
                3191100 format(a, i0, a)
                -
                3192 end subroutine
                -
                3193
                -
                3194! ------------------------------------------------------------------------------
                -
                3195 module subroutine mult_lq_mtx(lside, trans, a, tau, c, work, olwork, err)
                -
                3196 ! Arguments
                -
                3197 logical, intent(in) :: lside, trans
                -
                3198 real(real64), intent(in), dimension(:,:) :: a
                -
                3199 real(real64), intent(in), dimension(:) :: tau
                -
                3200 real(real64), intent(inout), dimension(:,:) :: c
                -
                3201 real(real64), intent(out), target, dimension(:), optional :: work
                -
                3202 integer(int32), intent(out), optional :: olwork
                -
                3203 class(errors), intent(inout), optional, target :: err
                -
                3204
                -
                3205 ! Local Variables
                -
                3206 character :: side, t
                -
                3207 integer(int32) :: m, n, k, ncola, istat, flag, lwork
                -
                3208 real(real64), pointer, dimension(:) :: wptr
                -
                3209 real(real64), allocatable, target, dimension(:) :: wrk
                -
                3210 real(real64), dimension(1) :: temp
                -
                3211 class(errors), pointer :: errmgr
                -
                3212 type(errors), target :: deferr
                -
                3213 character(len = 128) :: errmsg
                -
                3214
                -
                3215 ! Initialization
                -
                3216 m = size(c, 1)
                -
                3217 n = size(c, 2)
                -
                3218 k = size(tau)
                -
                3219 if (lside) then
                -
                3220 side = 'L'
                -
                3221 ncola = m
                -
                3222 else
                -
                3223 side = 'R'
                -
                3224 ncola = n
                -
                3225 end if
                -
                3226 if (trans) then
                -
                3227 t = 'T'
                -
                3228 else
                -
                3229 t = 'N'
                -
                3230 end if
                -
                3231 if (present(err)) then
                -
                3232 errmgr => err
                -
                3233 else
                -
                3234 errmgr => deferr
                -
                3235 end if
                -
                3236
                -
                3237 ! Input Check
                -
                3238 flag = 0
                -
                3239 if (size(a, 1) /= k .or. size(a, 2) /= ncola) then
                -
                3240 flag = 3
                -
                3241 end if
                -
                3242 if (flag /= 0) then
                -
                3243 ! ERROR: One of the input arrays is not sized correctly
                -
                3244 write(errmsg, 100) "Input number ", flag, &
                -
                3245 " is not sized correctly."
                -
                3246 call errmgr%report_error("mult_lq_mtx", trim(errmsg), &
                -
                3247 la_array_size_error)
                -
                3248 return
                -
                3249 end if
                -
                3250
                -
                3251 ! Workspace Query
                -
                3252 call dormlq(side, t, m, n, k, a, k, tau, c, m, temp, -1, flag)
                -
                3253 lwork = int(temp(1), int32)
                -
                3254 if (present(olwork)) then
                -
                3255 olwork = lwork
                -
                3256 return
                -
                3257 end if
                -
                3258
                -
                3259 ! Local Memory Allocation
                -
                3260 if (present(work)) then
                -
                3261 if (size(work) < lwork) then
                -
                3262 ! ERROR: WORK not sized correctly
                -
                3263 call errmgr%report_error("mult_lq_mtx", &
                -
                3264 "Incorrectly sized input array WORK, argument 6.", &
                -
                3265 la_array_size_error)
                -
                3266 return
                -
                3267 end if
                -
                3268 wptr => work(1:lwork)
                -
                3269 else
                -
                3270 allocate(wrk(lwork), stat = istat)
                -
                3271 if (istat /= 0) then
                -
                3272 ! ERROR: Out of memory
                -
                3273 call errmgr%report_error("mult_lq_mtx", &
                -
                3274 "Insufficient memory available.", &
                -
                3275 la_out_of_memory_error)
                -
                3276 return
                -
                3277 end if
                -
                3278 wptr => wrk
                -
                3279 end if
                -
                3280
                -
                3281 ! Call DORMLQ
                -
                3282 call dormlq(side, t, m, n, k, a, k, tau, c, m, wptr, lwork, flag)
                -
                3283
                -
                3284 ! Formatting
                -
                3285100 format(a, i0, a)
                -
                3286 end subroutine
                -
                3287
                -
                3288! ------------------------------------------------------------------------------
                -
                3289 module subroutine mult_lq_mtx_cmplx(lside, trans, a, tau, c, work, olwork, err)
                -
                3290 ! Arguments
                -
                3291 logical, intent(in) :: lside, trans
                -
                3292 complex(real64), intent(in), dimension(:,:) :: a
                -
                3293 complex(real64), intent(in), dimension(:) :: tau
                -
                3294 complex(real64), intent(inout), dimension(:,:) :: c
                -
                3295 complex(real64), intent(out), target, dimension(:), optional :: work
                -
                3296 integer(int32), intent(out), optional :: olwork
                -
                3297 class(errors), intent(inout), optional, target :: err
                -
                3298
                -
                3299 ! Local Variables
                -
                3300 character :: side, t
                -
                3301 integer(int32) :: m, n, k, ncola, istat, flag, lwork
                -
                3302 complex(real64), pointer, dimension(:) :: wptr
                -
                3303 complex(real64), allocatable, target, dimension(:) :: wrk
                -
                3304 complex(real64), dimension(1) :: temp
                -
                3305 class(errors), pointer :: errmgr
                -
                3306 type(errors), target :: deferr
                -
                3307 character(len = 128) :: errmsg
                -
                3308
                -
                3309 ! Initialization
                -
                3310 m = size(c, 1)
                -
                3311 n = size(c, 2)
                -
                3312 k = size(tau)
                -
                3313 if (lside) then
                -
                3314 side = 'L'
                -
                3315 ncola = m
                -
                3316 else
                -
                3317 side = 'R'
                -
                3318 ncola = n
                -
                3319 end if
                -
                3320 if (trans) then
                -
                3321 t = 'T'
                -
                3322 else
                -
                3323 t = 'N'
                -
                3324 end if
                -
                3325 if (present(err)) then
                -
                3326 errmgr => err
                -
                3327 else
                -
                3328 errmgr => deferr
                -
                3329 end if
                -
                3330
                -
                3331 ! Input Check
                -
                3332 flag = 0
                -
                3333 if (size(a, 1) /= k .or. size(a, 2) /= ncola) then
                -
                3334 flag = 3
                -
                3335 end if
                -
                3336 if (flag /= 0) then
                -
                3337 ! ERROR: One of the input arrays is not sized correctly
                -
                3338 write(errmsg, 100) "Input number ", flag, &
                -
                3339 " is not sized correctly."
                -
                3340 call errmgr%report_error("mult_lq_mtx_cmplx", trim(errmsg), &
                -
                3341 la_array_size_error)
                -
                3342 return
                -
                3343 end if
                -
                3344
                -
                3345 ! Workspace Query
                -
                3346 call zunmlq(side, t, m, n, k, a, k, tau, c, m, temp, -1, flag)
                -
                3347 lwork = int(temp(1), int32)
                -
                3348 if (present(olwork)) then
                -
                3349 olwork = lwork
                -
                3350 return
                -
                3351 end if
                -
                3352
                -
                3353 ! Local Memory Allocation
                -
                3354 if (present(work)) then
                -
                3355 if (size(work) < lwork) then
                -
                3356 ! ERROR: WORK not sized correctly
                -
                3357 call errmgr%report_error("mult_lq_mtx_cmplx", &
                -
                3358 "Incorrectly sized input array WORK, argument 6.", &
                -
                3359 la_array_size_error)
                -
                3360 return
                -
                3361 end if
                -
                3362 wptr => work(1:lwork)
                -
                3363 else
                -
                3364 allocate(wrk(lwork), stat = istat)
                -
                3365 if (istat /= 0) then
                -
                3366 ! ERROR: Out of memory
                -
                3367 call errmgr%report_error("mult_lq_mtx_cmplx", &
                -
                3368 "Insufficient memory available.", &
                -
                3369 la_out_of_memory_error)
                -
                3370 return
                -
                3371 end if
                -
                3372 wptr => wrk
                -
                3373 end if
                -
                3374
                -
                3375 ! Call ZUNMLQ
                -
                3376 call zunmlq(side, t, m, n, k, a, k, tau, c, m, wptr, lwork, flag)
                -
                3377
                -
                3378 ! Formatting
                -
                3379100 format(a, i0, a)
                -
                3380 end subroutine
                -
                3381
                -
                3382! ------------------------------------------------------------------------------
                -
                3383 module subroutine mult_lq_vec(trans, a, tau, c, work, olwork, err)
                -
                3384 ! Arguments
                -
                3385 logical, intent(in) :: trans
                -
                3386 real(real64), intent(in), dimension(:,:) :: a
                -
                3387 real(real64), intent(in), dimension(:) :: tau
                -
                3388 real(real64), intent(inout), dimension(:) :: c
                -
                3389 real(real64), intent(out), target, dimension(:), optional :: work
                -
                3390 integer(int32), intent(out), optional :: olwork
                -
                3391 class(errors), intent(inout), optional, target :: err
                -
                3392
                -
                3393 ! Local Variables
                -
                3394 character :: side, t
                -
                3395 integer(int32) :: m, n, k, istat, flag, lwork
                -
                3396 real(real64), pointer, dimension(:) :: wptr
                -
                3397 real(real64), allocatable, target, dimension(:) :: wrk
                -
                3398 real(real64), dimension(1) :: temp
                -
                3399 class(errors), pointer :: errmgr
                -
                3400 type(errors), target :: deferr
                -
                3401 character(len = 128) :: errmsg
                -
                3402
                -
                3403 ! Initialization
                -
                3404 m = size(c)
                -
                3405 n = 1
                -
                3406 k = size(tau)
                -
                3407 side = 'L'
                -
                3408 if (trans) then
                -
                3409 t = 'T'
                -
                3410 else
                -
                3411 t = 'N'
                -
                3412 end if
                -
                3413 if (present(err)) then
                -
                3414 errmgr => err
                -
                3415 else
                -
                3416 errmgr => deferr
                -
                3417 end if
                -
                3418
                -
                3419 ! Input Check
                -
                3420 flag = 0
                -
                3421 if (size(a, 1) /= k .or. size(a, 2) /= m) then
                -
                3422 flag = 3
                -
                3423 end if
                -
                3424 if (flag /= 0) then
                -
                3425 ! ERROR: One of the input arrays is not sized correctly
                -
                3426 write(errmsg, 100) "Input number ", flag, &
                -
                3427 " is not sized correctly."
                -
                3428 call errmgr%report_error("mult_lq_vec", trim(errmsg), &
                -
                3429 la_array_size_error)
                -
                3430 return
                -
                3431 end if
                -
                3432
                -
                3433 ! Workspace Query
                -
                3434 call dormlq(side, t, m, n, k, a, k, tau, c, m, temp, -1, flag)
                -
                3435 lwork = int(temp(1), int32)
                -
                3436 if (present(olwork)) then
                -
                3437 olwork = lwork
                -
                3438 return
                -
                3439 end if
                -
                3440
                -
                3441 ! Local Memory Allocation
                -
                3442 if (present(work)) then
                -
                3443 if (size(work) < lwork) then
                -
                3444 ! ERROR: WORK not sized correctly
                -
                3445 call errmgr%report_error("mult_lq_vec", &
                -
                3446 "Incorrectly sized input array WORK, argument 6.", &
                -
                3447 la_array_size_error)
                -
                3448 return
                -
                3449 end if
                -
                3450 wptr => work(1:lwork)
                -
                3451 else
                -
                3452 allocate(wrk(lwork), stat = istat)
                -
                3453 if (istat /= 0) then
                -
                3454 ! ERROR: Out of memory
                -
                3455 call errmgr%report_error("mult_lq_vec", &
                -
                3456 "Insufficient memory available.", &
                -
                3457 la_out_of_memory_error)
                -
                3458 return
                -
                3459 end if
                -
                3460 wptr => wrk
                -
                3461 end if
                -
                3462
                -
                3463 ! Call DORMLQ
                -
                3464 call dormlq(side, t, m, n, k, a, k, tau, c, m, wptr, lwork, flag)
                -
                3465
                -
                3466 ! Formatting
                -
                3467100 format(a, i0, a)
                -
                3468 end subroutine
                -
                3469
                -
                3470! ------------------------------------------------------------------------------
                -
                3471 module subroutine mult_lq_vec_cmplx(trans, a, tau, c, work, olwork, err)
                -
                3472 ! Arguments
                -
                3473 logical, intent(in) :: trans
                -
                3474 complex(real64), intent(in), dimension(:,:) :: a
                -
                3475 complex(real64), intent(in), dimension(:) :: tau
                -
                3476 complex(real64), intent(inout), dimension(:) :: c
                -
                3477 complex(real64), intent(out), target, dimension(:), optional :: work
                -
                3478 integer(int32), intent(out), optional :: olwork
                -
                3479 class(errors), intent(inout), optional, target :: err
                -
                3480
                -
                3481 ! Local Variables
                -
                3482 character :: side, t
                -
                3483 integer(int32) :: m, n, k, istat, flag, lwork
                -
                3484 complex(real64), pointer, dimension(:) :: wptr
                -
                3485 complex(real64), allocatable, target, dimension(:) :: wrk
                -
                3486 complex(real64), dimension(1) :: temp
                -
                3487 class(errors), pointer :: errmgr
                -
                3488 type(errors), target :: deferr
                -
                3489 character(len = 128) :: errmsg
                -
                3490
                -
                3491 ! Initialization
                -
                3492 m = size(c)
                -
                3493 n = 1
                -
                3494 k = size(tau)
                -
                3495 side = 'L'
                -
                3496 if (trans) then
                -
                3497 t = 'T'
                -
                3498 else
                -
                3499 t = 'N'
                -
                3500 end if
                -
                3501 if (present(err)) then
                -
                3502 errmgr => err
                -
                3503 else
                -
                3504 errmgr => deferr
                -
                3505 end if
                -
                3506
                -
                3507 ! Input Check
                -
                3508 flag = 0
                -
                3509 if (size(a, 1) /= k .or. size(a, 2) /= m) then
                -
                3510 flag = 3
                -
                3511 end if
                -
                3512 if (flag /= 0) then
                -
                3513 ! ERROR: One of the input arrays is not sized correctly
                -
                3514 write(errmsg, 100) "Input number ", flag, &
                -
                3515 " is not sized correctly."
                -
                3516 call errmgr%report_error("mult_lq_vec_cmplx", trim(errmsg), &
                -
                3517 la_array_size_error)
                -
                3518 return
                -
                3519 end if
                -
                3520
                -
                3521 ! Workspace Query
                -
                3522 call zunmlq(side, t, m, n, k, a, k, tau, c, m, temp, -1, flag)
                -
                3523 lwork = int(temp(1), int32)
                -
                3524 if (present(olwork)) then
                -
                3525 olwork = lwork
                -
                3526 return
                -
                3527 end if
                -
                3528
                -
                3529 ! Local Memory Allocation
                -
                3530 if (present(work)) then
                -
                3531 if (size(work) < lwork) then
                -
                3532 ! ERROR: WORK not sized correctly
                -
                3533 call errmgr%report_error("mult_lq_vec_cmplx", &
                -
                3534 "Incorrectly sized input array WORK, argument 6.", &
                -
                3535 la_array_size_error)
                -
                3536 return
                -
                3537 end if
                -
                3538 wptr => work(1:lwork)
                -
                3539 else
                -
                3540 allocate(wrk(lwork), stat = istat)
                -
                3541 if (istat /= 0) then
                -
                3542 ! ERROR: Out of memory
                -
                3543 call errmgr%report_error("mult_lq_vec_cmplx", &
                -
                3544 "Insufficient memory available.", &
                -
                3545 la_out_of_memory_error)
                -
                3546 return
                -
                3547 end if
                -
                3548 wptr => wrk
                -
                3549 end if
                -
                3550
                -
                3551 ! Call ZUNMLQ
                -
                3552 call zunmlq(side, t, m, n, k, a, k, tau, c, m, wptr, lwork, flag)
                -
                3553
                -
                3554 ! Formatting
                -
                3555100 format(a, i0, a)
                -
                3556 end subroutine
                -
                3557
                -
                3558! ------------------------------------------------------------------------------
                -
                3559end submodule
                +
                3125 if (present(err)) then
                +
                3126 errmgr => err
                +
                3127 else
                +
                3128 errmgr => deferr
                +
                3129 end if
                +
                3130
                +
                3131 ! Input Check
                +
                3132 flag = 0
                +
                3133 if (m > n) then
                +
                3134 flag = 1
                +
                3135 else if (size(tau) /= mn) then
                +
                3136 flag = 2
                +
                3137 else if (size(q, 1) /= n .or. size(q, 2) /= n) then
                +
                3138 flag = 3
                +
                3139 end if
                +
                3140 if (flag /= 0) then
                +
                3141 ! ERROR: One of the input arrays is not sized correctly
                +
                3142 write(errmsg, 100) "Input number ", flag, &
                +
                3143 " is not sized correctly."
                +
                3144 call errmgr%report_error("form_lq_no_pivot_cmplx", trim(errmsg), &
                +
                3145 la_array_size_error)
                +
                3146 return
                +
                3147 end if
                +
                3148
                +
                3149 ! Workspace Query
                +
                3150 call zunglq(n, n, mn, q, n, tau, temp, -1, flag)
                +
                3151 lwork = int(temp(1), int32)
                +
                3152 if (present(olwork)) then
                +
                3153 olwork = lwork
                +
                3154 return
                +
                3155 end if
                +
                3156
                +
                3157 ! Local Memory Allocation
                +
                3158 if (present(work)) then
                +
                3159 if (size(work) < lwork) then
                +
                3160 ! ERROR: WORK not sized correctly
                +
                3161 call errmgr%report_error("form_lq_no_pivot_cmplx", &
                +
                3162 "Incorrectly sized input array WORK, argument 4.", &
                +
                3163 la_array_size_error)
                +
                3164 return
                +
                3165 end if
                +
                3166 wptr => work(1:lwork)
                +
                3167 else
                +
                3168 allocate(wrk(lwork), stat = istat)
                +
                3169 if (istat /= 0) then
                +
                3170 ! ERROR: Out of memory
                +
                3171 call errmgr%report_error("form_lq_no_pivot_cmplx", &
                +
                3172 "Insufficient memory available.", &
                +
                3173 la_out_of_memory_error)
                +
                3174 return
                +
                3175 end if
                +
                3176 wptr => wrk
                +
                3177 end if
                +
                3178
                +
                3179 ! Copy the upper triangular portion of L to Q, and then zero it out in L
                +
                3180 do j = 2, n
                +
                3181 k = min(j - 1, m)
                +
                3182 q(1:j-1,j) = l(1:k,j)
                +
                3183 l(1:k,j) = zero
                +
                3184 end do
                +
                3185
                +
                3186 ! Build Q
                +
                3187 call zunglq(n, n, mn, q, n, tau, wptr, lwork, flag)
                +
                3188
                +
                3189 ! Formatting
                +
                3190100 format(a, i0, a)
                +
                3191 end subroutine
                +
                3192
                +
                3193! ------------------------------------------------------------------------------
                +
                3194 module subroutine mult_lq_mtx(lside, trans, a, tau, c, work, olwork, err)
                +
                3195 ! Arguments
                +
                3196 logical, intent(in) :: lside, trans
                +
                3197 real(real64), intent(in), dimension(:,:) :: a
                +
                3198 real(real64), intent(in), dimension(:) :: tau
                +
                3199 real(real64), intent(inout), dimension(:,:) :: c
                +
                3200 real(real64), intent(out), target, dimension(:), optional :: work
                +
                3201 integer(int32), intent(out), optional :: olwork
                +
                3202 class(errors), intent(inout), optional, target :: err
                +
                3203
                +
                3204 ! Local Variables
                +
                3205 character :: side, t
                +
                3206 integer(int32) :: m, n, k, ncola, istat, flag, lwork
                +
                3207 real(real64), pointer, dimension(:) :: wptr
                +
                3208 real(real64), allocatable, target, dimension(:) :: wrk
                +
                3209 real(real64), dimension(1) :: temp
                +
                3210 class(errors), pointer :: errmgr
                +
                3211 type(errors), target :: deferr
                +
                3212 character(len = 128) :: errmsg
                +
                3213
                +
                3214 ! Initialization
                +
                3215 m = size(c, 1)
                +
                3216 n = size(c, 2)
                +
                3217 k = size(tau)
                +
                3218 if (lside) then
                +
                3219 side = 'L'
                +
                3220 ncola = m
                +
                3221 else
                +
                3222 side = 'R'
                +
                3223 ncola = n
                +
                3224 end if
                +
                3225 if (trans) then
                +
                3226 t = 'T'
                +
                3227 else
                +
                3228 t = 'N'
                +
                3229 end if
                +
                3230 if (present(err)) then
                +
                3231 errmgr => err
                +
                3232 else
                +
                3233 errmgr => deferr
                +
                3234 end if
                +
                3235
                +
                3236 ! Input Check
                +
                3237 flag = 0
                +
                3238 if (size(a, 1) /= k .or. size(a, 2) /= ncola) then
                +
                3239 flag = 3
                +
                3240 end if
                +
                3241 if (flag /= 0) then
                +
                3242 ! ERROR: One of the input arrays is not sized correctly
                +
                3243 write(errmsg, 100) "Input number ", flag, &
                +
                3244 " is not sized correctly."
                +
                3245 call errmgr%report_error("mult_lq_mtx", trim(errmsg), &
                +
                3246 la_array_size_error)
                +
                3247 return
                +
                3248 end if
                +
                3249
                +
                3250 ! Workspace Query
                +
                3251 call dormlq(side, t, m, n, k, a, k, tau, c, m, temp, -1, flag)
                +
                3252 lwork = int(temp(1), int32)
                +
                3253 if (present(olwork)) then
                +
                3254 olwork = lwork
                +
                3255 return
                +
                3256 end if
                +
                3257
                +
                3258 ! Local Memory Allocation
                +
                3259 if (present(work)) then
                +
                3260 if (size(work) < lwork) then
                +
                3261 ! ERROR: WORK not sized correctly
                +
                3262 call errmgr%report_error("mult_lq_mtx", &
                +
                3263 "Incorrectly sized input array WORK, argument 6.", &
                +
                3264 la_array_size_error)
                +
                3265 return
                +
                3266 end if
                +
                3267 wptr => work(1:lwork)
                +
                3268 else
                +
                3269 allocate(wrk(lwork), stat = istat)
                +
                3270 if (istat /= 0) then
                +
                3271 ! ERROR: Out of memory
                +
                3272 call errmgr%report_error("mult_lq_mtx", &
                +
                3273 "Insufficient memory available.", &
                +
                3274 la_out_of_memory_error)
                +
                3275 return
                +
                3276 end if
                +
                3277 wptr => wrk
                +
                3278 end if
                +
                3279
                +
                3280 ! Call DORMLQ
                +
                3281 call dormlq(side, t, m, n, k, a, k, tau, c, m, wptr, lwork, flag)
                +
                3282
                +
                3283 ! Formatting
                +
                3284100 format(a, i0, a)
                +
                3285 end subroutine
                +
                3286
                +
                3287! ------------------------------------------------------------------------------
                +
                3288 module subroutine mult_lq_mtx_cmplx(lside, trans, a, tau, c, work, olwork, err)
                +
                3289 ! Arguments
                +
                3290 logical, intent(in) :: lside, trans
                +
                3291 complex(real64), intent(in), dimension(:,:) :: a
                +
                3292 complex(real64), intent(in), dimension(:) :: tau
                +
                3293 complex(real64), intent(inout), dimension(:,:) :: c
                +
                3294 complex(real64), intent(out), target, dimension(:), optional :: work
                +
                3295 integer(int32), intent(out), optional :: olwork
                +
                3296 class(errors), intent(inout), optional, target :: err
                +
                3297
                +
                3298 ! Local Variables
                +
                3299 character :: side, t
                +
                3300 integer(int32) :: m, n, k, ncola, istat, flag, lwork
                +
                3301 complex(real64), pointer, dimension(:) :: wptr
                +
                3302 complex(real64), allocatable, target, dimension(:) :: wrk
                +
                3303 complex(real64), dimension(1) :: temp
                +
                3304 class(errors), pointer :: errmgr
                +
                3305 type(errors), target :: deferr
                +
                3306 character(len = 128) :: errmsg
                +
                3307
                +
                3308 ! Initialization
                +
                3309 m = size(c, 1)
                +
                3310 n = size(c, 2)
                +
                3311 k = size(tau)
                +
                3312 if (lside) then
                +
                3313 side = 'L'
                +
                3314 ncola = m
                +
                3315 else
                +
                3316 side = 'R'
                +
                3317 ncola = n
                +
                3318 end if
                +
                3319 if (trans) then
                +
                3320 t = 'C'
                +
                3321 else
                +
                3322 t = 'N'
                +
                3323 end if
                +
                3324 if (present(err)) then
                +
                3325 errmgr => err
                +
                3326 else
                +
                3327 errmgr => deferr
                +
                3328 end if
                +
                3329
                +
                3330 ! Input Check
                +
                3331 flag = 0
                +
                3332 if (size(a, 1) /= k .or. size(a, 2) /= ncola) then
                +
                3333 flag = 3
                +
                3334 end if
                +
                3335 if (flag /= 0) then
                +
                3336 ! ERROR: One of the input arrays is not sized correctly
                +
                3337 write(errmsg, 100) "Input number ", flag, &
                +
                3338 " is not sized correctly."
                +
                3339 call errmgr%report_error("mult_lq_mtx_cmplx", trim(errmsg), &
                +
                3340 la_array_size_error)
                +
                3341 return
                +
                3342 end if
                +
                3343
                +
                3344 ! Workspace Query
                +
                3345 call zunmlq(side, t, m, n, k, a, k, tau, c, m, temp, -1, flag)
                +
                3346 lwork = int(temp(1), int32)
                +
                3347 if (present(olwork)) then
                +
                3348 olwork = lwork
                +
                3349 return
                +
                3350 end if
                +
                3351
                +
                3352 ! Local Memory Allocation
                +
                3353 if (present(work)) then
                +
                3354 if (size(work) < lwork) then
                +
                3355 ! ERROR: WORK not sized correctly
                +
                3356 call errmgr%report_error("mult_lq_mtx_cmplx", &
                +
                3357 "Incorrectly sized input array WORK, argument 6.", &
                +
                3358 la_array_size_error)
                +
                3359 return
                +
                3360 end if
                +
                3361 wptr => work(1:lwork)
                +
                3362 else
                +
                3363 allocate(wrk(lwork), stat = istat)
                +
                3364 if (istat /= 0) then
                +
                3365 ! ERROR: Out of memory
                +
                3366 call errmgr%report_error("mult_lq_mtx_cmplx", &
                +
                3367 "Insufficient memory available.", &
                +
                3368 la_out_of_memory_error)
                +
                3369 return
                +
                3370 end if
                +
                3371 wptr => wrk
                +
                3372 end if
                +
                3373
                +
                3374 ! Call ZUNMLQ
                +
                3375 call zunmlq(side, t, m, n, k, a, k, tau, c, m, wptr, lwork, flag)
                +
                3376
                +
                3377 ! Formatting
                +
                3378100 format(a, i0, a)
                +
                3379 end subroutine
                +
                3380
                +
                3381! ------------------------------------------------------------------------------
                +
                3382 module subroutine mult_lq_vec(trans, a, tau, c, work, olwork, err)
                +
                3383 ! Arguments
                +
                3384 logical, intent(in) :: trans
                +
                3385 real(real64), intent(in), dimension(:,:) :: a
                +
                3386 real(real64), intent(in), dimension(:) :: tau
                +
                3387 real(real64), intent(inout), dimension(:) :: c
                +
                3388 real(real64), intent(out), target, dimension(:), optional :: work
                +
                3389 integer(int32), intent(out), optional :: olwork
                +
                3390 class(errors), intent(inout), optional, target :: err
                +
                3391
                +
                3392 ! Local Variables
                +
                3393 character :: side, t
                +
                3394 integer(int32) :: m, n, k, istat, flag, lwork
                +
                3395 real(real64), pointer, dimension(:) :: wptr
                +
                3396 real(real64), allocatable, target, dimension(:) :: wrk
                +
                3397 real(real64), dimension(1) :: temp
                +
                3398 class(errors), pointer :: errmgr
                +
                3399 type(errors), target :: deferr
                +
                3400 character(len = 128) :: errmsg
                +
                3401
                +
                3402 ! Initialization
                +
                3403 m = size(c)
                +
                3404 n = 1
                +
                3405 k = size(tau)
                +
                3406 side = 'L'
                +
                3407 if (trans) then
                +
                3408 t = 'T'
                +
                3409 else
                +
                3410 t = 'N'
                +
                3411 end if
                +
                3412 if (present(err)) then
                +
                3413 errmgr => err
                +
                3414 else
                +
                3415 errmgr => deferr
                +
                3416 end if
                +
                3417
                +
                3418 ! Input Check
                +
                3419 flag = 0
                +
                3420 if (size(a, 1) /= k .or. size(a, 2) /= m) then
                +
                3421 flag = 3
                +
                3422 end if
                +
                3423 if (flag /= 0) then
                +
                3424 ! ERROR: One of the input arrays is not sized correctly
                +
                3425 write(errmsg, 100) "Input number ", flag, &
                +
                3426 " is not sized correctly."
                +
                3427 call errmgr%report_error("mult_lq_vec", trim(errmsg), &
                +
                3428 la_array_size_error)
                +
                3429 return
                +
                3430 end if
                +
                3431
                +
                3432 ! Workspace Query
                +
                3433 call dormlq(side, t, m, n, k, a, k, tau, c, m, temp, -1, flag)
                +
                3434 lwork = int(temp(1), int32)
                +
                3435 if (present(olwork)) then
                +
                3436 olwork = lwork
                +
                3437 return
                +
                3438 end if
                +
                3439
                +
                3440 ! Local Memory Allocation
                +
                3441 if (present(work)) then
                +
                3442 if (size(work) < lwork) then
                +
                3443 ! ERROR: WORK not sized correctly
                +
                3444 call errmgr%report_error("mult_lq_vec", &
                +
                3445 "Incorrectly sized input array WORK, argument 6.", &
                +
                3446 la_array_size_error)
                +
                3447 return
                +
                3448 end if
                +
                3449 wptr => work(1:lwork)
                +
                3450 else
                +
                3451 allocate(wrk(lwork), stat = istat)
                +
                3452 if (istat /= 0) then
                +
                3453 ! ERROR: Out of memory
                +
                3454 call errmgr%report_error("mult_lq_vec", &
                +
                3455 "Insufficient memory available.", &
                +
                3456 la_out_of_memory_error)
                +
                3457 return
                +
                3458 end if
                +
                3459 wptr => wrk
                +
                3460 end if
                +
                3461
                +
                3462 ! Call DORMLQ
                +
                3463 call dormlq(side, t, m, n, k, a, k, tau, c, m, wptr, lwork, flag)
                +
                3464
                +
                3465 ! Formatting
                +
                3466100 format(a, i0, a)
                +
                3467 end subroutine
                +
                3468
                +
                3469! ------------------------------------------------------------------------------
                +
                3470 module subroutine mult_lq_vec_cmplx(trans, a, tau, c, work, olwork, err)
                +
                3471 ! Arguments
                +
                3472 logical, intent(in) :: trans
                +
                3473 complex(real64), intent(in), dimension(:,:) :: a
                +
                3474 complex(real64), intent(in), dimension(:) :: tau
                +
                3475 complex(real64), intent(inout), dimension(:) :: c
                +
                3476 complex(real64), intent(out), target, dimension(:), optional :: work
                +
                3477 integer(int32), intent(out), optional :: olwork
                +
                3478 class(errors), intent(inout), optional, target :: err
                +
                3479
                +
                3480 ! Local Variables
                +
                3481 character :: side, t
                +
                3482 integer(int32) :: m, n, k, istat, flag, lwork
                +
                3483 complex(real64), pointer, dimension(:) :: wptr
                +
                3484 complex(real64), allocatable, target, dimension(:) :: wrk
                +
                3485 complex(real64), dimension(1) :: temp
                +
                3486 class(errors), pointer :: errmgr
                +
                3487 type(errors), target :: deferr
                +
                3488 character(len = 128) :: errmsg
                +
                3489
                +
                3490 ! Initialization
                +
                3491 m = size(c)
                +
                3492 n = 1
                +
                3493 k = size(tau)
                +
                3494 side = 'L'
                +
                3495 if (trans) then
                +
                3496 t = 'C'
                +
                3497 else
                +
                3498 t = 'N'
                +
                3499 end if
                +
                3500 if (present(err)) then
                +
                3501 errmgr => err
                +
                3502 else
                +
                3503 errmgr => deferr
                +
                3504 end if
                +
                3505
                +
                3506 ! Input Check
                +
                3507 flag = 0
                +
                3508 if (size(a, 1) /= k .or. size(a, 2) /= m) then
                +
                3509 flag = 3
                +
                3510 end if
                +
                3511 if (flag /= 0) then
                +
                3512 ! ERROR: One of the input arrays is not sized correctly
                +
                3513 write(errmsg, 100) "Input number ", flag, &
                +
                3514 " is not sized correctly."
                +
                3515 call errmgr%report_error("mult_lq_vec_cmplx", trim(errmsg), &
                +
                3516 la_array_size_error)
                +
                3517 return
                +
                3518 end if
                +
                3519
                +
                3520 ! Workspace Query
                +
                3521 call zunmlq(side, t, m, n, k, a, k, tau, c, m, temp, -1, flag)
                +
                3522 lwork = int(temp(1), int32)
                +
                3523 if (present(olwork)) then
                +
                3524 olwork = lwork
                +
                3525 return
                +
                3526 end if
                +
                3527
                +
                3528 ! Local Memory Allocation
                +
                3529 if (present(work)) then
                +
                3530 if (size(work) < lwork) then
                +
                3531 ! ERROR: WORK not sized correctly
                +
                3532 call errmgr%report_error("mult_lq_vec_cmplx", &
                +
                3533 "Incorrectly sized input array WORK, argument 6.", &
                +
                3534 la_array_size_error)
                +
                3535 return
                +
                3536 end if
                +
                3537 wptr => work(1:lwork)
                +
                3538 else
                +
                3539 allocate(wrk(lwork), stat = istat)
                +
                3540 if (istat /= 0) then
                +
                3541 ! ERROR: Out of memory
                +
                3542 call errmgr%report_error("mult_lq_vec_cmplx", &
                +
                3543 "Insufficient memory available.", &
                +
                3544 la_out_of_memory_error)
                +
                3545 return
                +
                3546 end if
                +
                3547 wptr => wrk
                +
                3548 end if
                +
                3549
                +
                3550 ! Call ZUNMLQ
                +
                3551 call zunmlq(side, t, m, n, k, a, k, tau, c, m, wptr, lwork, flag)
                +
                3552
                +
                3553 ! Formatting
                +
                3554100 format(a, i0, a)
                +
                3555 end subroutine
                +
                3556
                +
                3557! ------------------------------------------------------------------------------
                +
                3558end submodule
                Provides a set of common linear algebra routines.
                Definition: linalg.f90:145

                From fe0a664cf896ab35e228cbc68625fd68f4b0f64f Mon Sep 17 00:00:00 2001 From: jchristopherson Date: Tue, 20 Dec 2022 19:30:59 -0600 Subject: [PATCH 60/65] Add tests --- tests/c_linalg_test.c | 6 +++ tests/c_linalg_test.h | 2 + tests/c_linalg_test_factor.c | 87 ++++++++++++++++++++++++++++++++++++ 3 files changed, 95 insertions(+) diff --git a/tests/c_linalg_test.c b/tests/c_linalg_test.c index 651f4615..696437fa 100644 --- a/tests/c_linalg_test.c +++ b/tests/c_linalg_test.c @@ -79,6 +79,12 @@ int main() check = test_eigen_gen(); if (!check) flag = 15; + check = test_lq(); + if (!check) flag = 16; + + // check = test_cmplx_lq(); + // if (!check) flag = 17; + // End return flag; } diff --git a/tests/c_linalg_test.h b/tests/c_linalg_test.h index e50c61d5..167350a0 100644 --- a/tests/c_linalg_test.h +++ b/tests/c_linalg_test.h @@ -33,6 +33,8 @@ bool test_svd(); bool test_cmplx_svd(); bool test_inverse(); bool test_cmplx_inverse(); +bool test_lq(); +bool test_cmplx_lq(); // c_linalg_test_eigen.c bool test_eigen_symm(); diff --git a/tests/c_linalg_test_factor.c b/tests/c_linalg_test_factor.c index 2daf69f3..40340de1 100644 --- a/tests/c_linalg_test_factor.c +++ b/tests/c_linalg_test_factor.c @@ -649,3 +649,90 @@ bool test_cmplx_inverse() if (!is_cmplx_mtx_equal(n, n, a, ainv, tol)) rst = false; return rst; } + + + + + +bool test_lq() +{ + // Variables + const int m = 50; + const int n = 50; + const int nrhs = 20; + const int mn = m * n; + const int mnrhs = m * nrhs; + const int nnrhs = n * nrhs; + const int minmn = MIN(m, n); + const double tol = 1.0e-8; + const double zero = 0.0; + const double one = 1.0; + double a[mn], a1[mn], x[nnrhs], tau[minmn], b[mnrhs], bref[mnrhs]; + bool rst; + int i, j, flag; + + // Initialization + rst = true; + create_matrix(m, n, a); + copy_matrix(m, n, a, a1); + create_matrix(m, nrhs, bref); + copy_matrix(m, nrhs, bref, x); + + // Factor + flag = la_lq_factor(m, n, a, m, tau); + if (flag != LA_NO_ERROR) rst = false; + + // Solve + flag = la_solve_lq(m, n, nrhs, a, m, tau, x, n); + if (flag != LA_NO_ERROR) rst = false; + + // Test by ensuring A * X = B + flag = la_mtx_mult(false, false, m, nrhs, n, one, a1, m, x, n, zero, b, m); + if (flag != LA_NO_ERROR) rst = false; + if (!is_mtx_equal(m, nrhs, b, bref, tol)) rst = false; + + // End + return rst; +} + +bool test_cmplx_lq() +{ + // Variables + const int m = 50; + const int n = 50; + const int nrhs = 20; + const int mn = m * n; + const int mnrhs = m * nrhs; + const int nnrhs = n * nrhs; + const int minmn = MIN(m, n); + const double tol = 1.0e-8; + const double complex zero = 0.0 + 0.0 * I; + const double complex one = 1.0 + 1.0 * I; + double complex a[mn], a1[mn], x[nnrhs], tau[minmn], b[mnrhs], bref[mnrhs]; + bool rst; + int i, j, flag; + + // Initialization + rst = true; + cmplx_create_matrix(m, n, a); + cmplx_copy_matrix(m, n, a, a1); + cmplx_create_matrix(m, nrhs, bref); + cmplx_copy_matrix(m, nrhs, bref, x); + + // Factor + flag = la_lq_factor_cmplx(m, n, a, m, tau); + if (flag != LA_NO_ERROR) rst = false; + + // Solve + flag = la_solve_lq_cmplx(m, n, nrhs, a, m, tau, x, n); + if (flag != LA_NO_ERROR) rst = false; + + // Test by ensuring A * X = B + flag = la_mtx_mult_cmplx(LA_NO_OPERATION, LA_NO_OPERATION, m, nrhs, n, + one, a1, m, x, n, zero, b, m); + if (flag != LA_NO_ERROR) rst = false; + if (!is_cmplx_mtx_equal(m, nrhs, b, bref, tol)) rst = false; + + // End + return rst; +} From 87c5c47d34879b38b19633e6a156691e07954ef8 Mon Sep 17 00:00:00 2001 From: jchristopherson Date: Wed, 21 Dec 2022 06:12:48 -0600 Subject: [PATCH 61/65] Update build scripts --- CMakeLists.txt | 3 +- install/CMakeLists.txt | 63 +++++++++++++++++++++++++++++++++++ install/linalgConfig.cmake.in | 3 ++ install/template.pc | 10 ++++++ linalgConfig.cmake.in | 1 - 5 files changed, 78 insertions(+), 2 deletions(-) create mode 100644 install/CMakeLists.txt create mode 100644 install/linalgConfig.cmake.in create mode 100644 install/template.pc delete mode 100644 linalgConfig.cmake.in diff --git a/CMakeLists.txt b/CMakeLists.txt index 2aad2d42..b6179b4c 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -35,6 +35,7 @@ target_link_libraries(${PROJECT_NAME} ${BLAS_LIBRARIES} ${LAPACK_LIBRARIES}) link_library(${PROJECT_NAME} ${ferror_LIBRARY} ${ferror_INCLUDE_DIR}) # Installation +add_subdirectory(install) # Testing option(BUILD_TESTING "Build tests") @@ -46,7 +47,7 @@ if (BUILD_TESTING) endif() # Examples -option(BUILD_LINALG_EXAMPLES "Build examples") +option(BUILD_LINALG_EXAMPLES "Build LINALG examples") message(STATUS "Build LINALG examples: ${BUILD_LINALG_EXAMPLES}") if (BUILD_LINALG_EXAMPLES) add_subdirectory(examples) diff --git a/install/CMakeLists.txt b/install/CMakeLists.txt new file mode 100644 index 00000000..8c3e384e --- /dev/null +++ b/install/CMakeLists.txt @@ -0,0 +1,63 @@ +# Get the macros and functions we'll need +include("${PROJECT_SOURCE_DIR}/cmake/helper.cmake") +include(CMakePackageConfigHelpers) + +# Install the library and necessary include files +install_library( + ${PROJECT_NAME} + ${CMAKE_INSTALL_LIBDIR} + ${CMAKE_INSTALL_BINDIR} + ${PROJECT_INCLUDE_DIR} + ${CMAKE_INSTALL_PREFIX} +) + +# Install the documentation files +install_documentation( + ${PROJECT_SOURCE_DIR}/doc/html + ${CMAKE_INSTALL_PREFIX}/doc/Fortran +) +install_documentation( + ${PROJECT_SOURCE_DIR}/doc/C/html + ${CMAKE_INSTALL_PREFIX}/doc/C +) + +# Define the version file +write_basic_package_version_file( + ${CMAKE_BINARY_DIR}/${PROJECT_NAME}ConfigVersion.cmake + VERSION ${PROJECT_VERSION} + COMPATIBILITY AnyNewerVersion +) + +export( + EXPORT ${PROJECT_NAME}Targets + FILE ${CMAKE_BINARY_DIR}/${PROJECT_NAME}Targets.cmake +) + +# Define the configuration file +configure_file( + ${CMAKE_CURRENT_SOURCE_DIR}/${PROJECT_NAME}Config.cmake.in + ${CMAKE_BINARY_DIR}/${PROJECT_NAME}Config.cmake + COPYONLY +) + +install( + EXPORT ${PROJECT_NAME}Targets + FILE ${PROJECT_NAME}Targets.cmake + DESTINATION ${CMAKE_INSTALL_LIBDIR}/cmake/${PROJECT_NAME} +) +install( + FILES + ${CMAKE_BINARY_DIR}/${PROJECT_NAME}Config.cmake + ${CMAKE_BINARY_DIR}/${PROJECT_NAME}ConfigVersion.cmake + DESTINATION ${CMAKE_INSTALL_LIBDIR}/cmake/${PROJECT_NAME} +) + +configure_file( + ${CMAKE_CURRENT_SOURCE_DIR}/template.pc + ${CMAKE_CURRENT_BINARY_DIR}/${PROJECT_NAME}.pc + @ONLY +) +install( + FILES ${CMAKE_CURRENT_BINARY_DIR}/${PROJECT_NAME}.pc + DESTINATION ${CMAKE_INSTALL_LIBDIR}/pkgconfig +) \ No newline at end of file diff --git a/install/linalgConfig.cmake.in b/install/linalgConfig.cmake.in new file mode 100644 index 00000000..4b066ac2 --- /dev/null +++ b/install/linalgConfig.cmake.in @@ -0,0 +1,3 @@ +if (NOT TARGET linalg) + include("${CMAKE_CURRENT_LIST_DIR}/linalgTargets.cmake") +endif() diff --git a/install/template.pc b/install/template.pc new file mode 100644 index 00000000..6471e789 --- /dev/null +++ b/install/template.pc @@ -0,0 +1,10 @@ +prefix = @CMAKE_INSTALL_PREFIX@ +libdir = ${prefix}/@CMAKE_INSTALL_FULL_LIBDIR@ +includedir = ${prefix}/@CMAKE_INSTALL_INCLUDEDIR@ + +Name: @PROJECT_NAME@ +Description: LINALG is a linear algebra library that provides a user-friendly interface to several BLAS and LAPACK routines.. +Version: @PROJECT_VERSION@ +URL: https://github.com/jchristopherson/linalg +Libs: -L${libdir} -l@PROJECT_NAME@ +Cflags: -I${includedir} \ No newline at end of file diff --git a/linalgConfig.cmake.in b/linalgConfig.cmake.in deleted file mode 100644 index 772cd105..00000000 --- a/linalgConfig.cmake.in +++ /dev/null @@ -1 +0,0 @@ -include("${CMAKE_CURRENT_LIST_DIR}/linalgTargets.cmake") From dcfbc0967d857c541261238d69e28bb8d26c9543 Mon Sep 17 00:00:00 2001 From: jchristopherson Date: Wed, 21 Dec 2022 06:20:16 -0600 Subject: [PATCH 62/65] Update install script --- install/CMakeLists.txt | 6 ++++++ 1 file changed, 6 insertions(+) diff --git a/install/CMakeLists.txt b/install/CMakeLists.txt index 8c3e384e..665b25b5 100644 --- a/install/CMakeLists.txt +++ b/install/CMakeLists.txt @@ -11,6 +11,12 @@ install_library( ${CMAKE_INSTALL_PREFIX} ) +# Install the C API headers +install( + DIRECTORY ${PROJECT_SOURCE_DIR}/include + DESTINATION ${CMAKE_INSTALL_PREFIX} +) + # Install the documentation files install_documentation( ${PROJECT_SOURCE_DIR}/doc/html From f33abe54ec2370c313e851be76ec4bccf8a75683 Mon Sep 17 00:00:00 2001 From: jchristopherson Date: Wed, 21 Dec 2022 06:20:42 -0600 Subject: [PATCH 63/65] Clean up --- .gitmodules | 0 .travis.yml | 40 ---------------------------------------- README.md | 3 --- 3 files changed, 43 deletions(-) delete mode 100644 .gitmodules delete mode 100644 .travis.yml diff --git a/.gitmodules b/.gitmodules deleted file mode 100644 index e69de29b..00000000 diff --git a/.travis.yml b/.travis.yml deleted file mode 100644 index 4eb9cce3..00000000 --- a/.travis.yml +++ /dev/null @@ -1,40 +0,0 @@ -language: c - -sudo: required - -before_install: - - sudo add-apt-repository -y ppa:ubuntu-toolchain-r/test - - sudo apt-get update -qq - -install: - - sudo apt-get install -qq gfortran-7 - - sudo update-alternatives --install /usr/bin/gfortran gfortran /usr/bin/gfortran-7 90 - - sudo apt install git - - sudo apt install cmake - - sudo git clone https://github.com/Reference-LAPACK/lapack.git - - pushd lapack - - sudo mkdir build - - pushd build - - sudo cmake -DCMAKE_INSTALL_LIBDIR=$HOME/.local/lapack .. - - sudo cmake - - sudo make - - sudo make install - - popd - - popd - - sudo git clone https://github.com/jchristopherson/ferror.git - - pushd ferror - - sudo mkdir build - - pushd build - - sudo cmake -DCMAKE_INSTALL_LIBDIR=$HOME/.local/ferror .. - - sudo cmake - - sudo make - - sudo make install - - popd - - popd - -before_script: - - mkdir build - - cd build - - cmake .. - -script: make diff --git a/README.md b/README.md index 776a489e..b8788e3e 100644 --- a/README.md +++ b/README.md @@ -1,9 +1,6 @@ # linalg A linear algebra library that provides a user-friendly interface to several BLAS and LAPACK routines. The examples below provide an illustration of just how simple it is to perform a few common linear algebra operations. -## Status -![Build Status](https://travis-ci.org/jchristopherson/linalg.svg?branch=master) - ## Example 1 This example solves a normally defined system of 3 equations of 3 unknowns. From f6f1073bee5f07f04d26d11aa8618f4fc2cbcac2 Mon Sep 17 00:00:00 2001 From: jchristopherson Date: Wed, 21 Dec 2022 06:21:51 -0600 Subject: [PATCH 64/65] Update version information --- CMakeLists.txt | 2 +- doc/C Doxyfile | 2 +- doc/Doxyfile | 2 +- 3 files changed, 3 insertions(+), 3 deletions(-) diff --git a/CMakeLists.txt b/CMakeLists.txt index b6179b4c..46becbdf 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -3,7 +3,7 @@ cmake_minimum_required(VERSION 3.17) project( linalg LANGUAGES Fortran C - VERSION 1.6.1 + VERSION 1.7.0 ) # Utilize the GNU installation structure diff --git a/doc/C Doxyfile b/doc/C Doxyfile index 3dca2dd5..fc142f62 100644 --- a/doc/C Doxyfile +++ b/doc/C Doxyfile @@ -48,7 +48,7 @@ PROJECT_NAME = linalg # could be handy for archiving the generated documentation or if some version # control system is used. -PROJECT_NUMBER = 1.6.1 +PROJECT_NUMBER = 1.7.0 # Using the PROJECT_BRIEF tag one can provide an optional one line description # for a project that appears at the top of each page and should give viewer a diff --git a/doc/Doxyfile b/doc/Doxyfile index 29090f1a..d5115c85 100644 --- a/doc/Doxyfile +++ b/doc/Doxyfile @@ -48,7 +48,7 @@ PROJECT_NAME = linalg # could be handy for archiving the generated documentation or if some version # control system is used. -PROJECT_NUMBER = 1.6.1 +PROJECT_NUMBER = 1.7.0 # Using the PROJECT_BRIEF tag one can provide an optional one line description # for a project that appears at the top of each page and should give viewer a From d19ed2cd027815c08729bc1cfb9a72922d56d6be Mon Sep 17 00:00:00 2001 From: jchristopherson Date: Wed, 21 Dec 2022 06:23:39 -0600 Subject: [PATCH 65/65] Update documentation --- doc/C/html/dir_d44c64559bbebec7f509842c48db8b23.html | 2 +- doc/C/html/files.html | 2 +- doc/C/html/globals.html | 2 +- doc/C/html/globals_func.html | 2 +- doc/C/html/index.html | 2 +- doc/C/html/linalg_8h.html | 2 +- doc/C/html/linalg_8h_source.html | 2 +- doc/html/annotated.html | 2 +- doc/html/classes.html | 2 +- doc/html/dir_68267d1309a1af8e8297ef4c3efbcdba.html | 2 +- doc/html/dir_d44c64559bbebec7f509842c48db8b23.html | 2 +- doc/html/files.html | 2 +- doc/html/globals.html | 2 +- doc/html/globals_func.html | 2 +- doc/html/graph_legend.html | 2 +- doc/html/index.html | 2 +- doc/html/interfacelinalg_1_1cholesky__factor-members.html | 2 +- doc/html/interfacelinalg_1_1cholesky__factor.html | 2 +- .../interfacelinalg_1_1cholesky__rank1__downdate-members.html | 2 +- doc/html/interfacelinalg_1_1cholesky__rank1__downdate.html | 2 +- .../interfacelinalg_1_1cholesky__rank1__update-members.html | 2 +- doc/html/interfacelinalg_1_1cholesky__rank1__update.html | 2 +- doc/html/interfacelinalg_1_1det-members.html | 2 +- doc/html/interfacelinalg_1_1det.html | 2 +- doc/html/interfacelinalg_1_1diag__mtx__mult-members.html | 2 +- doc/html/interfacelinalg_1_1diag__mtx__mult.html | 2 +- doc/html/interfacelinalg_1_1eigen-members.html | 2 +- doc/html/interfacelinalg_1_1eigen.html | 2 +- doc/html/interfacelinalg_1_1form__lq-members.html | 2 +- doc/html/interfacelinalg_1_1form__lq.html | 2 +- doc/html/interfacelinalg_1_1form__lu-members.html | 2 +- doc/html/interfacelinalg_1_1form__lu.html | 2 +- doc/html/interfacelinalg_1_1form__qr-members.html | 2 +- doc/html/interfacelinalg_1_1form__qr.html | 2 +- doc/html/interfacelinalg_1_1lq__factor-members.html | 2 +- doc/html/interfacelinalg_1_1lq__factor.html | 2 +- doc/html/interfacelinalg_1_1lu__factor-members.html | 2 +- doc/html/interfacelinalg_1_1lu__factor.html | 2 +- doc/html/interfacelinalg_1_1mtx__inverse-members.html | 2 +- doc/html/interfacelinalg_1_1mtx__inverse.html | 2 +- doc/html/interfacelinalg_1_1mtx__mult-members.html | 2 +- doc/html/interfacelinalg_1_1mtx__mult.html | 2 +- doc/html/interfacelinalg_1_1mtx__pinverse-members.html | 2 +- doc/html/interfacelinalg_1_1mtx__pinverse.html | 2 +- doc/html/interfacelinalg_1_1mtx__rank-members.html | 2 +- doc/html/interfacelinalg_1_1mtx__rank.html | 2 +- doc/html/interfacelinalg_1_1mult__lq-members.html | 2 +- doc/html/interfacelinalg_1_1mult__lq.html | 2 +- doc/html/interfacelinalg_1_1mult__qr-members.html | 2 +- doc/html/interfacelinalg_1_1mult__qr.html | 2 +- doc/html/interfacelinalg_1_1mult__rz-members.html | 2 +- doc/html/interfacelinalg_1_1mult__rz.html | 2 +- doc/html/interfacelinalg_1_1qr__factor-members.html | 2 +- doc/html/interfacelinalg_1_1qr__factor.html | 2 +- doc/html/interfacelinalg_1_1qr__rank1__update-members.html | 2 +- doc/html/interfacelinalg_1_1qr__rank1__update.html | 2 +- doc/html/interfacelinalg_1_1rank1__update-members.html | 2 +- doc/html/interfacelinalg_1_1rank1__update.html | 2 +- doc/html/interfacelinalg_1_1recip__mult__array-members.html | 2 +- doc/html/interfacelinalg_1_1recip__mult__array.html | 2 +- doc/html/interfacelinalg_1_1rz__factor-members.html | 2 +- doc/html/interfacelinalg_1_1rz__factor.html | 2 +- doc/html/interfacelinalg_1_1solve__cholesky-members.html | 2 +- doc/html/interfacelinalg_1_1solve__cholesky.html | 2 +- doc/html/interfacelinalg_1_1solve__least__squares-members.html | 2 +- doc/html/interfacelinalg_1_1solve__least__squares.html | 2 +- .../interfacelinalg_1_1solve__least__squares__full-members.html | 2 +- doc/html/interfacelinalg_1_1solve__least__squares__full.html | 2 +- .../interfacelinalg_1_1solve__least__squares__svd-members.html | 2 +- doc/html/interfacelinalg_1_1solve__least__squares__svd.html | 2 +- doc/html/interfacelinalg_1_1solve__lq-members.html | 2 +- doc/html/interfacelinalg_1_1solve__lq.html | 2 +- doc/html/interfacelinalg_1_1solve__lu-members.html | 2 +- doc/html/interfacelinalg_1_1solve__lu.html | 2 +- doc/html/interfacelinalg_1_1solve__qr-members.html | 2 +- doc/html/interfacelinalg_1_1solve__qr.html | 2 +- .../interfacelinalg_1_1solve__triangular__system-members.html | 2 +- doc/html/interfacelinalg_1_1solve__triangular__system.html | 2 +- doc/html/interfacelinalg_1_1sort-members.html | 2 +- doc/html/interfacelinalg_1_1sort.html | 2 +- doc/html/interfacelinalg_1_1svd-members.html | 2 +- doc/html/interfacelinalg_1_1svd.html | 2 +- doc/html/interfacelinalg_1_1swap-members.html | 2 +- doc/html/interfacelinalg_1_1swap.html | 2 +- doc/html/interfacelinalg_1_1trace-members.html | 2 +- doc/html/interfacelinalg_1_1trace.html | 2 +- doc/html/interfacelinalg_1_1tri__mtx__mult-members.html | 2 +- doc/html/interfacelinalg_1_1tri__mtx__mult.html | 2 +- doc/html/linalg_8f90_source.html | 2 +- doc/html/linalg_8h.html | 2 +- doc/html/linalg_8h_source.html | 2 +- doc/html/linalg__basic_8f90_source.html | 2 +- doc/html/linalg__eigen_8f90_source.html | 2 +- doc/html/linalg__factor_8f90_source.html | 2 +- doc/html/linalg__solve_8f90_source.html | 2 +- doc/html/linalg__sorting_8f90_source.html | 2 +- doc/html/namespacelinalg.html | 2 +- doc/html/namespacemembers.html | 2 +- doc/html/namespacemembers_vars.html | 2 +- doc/html/namespaces.html | 2 +- 100 files changed, 100 insertions(+), 100 deletions(-) diff --git a/doc/C/html/dir_d44c64559bbebec7f509842c48db8b23.html b/doc/C/html/dir_d44c64559bbebec7f509842c48db8b23.html index 1631d7ca..b711d2c6 100644 --- a/doc/C/html/dir_d44c64559bbebec7f509842c48db8b23.html +++ b/doc/C/html/dir_d44c64559bbebec7f509842c48db8b23.html @@ -32,7 +32,7 @@ -
                linalg 1.6.1 +
                linalg 1.7.0
                A linear algebra library that provides a user-friendly interface to several BLAS and LAPACK routines.
                diff --git a/doc/C/html/files.html b/doc/C/html/files.html index dab55ba5..3a07eeb6 100644 --- a/doc/C/html/files.html +++ b/doc/C/html/files.html @@ -32,7 +32,7 @@ -
                linalg 1.6.1 +
                linalg 1.7.0
                A linear algebra library that provides a user-friendly interface to several BLAS and LAPACK routines.
                diff --git a/doc/C/html/globals.html b/doc/C/html/globals.html index 0ffa3f4a..a8b7fb91 100644 --- a/doc/C/html/globals.html +++ b/doc/C/html/globals.html @@ -32,7 +32,7 @@ -
                linalg 1.6.1 +
                linalg 1.7.0
                A linear algebra library that provides a user-friendly interface to several BLAS and LAPACK routines.
                diff --git a/doc/C/html/globals_func.html b/doc/C/html/globals_func.html index 85652ded..c5055efb 100644 --- a/doc/C/html/globals_func.html +++ b/doc/C/html/globals_func.html @@ -32,7 +32,7 @@ -
                linalg 1.6.1 +
                linalg 1.7.0
                A linear algebra library that provides a user-friendly interface to several BLAS and LAPACK routines.
                diff --git a/doc/C/html/index.html b/doc/C/html/index.html index f3938df5..4d9437a4 100644 --- a/doc/C/html/index.html +++ b/doc/C/html/index.html @@ -32,7 +32,7 @@ -
                linalg 1.6.1 +
                linalg 1.7.0
                A linear algebra library that provides a user-friendly interface to several BLAS and LAPACK routines.
                diff --git a/doc/C/html/linalg_8h.html b/doc/C/html/linalg_8h.html index 91b5d1db..2832e335 100644 --- a/doc/C/html/linalg_8h.html +++ b/doc/C/html/linalg_8h.html @@ -32,7 +32,7 @@ -
                linalg 1.6.1 +
                linalg 1.7.0
                A linear algebra library that provides a user-friendly interface to several BLAS and LAPACK routines.
                diff --git a/doc/C/html/linalg_8h_source.html b/doc/C/html/linalg_8h_source.html index b914016e..3e409944 100644 --- a/doc/C/html/linalg_8h_source.html +++ b/doc/C/html/linalg_8h_source.html @@ -32,7 +32,7 @@ -
                linalg 1.6.1 +
                linalg 1.7.0
                A linear algebra library that provides a user-friendly interface to several BLAS and LAPACK routines.
                diff --git a/doc/html/annotated.html b/doc/html/annotated.html index 5a4e0de2..da24911e 100644 --- a/doc/html/annotated.html +++ b/doc/html/annotated.html @@ -32,7 +32,7 @@ -
                linalg 1.6.1 +
                linalg 1.7.0
                A linear algebra library that provides a user-friendly interface to several BLAS and LAPACK routines.
                diff --git a/doc/html/classes.html b/doc/html/classes.html index 751dc4d2..cf87440e 100644 --- a/doc/html/classes.html +++ b/doc/html/classes.html @@ -32,7 +32,7 @@ -
                linalg 1.6.1 +
                linalg 1.7.0
                A linear algebra library that provides a user-friendly interface to several BLAS and LAPACK routines.
                diff --git a/doc/html/dir_68267d1309a1af8e8297ef4c3efbcdba.html b/doc/html/dir_68267d1309a1af8e8297ef4c3efbcdba.html index 4dba4eb0..3e056e8b 100644 --- a/doc/html/dir_68267d1309a1af8e8297ef4c3efbcdba.html +++ b/doc/html/dir_68267d1309a1af8e8297ef4c3efbcdba.html @@ -32,7 +32,7 @@ -
                linalg 1.6.1 +
                linalg 1.7.0
                A linear algebra library that provides a user-friendly interface to several BLAS and LAPACK routines.
                diff --git a/doc/html/dir_d44c64559bbebec7f509842c48db8b23.html b/doc/html/dir_d44c64559bbebec7f509842c48db8b23.html index 62de7634..3983ecd1 100644 --- a/doc/html/dir_d44c64559bbebec7f509842c48db8b23.html +++ b/doc/html/dir_d44c64559bbebec7f509842c48db8b23.html @@ -32,7 +32,7 @@ -
                linalg 1.6.1 +
                linalg 1.7.0
                A linear algebra library that provides a user-friendly interface to several BLAS and LAPACK routines.
                diff --git a/doc/html/files.html b/doc/html/files.html index 277feb59..bad4ff5c 100644 --- a/doc/html/files.html +++ b/doc/html/files.html @@ -32,7 +32,7 @@ -
                linalg 1.6.1 +
                linalg 1.7.0
                A linear algebra library that provides a user-friendly interface to several BLAS and LAPACK routines.
                diff --git a/doc/html/globals.html b/doc/html/globals.html index 40a27cc9..33f10a3a 100644 --- a/doc/html/globals.html +++ b/doc/html/globals.html @@ -32,7 +32,7 @@ -
                linalg 1.6.1 +
                linalg 1.7.0
                A linear algebra library that provides a user-friendly interface to several BLAS and LAPACK routines.
                diff --git a/doc/html/globals_func.html b/doc/html/globals_func.html index 2f83e1a4..a24e41ab 100644 --- a/doc/html/globals_func.html +++ b/doc/html/globals_func.html @@ -32,7 +32,7 @@ -
                linalg 1.6.1 +
                linalg 1.7.0
                A linear algebra library that provides a user-friendly interface to several BLAS and LAPACK routines.
                diff --git a/doc/html/graph_legend.html b/doc/html/graph_legend.html index 7929fef5..eaf60ef5 100644 --- a/doc/html/graph_legend.html +++ b/doc/html/graph_legend.html @@ -32,7 +32,7 @@ -
                linalg 1.6.1 +
                linalg 1.7.0
                A linear algebra library that provides a user-friendly interface to several BLAS and LAPACK routines.
                diff --git a/doc/html/index.html b/doc/html/index.html index 9a7e4f32..d3e71328 100644 --- a/doc/html/index.html +++ b/doc/html/index.html @@ -32,7 +32,7 @@ -
                linalg 1.6.1 +
                linalg 1.7.0
                A linear algebra library that provides a user-friendly interface to several BLAS and LAPACK routines.
                diff --git a/doc/html/interfacelinalg_1_1cholesky__factor-members.html b/doc/html/interfacelinalg_1_1cholesky__factor-members.html index abf1be03..751bfec2 100644 --- a/doc/html/interfacelinalg_1_1cholesky__factor-members.html +++ b/doc/html/interfacelinalg_1_1cholesky__factor-members.html @@ -32,7 +32,7 @@ -
                linalg 1.6.1 +
                linalg 1.7.0
                A linear algebra library that provides a user-friendly interface to several BLAS and LAPACK routines.
                diff --git a/doc/html/interfacelinalg_1_1cholesky__factor.html b/doc/html/interfacelinalg_1_1cholesky__factor.html index 38860e7c..cfc76f2f 100644 --- a/doc/html/interfacelinalg_1_1cholesky__factor.html +++ b/doc/html/interfacelinalg_1_1cholesky__factor.html @@ -32,7 +32,7 @@ -
                linalg 1.6.1 +
                linalg 1.7.0
                A linear algebra library that provides a user-friendly interface to several BLAS and LAPACK routines.
                diff --git a/doc/html/interfacelinalg_1_1cholesky__rank1__downdate-members.html b/doc/html/interfacelinalg_1_1cholesky__rank1__downdate-members.html index f1c6480e..16ccb376 100644 --- a/doc/html/interfacelinalg_1_1cholesky__rank1__downdate-members.html +++ b/doc/html/interfacelinalg_1_1cholesky__rank1__downdate-members.html @@ -32,7 +32,7 @@ -
                linalg 1.6.1 +
                linalg 1.7.0
                A linear algebra library that provides a user-friendly interface to several BLAS and LAPACK routines.
                diff --git a/doc/html/interfacelinalg_1_1cholesky__rank1__downdate.html b/doc/html/interfacelinalg_1_1cholesky__rank1__downdate.html index 287fc6d6..0ad16f61 100644 --- a/doc/html/interfacelinalg_1_1cholesky__rank1__downdate.html +++ b/doc/html/interfacelinalg_1_1cholesky__rank1__downdate.html @@ -32,7 +32,7 @@ -
                linalg 1.6.1 +
                linalg 1.7.0
                A linear algebra library that provides a user-friendly interface to several BLAS and LAPACK routines.
                diff --git a/doc/html/interfacelinalg_1_1cholesky__rank1__update-members.html b/doc/html/interfacelinalg_1_1cholesky__rank1__update-members.html index 1bd34a89..bd46ff8a 100644 --- a/doc/html/interfacelinalg_1_1cholesky__rank1__update-members.html +++ b/doc/html/interfacelinalg_1_1cholesky__rank1__update-members.html @@ -32,7 +32,7 @@ -
                linalg 1.6.1 +
                linalg 1.7.0
                A linear algebra library that provides a user-friendly interface to several BLAS and LAPACK routines.
                diff --git a/doc/html/interfacelinalg_1_1cholesky__rank1__update.html b/doc/html/interfacelinalg_1_1cholesky__rank1__update.html index a7075811..d2db8328 100644 --- a/doc/html/interfacelinalg_1_1cholesky__rank1__update.html +++ b/doc/html/interfacelinalg_1_1cholesky__rank1__update.html @@ -32,7 +32,7 @@ -
                linalg 1.6.1 +
                linalg 1.7.0
                A linear algebra library that provides a user-friendly interface to several BLAS and LAPACK routines.
                diff --git a/doc/html/interfacelinalg_1_1det-members.html b/doc/html/interfacelinalg_1_1det-members.html index 261366d7..a06762be 100644 --- a/doc/html/interfacelinalg_1_1det-members.html +++ b/doc/html/interfacelinalg_1_1det-members.html @@ -32,7 +32,7 @@ -
                linalg 1.6.1 +
                linalg 1.7.0
                A linear algebra library that provides a user-friendly interface to several BLAS and LAPACK routines.
                diff --git a/doc/html/interfacelinalg_1_1det.html b/doc/html/interfacelinalg_1_1det.html index f856e86c..ad67383d 100644 --- a/doc/html/interfacelinalg_1_1det.html +++ b/doc/html/interfacelinalg_1_1det.html @@ -32,7 +32,7 @@ -
                linalg 1.6.1 +
                linalg 1.7.0
                A linear algebra library that provides a user-friendly interface to several BLAS and LAPACK routines.
                diff --git a/doc/html/interfacelinalg_1_1diag__mtx__mult-members.html b/doc/html/interfacelinalg_1_1diag__mtx__mult-members.html index d96b786d..5449c3e8 100644 --- a/doc/html/interfacelinalg_1_1diag__mtx__mult-members.html +++ b/doc/html/interfacelinalg_1_1diag__mtx__mult-members.html @@ -32,7 +32,7 @@ -
                linalg 1.6.1 +
                linalg 1.7.0
                A linear algebra library that provides a user-friendly interface to several BLAS and LAPACK routines.
                diff --git a/doc/html/interfacelinalg_1_1diag__mtx__mult.html b/doc/html/interfacelinalg_1_1diag__mtx__mult.html index f4ac6a5f..18d35b82 100644 --- a/doc/html/interfacelinalg_1_1diag__mtx__mult.html +++ b/doc/html/interfacelinalg_1_1diag__mtx__mult.html @@ -32,7 +32,7 @@ -
                linalg 1.6.1 +
                linalg 1.7.0
                A linear algebra library that provides a user-friendly interface to several BLAS and LAPACK routines.
                diff --git a/doc/html/interfacelinalg_1_1eigen-members.html b/doc/html/interfacelinalg_1_1eigen-members.html index b3ebdf8d..9b00a2fe 100644 --- a/doc/html/interfacelinalg_1_1eigen-members.html +++ b/doc/html/interfacelinalg_1_1eigen-members.html @@ -32,7 +32,7 @@ -
                linalg 1.6.1 +
                linalg 1.7.0
                A linear algebra library that provides a user-friendly interface to several BLAS and LAPACK routines.
                diff --git a/doc/html/interfacelinalg_1_1eigen.html b/doc/html/interfacelinalg_1_1eigen.html index 93a3f881..dcf1c39a 100644 --- a/doc/html/interfacelinalg_1_1eigen.html +++ b/doc/html/interfacelinalg_1_1eigen.html @@ -32,7 +32,7 @@ -
                linalg 1.6.1 +
                linalg 1.7.0
                A linear algebra library that provides a user-friendly interface to several BLAS and LAPACK routines.
                diff --git a/doc/html/interfacelinalg_1_1form__lq-members.html b/doc/html/interfacelinalg_1_1form__lq-members.html index 45d6f62c..53545055 100644 --- a/doc/html/interfacelinalg_1_1form__lq-members.html +++ b/doc/html/interfacelinalg_1_1form__lq-members.html @@ -32,7 +32,7 @@ -
                linalg 1.6.1 +
                linalg 1.7.0
                A linear algebra library that provides a user-friendly interface to several BLAS and LAPACK routines.
                diff --git a/doc/html/interfacelinalg_1_1form__lq.html b/doc/html/interfacelinalg_1_1form__lq.html index dc45d0c8..30ad0ba8 100644 --- a/doc/html/interfacelinalg_1_1form__lq.html +++ b/doc/html/interfacelinalg_1_1form__lq.html @@ -32,7 +32,7 @@ -
                linalg 1.6.1 +
                linalg 1.7.0
                A linear algebra library that provides a user-friendly interface to several BLAS and LAPACK routines.
                diff --git a/doc/html/interfacelinalg_1_1form__lu-members.html b/doc/html/interfacelinalg_1_1form__lu-members.html index 0955c56d..4ef53bb4 100644 --- a/doc/html/interfacelinalg_1_1form__lu-members.html +++ b/doc/html/interfacelinalg_1_1form__lu-members.html @@ -32,7 +32,7 @@ -
                linalg 1.6.1 +
                linalg 1.7.0
                A linear algebra library that provides a user-friendly interface to several BLAS and LAPACK routines.
                diff --git a/doc/html/interfacelinalg_1_1form__lu.html b/doc/html/interfacelinalg_1_1form__lu.html index fad23c5f..280960fb 100644 --- a/doc/html/interfacelinalg_1_1form__lu.html +++ b/doc/html/interfacelinalg_1_1form__lu.html @@ -32,7 +32,7 @@ -
                linalg 1.6.1 +
                linalg 1.7.0
                A linear algebra library that provides a user-friendly interface to several BLAS and LAPACK routines.
                diff --git a/doc/html/interfacelinalg_1_1form__qr-members.html b/doc/html/interfacelinalg_1_1form__qr-members.html index ba5a8619..f96c20f0 100644 --- a/doc/html/interfacelinalg_1_1form__qr-members.html +++ b/doc/html/interfacelinalg_1_1form__qr-members.html @@ -32,7 +32,7 @@ -
                linalg 1.6.1 +
                linalg 1.7.0
                A linear algebra library that provides a user-friendly interface to several BLAS and LAPACK routines.
                diff --git a/doc/html/interfacelinalg_1_1form__qr.html b/doc/html/interfacelinalg_1_1form__qr.html index 9e97285d..001c2a70 100644 --- a/doc/html/interfacelinalg_1_1form__qr.html +++ b/doc/html/interfacelinalg_1_1form__qr.html @@ -32,7 +32,7 @@ -
                linalg 1.6.1 +
                linalg 1.7.0
                A linear algebra library that provides a user-friendly interface to several BLAS and LAPACK routines.
                diff --git a/doc/html/interfacelinalg_1_1lq__factor-members.html b/doc/html/interfacelinalg_1_1lq__factor-members.html index d7026863..adc8eb28 100644 --- a/doc/html/interfacelinalg_1_1lq__factor-members.html +++ b/doc/html/interfacelinalg_1_1lq__factor-members.html @@ -32,7 +32,7 @@ -
                linalg 1.6.1 +
                linalg 1.7.0
                A linear algebra library that provides a user-friendly interface to several BLAS and LAPACK routines.
                diff --git a/doc/html/interfacelinalg_1_1lq__factor.html b/doc/html/interfacelinalg_1_1lq__factor.html index f8905f7a..99eabbaf 100644 --- a/doc/html/interfacelinalg_1_1lq__factor.html +++ b/doc/html/interfacelinalg_1_1lq__factor.html @@ -32,7 +32,7 @@ -
                linalg 1.6.1 +
                linalg 1.7.0
                A linear algebra library that provides a user-friendly interface to several BLAS and LAPACK routines.
                diff --git a/doc/html/interfacelinalg_1_1lu__factor-members.html b/doc/html/interfacelinalg_1_1lu__factor-members.html index 99ed60f5..30896d89 100644 --- a/doc/html/interfacelinalg_1_1lu__factor-members.html +++ b/doc/html/interfacelinalg_1_1lu__factor-members.html @@ -32,7 +32,7 @@ -
                linalg 1.6.1 +
                linalg 1.7.0
                A linear algebra library that provides a user-friendly interface to several BLAS and LAPACK routines.
                diff --git a/doc/html/interfacelinalg_1_1lu__factor.html b/doc/html/interfacelinalg_1_1lu__factor.html index 686e0967..08288604 100644 --- a/doc/html/interfacelinalg_1_1lu__factor.html +++ b/doc/html/interfacelinalg_1_1lu__factor.html @@ -32,7 +32,7 @@ -
                linalg 1.6.1 +
                linalg 1.7.0
                A linear algebra library that provides a user-friendly interface to several BLAS and LAPACK routines.
                diff --git a/doc/html/interfacelinalg_1_1mtx__inverse-members.html b/doc/html/interfacelinalg_1_1mtx__inverse-members.html index 8d5ebb64..048f6f0c 100644 --- a/doc/html/interfacelinalg_1_1mtx__inverse-members.html +++ b/doc/html/interfacelinalg_1_1mtx__inverse-members.html @@ -32,7 +32,7 @@ -
                linalg 1.6.1 +
                linalg 1.7.0
                A linear algebra library that provides a user-friendly interface to several BLAS and LAPACK routines.
                diff --git a/doc/html/interfacelinalg_1_1mtx__inverse.html b/doc/html/interfacelinalg_1_1mtx__inverse.html index 680051f0..d0e95ddd 100644 --- a/doc/html/interfacelinalg_1_1mtx__inverse.html +++ b/doc/html/interfacelinalg_1_1mtx__inverse.html @@ -32,7 +32,7 @@ -
                linalg 1.6.1 +
                linalg 1.7.0
                A linear algebra library that provides a user-friendly interface to several BLAS and LAPACK routines.
                diff --git a/doc/html/interfacelinalg_1_1mtx__mult-members.html b/doc/html/interfacelinalg_1_1mtx__mult-members.html index 0e93fa36..8a94c1c2 100644 --- a/doc/html/interfacelinalg_1_1mtx__mult-members.html +++ b/doc/html/interfacelinalg_1_1mtx__mult-members.html @@ -32,7 +32,7 @@ -
                linalg 1.6.1 +
                linalg 1.7.0
                A linear algebra library that provides a user-friendly interface to several BLAS and LAPACK routines.
                diff --git a/doc/html/interfacelinalg_1_1mtx__mult.html b/doc/html/interfacelinalg_1_1mtx__mult.html index e94b4c95..37a3d6d6 100644 --- a/doc/html/interfacelinalg_1_1mtx__mult.html +++ b/doc/html/interfacelinalg_1_1mtx__mult.html @@ -32,7 +32,7 @@ -
                linalg 1.6.1 +
                linalg 1.7.0
                A linear algebra library that provides a user-friendly interface to several BLAS and LAPACK routines.
                diff --git a/doc/html/interfacelinalg_1_1mtx__pinverse-members.html b/doc/html/interfacelinalg_1_1mtx__pinverse-members.html index f1cf4563..37f9cca5 100644 --- a/doc/html/interfacelinalg_1_1mtx__pinverse-members.html +++ b/doc/html/interfacelinalg_1_1mtx__pinverse-members.html @@ -32,7 +32,7 @@ -
                linalg 1.6.1 +
                linalg 1.7.0
                A linear algebra library that provides a user-friendly interface to several BLAS and LAPACK routines.
                diff --git a/doc/html/interfacelinalg_1_1mtx__pinverse.html b/doc/html/interfacelinalg_1_1mtx__pinverse.html index cf4db6f6..ff732cc4 100644 --- a/doc/html/interfacelinalg_1_1mtx__pinverse.html +++ b/doc/html/interfacelinalg_1_1mtx__pinverse.html @@ -32,7 +32,7 @@ -
                linalg 1.6.1 +
                linalg 1.7.0
                A linear algebra library that provides a user-friendly interface to several BLAS and LAPACK routines.
                diff --git a/doc/html/interfacelinalg_1_1mtx__rank-members.html b/doc/html/interfacelinalg_1_1mtx__rank-members.html index efb68bc3..9ff5e55c 100644 --- a/doc/html/interfacelinalg_1_1mtx__rank-members.html +++ b/doc/html/interfacelinalg_1_1mtx__rank-members.html @@ -32,7 +32,7 @@ -
                linalg 1.6.1 +
                linalg 1.7.0
                A linear algebra library that provides a user-friendly interface to several BLAS and LAPACK routines.
                diff --git a/doc/html/interfacelinalg_1_1mtx__rank.html b/doc/html/interfacelinalg_1_1mtx__rank.html index 85898b6b..a9402474 100644 --- a/doc/html/interfacelinalg_1_1mtx__rank.html +++ b/doc/html/interfacelinalg_1_1mtx__rank.html @@ -32,7 +32,7 @@ -
                linalg 1.6.1 +
                linalg 1.7.0
                A linear algebra library that provides a user-friendly interface to several BLAS and LAPACK routines.
                diff --git a/doc/html/interfacelinalg_1_1mult__lq-members.html b/doc/html/interfacelinalg_1_1mult__lq-members.html index 830009f5..99549a59 100644 --- a/doc/html/interfacelinalg_1_1mult__lq-members.html +++ b/doc/html/interfacelinalg_1_1mult__lq-members.html @@ -32,7 +32,7 @@ -
                linalg 1.6.1 +
                linalg 1.7.0
                A linear algebra library that provides a user-friendly interface to several BLAS and LAPACK routines.
                diff --git a/doc/html/interfacelinalg_1_1mult__lq.html b/doc/html/interfacelinalg_1_1mult__lq.html index ffc2193a..28245769 100644 --- a/doc/html/interfacelinalg_1_1mult__lq.html +++ b/doc/html/interfacelinalg_1_1mult__lq.html @@ -32,7 +32,7 @@ -
                linalg 1.6.1 +
                linalg 1.7.0
                A linear algebra library that provides a user-friendly interface to several BLAS and LAPACK routines.
                diff --git a/doc/html/interfacelinalg_1_1mult__qr-members.html b/doc/html/interfacelinalg_1_1mult__qr-members.html index 14110114..1e639215 100644 --- a/doc/html/interfacelinalg_1_1mult__qr-members.html +++ b/doc/html/interfacelinalg_1_1mult__qr-members.html @@ -32,7 +32,7 @@ -
                linalg 1.6.1 +
                linalg 1.7.0
                A linear algebra library that provides a user-friendly interface to several BLAS and LAPACK routines.
                diff --git a/doc/html/interfacelinalg_1_1mult__qr.html b/doc/html/interfacelinalg_1_1mult__qr.html index a909ca41..44cec913 100644 --- a/doc/html/interfacelinalg_1_1mult__qr.html +++ b/doc/html/interfacelinalg_1_1mult__qr.html @@ -32,7 +32,7 @@ -
                linalg 1.6.1 +
                linalg 1.7.0
                A linear algebra library that provides a user-friendly interface to several BLAS and LAPACK routines.
                diff --git a/doc/html/interfacelinalg_1_1mult__rz-members.html b/doc/html/interfacelinalg_1_1mult__rz-members.html index fd5eab53..9aa7db7b 100644 --- a/doc/html/interfacelinalg_1_1mult__rz-members.html +++ b/doc/html/interfacelinalg_1_1mult__rz-members.html @@ -32,7 +32,7 @@ -
                linalg 1.6.1 +
                linalg 1.7.0
                A linear algebra library that provides a user-friendly interface to several BLAS and LAPACK routines.
                diff --git a/doc/html/interfacelinalg_1_1mult__rz.html b/doc/html/interfacelinalg_1_1mult__rz.html index ec61427e..4c018ed3 100644 --- a/doc/html/interfacelinalg_1_1mult__rz.html +++ b/doc/html/interfacelinalg_1_1mult__rz.html @@ -32,7 +32,7 @@ -
                linalg 1.6.1 +
                linalg 1.7.0
                A linear algebra library that provides a user-friendly interface to several BLAS and LAPACK routines.
                diff --git a/doc/html/interfacelinalg_1_1qr__factor-members.html b/doc/html/interfacelinalg_1_1qr__factor-members.html index 7e4c29ea..ee0d2689 100644 --- a/doc/html/interfacelinalg_1_1qr__factor-members.html +++ b/doc/html/interfacelinalg_1_1qr__factor-members.html @@ -32,7 +32,7 @@ -
                linalg 1.6.1 +
                linalg 1.7.0
                A linear algebra library that provides a user-friendly interface to several BLAS and LAPACK routines.
                diff --git a/doc/html/interfacelinalg_1_1qr__factor.html b/doc/html/interfacelinalg_1_1qr__factor.html index b806296d..9f886367 100644 --- a/doc/html/interfacelinalg_1_1qr__factor.html +++ b/doc/html/interfacelinalg_1_1qr__factor.html @@ -32,7 +32,7 @@ -
                linalg 1.6.1 +
                linalg 1.7.0
                A linear algebra library that provides a user-friendly interface to several BLAS and LAPACK routines.
                diff --git a/doc/html/interfacelinalg_1_1qr__rank1__update-members.html b/doc/html/interfacelinalg_1_1qr__rank1__update-members.html index 8a79e9e0..13846aa5 100644 --- a/doc/html/interfacelinalg_1_1qr__rank1__update-members.html +++ b/doc/html/interfacelinalg_1_1qr__rank1__update-members.html @@ -32,7 +32,7 @@ -
                linalg 1.6.1 +
                linalg 1.7.0
                A linear algebra library that provides a user-friendly interface to several BLAS and LAPACK routines.
                diff --git a/doc/html/interfacelinalg_1_1qr__rank1__update.html b/doc/html/interfacelinalg_1_1qr__rank1__update.html index 9ad6d407..17efd021 100644 --- a/doc/html/interfacelinalg_1_1qr__rank1__update.html +++ b/doc/html/interfacelinalg_1_1qr__rank1__update.html @@ -32,7 +32,7 @@ -
                linalg 1.6.1 +
                linalg 1.7.0
                A linear algebra library that provides a user-friendly interface to several BLAS and LAPACK routines.
                diff --git a/doc/html/interfacelinalg_1_1rank1__update-members.html b/doc/html/interfacelinalg_1_1rank1__update-members.html index 89892878..db00688a 100644 --- a/doc/html/interfacelinalg_1_1rank1__update-members.html +++ b/doc/html/interfacelinalg_1_1rank1__update-members.html @@ -32,7 +32,7 @@ -
                linalg 1.6.1 +
                linalg 1.7.0
                A linear algebra library that provides a user-friendly interface to several BLAS and LAPACK routines.
                diff --git a/doc/html/interfacelinalg_1_1rank1__update.html b/doc/html/interfacelinalg_1_1rank1__update.html index fa6b8625..b58a1860 100644 --- a/doc/html/interfacelinalg_1_1rank1__update.html +++ b/doc/html/interfacelinalg_1_1rank1__update.html @@ -32,7 +32,7 @@ -
                linalg 1.6.1 +
                linalg 1.7.0
                A linear algebra library that provides a user-friendly interface to several BLAS and LAPACK routines.
                diff --git a/doc/html/interfacelinalg_1_1recip__mult__array-members.html b/doc/html/interfacelinalg_1_1recip__mult__array-members.html index 87396e08..9716f597 100644 --- a/doc/html/interfacelinalg_1_1recip__mult__array-members.html +++ b/doc/html/interfacelinalg_1_1recip__mult__array-members.html @@ -32,7 +32,7 @@ -
                linalg 1.6.1 +
                linalg 1.7.0
                A linear algebra library that provides a user-friendly interface to several BLAS and LAPACK routines.
                diff --git a/doc/html/interfacelinalg_1_1recip__mult__array.html b/doc/html/interfacelinalg_1_1recip__mult__array.html index d235e9a9..97b15ae5 100644 --- a/doc/html/interfacelinalg_1_1recip__mult__array.html +++ b/doc/html/interfacelinalg_1_1recip__mult__array.html @@ -32,7 +32,7 @@ -
                linalg 1.6.1 +
                linalg 1.7.0
                A linear algebra library that provides a user-friendly interface to several BLAS and LAPACK routines.
                diff --git a/doc/html/interfacelinalg_1_1rz__factor-members.html b/doc/html/interfacelinalg_1_1rz__factor-members.html index 20837f53..b3bcf3c5 100644 --- a/doc/html/interfacelinalg_1_1rz__factor-members.html +++ b/doc/html/interfacelinalg_1_1rz__factor-members.html @@ -32,7 +32,7 @@ -
                linalg 1.6.1 +
                linalg 1.7.0
                A linear algebra library that provides a user-friendly interface to several BLAS and LAPACK routines.
                diff --git a/doc/html/interfacelinalg_1_1rz__factor.html b/doc/html/interfacelinalg_1_1rz__factor.html index 22fae493..a9e5fb9f 100644 --- a/doc/html/interfacelinalg_1_1rz__factor.html +++ b/doc/html/interfacelinalg_1_1rz__factor.html @@ -32,7 +32,7 @@ -
                linalg 1.6.1 +
                linalg 1.7.0
                A linear algebra library that provides a user-friendly interface to several BLAS and LAPACK routines.
                diff --git a/doc/html/interfacelinalg_1_1solve__cholesky-members.html b/doc/html/interfacelinalg_1_1solve__cholesky-members.html index 5148566c..710513d5 100644 --- a/doc/html/interfacelinalg_1_1solve__cholesky-members.html +++ b/doc/html/interfacelinalg_1_1solve__cholesky-members.html @@ -32,7 +32,7 @@ -
                linalg 1.6.1 +
                linalg 1.7.0
                A linear algebra library that provides a user-friendly interface to several BLAS and LAPACK routines.
                diff --git a/doc/html/interfacelinalg_1_1solve__cholesky.html b/doc/html/interfacelinalg_1_1solve__cholesky.html index 01bb7f88..c5b73967 100644 --- a/doc/html/interfacelinalg_1_1solve__cholesky.html +++ b/doc/html/interfacelinalg_1_1solve__cholesky.html @@ -32,7 +32,7 @@ -
                linalg 1.6.1 +
                linalg 1.7.0
                A linear algebra library that provides a user-friendly interface to several BLAS and LAPACK routines.
                diff --git a/doc/html/interfacelinalg_1_1solve__least__squares-members.html b/doc/html/interfacelinalg_1_1solve__least__squares-members.html index 8837baf7..2606c393 100644 --- a/doc/html/interfacelinalg_1_1solve__least__squares-members.html +++ b/doc/html/interfacelinalg_1_1solve__least__squares-members.html @@ -32,7 +32,7 @@ -
                linalg 1.6.1 +
                linalg 1.7.0
                A linear algebra library that provides a user-friendly interface to several BLAS and LAPACK routines.
                diff --git a/doc/html/interfacelinalg_1_1solve__least__squares.html b/doc/html/interfacelinalg_1_1solve__least__squares.html index 2623eeed..612731cf 100644 --- a/doc/html/interfacelinalg_1_1solve__least__squares.html +++ b/doc/html/interfacelinalg_1_1solve__least__squares.html @@ -32,7 +32,7 @@ -
                linalg 1.6.1 +
                linalg 1.7.0
                A linear algebra library that provides a user-friendly interface to several BLAS and LAPACK routines.
                diff --git a/doc/html/interfacelinalg_1_1solve__least__squares__full-members.html b/doc/html/interfacelinalg_1_1solve__least__squares__full-members.html index 542aa680..e263086f 100644 --- a/doc/html/interfacelinalg_1_1solve__least__squares__full-members.html +++ b/doc/html/interfacelinalg_1_1solve__least__squares__full-members.html @@ -32,7 +32,7 @@ -
                linalg 1.6.1 +
                linalg 1.7.0
                A linear algebra library that provides a user-friendly interface to several BLAS and LAPACK routines.
                diff --git a/doc/html/interfacelinalg_1_1solve__least__squares__full.html b/doc/html/interfacelinalg_1_1solve__least__squares__full.html index 916fcd4b..2099aa8c 100644 --- a/doc/html/interfacelinalg_1_1solve__least__squares__full.html +++ b/doc/html/interfacelinalg_1_1solve__least__squares__full.html @@ -32,7 +32,7 @@ -
                linalg 1.6.1 +
                linalg 1.7.0
                A linear algebra library that provides a user-friendly interface to several BLAS and LAPACK routines.
                diff --git a/doc/html/interfacelinalg_1_1solve__least__squares__svd-members.html b/doc/html/interfacelinalg_1_1solve__least__squares__svd-members.html index a9d9812a..ae48b5cc 100644 --- a/doc/html/interfacelinalg_1_1solve__least__squares__svd-members.html +++ b/doc/html/interfacelinalg_1_1solve__least__squares__svd-members.html @@ -32,7 +32,7 @@ -
                linalg 1.6.1 +
                linalg 1.7.0
                A linear algebra library that provides a user-friendly interface to several BLAS and LAPACK routines.
                diff --git a/doc/html/interfacelinalg_1_1solve__least__squares__svd.html b/doc/html/interfacelinalg_1_1solve__least__squares__svd.html index b6b570fc..72a80306 100644 --- a/doc/html/interfacelinalg_1_1solve__least__squares__svd.html +++ b/doc/html/interfacelinalg_1_1solve__least__squares__svd.html @@ -32,7 +32,7 @@ -
                linalg 1.6.1 +
                linalg 1.7.0
                A linear algebra library that provides a user-friendly interface to several BLAS and LAPACK routines.
                diff --git a/doc/html/interfacelinalg_1_1solve__lq-members.html b/doc/html/interfacelinalg_1_1solve__lq-members.html index 1c900adc..c6f25590 100644 --- a/doc/html/interfacelinalg_1_1solve__lq-members.html +++ b/doc/html/interfacelinalg_1_1solve__lq-members.html @@ -32,7 +32,7 @@ -
                linalg 1.6.1 +
                linalg 1.7.0
                A linear algebra library that provides a user-friendly interface to several BLAS and LAPACK routines.
                diff --git a/doc/html/interfacelinalg_1_1solve__lq.html b/doc/html/interfacelinalg_1_1solve__lq.html index 7cc930ed..125bf99c 100644 --- a/doc/html/interfacelinalg_1_1solve__lq.html +++ b/doc/html/interfacelinalg_1_1solve__lq.html @@ -32,7 +32,7 @@ -
                linalg 1.6.1 +
                linalg 1.7.0
                A linear algebra library that provides a user-friendly interface to several BLAS and LAPACK routines.
                diff --git a/doc/html/interfacelinalg_1_1solve__lu-members.html b/doc/html/interfacelinalg_1_1solve__lu-members.html index 6da94e66..2f1541c9 100644 --- a/doc/html/interfacelinalg_1_1solve__lu-members.html +++ b/doc/html/interfacelinalg_1_1solve__lu-members.html @@ -32,7 +32,7 @@ -
                linalg 1.6.1 +
                linalg 1.7.0
                A linear algebra library that provides a user-friendly interface to several BLAS and LAPACK routines.
                diff --git a/doc/html/interfacelinalg_1_1solve__lu.html b/doc/html/interfacelinalg_1_1solve__lu.html index a46404b5..368cf464 100644 --- a/doc/html/interfacelinalg_1_1solve__lu.html +++ b/doc/html/interfacelinalg_1_1solve__lu.html @@ -32,7 +32,7 @@ -
                linalg 1.6.1 +
                linalg 1.7.0
                A linear algebra library that provides a user-friendly interface to several BLAS and LAPACK routines.
                diff --git a/doc/html/interfacelinalg_1_1solve__qr-members.html b/doc/html/interfacelinalg_1_1solve__qr-members.html index d0432978..47643682 100644 --- a/doc/html/interfacelinalg_1_1solve__qr-members.html +++ b/doc/html/interfacelinalg_1_1solve__qr-members.html @@ -32,7 +32,7 @@ -
                linalg 1.6.1 +
                linalg 1.7.0
                A linear algebra library that provides a user-friendly interface to several BLAS and LAPACK routines.
                diff --git a/doc/html/interfacelinalg_1_1solve__qr.html b/doc/html/interfacelinalg_1_1solve__qr.html index 4bc608a3..4c8e65e4 100644 --- a/doc/html/interfacelinalg_1_1solve__qr.html +++ b/doc/html/interfacelinalg_1_1solve__qr.html @@ -32,7 +32,7 @@ -
                linalg 1.6.1 +
                linalg 1.7.0
                A linear algebra library that provides a user-friendly interface to several BLAS and LAPACK routines.
                diff --git a/doc/html/interfacelinalg_1_1solve__triangular__system-members.html b/doc/html/interfacelinalg_1_1solve__triangular__system-members.html index 1e7b9f02..7bc004e1 100644 --- a/doc/html/interfacelinalg_1_1solve__triangular__system-members.html +++ b/doc/html/interfacelinalg_1_1solve__triangular__system-members.html @@ -32,7 +32,7 @@ -
                linalg 1.6.1 +
                linalg 1.7.0
                A linear algebra library that provides a user-friendly interface to several BLAS and LAPACK routines.
                diff --git a/doc/html/interfacelinalg_1_1solve__triangular__system.html b/doc/html/interfacelinalg_1_1solve__triangular__system.html index d0e562bd..1434de15 100644 --- a/doc/html/interfacelinalg_1_1solve__triangular__system.html +++ b/doc/html/interfacelinalg_1_1solve__triangular__system.html @@ -32,7 +32,7 @@ -
                linalg 1.6.1 +
                linalg 1.7.0
                A linear algebra library that provides a user-friendly interface to several BLAS and LAPACK routines.
                diff --git a/doc/html/interfacelinalg_1_1sort-members.html b/doc/html/interfacelinalg_1_1sort-members.html index ca21a437..b801be29 100644 --- a/doc/html/interfacelinalg_1_1sort-members.html +++ b/doc/html/interfacelinalg_1_1sort-members.html @@ -32,7 +32,7 @@ -
                linalg 1.6.1 +
                linalg 1.7.0
                A linear algebra library that provides a user-friendly interface to several BLAS and LAPACK routines.
                diff --git a/doc/html/interfacelinalg_1_1sort.html b/doc/html/interfacelinalg_1_1sort.html index 0b35af4a..f76ade68 100644 --- a/doc/html/interfacelinalg_1_1sort.html +++ b/doc/html/interfacelinalg_1_1sort.html @@ -32,7 +32,7 @@ -
                linalg 1.6.1 +
                linalg 1.7.0
                A linear algebra library that provides a user-friendly interface to several BLAS and LAPACK routines.
                diff --git a/doc/html/interfacelinalg_1_1svd-members.html b/doc/html/interfacelinalg_1_1svd-members.html index 0e1e3453..088f7c30 100644 --- a/doc/html/interfacelinalg_1_1svd-members.html +++ b/doc/html/interfacelinalg_1_1svd-members.html @@ -32,7 +32,7 @@ -
                linalg 1.6.1 +
                linalg 1.7.0
                A linear algebra library that provides a user-friendly interface to several BLAS and LAPACK routines.
                diff --git a/doc/html/interfacelinalg_1_1svd.html b/doc/html/interfacelinalg_1_1svd.html index 2ee1b376..1ab1615b 100644 --- a/doc/html/interfacelinalg_1_1svd.html +++ b/doc/html/interfacelinalg_1_1svd.html @@ -32,7 +32,7 @@ -
                linalg 1.6.1 +
                linalg 1.7.0
                A linear algebra library that provides a user-friendly interface to several BLAS and LAPACK routines.
                diff --git a/doc/html/interfacelinalg_1_1swap-members.html b/doc/html/interfacelinalg_1_1swap-members.html index 25b1697d..64eb2b7e 100644 --- a/doc/html/interfacelinalg_1_1swap-members.html +++ b/doc/html/interfacelinalg_1_1swap-members.html @@ -32,7 +32,7 @@ -
                linalg 1.6.1 +
                linalg 1.7.0
                A linear algebra library that provides a user-friendly interface to several BLAS and LAPACK routines.
                diff --git a/doc/html/interfacelinalg_1_1swap.html b/doc/html/interfacelinalg_1_1swap.html index bb64657b..d84fb34e 100644 --- a/doc/html/interfacelinalg_1_1swap.html +++ b/doc/html/interfacelinalg_1_1swap.html @@ -32,7 +32,7 @@ -
                linalg 1.6.1 +
                linalg 1.7.0
                A linear algebra library that provides a user-friendly interface to several BLAS and LAPACK routines.
                diff --git a/doc/html/interfacelinalg_1_1trace-members.html b/doc/html/interfacelinalg_1_1trace-members.html index 53866cf7..58874405 100644 --- a/doc/html/interfacelinalg_1_1trace-members.html +++ b/doc/html/interfacelinalg_1_1trace-members.html @@ -32,7 +32,7 @@ -
                linalg 1.6.1 +
                linalg 1.7.0
                A linear algebra library that provides a user-friendly interface to several BLAS and LAPACK routines.
                diff --git a/doc/html/interfacelinalg_1_1trace.html b/doc/html/interfacelinalg_1_1trace.html index 5040cc4a..a2b08f6a 100644 --- a/doc/html/interfacelinalg_1_1trace.html +++ b/doc/html/interfacelinalg_1_1trace.html @@ -32,7 +32,7 @@ -
                linalg 1.6.1 +
                linalg 1.7.0
                A linear algebra library that provides a user-friendly interface to several BLAS and LAPACK routines.
                diff --git a/doc/html/interfacelinalg_1_1tri__mtx__mult-members.html b/doc/html/interfacelinalg_1_1tri__mtx__mult-members.html index 664d8295..7f0b54a0 100644 --- a/doc/html/interfacelinalg_1_1tri__mtx__mult-members.html +++ b/doc/html/interfacelinalg_1_1tri__mtx__mult-members.html @@ -32,7 +32,7 @@ -
                linalg 1.6.1 +
                linalg 1.7.0
                A linear algebra library that provides a user-friendly interface to several BLAS and LAPACK routines.
                diff --git a/doc/html/interfacelinalg_1_1tri__mtx__mult.html b/doc/html/interfacelinalg_1_1tri__mtx__mult.html index e13e26e4..d78e437c 100644 --- a/doc/html/interfacelinalg_1_1tri__mtx__mult.html +++ b/doc/html/interfacelinalg_1_1tri__mtx__mult.html @@ -32,7 +32,7 @@ -
                linalg 1.6.1 +
                linalg 1.7.0
                A linear algebra library that provides a user-friendly interface to several BLAS and LAPACK routines.
                diff --git a/doc/html/linalg_8f90_source.html b/doc/html/linalg_8f90_source.html index 7f965ea2..5e70d3f3 100644 --- a/doc/html/linalg_8f90_source.html +++ b/doc/html/linalg_8f90_source.html @@ -32,7 +32,7 @@ -
                linalg 1.6.1 +
                linalg 1.7.0
                A linear algebra library that provides a user-friendly interface to several BLAS and LAPACK routines.
                diff --git a/doc/html/linalg_8h.html b/doc/html/linalg_8h.html index 345bb6b0..406c6fa2 100644 --- a/doc/html/linalg_8h.html +++ b/doc/html/linalg_8h.html @@ -32,7 +32,7 @@ -
                linalg 1.6.1 +
                linalg 1.7.0
                A linear algebra library that provides a user-friendly interface to several BLAS and LAPACK routines.
                diff --git a/doc/html/linalg_8h_source.html b/doc/html/linalg_8h_source.html index 79ace52f..de3fdd08 100644 --- a/doc/html/linalg_8h_source.html +++ b/doc/html/linalg_8h_source.html @@ -32,7 +32,7 @@ -
                linalg 1.6.1 +
                linalg 1.7.0
                A linear algebra library that provides a user-friendly interface to several BLAS and LAPACK routines.
                diff --git a/doc/html/linalg__basic_8f90_source.html b/doc/html/linalg__basic_8f90_source.html index 1a09a6fc..b8fb9246 100644 --- a/doc/html/linalg__basic_8f90_source.html +++ b/doc/html/linalg__basic_8f90_source.html @@ -32,7 +32,7 @@ -
                linalg 1.6.1 +
                linalg 1.7.0
                A linear algebra library that provides a user-friendly interface to several BLAS and LAPACK routines.
                diff --git a/doc/html/linalg__eigen_8f90_source.html b/doc/html/linalg__eigen_8f90_source.html index d3035a8a..caeffb80 100644 --- a/doc/html/linalg__eigen_8f90_source.html +++ b/doc/html/linalg__eigen_8f90_source.html @@ -32,7 +32,7 @@ -
                linalg 1.6.1 +
                linalg 1.7.0
                A linear algebra library that provides a user-friendly interface to several BLAS and LAPACK routines.
                diff --git a/doc/html/linalg__factor_8f90_source.html b/doc/html/linalg__factor_8f90_source.html index bf7b8706..d9407986 100644 --- a/doc/html/linalg__factor_8f90_source.html +++ b/doc/html/linalg__factor_8f90_source.html @@ -32,7 +32,7 @@ -
                linalg 1.6.1 +
                linalg 1.7.0
                A linear algebra library that provides a user-friendly interface to several BLAS and LAPACK routines.
                diff --git a/doc/html/linalg__solve_8f90_source.html b/doc/html/linalg__solve_8f90_source.html index 6da85cd8..63925d61 100644 --- a/doc/html/linalg__solve_8f90_source.html +++ b/doc/html/linalg__solve_8f90_source.html @@ -32,7 +32,7 @@ -
                linalg 1.6.1 +
                linalg 1.7.0
                A linear algebra library that provides a user-friendly interface to several BLAS and LAPACK routines.
                diff --git a/doc/html/linalg__sorting_8f90_source.html b/doc/html/linalg__sorting_8f90_source.html index 7c2a6ed4..2437452a 100644 --- a/doc/html/linalg__sorting_8f90_source.html +++ b/doc/html/linalg__sorting_8f90_source.html @@ -32,7 +32,7 @@ -
                linalg 1.6.1 +
                linalg 1.7.0
                A linear algebra library that provides a user-friendly interface to several BLAS and LAPACK routines.
                diff --git a/doc/html/namespacelinalg.html b/doc/html/namespacelinalg.html index d0bdd60c..b83cc70f 100644 --- a/doc/html/namespacelinalg.html +++ b/doc/html/namespacelinalg.html @@ -32,7 +32,7 @@ -
                linalg 1.6.1 +
                linalg 1.7.0
                A linear algebra library that provides a user-friendly interface to several BLAS and LAPACK routines.
                diff --git a/doc/html/namespacemembers.html b/doc/html/namespacemembers.html index 65201632..943ac932 100644 --- a/doc/html/namespacemembers.html +++ b/doc/html/namespacemembers.html @@ -32,7 +32,7 @@ -
                linalg 1.6.1 +
                linalg 1.7.0
                A linear algebra library that provides a user-friendly interface to several BLAS and LAPACK routines.
                diff --git a/doc/html/namespacemembers_vars.html b/doc/html/namespacemembers_vars.html index 11fe5086..b1a772f1 100644 --- a/doc/html/namespacemembers_vars.html +++ b/doc/html/namespacemembers_vars.html @@ -32,7 +32,7 @@ -
                linalg 1.6.1 +
                linalg 1.7.0
                A linear algebra library that provides a user-friendly interface to several BLAS and LAPACK routines.
                diff --git a/doc/html/namespaces.html b/doc/html/namespaces.html index 55194aab..884b60f8 100644 --- a/doc/html/namespaces.html +++ b/doc/html/namespaces.html @@ -32,7 +32,7 @@ -
                linalg 1.6.1 +
                linalg 1.7.0
                A linear algebra library that provides a user-friendly interface to several BLAS and LAPACK routines.